Per-thread magicals now stored in their own thr->magicals and keyed

more directly. cvcache and oursv become ordinary struct thread
fields instead of #defined thr->Tfoo ones. SvREFCNT_inc now checks
for 0 again. Main thread initialisation done by new function
init_main_thread instead of (now fixed) new_struct_thread.

p4raw-id: //depot/perl@205

13 files changed, 156 insertions, 106 deletions

diff --git a/embed.h b/embed.h
index 1c1e15cc8e..762ce18fab 100644
--- a/embed.h
+++ b/embed.h
@@ -289,8 +289,6 @@
 #define invert			Perl_invert
 #define io_close		Perl_io_close
 #define jmaybe			Perl_jmaybe
-#define key_create		Perl_key_create
-#define key_destroy		Perl_key_destroy
 #define keyword			Perl_keyword
 #define know_next		Perl_know_next
 #define last_lop		Perl_last_lop
diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs
index 1ef3ebc6fc..9c0325e07d 100644
--- a/ext/Thread/Thread.xs
+++ b/ext/Thread/Thread.xs
@@ -115,6 +115,8 @@ void *arg;
 	goto finishoff;
     }
 
+    CATCH_SET(TRUE);
+
     /* Now duplicate most of perl_call_sv but with a few twists */
     op = (OP*)&myop;
     Zero(op, 1, LOGOP);
@@ -142,7 +144,7 @@ void *arg;
     /* removed for debug */
     SvREFCNT_dec(curstack);
 #endif
-    SvREFCNT_dec(cvcache);
+    SvREFCNT_dec(thr->cvcache);
     SvREFCNT_dec(thr->magicals);
     SvREFCNT_dec(thr->specific);
     Safefree(markstack);
@@ -151,6 +153,7 @@ void *arg;
     Safefree(retstack);
     Safefree(cxstack);
     Safefree(tmps_stack);
+    Safefree(ofs);
 
     MUTEX_LOCK(&thr->mutex);
     DEBUG_L(PerlIO_printf(PerlIO_stderr(),
@@ -207,7 +210,6 @@ char *class;
     
     savethread = thr;
     thr = new_struct_thread(thr);
-    init_stacks(ARGS);
     SPAGAIN;
     DEBUG_L(PerlIO_printf(PerlIO_stderr(),
 			  "%p: newthread, tid is %u, preparing stack\n",
@@ -236,7 +238,7 @@ char *class;
 #endif
     if (err) {
 	/* Thread creation failed--clean up */
-	SvREFCNT_dec(cvcache);
+	SvREFCNT_dec(thr->cvcache);
 	remove_thread(thr);
 	MUTEX_DESTROY(&thr->mutex);
 	for (i = 0; i <= AvFILL(initargs); i++)
@@ -251,7 +253,7 @@ char *class;
 	croak("panic: sigprocmask");
 #endif
     sv = newSViv(thr->tid);
-    sv_magic(sv, oursv, '~', 0, 0);
+    sv_magic(sv, thr->oursv, '~', 0, 0);
     SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE;
     return sv_bless(newRV_noinc(sv), gv_stashpv(class, TRUE));
 }
@@ -352,7 +354,7 @@ self(class)
 	SV *sv;
     PPCODE:
 	sv = newSViv(thr->tid);
-	sv_magic(sv, oursv, '~', 0, 0);
+	sv_magic(sv, thr->oursv, '~', 0, 0);
 	SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE;
 	PUSHs(sv_2mortal(sv_bless(newRV_noinc(sv), gv_stashpv(class, TRUE))));
 
@@ -479,7 +481,7 @@ list(class)
 	do {
 	    SV *sv = (SV*)SvRV(*svp);
 	    sv_setiv(sv, t->tid);
-	    SvMAGIC(sv)->mg_obj = SvREFCNT_inc(t->Toursv);
+	    SvMAGIC(sv)->mg_obj = SvREFCNT_inc(t->oursv);
 	    SvMAGIC(sv)->mg_flags |= MGf_REFCOUNTED;
 	    SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE;
 	    t = t->next;
diff --git a/global.sym b/global.sym
index 2ea71b231f..aab677c115 100644
--- a/global.sym
+++ b/global.sym
@@ -74,8 +74,6 @@ in_my
 in_my_stash
 inc_amg
 io_close
-key_create
-key_destroy
 know_next
 last_lop
 last_lop_op
diff --git a/gv.c b/gv.c
index d74160e09c..857e19c221 100644
--- a/gv.c
+++ b/gv.c
@@ -1112,7 +1112,7 @@ HV* stash;
 	    filled = 1;
 	}
 #endif 
-	amt.table[i]= cv ? (CV*)SvREFCNT_inc(cv) : 0;
+	amt.table[i]=(CV*)SvREFCNT_inc(cv);
     }
     if (filled) {
       AMT_AMAGIC_on(&amt);
diff --git a/op.c b/op.c
index c562a377bc..243b3c7cc3 100644
--- a/op.c
+++ b/op.c
@@ -247,7 +247,7 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
 			    warn("Variable \"%s\" will not stay shared", name);
 		    }
 		}
-		av_store(comppad, newoff, oldsv ? SvREFCNT_inc(oldsv) : 0);
+		av_store(comppad, newoff, SvREFCNT_inc(oldsv));
 		return newoff;
 	    }
 	}
