From: Malcolm Beattie Date: Wed, 5 Nov 1997 17:18:18 +0000 (+0000) Subject: Per-thread magicals mostly working (and localisable). Now getting X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=554b3ecafd2a8f619792c82298bc621b9e48a923;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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