Per-thread magicals mostly working (and localisable). Now getting

intermittent occasional "Use of uninitialized value" warnings
which may be due to some op flag black magic I've broken.

p4raw-id: //depot/perl@204

13 files changed, 95 insertions, 85 deletions

diff --git a/embed.h b/embed.h
index ee5feeae81..1c1e15cc8e 100644
--- a/embed.h
+++ b/embed.h
@@ -822,6 +822,7 @@
 #define pp_socket		Perl_pp_socket
 #define pp_sockpair		Perl_pp_sockpair
 #define pp_sort			Perl_pp_sort
+#define pp_specific		Perl_pp_specific
 #define pp_splice		Perl_pp_splice
 #define pp_split		Perl_pp_split
 #define pp_sprintf		Perl_pp_sprintf
@@ -1280,8 +1281,6 @@
 #define incgv			(curinterp->Iincgv)
 #define initav			(curinterp->Iinitav)
 #define inplace			(curinterp->Iinplace)
-#define keys			(curinterp->Ikeys)
-#define keys_mutex		(curinterp->Ikeys_mutex)
 #define last_in_gv		(curinterp->Ilast_in_gv)
 #define lastfd			(curinterp->Ilastfd)
 #define lastretstr		(curinterp->Ilastretstr)
@@ -1294,7 +1293,6 @@
 #define lineary			(curinterp->Ilineary)
 #define localizing		(curinterp->Ilocalizing)
 #define localpatches		(curinterp->Ilocalpatches)
-#define magical_keys		(curinterp->Imagical_keys)
 #define main_cv			(curinterp->Imain_cv)
 #define main_root		(curinterp->Imain_root)
 #define main_start		(curinterp->Imain_start)
@@ -1436,8 +1434,6 @@
 #define Iincgv			incgv
 #define Iinitav			initav
 #define Iinplace		inplace
-#define Ikeys			keys
-#define Ikeys_mutex		keys_mutex
 #define Ilast_in_gv		last_in_gv
 #define Ilastfd			lastfd
 #define Ilastretstr		lastretstr
@@ -1450,7 +1446,6 @@
 #define Ilineary		lineary
 #define Ilocalizing		localizing
 #define Ilocalpatches		localpatches
-#define Imagical_keys		magical_keys
 #define Imain_cv		main_cv
 #define Imain_root		main_root
 #define Imain_start		main_start
@@ -1601,8 +1596,6 @@
 #define incgv			Perl_incgv
 #define initav			Perl_initav
 #define inplace			Perl_inplace
-#define keys			Perl_keys
-#define keys_mutex		Perl_keys_mutex
 #define last_in_gv		Perl_last_in_gv
 #define lastfd			Perl_lastfd
 #define lastretstr		Perl_lastretstr
@@ -1615,7 +1608,6 @@
 #define lineary			Perl_lineary
 #define localizing		Perl_localizing
 #define localpatches		Perl_localpatches
-#define magical_keys		Perl_magical_keys
 #define main_cv			Perl_main_cv
 #define main_root		Perl_main_root
 #define main_start		Perl_main_start
diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm
index 1878417ceb..d2db5ecba4 100644
--- a/ext/Opcode/Opcode.pm
+++ b/ext/Opcode/Opcode.pm
@@ -429,9 +429,9 @@ beyond the scope of the compartment.
 
 =item :base_thread
 
-This op is related to multi-threading.
+These ops are related to multi-threading.
 
-    lock
+    lock specific
 
 =item :default
 
diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs
index a6386176ff..1ef3ebc6fc 100644
--- a/ext/Thread/Thread.xs
+++ b/ext/Thread/Thread.xs
@@ -143,6 +143,8 @@ void *arg;
     SvREFCNT_dec(curstack);
 #endif
     SvREFCNT_dec(cvcache);
+    SvREFCNT_dec(thr->magicals);
+    SvREFCNT_dec(thr->specific);
     Safefree(markstack);
     Safefree(scopestack);
     Safefree(savestack);