diff --git a/perl.c b/perl.c
index f2fc06390f..fff0450593 100644
--- a/perl.c
+++ b/perl.c
@@ -69,6 +69,9 @@ static void init_ids _((void));
 static void init_debugger _((void));
 static void init_lexer _((void));
 static void init_main_stash _((void));
+#ifdef USE_THREADS
+static struct thread * init_main_thread _((void));
+#endif /* USE_THREADS */
 static void init_perllib _((void));
 static void init_postdump_symbols _((int, char **, char **));
 static void init_predump_symbols _((void));
@@ -139,7 +142,7 @@ register PerlInterpreter *sv_interp;
 	MUTEX_INIT(&threads_mutex);
 	COND_INIT(&nthreads_cond);
 	
-	thr = new_struct_thread(0);
+	thr = init_main_thread();
 #endif /* USE_THREADS */
 
 	linestr = NEWSV(65,80);
@@ -2825,6 +2828,63 @@ int addsubdirs;
     SvREFCNT_dec(subdir);
 }
 
+#ifdef USE_THREADS
+static struct thread *
+init_main_thread()
+{
+    struct thread *thr;
+    XPV *xpv;
+
+    Newz(53, thr, 1, struct thread);
+    curcop = &compiling;
+    thr->cvcache = newHV();
+    thr->magicals = newAV();
+    thr->specific = newAV();
+    thr->flags = THRf_R_JOINABLE;
+    MUTEX_INIT(&thr->mutex);
+    /* Handcraft thrsv similarly to mess_sv */
+    New(53, thrsv, 1, SV);
+    Newz(53, xpv, 1, XPV);
+    SvFLAGS(thrsv) = SVt_PV;
+    SvANY(thrsv) = (void*)xpv;
+    SvREFCNT(thrsv) = 1 << 30;	/* practically infinite */
+    SvPVX(thrsv) = (char*)thr;
+    SvCUR_set(thrsv, sizeof(thr));
+    SvLEN_set(thrsv, sizeof(thr));
+    *SvEND(thrsv) = '\0';	/* in the trailing_nul field */
+    thr->oursv = thrsv;
+    curcop = &compiling;
+    chopset = " \n-";
+
+    MUTEX_LOCK(&threads_mutex);
+    nthreads++;
+    thr->tid = 0;
+    thr->next = thr;
+    thr->prev = thr;
+    MUTEX_UNLOCK(&threads_mutex);
+
+#ifdef HAVE_THREAD_INTERN
+    init_thread_intern(thr);
+#else
+    thr->self = pthread_self();
+#endif /* HAVE_THREAD_INTERN */
+    SET_THR(thr);
+
+    /*
+     * These must come after the SET_THR because sv_setpvn does
+     * SvTAINT and the taint fields require dTHR.
+     */
+    toptarget = NEWSV(0,0);
+    sv_upgrade(toptarget, SVt_PVFM);
+    sv_setpvn(toptarget, "", 0);
+    bodytarget = NEWSV(0,0);
+    sv_upgrade(bodytarget, SVt_PVFM);
+    sv_setpvn(bodytarget, "", 0);
+    formtarget = bodytarget;
+    return thr;
+}
+#endif /* USE_THREADS */
+
 void
 call_list(oldscope, list)
 I32 oldscope;
diff --git a/pp_ctl.c b/pp_ctl.c
index 532fda3910..d4d2e2f4a2 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2186,7 +2186,7 @@ int gimme;
     CvPADLIST(compcv) = comppadlist;
 
     if (saveop->op_type != OP_REQUIRE)
-	CvOUTSIDE(compcv) = caller ? (CV*)SvREFCNT_inc(caller) : 0;
+	CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc(caller);
 
     SAVEFREESV(compcv);
 
diff --git a/pp_hot.c b/pp_hot.c
index f4741a1d68..6df60d7934 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1901,7 +1901,7 @@ PP(pp_entersub)
      	 * (3) instead of (2) so we'd have to clone. Would the fact
      	 * that we released the mutex more quickly make up for this?
      	 */
