Assorted changes for multi-threading (now works rather more).

p4raw-id: //depot/perl@44

diff --git a/README.threads b/README.threads
new file mode 100644 (file)
index 0000000..7dae3ef
--- /dev/null
+++ b/README.threads
@@ -0,0 +1,52 @@
+Some old globals (e.g. stack_sp, op) and some old per-interpreter
+variables (e.g. tmps_stack, cxstack) move into struct thread.
+All fields of struct thread (apart from a few only applicable to
+FAKE_THREADS) are of the form Tfoo. For example, stack_sp becomes
+the field Tstack_sp of struct thread. For those fields which moved
+from original perl, thread.h does
+    #define foo (thr->Tfoo)
+This means that all functions in perl which need to use one of these
+fields need an (automatic) variable thr which points at the current
+thread's struct thread. For pp_foo functions, it is passed around as
+an argument, for other functions they do
+    dTHR;
+which declares and initialises thr from thread-specific data
+via pthread_getspecific. If a function fails to compile with an
+error about "no such variable thr", it probably just needs a dTHR
+at the top.
+
+For FAKE_THREADS, thr is a global variable and perl schedules threads
+by altering thr in between appropriate ops. The next and prev fields
+of struct thread keep all fake threads on a doubly linked list and
+the next_run and prev_run fields keep all runnable threads on a
+doubly linked list. Mutexes are stubs for FAKE_THREADS. Condition
+variables are implemented as a list of waiting threads.
+
+
+Mutexes and condition variables
+
+The API is via macros MUTEX_{INIT,LOCK,UNLOCK,DESTROY} and
+COND_{INIT,WAIT,SIGNAL,BROADCAST,DESTROY}. For POSIX threads,
+perl mutexes and condition variables correspond to POSIX ones.
+For FAKE_THREADS, mutexes are stubs and condition variables are
+implmented as lists of waiting threads. For FAKE_THREADS, a thread
+waits on a condition variable by removing itself from the runnable
+list, calling SCHEDULE to change thr to the next appropriate
+runnable thread and returning op (i.e. the new threads next op).
+This means that fake threads can only block while in PP code.
+A PP function which contains a COND_WAIT must be prepared to
+handle such restarts and can use the field "private" of struct
+thread to record its state. For fake threads, COND_SIGNAL and
+COND_BROADCAST work by putting back all the threads on the
+condition variables list into the run queue. Note that a mutex
+must *not* be held while returning from a PP function.
+
+Perl locks are a condpair_t structure (a triple of a mutex, a
+condtion variable and an owner thread field) attached by 'm'
+magic to any SV. pp_lock locks such an object by waiting on the
+condition variable until the owner field is zero and then setting
+the owner field to its own thread pointer. The lock is recursive
+so if the owner field already matches the current thread then
+pp_lock returns straight away. If the owner field has to be filled
+in then unlock_condpair is queued as an end-of-block destructor and
+that function zeroes out the owner field, releasing the lock.

