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

diff --git a/embed.h b/embed.h
index ee5feea..1c1e15c 100644 (file)
--- 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 1878417..d2db5ec 100644 (file)
--- 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 a638617..1ef3ebc 100644 (file)
--- 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 857e19c..d74160e 100644 (file)
--- 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 d64093e..ae064a8 100644 (file)
--- 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 71f6689..c562a37 100644 (file)
--- 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 ad208cf..8f3b2b9 100644 (file)
--- 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 17403fb..f2fc063 100644 (file)
--- 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 507fbe8..09cb1d6 100644 (file)
--- 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 981e488..866ddb0 100644 (file)
--- 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 d8da3ee..f7668c1 100644 (file)
--- 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 3786719..559c6e3 100644 (file)
--- 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 fcba8c4..c7fa000 100644 (file)
--- 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