-	svp = hv_fetch(cvcache, (char *)cv, sizeof(cv), FALSE);
+	svp = hv_fetch(thr->cvcache, (char *)cv, sizeof(cv), FALSE);
      	if (svp) {
 	    /* We already have a clone to use */
 	    MUTEX_UNLOCK(CvMUTEXP(cv));
@@ -1941,7 +1941,7 @@ PP(pp_entersub)
 		 */
 	     	clonecv = cv_clone(cv);
     		SvREFCNT_dec(cv); /* finished with this */
-		hv_store(cvcache, (char*)cv, sizeof(cv), (SV*)clonecv,0);
+		hv_store(thr->cvcache, (char*)cv, sizeof(cv), (SV*)clonecv,0);
 		CvOWNER(clonecv) = thr;
 		cv = clonecv;
 		SvREFCNT_inc(cv);
diff --git a/proto.h b/proto.h
index 7eddfd9cb2..963cd171f4 100644
--- a/proto.h
+++ b/proto.h
@@ -190,8 +190,6 @@ bool	io_close _((IO* io));
 OP*	invert _((OP* cmd));
 OP*	jmaybe _((OP* arg));
 I32	keyword _((char* d, I32 len));
-PADOFFSET	key_create _((void));
-void	key_destroy _((PADOFFSET key));
 void	leave_scope _((I32 base));
 void	lex_end _((void));
 void	lex_start _((SV* line));
diff --git a/sv.h b/sv.h
index 437f4888fa..916dc17fe6 100644
--- a/sv.h
+++ b/sv.h
@@ -73,12 +73,12 @@ struct io {
 #define SvREFCNT(sv)	(sv)->sv_refcnt
 
 #ifdef __GNUC__
-#  define SvREFCNT_inc(sv)	({SV *nsv = (SV*)(sv); ++SvREFCNT(nsv); nsv;})
+#  define SvREFCNT_inc(sv) ({SV* nsv=(SV*)(sv); if(nsv) ++SvREFCNT(nsv); nsv;})
 #else
 #  if defined(CRIPPLED_CC) || defined(USE_THREADS)
-#    define SvREFCNT_inc(sv)	sv_newref((SV*)sv)
+#    define SvREFCNT_inc(sv) sv_newref((SV*)sv)
 #  else
-#    define SvREFCNT_inc(sv)	((Sv = (SV*)(sv)), ++SvREFCNT(Sv), (SV*)Sv)
+#    define SvREFCNT_inc(sv) ((Sv=(SV*)(sv)), (Sv && ++SvREFCNT(Sv)), (SV*)Sv)
 #  endif
 #endif
 
diff --git a/thread.h b/thread.h
index f7668c1173..b496d6997c 100644
--- a/thread.h
+++ b/thread.h
@@ -213,8 +213,8 @@ struct thread {
 
     /* XXX Sort stuff, firstgv, secongv and so on? */
 
-    SV *	Toursv;
-    HV *	Tcvcache;
+    SV *	oursv;
+    HV *	cvcache;
     perl_thread	self;			/* Underlying thread object */
     U32		flags;
     AV *	magicals;		/* Per-thread magicals */
@@ -226,7 +226,7 @@ struct thread {
 #ifdef ADD_THREAD_INTERN
     struct thread_intern i;		/* Platform-dependent internals */
 #endif
-    char	trailing_nul;		/* For the sake of thrsv, t->Toursv */
+    char	trailing_nul;		/* For the sake of thrsv and oursv */
 };
 
 typedef struct thread *Thread;
@@ -314,7 +314,6 @@ typedef struct condpair {
 #undef	dirty
 #undef	localizing
 
-#define oursv		(thr->Toursv)
 #define stack_base	(thr->Tstack_base)
 #define stack_sp	(thr->Tstack_sp)
 #define stack_max	(thr->Tstack_max)
@@ -381,7 +380,6 @@ typedef struct condpair {
 #define	top_env		(thr->Ttop_env)
 #define	runlevel	(thr->Trunlevel)
 
-#define	cvcache		(thr->Tcvcache)
 #else
 /* USE_THREADS is not defined */
 #define MUTEX_LOCK(m)
diff --git a/toke.c b/toke.c
index 559c6e3d0d..6c53b99dd5 100644
--- a/toke.c
+++ b/toke.c
@@ -5346,7 +5346,7 @@ U32 flags;
     av_store(comppadlist, 1, (SV*)comppad);
 
     CvPADLIST(compcv) = comppadlist;
-    CvOUTSIDE(compcv) = outsidecv ? (CV*)SvREFCNT_inc(outsidecv) : 0;
+    CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc(outsidecv);
 #ifdef USE_THREADS
     CvOWNER(compcv) = 0;
     New(666, CvMUTEXP(compcv), 1, perl_mutex);
diff --git a/util.c b/util.c
index c7fa0008df..b348066fe7 100644
--- a/util.c
+++ b/util.c
@@ -1176,8 +1176,9 @@ die(pat, va_alist)
     GV *gv;
     CV *cv;
 
-    DEBUG_L(PerlIO_printf(PerlIO_stderr(), "die: curstack = %p, mainstack= %p\n",
-    		    curstack, mainstack));/*debug*/
+    DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+			  "%p: die: curstack = %p, mainstack = %p\n",
+			  thr, curstack, mainstack));
     /* 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 */
@@ -1194,8 +1195,9 @@ die(pat, va_alist)
     message = mess(pat, &args);
     va_end(args);
 
-    DEBUG_L(PerlIO_printf(PerlIO_stderr(), "die: message = %s\ndiehook = %p\n",
-		   message, diehook));/*debug*/
+    DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+			  "%p: die: message = %s\ndiehook = %p\n",
+			  thr, message, diehook));
     if (diehook) {
 	/* sv_2cv might call croak() */
 	SV *olddiehook = diehook;
@@ -1224,8 +1226,8 @@ die(pat, va_alist)
 
     restartop = die_where(message);
     DEBUG_L(PerlIO_printf(PerlIO_stderr(),
-    		    "die: restartop = %p, was_in_eval = %d, oldrunlevel = %d\n",
-		    restartop, was_in_eval, oldrunlevel));/*debug*/
+	  "%p: die: restartop = %p, was_in_eval = %d, oldrunlevel = %d\n",
+	  thr, restartop, was_in_eval, oldrunlevel));
     if ((!restartop && was_in_eval) || oldrunlevel > 1)
 	JMPENV_JUMP(3);
     return restartop;