diff --git a/gv.c b/gv.c
index 857e19c221..d74160e09c 100644
--- a/gv.c
+++ b/gv.c
@@ -1112,7 +1112,7 @@ HV* stash;
 	    filled = 1;
 	}
 #endif 
-	amt.table[i]=(CV*)SvREFCNT_inc(cv);
+	amt.table[i]= cv ? (CV*)SvREFCNT_inc(cv) : 0;
     }
     if (filled) {
       AMT_AMAGIC_on(&amt);
diff --git a/interp.sym b/interp.sym
index d64093eaea..ae064a8031 100644
--- a/interp.sym
+++ b/interp.sym
@@ -62,8 +62,6 @@ in_eval
 incgv
 initav
 inplace
-keys
-keys_mutex
 last_in_gv
 lastfd
 lastretstr
@@ -76,7 +74,6 @@ leftgv
 lineary
 localizing
 localpatches
-magical_keys
 main_cv
 main_root
 main_start
diff --git a/op.c b/op.c
index 71f6689885..c562a377bc 100644
--- a/op.c
+++ b/op.c
@@ -512,6 +512,7 @@ pad_reset()
 }
 
 #ifdef USE_THREADS
+/* find_thread_magical is not reentrant */
 PADOFFSET
 find_thread_magical(name)
 char *name;
@@ -519,20 +520,31 @@ char *name;
     dTHR;
     char *p;
     PADOFFSET key;
+    SV **svp;
     /* We currently only handle single character magicals */
     p = strchr(per_thread_magicals, *name);
     if (!p)
 	return NOT_IN_PAD;
-    key = magical_keys[p - per_thread_magicals];
-    if (key == NOT_IN_PAD) {
-	SV *sv;
-	key = magical_keys[p - per_thread_magicals] = key_create();
-	sv = NEWSV(0, 0);
-	av_store(thr->specific, key, sv);
+    key = p - per_thread_magicals;
+    svp = av_fetch(thr->magicals, key, FALSE);
+    if (!svp) {
+	SV *sv = NEWSV(0, 0);
+	av_store(thr->magicals, key, sv);
+	/*
+	 * Some magic variables used to be automagically initialised
+	 * in gv_fetchpv. Those which are now per-thread magicals get
+	 * initialised here instead.
+	 */
+	switch (*name) {
+	case ';':
+	    sv_setpv(sv, "\034");
+	    break;
+	}
 	sv_magic(sv, 0, 0, name, 1); 
 	DEBUG_L(PerlIO_printf(PerlIO_stderr(),
-			      "find_thread_magical: key %d new SV %p for %d\n",
-			      (int)key, sv, (int)*name));
+			      "find_thread_magical: new SV %p for $%s%c\n",
+			      sv, (*name < 32) ? "^" : "",
+			      (*name < 32) ? toCTRL(*name) : *name));
     }
     return key;
 }
@@ -563,6 +575,11 @@ OP *o;
     case OP_ENTEREVAL:
 	o->op_targ = 0;	/* Was holding hints. */
 	break;
+#ifdef USE_THREADS
+    case OP_SPECIFIC:
+	o->op_targ = 0;	/* Was holding index into thr->magicals AV. */
+	break;
+#endif /* USE_THREADS */
     default:
 	if (!(o->op_flags & OPf_REF) || (check[o->op_type] != ck_ftst))
 	    break;
@@ -1179,13 +1196,22 @@ I32 type;
 	    goto nomod;
 	/* FALL THROUGH */
     case OP_PADSV:
-    case OP_SPECIFIC:
 	modcount++;
 	if (!type)
 	    croak("Can't localize lexical variable %s",
 		SvPV(*av_fetch(comppad_name, o->op_targ, 4), na));
 	break;
 
+#ifdef USE_THREADS
+    case OP_SPECIFIC:
+	modcount++;	/* XXX ??? */
+#if 0
+	if (!type) 
+	    croak("Can't localize thread-specific variable");
+#endif
+	break;
+#endif /* USE_THREADS */
+
     case OP_PUSHMARK:
 	break;
 	
