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

1 files changed, 59 insertions, 15 deletions

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