Initial integration of ansi branch into mainline (untested).
Malcolm Beattie [Tue, 11 Nov 1997 16:36:22 +0000 (16:36 +0000)]
p4raw-id: //depot/perl@230

14 files changed:
1  2 
ext/Opcode/Opcode.pm
ext/Thread/Thread.xs
mg.c
op.c
opcode.h
opcode.pl
perl.c
perl.h
pp.c
pp_ctl.c
pp_sys.c
thread.h
toke.c
util.c

Simple merge
Simple merge
diff --cc mg.c
Simple merge
diff --cc op.c
Simple merge
diff --cc opcode.h
+++ b/opcode.h
@@@ -1439,12 -1441,14 +1441,14 @@@ OP * pp_egrent       _((ARGSproto))
  OP *  pp_getlogin     _((ARGSproto));
  OP *  pp_syscall      _((ARGSproto));
  OP *  pp_lock         _((ARGSproto));
 -OP *  pp_specific     _((ARGSproto));
 +OP *  pp_threadsv     _((ARGSproto));
  
+ END_EXTERN_C
  #ifndef DOINIT
- EXT OP * (*ppaddr[])();
+ EXT OP * (*ppaddr[])(ARGSproto);
  #else
- EXT OP * (*ppaddr[])() = {
+ EXT OP * (*ppaddr[])(ARGSproto) = {
        pp_null,
        pp_stub,
        pp_scalar,
diff --cc opcode.pl
Simple merge
diff --cc perl.c
--- 1/perl.c
--- 2/perl.c
+++ b/perl.c
@@@ -1082,21 -1078,9 +1078,19 @@@ perl_run(PerlInterpreter *sv_interp
  }
  
  SV*
- perl_get_sv(name, create)
- char* name;
- I32 create;
+ perl_get_sv(char *name, I32 create)
  {
 -    GV* gv = gv_fetchpv(name, create, SVt_PV);
 +    GV *gv;
 +#ifdef USE_THREADS
 +    if (name[1] == '\0' && !isALPHA(name[0])) {
 +      PADOFFSET tmp = find_thread_magical(name);
 +      if (tmp != NOT_IN_PAD) {
 +          dTHR;
 +          return *av_fetch(thr->magicals, tmp, FALSE);
 +      }
 +    }
 +#endif /* USE_THREADS */
 +    gv = gv_fetchpv(name, create, SVt_PV);
      if (gv)
        return GvSV(gv);
      return Nullsv;
@@@ -1813,11 -1781,11 +1791,11 @@@ init_main_stash(void
      incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV)));
      GvMULTI_on(incgv);
      defgv = gv_fetchpv("_",TRUE, SVt_PVAV);
-     errgv = gv_HVadd(gv_fetchpv("@", TRUE, SVt_PV));
-     GvMULTI_on(errgv);
+     errsv = newSVpv("", 0);
+     errhv = newHV();
      (void)form("%240s","");   /* Preallocate temp - for immediate signals. */
 -    sv_grow(errsv, 240);      /* Preallocate - for immediate signals. */
 -    sv_setpvn(errsv, "", 0);
 +    sv_grow(ERRSV, 240);      /* Preallocate - for immediate signals. */
 +    sv_setpvn(ERRSV, "", 0);
      curstash = defstash;
      compiling.cop_stash = defstash;
      debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
@@@ -2915,10 -2870,9 +2882,10 @@@ call_list(I32 oldscope, AV *list
        JMPENV_PUSH(ret);
        switch (ret) {
        case 0: {
 +              SV* atsv = ERRSV;
                PUSHMARK(stack_sp);
                perl_call_sv((SV*)cv, G_EVAL|G_DISCARD);
-               (void)SvPV(atsv, len);
+               (void)SvPV(errsv, len);
                if (len) {
                    JMPENV_POP;
                    curcop = &compiling;
diff --cc perl.h
Simple merge
diff --cc pp.c
Simple merge
diff --cc pp_ctl.c
Simple merge
diff --cc pp_sys.c
Simple merge
diff --cc thread.h
Simple merge
diff --cc toke.c
Simple merge
diff --cc util.c
--- 1/util.c
--- 2/util.c
+++ b/util.c
@@@ -2499,92 -2407,111 +2407,206 @@@ condpair_magic(SV *sv
   * thread calling new_struct_thread) clearly satisfies this constraint.
   */
  struct thread *
 +new_struct_thread(t)
 +struct thread *t;
 +{
 +    struct thread *thr;
 +    SV *sv;
 +    SV **svp;
 +    I32 i;
 +
 +    sv = newSVpv("", 0);
 +    SvGROW(sv, sizeof(struct thread) + 1);
 +    SvCUR_set(sv, sizeof(struct thread));
 +    thr = (Thread) SvPVX(sv);
 +    /* Zero(thr, 1, struct thread); */
 +
 +    /* debug */
 +    memset(thr, 0xab, sizeof(struct thread));
 +    markstack = 0;
 +    scopestack = 0;
 +    savestack = 0;
 +    retstack = 0;
 +    dirty = 0;
 +    localizing = 0;
 +    /* end debug */
 +
 +    thr->oursv = sv;
 +    init_stacks(thr);
 +
 +    curcop = &compiling;
 +    thr->cvcache = newHV();
 +    thr->magicals = newAV();
 +    thr->specific = newAV();
 +    thr->errsv = newSVpv("", 0);
 +    thr->errhv = newHV();
 +    thr->flags = THRf_R_JOINABLE;
 +    MUTEX_INIT(&thr->mutex);
 +
 +    curcop = t->Tcurcop;       /* XXX As good a guess as any? */
 +    defstash = t->Tdefstash;   /* XXX maybe these should */
 +    curstash = t->Tcurstash;   /* always be set to main? */
 +    /* top_env needs to be non-zero. The particular value doesn't matter */
 +    top_env = t->Ttop_env;
 +    runlevel = 1;             /* XXX should be safe ? */
 +    in_eval = FALSE;
 +    restartop = 0;
 +
 +    tainted = t->Ttainted;
 +    curpm = t->Tcurpm;         /* XXX No PMOP ref count */
 +    nrs = newSVsv(t->Tnrs);
 +    rs = newSVsv(t->Trs);
 +    last_in_gv = (GV*)SvREFCNT_inc(t->Tlast_in_gv);
 +    ofslen = t->Tofslen;
 +    ofs = savepvn(t->Tofs, ofslen);
 +    defoutgv = (GV*)SvREFCNT_inc(t->Tdefoutgv);
 +    chopset = t->Tchopset;
 +    formtarget = newSVsv(t->Tformtarget);
 +    bodytarget = newSVsv(t->Tbodytarget);
 +    toptarget = newSVsv(t->Ttoptarget);
 +    
 +    /* Initialise all per-thread magicals that the template thread used */
 +    svp = AvARRAY(t->magicals);
 +    for (i = 0; i <= AvFILL(t->magicals); i++, svp++) {
 +      if (*svp && *svp != &sv_undef) {
 +          SV *sv = newSVsv(*svp);
 +          av_store(thr->magicals, i, sv);
 +          sv_magic(sv, 0, 0, &per_thread_magicals[i], 1);
 +          DEBUG_L(PerlIO_printf(PerlIO_stderr(),
 +                                "new_struct_thread: copied magical %d\n",i));
 +      }
 +    } 
 +
 +    MUTEX_LOCK(&threads_mutex);
 +    nthreads++;
 +    thr->tid = ++threadnum;
 +    thr->next = t->next;
 +    thr->prev = t;
 +    t->next = thr;
 +    thr->next->prev = thr;
 +    MUTEX_UNLOCK(&threads_mutex);
 +
 +#ifdef HAVE_THREAD_INTERN
 +    init_thread_intern(thr);
 +#else
 +    thr->self = pthread_self();
 +#endif /* HAVE_THREAD_INTERN */
 +    return thr;
 +}
++
++/*
++ * Make a new perl thread structure using t as a prototype. Some of the
++ * fields for the new thread are copied from the prototype thread, t,
++ * so t should not be running in perl at the time this function is
++ * called. The use by ext/Thread/Thread.xs in core perl (where t is the
++ * thread calling new_struct_thread) clearly satisfies this constraint.
++ */
++struct thread *
+ new_struct_thread(struct thread *t)
+ {
+     struct thread *thr;
+     SV *sv;
+     SV **svp;
+     I32 i;
+     sv = newSVpv("", 0);
+     SvGROW(sv, sizeof(struct thread) + 1);
+     SvCUR_set(sv, sizeof(struct thread));
+     thr = (Thread) SvPVX(sv);
+     /* debug */
+     memset(thr, 0xab, sizeof(struct thread));
+     markstack = 0;
+     scopestack = 0;
+     savestack = 0;
+     retstack = 0;
+     dirty = 0;
+     localizing = 0;
+     /* end debug */
+     thr->oursv = sv;
+     init_stacks(ARGS);
+     curcop = &compiling;
+     thr->cvcache = newHV();
+     thr->magicals = newAV();
+     thr->specific = newAV();
+     thr->flags = THRf_R_JOINABLE;
+     MUTEX_INIT(&thr->mutex);
+     curcop = t->Tcurcop;       /* XXX As good a guess as any? */
+     defstash = t->Tdefstash;   /* XXX maybe these should */
+     curstash = t->Tcurstash;   /* always be set to main? */
+     /* top_env needs to be non-zero. It points to an area
+        in which longjmp() stuff is stored, as C callstack
+        info there at least is thread specific this has to
+        be per-thread. Otherwise a 'die' in a thread gives
+        that thread the C stack of last thread to do an eval {}!
+        See comments in scope.h    
+        Initialize top entry (as in perl.c for main thread)
+      */
+     start_env.je_prev = NULL;
+     start_env.je_ret = -1;
+     start_env.je_mustcatch = TRUE;
+     top_env  = &start_env;
+     runlevel = 0;             /* Let entering sub do increment */
+     in_eval = FALSE;
+     restartop = 0;
+     tainted = t->Ttainted;
+     curpm = t->Tcurpm;         /* XXX No PMOP ref count */
+     nrs = newSVsv(t->Tnrs);
+     rs = newSVsv(t->Trs);
+     last_in_gv = (GV*)SvREFCNT_inc(t->Tlast_in_gv);
+     ofslen = t->Tofslen;
+     ofs = savepvn(t->Tofs, ofslen);
+     defoutgv = (GV*)SvREFCNT_inc(t->Tdefoutgv);
+     chopset = t->Tchopset;
+     formtarget = newSVsv(t->Tformtarget);
+     bodytarget = newSVsv(t->Tbodytarget);
+     toptarget = newSVsv(t->Ttoptarget);
+     
+     /* Initialise all per-thread magicals that the template thread used */
+     svp = AvARRAY(t->magicals);
+     for (i = 0; i <= AvFILL(t->magicals); i++, svp++) {
+       if (*svp && *svp != &sv_undef) {
+           SV *sv = newSVsv(*svp);
+           av_store(thr->magicals, i, sv);
+           sv_magic(sv, 0, 0, &per_thread_magicals[i], 1);
+           DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+                                 "new_struct_thread: copied magical %d %p->%p\n",i,
+                                   t, thr));
+       }
+     } 
+     MUTEX_LOCK(&threads_mutex);
+     nthreads++;
+     thr->tid = ++threadnum;
+     thr->next = t->next;
+     thr->prev = t;
+     t->next = thr;
+     thr->next->prev = thr;
+     MUTEX_UNLOCK(&threads_mutex);
+ /*
+  * This is highly suspect - new_struct_thread is executed
+  * by creating thread so pthread_self() or equivalent
+  * is parent thread not the child.
+  * In particular this should _NOT_ change dTHR value of calling thread.
+  * 
+  * But a good place to have a 'hook' for filling in port-private
+  * fields of thr. 
+  */
+ #ifdef INIT_THREAD_INTERN
+     INIT_THREAD_INTERN(thr);
+ #else
+     thr->self = pthread_self();
+ #endif /* HAVE_THREAD_INTERN */
+     return thr;
+ }
  #endif /* USE_THREADS */
  
  #ifdef HUGE_VAL