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

p4raw-id: //depot/perl@44

12 files changed, 173 insertions, 85 deletions

diff --git a/README.threads b/README.threads
new file mode 100644
index 0000000000..7dae3efbcb
--- /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 01cad2e149..5dcf8e03e5 100644
--- 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 960e0c1cd4..305f00f7e5 100644
--- 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 bd2f09aa36..4c2f5fb228 100644
--- 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 edaf97219d..1cd136ea71 100644
--- 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 64d47acdc6..9507f8befd 100644
--- 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 3101e5c1d5..a2074c2933 100644
--- 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 07f0754cd5..87bcad274f 100644
--- 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 a23ac14c3f..2868073c53 100644
--- 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 8bef7a57a0..655851de74 100644
--- 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 39359b7613..ca8657b3a7 100644
--- 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 5bf20955e6..8fa30a0636 100644
--- 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;