diff --git a/gv.c b/gv.c
index 01cad2e..5dcf8e0 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -93,6 +93,7 @@ char *name;
 STRLEN len;
 int multi;
 {
+    dTHR;
     register GP *gp;
 
     sv_upgrade((SV*)gv, SVt_PVGV);
@@ -261,6 +262,7 @@ HV* stash;
 char* name;
 I32 autoload;
 {
+    dTHR;
     register char *nend;
     char *nsplit = 0;
     GV* gv;

diff --git a/mg.c b/mg.c
index 960e0c1..305f00f 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -491,7 +491,7 @@ MAGIC *mg;
     case '/':
        break;
     case '[':
-       sv_setiv(sv, (IV)curcop->cop_arybase);
+       WITH_THR(sv_setiv(sv, (IV)curcop->cop_arybase));
        break;
     case '|':
        sv_setiv(sv, (IV)(IoFLAGS(GvIOp(defoutgv)) & IOf_FLUSH) != 0 );
@@ -967,6 +967,7 @@ magic_getarylen(sv,mg)
 SV* sv;
 MAGIC* mg;
 {
+    dTHR;
     sv_setiv(sv, AvFILL((AV*)mg->mg_obj) + curcop->cop_arybase);
     return 0;
 }
@@ -976,6 +977,7 @@ magic_setarylen(sv,mg)
 SV* sv;
 MAGIC* mg;
 {
+    dTHR;
     av_fill((AV*)mg->mg_obj, SvIV(sv) - curcop->cop_arybase);
     return 0;
 }
@@ -990,6 +992,7 @@ MAGIC* mg;
     if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) {
        mg = mg_find(lsv, 'g');
        if (mg && mg->mg_len >= 0) {
+           dTHR;
            sv_setiv(sv, mg->mg_len + curcop->cop_arybase);
            return 0;
        }
@@ -1023,7 +1026,7 @@ MAGIC* mg;
     }
     len = SvPOK(lsv) ? SvCUR(lsv) : sv_len(lsv);
 
-    pos = SvIV(sv) - curcop->cop_arybase;
+    WITH_THR(pos = SvIV(sv) - curcop->cop_arybase);
     if (pos < 0) {
        pos += len;
        if (pos < 0)

diff --git a/op.c b/op.c
index bd2f09a..4c2f5fb 100644 (file)
--- a/op.c
+++ b/op.c
@@ -637,6 +637,7 @@ OP *o;
 {
     if (dowarn &&
        o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) {
+       dTHR;
        line_t oldline = curcop->cop_line;
 
        if (copline != NOLINE)
@@ -697,7 +698,7 @@ OP *o;
            else
                scalar(kid);
        }
-       curcop = &compiling;
+       WITH_THR(curcop = &compiling);
        break;
     case OP_SCOPE:
     case OP_LINESEQ:
@@ -708,7 +709,7 @@ OP *o;
            else
                scalar(kid);
        }
-       curcop = &compiling;
+       WITH_THR(curcop = &compiling);
        break;
     }
     return o;
@@ -821,7 +822,7 @@ OP *o;
 
     case OP_NEXTSTATE:
     case OP_DBSTATE:
-       curcop = ((COP*)o);             /* for warning below */
+       WITH_THR(curcop = ((COP*)o));           /* for warning below */
        break;
 
     case OP_CONST:
@@ -860,7 +861,7 @@ OP *o;
 
     case OP_NULL:
        if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
-           curcop = ((COP*)o);         /* for warning below */
+           WITH_THR(curcop = ((COP*)o));       /* for warning below */
        if (o->op_flags & OPf_STACKED)
            break;
        /* FALL THROUGH */
@@ -957,7 +958,7 @@ OP *o;
            else
                list(kid);
        }
-       curcop = &compiling;
+       WITH_THR(curcop = &compiling);
        break;
     case OP_SCOPE:
     case OP_LINESEQ:
@@ -967,7 +968,7 @@ OP *o;
            else
                list(kid);
        }
-       curcop = &compiling;
+       WITH_THR(curcop = &compiling);
        break;
     case OP_REQUIRE:
        /* all requires must return a boolean value */