@@ -2484,80 +2486,88 @@ SV *sv;
 }
 
 /*
- * Make a new perl thread structure using t as a prototype. If t is NULL
- * then this is the initial main thread and we have to bootstrap carefully.
- * 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 usual case, where t is the thread calling new_struct_thread,
- * clearly satisfies this constraint.
+ * 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(t)
 struct thread *t;
 {
     struct thread *thr;
-    XPV *xpv;
     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);
 
-    Newz(53, thr, 1, struct thread);
-    cvcache = newHV();
     curcop = &compiling;
+    thr->cvcache = newHV();
     thr->magicals = newAV();
     thr->specific = newAV();
     thr->flags = THRf_R_JOINABLE;
     MUTEX_INIT(&thr->mutex);
-    if (t) {
-	oursv = newSVpv("", 0);
-	SvGROW(oursv, sizeof(struct thread) + 1);
-	SvCUR_set(oursv, sizeof(struct thread));
-	thr = (struct thread *) SvPVX(sv);
-    } else {
-	/* Handcraft thrsv similarly to mess_sv */
-	New(53, thrsv, 1, SV);
-	Newz(53, xpv, 1, XPV);
-	SvFLAGS(thrsv) = SVt_PV;
-	SvANY(thrsv) = (void*)xpv;
-	SvREFCNT(thrsv) = 1 << 30;	/* practically infinite */
-	SvPVX(thrsv) = (char*)thr;
-	SvCUR_set(thrsv, sizeof(thr));
-	SvLEN_set(thrsv, sizeof(thr));
-	*SvEND(thrsv) = '\0';		/* in the trailing_nul field */
-	oursv = thrsv;
-    }
-    if (t) {
-	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? */
-	/* runlevel */
-	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);
-    } else {
-	curcop = &compiling;
-	chopset = " \n-";
-   }
+
+    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++;
-    if (t) {
-	thr->next = t->next;
-	thr->prev = t;
-	t->next = thr;
-	thr->next->prev = thr;
-    } else {
-	thr->next = thr;
-	thr->prev = thr;
-    }
+    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
@@ -2565,20 +2575,6 @@ struct thread *t;
 #else
     thr->self = pthread_self();
 #endif /* HAVE_THREAD_INTERN */
-    SET_THR(thr);
-    if (!t) {
-	/*
-	 * These must come after the SET_THR because sv_setpvn does
-	 * SvTAINT and the taint fields require dTHR.
-	 */
-	toptarget = NEWSV(0,0);
-	sv_upgrade(toptarget, SVt_PVFM);
-	sv_setpvn(toptarget, "", 0);
-	bodytarget = NEWSV(0,0);
-	sv_upgrade(bodytarget, SVt_PVFM);
-	sv_setpvn(bodytarget, "", 0);
-	formtarget = bodytarget;
-    }
     return thr;
 }
 #endif /* USE_THREADS */