@@ -1613,10 +1639,14 @@ jmaybe(o)
 OP *o;
 {
     if (o->op_type == OP_LIST) {
-	o = convert(OP_JOIN, 0,
-		prepend_elem(OP_LIST,
-		    newSVREF(newGVOP(OP_GV, 0, gv_fetchpv(";", TRUE, SVt_PV))),
-		    o));
+	OP *o2;
+#ifdef USE_THREADS
+	o2 = newOP(OP_SPECIFIC, 0);
+	o2->op_targ = find_thread_magical(";");
+#else
+	o2 = newSVREF(newGVOP(OP_GV, 0, gv_fetchpv(";", TRUE, SVt_PV))),
+#endif /* USE_THREADS */
+	o = convert(OP_JOIN, 0, prepend_elem(OP_LIST, o2, o));
     }
     return o;
 }
@@ -2159,17 +2189,32 @@ OP *repl;
 	OP *curop;
 	if (pm->op_pmflags & PMf_EVAL)
 	    curop = 0;
+#ifdef USE_THREADS
+	else if (repl->op_type == OP_SPECIFIC
+		 && strchr("&`'123456789+",
+			   per_thread_magicals[repl->op_targ]))
+	{
+	    curop = 0;
+	}
+#endif /* USE_THREADS */
 	else if (repl->op_type == OP_CONST)
 	    curop = repl;
 	else {
 	    OP *lastop = 0;
 	    for (curop = LINKLIST(repl); curop!=repl; curop = LINKLIST(curop)) {
 		if (opargs[curop->op_type] & OA_DANGEROUS) {
+#ifdef USE_THREADS
+		    if (curop->op_type == OP_SPECIFIC
+			&& strchr("&`'123456789+", curop->op_private)) {
+			break;
+		    }
+#else
 		    if (curop->op_type == OP_GV) {
 			GV *gv = ((GVOP*)curop)->op_gv;
 			if (strchr("&`'123456789+", *GvENAME(gv)))
 			    break;
 		    }
+#endif /* USE_THREADS */
 		    else if (curop->op_type == OP_RV2CV)
 			break;
 		    else if (curop->op_type == OP_RV2SV ||
@@ -2182,8 +2227,7 @@ OP *repl;
 		    else if (curop->op_type == OP_PADSV ||
 			     curop->op_type == OP_PADAV ||
 			     curop->op_type == OP_PADHV ||
-			     curop->op_type == OP_PADANY ||
-			     curop->op_type == OP_SPECIFIC) {
+			     curop->op_type == OP_PADANY) {
 			     /* is okay */
 		    }
 		    else
diff --git a/op.h b/op.h
index ad208cfabb..8f3b2b9e08 100644
--- a/op.h
+++ b/op.h
@@ -130,6 +130,9 @@ typedef U32 PADOFFSET;
 /* Private for OP_SORT, OP_PRTF, OP_SPRINTF, string cmp'n, and case changers */
 #define OPpLOCALE		64	/* Use locale */
 
+/* Private for OP_SPECIFIC */
+#define OPpPM_NOT_CONST		64	/* Not constant enough for pmruntime */
+
 struct op {
     BASEOP
 };
diff --git a/perl.c b/perl.c
index 17403fb92b..f2fc06390f 100644
--- a/perl.c
+++ b/perl.c
@@ -138,7 +138,6 @@ register PerlInterpreter *sv_interp;
 	COND_INIT(&eval_cond);
 	MUTEX_INIT(&threads_mutex);
 	COND_INIT(&nthreads_cond);
-	MUTEX_INIT(&keys_mutex);
 	
 	thr = new_struct_thread(0);
 #endif /* USE_THREADS */
@@ -210,9 +209,6 @@ register PerlInterpreter *sv_interp;
 
     fdpid = newAV();	/* for remembering popen pids by fd */
 
-    for (i = 0; i < N_PER_THREAD_MAGICALS; i++)
-	magical_keys[i] = NOT_IN_PAD;
-    keys = newSVpv("", 0);
     init_stacks(ARGS);
     DEBUG( {
 	New(51,debname,128,char);
@@ -973,7 +969,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
     SvREFCNT_dec(rs);
     rs = SvREFCNT_inc(nrs);
 #ifdef USE_THREADS
-    sv_setsv(*av_fetch(thr->specific, find_thread_magical("/"), TRUE), rs); 
+    sv_setsv(*av_fetch(thr->magicals, find_thread_magical("/"), FALSE), rs); 
 #else
     sv_setsv(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), rs);
 #endif /* USE_THREADS */
@@ -2546,7 +2542,7 @@ init_predump_symbols()
     GV *othergv;
 
 #ifdef USE_THREADS
-    sv_setpvn(*av_fetch(thr->specific,find_thread_magical("\""),TRUE), " ", 1);
+    sv_setpvn(*av_fetch(thr->magicals,find_thread_magical("\""),FALSE)," ", 1);
 #else
     sv_setpvn(GvSV(gv_fetchpv("\"", TRUE, SVt_PV)), " ", 1);
 #endif /* USE_THREADS */
@@ -2848,21 +2844,20 @@ AV* list;
 	JMPENV_PUSH(ret);
 	switch (ret) {
 	case 0: {
-		SV* atsv = sv_mortalcopy(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;
 		    curcop->cop_line = oldline;
 		    if (list == beginav)
-			sv_catpv(atsv, "BEGIN failed--compilation aborted");
+			sv_catpv(errsv, "BEGIN failed--compilation aborted");
 		    else
-			sv_catpv(atsv, "END failed--cleanup aborted");
+			sv_catpv(errsv, "END failed--cleanup aborted");
 		    while (scopestack_ix > oldscope)
 			LEAVE;
-		    croak("%s", SvPVX(atsv));
+		    croak("%s", SvPVX(errsv));
 		}
 	    }
 	    break;
diff --git a/perl.h b/perl.h
index 507fbe8cd1..09cb1d6b87 100644
--- a/perl.h
+++ b/perl.h
@@ -1339,7 +1339,6 @@ int runops_debug _((void));
 #endif
 
 #define PER_THREAD_MAGICALS "123456789&`'+/.,\\\";^-%=|~:\001\005!@"
-#define N_PER_THREAD_MAGICALS 30
 
 /****************/
 /* Truly global */
@@ -1970,10 +1969,6 @@ IEXT SV *	Imess_sv;
 #ifdef USE_THREADS
 /* threads stuff */
 IEXT SV *	Ithrsv;		/* holds struct thread for main thread */
-IEXT perl_mutex	Ikeys_mutex;	/* protects keys and magical_keys */
-IEXT SV *	Ikeys;		/* each char marks a per-thread key in-use */
-IEXT PADOFFSET	Imagical_keys[N_PER_THREAD_MAGICALS];
-				/* index is position in per_thread_magicals */
 #endif /* USE_THREADS */
 
 #undef IEXT
diff --git a/pp.c b/pp.c
index 981e4889e2..866ddb0465 100644
--- a/pp.c
+++ b/pp.c
@@ -4300,8 +4300,14 @@ PP(pp_specific)
 {
 #ifdef USE_THREADS
     dSP;
-    SV **svp = av_fetch(thr->specific, op->op_targ, TRUE);
-    XPUSHs(svp ? *svp : &sv_undef);
+    SV **svp = av_fetch(thr->magicals, op->op_targ, FALSE);
+    if (!svp)
+	croak("panic: pp_specific");
+    EXTEND(sp, 1);
+    if (op->op_private & OPpLVAL_INTRO)
+	PUSHs(save_svref(svp));
+    else
+	PUSHs(*svp);
 #else
     DIE("tried to access thread-specific data in non-threaded perl");
 #endif /* USE_THREADS */
diff --git a/thread.h b/thread.h
index d8da3ee4b6..f7668c1173 100644
--- a/thread.h
+++ b/thread.h
@@ -217,7 +217,8 @@ struct thread {
     HV *	Tcvcache;
     perl_thread	self;			/* Underlying thread object */
     U32		flags;
-    AV *	specific;		/* Thread specific data (& magicals) */
+    AV *	magicals;		/* Per-thread magicals */
+    AV *	specific;		/* Thread-specific user data */
     perl_mutex	mutex;			/* For the fields others can change */
     U32		tid;
     struct thread *next, *prev;		/* Circular linked list of threads */
diff --git a/toke.c b/toke.c
index 3786719096..559c6e3d0d 100644
--- a/toke.c
+++ b/toke.c
@@ -1260,7 +1260,9 @@ yylex()
 #ifdef USE_THREADS
 	    /* Check for single character per-thread magicals */
 	    if (tokenbuf[0] == '$' && tokenbuf[2] == '\0'
-		&& (tmp = find_thread_magical(&tokenbuf[1])) != NOT_IN_PAD) {
+		&& !isALPHA(tokenbuf[1]) /* Rule out obvious non-magicals */
+		&& (tmp = find_thread_magical(&tokenbuf[1])) != NOT_IN_PAD)
+	    {
 		yylval.opval = newOP(OP_SPECIFIC, 0);
 		yylval.opval->op_targ = tmp;
 		return PRIVATEREF;
@@ -1401,7 +1403,13 @@ yylex()
 	if (lex_dojoin) {
 	    nextval[nexttoke].ival = 0;
 	    force_next(',');
+#ifdef USE_THREADS
+	    nextval[nexttoke].opval = newOP(OP_SPECIFIC, 0);
+	    nextval[nexttoke].opval->op_targ = find_thread_magical("\"");
+	    force_next(PRIVATEREF);
+#else
 	    force_ident("\"", '$');
+#endif /* USE_THREADS */
 	    nextval[nexttoke].ival = 0;
 	    force_next('$');
 	    nextval[nexttoke].ival = 0;
@@ -5338,7 +5346,7 @@ U32 flags;
     av_store(comppadlist, 1, (SV*)comppad);
 
     CvPADLIST(compcv) = comppadlist;
-    CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc((SV*)outsidecv);
+    CvOUTSIDE(compcv) = outsidecv ? (CV*)SvREFCNT_inc(outsidecv) : 0;
 #ifdef USE_THREADS
     CvOWNER(compcv) = 0;
     New(666, CvMUTEXP(compcv), 1, perl_mutex);
diff --git a/util.c b/util.c
index fcba8c4ac2..c7fa0008df 100644
--- a/util.c
+++ b/util.c
@@ -2502,6 +2502,7 @@ struct thread *t;
     Newz(53, thr, 1, struct thread);
     cvcache = newHV();
     curcop = &compiling;
+    thr->magicals = newAV();
     thr->specific = newAV();
     thr->flags = THRf_R_JOINABLE;
     MUTEX_INIT(&thr->mutex);
@@ -2541,7 +2542,6 @@ struct thread *t;
 	formtarget = newSVsv(t->Tformtarget);
 	bodytarget = newSVsv(t->Tbodytarget);
 	toptarget = newSVsv(t->Ttoptarget);
-	keys = newSVpv("", 0);
     } else {
 	curcop = &compiling;
 	chopset = " \n-";
@@ -2581,39 +2581,6 @@ struct thread *t;
     }
     return thr;
 }
-
-PADOFFSET
-key_create()
-{
-    char *s;
-    STRLEN len;
-    PADOFFSET i;
-    MUTEX_LOCK(&keys_mutex);
-    s = SvPV(keys, len);
-    for (i = 0; i < len; i++) {
-	if (!s[i]) {
-	    s[i] = 1;
-	    break;
-	}
-    }
-    if (i == len)
-	sv_catpvn(keys, "\1", 1);
-    MUTEX_UNLOCK(&keys_mutex);
-    DEBUG_L(PerlIO_printf(PerlIO_stderr(), "key_create: %d\n", (int)i));
-    return i;
-}
-
-void
-key_destroy(key)
-PADOFFSET key;
-{
-    char *s;
-    MUTEX_LOCK(&keys_mutex);
-    s = SvPVX(keys);
-    s[key] = 0;
-    MUTEX_UNLOCK(&keys_mutex);
-    DEBUG_L(PerlIO_printf(PerlIO_stderr(), "key_destroy: %d\n", (int)key));
-}
 #endif /* USE_THREADS */
 
 #ifdef HUGE_VAL