@@ -989,6 +990,7 @@ OP *o;
             o->op_type == OP_LEAVE ||
             o->op_type == OP_LEAVETRY)
        {
+           dTHR;
            for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
                if (kid->op_sibling) {
                    scalarvoid(kid);

diff --git a/perl.c b/perl.c
index edaf972..1cd136e 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -97,9 +97,9 @@ void
 perl_construct( sv_interp )
 register PerlInterpreter *sv_interp;
 {
-#ifdef USE_THREADS
+#if defined(USE_THREADS) && !defined(FAKE_THREADS)
     struct thread *thr;
-#endif /* USE_THREADS */
+#endif
     
     if (!(curinterp = sv_interp))
        return;
@@ -113,14 +113,22 @@ register PerlInterpreter *sv_interp;
     pthread_init();
 #endif /* NEED_PTHREAD_INIT */
     New(53, thr, 1, struct thread);
+#ifdef FAKE_THREADS
+    self = thr;
+    thr->next = thr->prev = thr->next_run = thr->prev_run = thr;
+    thr->wait_queue = 0;
+    thr->private = 0;
+#else
     self = pthread_self();
     if (pthread_key_create(&thr_key, thread_destruct))
        croak("panic: pthread_key_create");
     if (pthread_setspecific(thr_key, (void *) thr))
        croak("panic: pthread_setspecific");
+#endif /* !FAKE_THREADS */
     nthreads = 1;
     cvcache = newHV();
     thrflags = 0;
+    curcop = &compiling;
 #endif /* USE_THREADS */
 
     /* Init the real globals? */
@@ -240,6 +248,7 @@ register PerlInterpreter *sv_interp;
        return;
 
 #ifdef USE_THREADS
+#ifndef FAKE_THREADS
     /* Wait until all user-created threads go away */
     MUTEX_LOCK(&nthreads_mutex);
     while (nthreads > 1)
@@ -253,6 +262,7 @@ register PerlInterpreter *sv_interp;
     DEBUG_L(fprintf(stderr, "perl_destruct: armageddon has arrived\n"));
     MUTEX_DESTROY(&nthreads_mutex);
     COND_DESTROY(&nthreads_cond);
+#endif /* !defined(FAKE_THREADS) */
 #endif /* USE_THREADS */
 
     destruct_level = perl_destruct_level;
@@ -1715,6 +1725,7 @@ bool dosearch;
 SV *sv;
 #endif
 {
+    dTHR;
     char *xfound = Nullch;
     char *xfailed = Nullch;
     register char *s;

diff --git a/perl.h b/perl.h
index 64d47ac..9507f8b 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -62,6 +62,7 @@ register struct op *op asm(stringify(OP_IN_REGISTER));
 
 #define NOOP (void)0
 
+#define WITH_THR(s) do { dTHR; s; } while (0)
 #ifdef USE_THREADS
 #ifdef FAKE_THREADS
 #include "fakethr.h"
@@ -69,6 +70,7 @@ register struct op *op asm(stringify(OP_IN_REGISTER));
 #include <pthread.h>
 typedef pthread_mutex_t perl_mutex;
 typedef pthread_cond_t perl_cond;
+typedef pthread_key_t perl_key;
 #endif /* FAKE_THREADS */
 #endif /* USE_THREADS */
 
@@ -1323,7 +1325,7 @@ typedef Sighandler_t Sigsave_t;
 /* global state */
 EXT PerlInterpreter *  curinterp;      /* currently running interpreter */
 #ifdef USE_THREADS
-EXT pthread_key_t      thr_key;        /* For per-thread struct thread ptr */
+EXT perl_key           thr_key;        /* For per-thread struct thread ptr */
 EXT perl_mutex         sv_mutex;       /* Mutex for allocating SVs in sv.c */
 EXT perl_mutex         malloc_mutex;   /* Mutex for malloc */
 EXT perl_mutex         eval_mutex;     /* Mutex for doeval */
@@ -1332,6 +1334,9 @@ EXT struct thread *       eval_owner;     /* Owner thread for doeval */
 EXT int                        nthreads;       /* Number of threads currently */
 EXT perl_mutex         nthreads_mutex; /* Mutex for nthreads */
 EXT perl_cond          nthreads_cond;  /* Condition variable for nthreads */
+#ifdef FAKE_THREADS
+EXT struct thread *    thr;            /* Currently executing (fake) thread */
+#endif
 #endif /* USE_THREADS */
 
 /* VMS doesn't use environ array and NeXT has problems with crt0.o globals */
@@ -1904,9 +1909,11 @@ IEXT I32 Irunlevel;
 /* stack stuff */
 IEXT AV *      Icurstack;              /* THE STACK */
 IEXT AV *      Imainstack;     /* the stack when nothing funny is happening */
+#if 0
 IEXT SV **     Imystack_base;  /* stack->array_ary */
 IEXT SV **     Imystack_sp;    /* stack pointer now */
 IEXT SV **     Imystack_max;   /* stack->array_ary + stack->array_max */
+#endif
 
 /* format accumulators */
 IEXT SV *      Iformtarget;

diff --git a/pp_ctl.c b/pp_ctl.c
index 3101e5c..a2074c2 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2123,6 +2123,7 @@ OP *o;
     return Nullop;
 }
 
+/* With USE_THREADS, eval_owner must be held on entry to doeval */
 static OP *
 doeval(gimme)
 int gimme;
@@ -2134,14 +2135,6 @@ int gimme;
     CV *caller;
     AV* comppadlist;
 
-#ifdef USE_THREADS
-    MUTEX_LOCK(&eval_mutex);
-    if (eval_owner && eval_owner != thr)
-       while (eval_owner)
-           COND_WAIT(&eval_cond, &eval_mutex);
-    eval_owner = thr;
-    MUTEX_UNLOCK(&eval_mutex);
-#endif /* USE_THREADS */
     in_eval = 1;
 
     PUSHMARK(SP);
@@ -2406,6 +2399,14 @@ PP(pp_require)
     compiling.cop_line = 0;
 
     PUTBACK;
+#ifdef USE_THREADS
+    MUTEX_LOCK(&eval_mutex);
+    if (eval_owner && eval_owner != thr)
+       while (eval_owner)
+           COND_WAIT(&eval_cond, &eval_mutex);
+    eval_owner = thr;
+    MUTEX_UNLOCK(&eval_mutex);
+#endif /* USE_THREADS */
     return DOCATCH(doeval(G_SCALAR));
 }
 
@@ -2458,6 +2459,14 @@ PP(pp_entereval)
     if (perldb && curstash != debstash)
        save_lines(GvAV(compiling.cop_filegv), linestr);
     PUTBACK;
+#ifdef USE_THREADS
+    MUTEX_LOCK(&eval_mutex);
+    if (eval_owner && eval_owner != thr)
+       while (eval_owner)
+           COND_WAIT(&eval_cond, &eval_mutex);
+    eval_owner = thr;
+    MUTEX_UNLOCK(&eval_mutex);
+#endif /* USE_THREADS */
     ret = doeval(gimme);
     if (perldb && was != sub_generation) { /* Some subs defined here. */
        strcpy(safestr, "_<(eval )");   /* Anything fake and short. */

diff --git a/pp_hot.c b/pp_hot.c
index 07f0754..87bcad2 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2125,6 +2125,8 @@ PP(pp_entersub)
            AV* av;
            SV** ary;
 
+           DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+                                 "%p entersub preparing @_\n", thr));
            av = (AV*)curpad[0];
            if (AvREAL(av)) {
                av_clear(av);
@@ -2159,6 +2161,8 @@ PP(pp_entersub)
                MARK++;
            }
        }
+       DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+                             "%p entersub returning %p\n", thr, CvSTART(cv)));
        RETURNOP(CvSTART(cv));
     }
 }

diff --git a/sv.c b/sv.c
index a23ac14..2868073 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -57,6 +57,7 @@ static void del_xpv _((XPV* p));
 static void del_xrv _((XRV* p));
 static void sv_mortalgrow _((void));
 static void sv_unglob _((SV* sv));
+static void sv_check_thinkfirst _((SV *sv));
 
 typedef void (*SVFUNC) _((SV*));
 
@@ -1093,12 +1094,7 @@ sv_setiv(sv,i)
 register SV *sv;
 IV i;
 {
-    if (SvTHINKFIRST(sv)) {
-       if (SvREADONLY(sv) && curcop != &compiling)
-           croak(no_modify);
-       if (SvROK(sv))
-           sv_unref(sv);
-    }
+    sv_check_thinkfirst(sv);
     switch (SvTYPE(sv)) {
     case SVt_NULL:
        sv_upgrade(sv, SVt_IV);
@@ -1149,12 +1145,7 @@ sv_setnv(sv,num)
 register SV *sv;
 double num;
 {
-    if (SvTHINKFIRST(sv)) {
-       if (SvREADONLY(sv) && curcop != &compiling)
-           croak(no_modify);
-       if (SvROK(sv))
-           sv_unref(sv);
-    }
+    sv_check_thinkfirst(sv);
     switch (SvTYPE(sv)) {
     case SVt_NULL:
     case SVt_IV:
@@ -1845,12 +1836,7 @@ register SV *sstr;
 
     if (sstr == dstr)
        return;
-    if (SvTHINKFIRST(dstr)) {
-       if (SvREADONLY(dstr) && curcop != &compiling)
-           croak(no_modify);
-       if (SvROK(dstr))
-           sv_unref(dstr);
-    }
+    sv_check_thinkfirst(dstr);
     if (!sstr)
        sstr = &sv_undef;
     stype = SvTYPE(sstr);
@@ -2183,12 +2169,7 @@ register STRLEN len;
 {
     assert(len >= 0);  /* STRLEN is probably unsigned, so this may
                          elicit a warning, but it won't hurt. */
-    if (SvTHINKFIRST(sv)) {
-       if (SvREADONLY(sv) && curcop != &compiling)
-           croak(no_modify);
-       if (SvROK(sv))
-           sv_unref(sv);
-    }
+    sv_check_thinkfirst(sv);
     if (!ptr) {
        (void)SvOK_off(sv);
        return;
@@ -2214,12 +2195,7 @@ register const char *ptr;
 {
     register STRLEN len;
 
-    if (SvTHINKFIRST(sv)) {
-       if (SvREADONLY(sv) && curcop != &compiling)
-           croak(no_modify);
-       if (SvROK(sv))
-           sv_unref(sv);
-    }
+    sv_check_thinkfirst(sv);
     if (!ptr) {
        (void)SvOK_off(sv);
        return;
@@ -2244,12 +2220,7 @@ register SV *sv;
 register char *ptr;
 register STRLEN len;
 {
-    if (SvTHINKFIRST(sv)) {
-       if (SvREADONLY(sv) && curcop != &compiling)
-           croak(no_modify);
-       if (SvROK(sv))
-           sv_unref(sv);
-    }
+    sv_check_thinkfirst(sv);
     if (!SvUPGRADE(sv, SVt_PV))
        return;
     if (!ptr) {
@@ -2267,6 +2238,21 @@ register STRLEN len;
     SvTAINT(sv);
 }
 
+static void
+sv_check_thinkfirst(sv)
+register SV *sv;
+{
+    if (SvTHINKFIRST(sv)) {
+       if (SvREADONLY(sv)) {
+           dTHR;
+           if (curcop != &compiling)
+               croak(no_modify);
+       }
+       if (SvROK(sv))
+           sv_unref(sv);
+    }
+}
+    
 void
 sv_chop(sv,ptr)        /* like set but assuming ptr is in sv */
 register SV *sv;
@@ -2276,12 +2262,7 @@ register char *ptr;
 
     if (!ptr || !SvPOKp(sv))
        return;
-    if (SvTHINKFIRST(sv)) {
-       if (SvREADONLY(sv) && curcop != &compiling)
-           croak(no_modify);
-       if (SvROK(sv))
-           sv_unref(sv);
-    }
+    sv_check_thinkfirst(sv);
     if (SvTYPE(sv) < SVt_PVIV)
        sv_upgrade(sv,SVt_PVIV);
 
@@ -2386,8 +2367,11 @@ I32 namlen;
 {
     MAGIC* mg;
     
-    if (SvREADONLY(sv) && curcop != &compiling && !strchr("gBf", how))
-       croak(no_modify);
+    if (SvREADONLY(sv)) {
+       dTHR;
+       if (curcop != &compiling && !strchr("gBf", how))
+           croak(no_modify);
+    }
     if (SvMAGICAL(sv) || (how == 't' && SvTYPE(sv) >= SVt_PVMG)) {
        if (SvMAGIC(sv) && (mg = mg_find(sv, how))) {
            if (how == 't')
@@ -2653,12 +2637,7 @@ register SV *sv;
 register SV *nsv;
 {
     U32 refcnt = SvREFCNT(sv);
-    if (SvTHINKFIRST(sv)) {
-       if (SvREADONLY(sv) && curcop != &compiling)
-           croak(no_modify);
-       if (SvROK(sv))
-           sv_unref(sv);
-    }
+    sv_check_thinkfirst(sv);
     if (SvREFCNT(nsv) != 1)
        warn("Reference miscount in sv_replace()");
     if (SvMAGICAL(sv)) {
@@ -2880,7 +2859,7 @@ SV *sv;
        return;
 #ifdef DEBUGGING
     if (SvTEMP(sv)) {
-       warn("Attempt to free temp prematurely");
+       warn("Attempt to free temp prematurely: %s", SvPEEK(sv));
        return;
     }
 #endif
@@ -3080,12 +3059,7 @@ I32 append;
     register I32 cnt;
     I32 i;
 
-    if (SvTHINKFIRST(sv)) {
-       if (SvREADONLY(sv) && curcop != &compiling)
-           croak(no_modify);
-       if (SvROK(sv))
-           sv_unref(sv);
-    }
+    sv_check_thinkfirst(sv);
     if (!SvUPGRADE(sv, SVt_PV))
        return 0;
     SvSCREAM_off(sv);
@@ -3323,8 +3297,11 @@ register SV *sv;
     if (!sv)
        return;
     if (SvTHINKFIRST(sv)) {
-       if (SvREADONLY(sv) && curcop != &compiling)
-           croak(no_modify);
+       if (SvREADONLY(sv)) {
+           dTHR;
+           if (curcop != &compiling)
+               croak(no_modify);
+       }
        if (SvROK(sv)) {
 #ifdef OVERLOAD
          if (SvAMAGIC(sv) && AMG_CALLun(sv,inc)) return;
@@ -3398,8 +3375,11 @@ register SV *sv;
     if (!sv)
        return;
     if (SvTHINKFIRST(sv)) {
-       if (SvREADONLY(sv) && curcop != &compiling)
-           croak(no_modify);
+       if (SvREADONLY(sv)) {
+           dTHR;
+           if (curcop != &compiling)
+               croak(no_modify);
+       }
        if (SvROK(sv)) {
 #ifdef OVERLOAD
          if (SvAMAGIC(sv) && AMG_CALLun(sv,dec)) return;
@@ -3883,8 +3863,11 @@ STRLEN *lp;
 {
     char *s;
 
-    if (SvREADONLY(sv) && curcop != &compiling)
-       croak(no_modify);
+    if (SvREADONLY(sv)) {
+       dTHR;
+       if (curcop != &compiling)
+           croak(no_modify);
+    }
     
     if (SvPOK(sv)) {
        *lp = SvCUR(sv);

diff --git a/thread.h b/thread.h
index 8bef7a5..655851d 100644 (file)
--- a/thread.h
+++ b/thread.h
@@ -139,12 +139,13 @@ struct thread {
     int                Tdelaymagic;
     bool       Tdirty;
     U8         Tlocalizing;
+    COP *      Tcurcop;
 
     CONTEXT *  Tcxstack;
     I32                Tcxstack_ix;
     I32                Tcxstack_max;
 
-    AV *       Tstack;
+    AV *       Tcurstack;
     AV *       Tmainstack;
     JMPENV *   Ttop_env;
     I32                Trunlevel;
@@ -160,6 +161,7 @@ struct thread {
     perl_thread next_run, prev_run;    /* Linked list of runnable threads */
     perl_cond  wait_queue;             /* Wait queue that we are waiting on */
     IV         private;                /* Holds data across time slices */
+    I32                savemark;               /* Holds MARK for thread join values */
 #endif /* FAKE_THREADS */
 };
 
@@ -195,7 +197,7 @@ typedef struct condpair {
 #undef stack_base
 #undef stack_sp
 #undef stack_max
-#undef stack
+#undef curstack
 #undef mainstack
 #undef markstack
 #undef markstack_ptr
@@ -209,6 +211,7 @@ typedef struct condpair {
 #undef retstack
 #undef retstack_ix
 #undef retstack_max
+#undef curcop
 #undef cxstack
 #undef cxstack_ix
 #undef cxstack_max
@@ -233,6 +236,7 @@ typedef struct condpair {
 #undef op
 #define op             (thr->Top)
 #endif
+#define        curcop          (thr->Tcurcop)
 #define        stack           (thr->Tstack)
 #define        mainstack       (thr->Tmainstack)
 #define        markstack       (thr->Tmarkstack)

diff --git a/toke.c b/toke.c
index 39359b7..ca8657b 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -226,6 +226,7 @@ void
 lex_start(line)
 SV *line;
 {
+    dTHR;
     char *s;
     STRLEN len;
 
@@ -309,6 +310,7 @@ static void
 incline(s)
 char *s;
 {
+    dTHR;
     char *t;
     char *n;
     char ch;
@@ -459,6 +461,7 @@ expectation x;
 char *s;
 #endif /* CAN_PROTOTYPE */
 {
+    dTHR;
     yylval.ival = f;
     CLINE;
     expect = x;
@@ -651,6 +654,7 @@ sublex_start()
 static I32
 sublex_push()
 {
+    dTHR;
     push_scope();
 
     lex_state = sublex_info.super_state;

diff --git a/util.c b/util.c
index 5bf2095..8fa30a0 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1172,6 +1172,8 @@ die(pat, va_alist)
     GV *gv;
     CV *cv;
 
+    DEBUG_L(fprintf(stderr, "die: curstack = %p, mainstack= %p\n",
+                   curstack, mainstack));/*debug*/
     /* We have to switch back to mainstack or die_where may try to pop
      * the eval block from the wrong stack if die is being called from a
      * signal handler.  - dkindred@cs.cmu.edu */
@@ -1188,6 +1190,8 @@ die(pat, va_alist)
     message = mess(pat, &args);
     va_end(args);
 
+    DEBUG_L(fprintf(stderr, "die: message = %s\ndiehook = %p\n",
+                  message, diehook));/*debug*/
     if (diehook) {
        /* sv_2cv might call croak() */
        SV *olddiehook = diehook;
@@ -1215,6 +1219,9 @@ die(pat, va_alist)
     }
 
     restartop = die_where(message);
+    DEBUG_L(fprintf(stderr,
+                   "die: restartop = %p, was_in_eval = %d, oldrunlevel = %d\n",
+                   restartop, was_in_eval, oldrunlevel));/*debug*/
     if ((!restartop && was_in_eval) || oldrunlevel > 1)
        JMPENV_JUMP(3);
     return restartop;
@@ -2360,7 +2367,7 @@ perl_cond *cp;
     if (thr->next_run == thr)
        croak("panic: perl_cond_wait called by last runnable thread");
     
-    New(666, cond, 1, perl_wait_queue);
+    New(666, cond, 1, struct perl_wait_queue);
     cond->thread = thr;
     cond->next = *cp;
     *cp = cond;