*-linux-thread at the moment.
p4raw-id: //depot/perl@274
#define filter_add Perl_filter_add
#define filter_del Perl_filter_del
#define filter_read Perl_filter_read
+#define find_threadsv Perl_find_threadsv
#define fold Perl_fold
#define fold_constants Perl_fold_constants
#define fold_locale Perl_fold_locale
#define padix Perl_padix
#define patleave Perl_patleave
#define peep Perl_peep
-#define per_thread_magicals Perl_per_thread_magicals
#define pidgone Perl_pidgone
#define pidstatus Perl_pidstatus
#define pmflag Perl_pmflag
#define save_scalar Perl_save_scalar
#define save_sptr Perl_save_sptr
#define save_svref Perl_save_svref
+#define save_threadsv Perl_save_threadsv
#define savepv Perl_savepv
#define savepvn Perl_savepvn
#define savestack Perl_savestack
#define thisexpr Perl_thisexpr
#define thr_key Perl_thr_key
#define threads_mutex Perl_threads_mutex
+#define threadsv_names Perl_threadsv_names
#define timesbuf Perl_timesbuf
#define tokenbuf Perl_tokenbuf
#define too_few_arguments Perl_too_few_arguments
SvREFCNT_dec(curstack);
#endif
SvREFCNT_dec(thr->cvcache);
- SvREFCNT_dec(thr->magicals);
+ SvREFCNT_dec(thr->threadsv);
SvREFCNT_dec(thr->specific);
SvREFCNT_dec(thr->errsv);
SvREFCNT_dec(thr->errhv);
expect
expectterm
fallback_amg
+find_threadsv
fold
fold_locale
freq
padix
padix_floor
patleave
-per_thread_magicals
pidstatus
pow_amg
pow_ass_amg
sv_undef
sv_yes
thisexpr
+threadsv_names
thr_key
timesbuf
tokenbuf
save_scalar
save_sptr
save_svref
+save_threadsv
savepv
savepvn
savestack_grow
static void null _((OP* o));
static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq,
CV* startcv, I32 cx_ix));
+static OP *newDEFSVOP _((void));
static char*
gv_ename(GV *gv)
}
#ifdef USE_THREADS
-/* find_thread_magical is not reentrant */
+/* find_threadsv is not reentrant */
PADOFFSET
-find_thread_magical(char *name)
+find_threadsv(char *name)
{
dTHR;
char *p;
PADOFFSET key;
SV **svp;
- /* We currently only handle single character magicals */
- p = strchr(per_thread_magicals, *name);
+ /* We currently only handle names of a single character */
+ p = strchr(threadsv_names, *name);
if (!p)
return NOT_IN_PAD;
- key = p - per_thread_magicals;
- svp = av_fetch(thr->magicals, key, FALSE);
+ key = p - threadsv_names;
+ svp = av_fetch(thr->threadsv, key, FALSE);
if (!svp) {
SV *sv = NEWSV(0, 0);
- av_store(thr->magicals, key, sv);
+ av_store(thr->threadsv, 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 '_':
+ break;
case ';':
sv_setpv(sv, "\034");
+ sv_magic(sv, 0, 0, name, 1);
break;
case '&':
case '`':
case '\'':
sawampersand = TRUE;
SvREADONLY_on(sv);
+ sv_magic(sv, 0, 0, name, 1);
break;
+ default:
+ sv_magic(sv, 0, 0, name, 1);
}
- sv_magic(sv, 0, 0, name, 1);
DEBUG_L(PerlIO_printf(PerlIO_stderr(),
- "find_thread_magical: new SV %p for $%s%c\n",
+ "find_threadsv: new SV %p for $%s%c\n",
sv, (*name < 32) ? "^" : "",
(*name < 32) ? toCTRL(*name) : *name));
}
break;
#ifdef USE_THREADS
case OP_THREADSV:
- o->op_targ = 0; /* Was holding index into thr->magicals AV. */
+ o->op_targ = 0; /* Was holding index into thr->threadsv AV. */
break;
#endif /* USE_THREADS */
default:
static void
null(OP *o)
{
- if (o->op_type != OP_NULL && o->op_targ > 0)
+ if (o->op_type != OP_NULL && o->op_type != OP_THREADSV && o->op_targ > 0)
pad_free(o->op_targ);
o->op_targ = o->op_type;
o->op_type = OP_NULL;
return retval;
}
+static OP *
+newDEFSVOP(void)
+{
+#ifdef USE_THREADS
+ OP *o = newOP(OP_THREADSV, 0);
+ o->op_targ = find_threadsv("_");
+ return o;
+#else
+ return newSVREF(newGVOP(OP_GV, 0, defgv));
+#endif /* USE_THREADS */
+}
+
void
newPROG(OP *o)
{
OP *o2;
#ifdef USE_THREADS
o2 = newOP(OP_THREADSV, 0);
- o2->op_targ = find_thread_magical(";");
+ o2->op_targ = find_threadsv(";");
#else
o2 = newSVREF(newGVOP(OP_GV, 0, gv_fetchpv(";", TRUE, SVt_PV))),
#endif /* USE_THREADS */
#ifdef USE_THREADS
else if (repl->op_type == OP_THREADSV
&& strchr("&`'123456789+",
- per_thread_magicals[repl->op_targ]))
+ threadsv_names[repl->op_targ]))
{
curop = 0;
}
if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
|| (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB)) {
expr = newUNOP(OP_DEFINED, 0,
- newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr) );
+ newASSIGNOP(0, newDEFSVOP(), 0, expr) );
}
}
if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
|| (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB))) {
expr = newUNOP(OP_DEFINED, 0,
- newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr) );
+ newASSIGNOP(0, newDEFSVOP(), 0, expr) );
}
if (!block)
op_free(sv);
sv = Nullop;
}
+ else if (sv->op_type == OP_THREADSV) { /* per-thread variable */
+ padoff = sv->op_targ;
+ iterflags |= OPf_SPECIAL;
+ op_free(sv);
+ sv = Nullop;
+ }
else
croak("Can't use %s for loop variable", op_desc[sv->op_type]);
}
else {
+#ifdef USE_THREADS
+ padoff = find_threadsv("_");
+ iterflags |= OPf_SPECIAL;
+#else
sv = newGVOP(OP_GV, 0, defgv);
+#endif
}
if (expr->op_type == OP_RV2AV || expr->op_type == OP_PADAV) {
expr = scalar(ref(expr, OP_ITER));
}
else {
op_free(o);
- o = newUNOP(OP_ENTEREVAL, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
+ o = newUNOP(OP_ENTEREVAL, 0, newDEFSVOP());
}
o->op_targ = (PADOFFSET)hints;
return o;
return newGVOP(type, OPf_REF, gv_fetchpv("main::STDIN", TRUE,
SVt_PVIO));
else
- return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
+ return newUNOP(type, 0, newDEFSVOP());
}
return o;
}
kid = kid->op_sibling;
}
if (!kid && opargs[type] & OA_DEFGV)
- *tokid = kid = newSVREF(newGVOP(OP_GV, 0, defgv));
+ *tokid = kid = newDEFSVOP();
while (oa && kid) {
numargs++;
}
else if (opargs[type] & OA_DEFGV) {
op_free(o);
- return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
+ return newUNOP(type, 0, newDEFSVOP());
}
if (oa) {
GV *gv;
if ((o->op_flags & OPf_KIDS) && !cLISTOPo->op_first->op_sibling)
- append_elem(OP_GLOB, o, newSVREF(newGVOP(OP_GV, 0, defgv)));
+ append_elem(OP_GLOB, o, newDEFSVOP());
if (!((gv = gv_fetchpv("glob", FALSE, SVt_PVCV)) && GvIMPORTED_CV(gv)))
gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
}
if (!kid)
- append_elem(o->op_type, o, newSVREF(newGVOP(OP_GV, 0, defgv)) );
+ append_elem(o->op_type, o, newDEFSVOP());
o = listkids(o);
scalar(kid);
if (!kid->op_sibling)
- append_elem(OP_SPLIT, o, newSVREF(newGVOP(OP_GV, 0, defgv)) );
+ append_elem(OP_SPLIT, o, newDEFSVOP());
kid = kid->op_sibling;
scalar(kid);
/* On UNOPs, saw bare parens, e.g. eof(). */
/* On OP_ENTERSUB || OP_NULL, saw a "do". */
/* On OP_(ENTER|LEAVE)EVAL, don't clear $@ */
+ /* On OP_ENTERITER, loop var is per-thread */
/* old names; don't use in new code, but don't break them, either */
#define OPf_LIST 1
SvREFCNT_dec(rs);
rs = SvREFCNT_inc(nrs);
#ifdef USE_THREADS
- sv_setsv(*av_fetch(thr->magicals, find_thread_magical("/"), FALSE), rs);
+ sv_setsv(*av_fetch(thr->threadsv, find_threadsv("/"), FALSE), rs);
#else
sv_setsv(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), rs);
#endif /* USE_THREADS */
GV *gv;
#ifdef USE_THREADS
if (name[1] == '\0' && !isALPHA(name[0])) {
- PADOFFSET tmp = find_thread_magical(name);
+ PADOFFSET tmp = find_threadsv(name);
if (tmp != NOT_IN_PAD) {
dTHR;
- return *av_fetch(thr->magicals, tmp, FALSE);
+ return *av_fetch(thr->threadsv, tmp, FALSE);
}
}
#endif /* USE_THREADS */
GV *othergv;
#ifdef USE_THREADS
- sv_setpvn(*av_fetch(thr->magicals,find_thread_magical("\""),FALSE)," ", 1);
+ sv_setpvn(*av_fetch(thr->threadsv,find_threadsv("\""),FALSE)," ", 1);
#else
sv_setpvn(GvSV(gv_fetchpv("\"", TRUE, SVt_PV)), " ", 1);
#endif /* USE_THREADS */
Newz(53, thr, 1, struct thread);
curcop = &compiling;
thr->cvcache = newHV();
- thr->magicals = newAV();
+ thr->threadsv = newAV();
thr->specific = newAV();
thr->errhv = newHV();
thr->flags = THRf_R_JOINABLE;
#ifdef USE_THREADS
# define ERRSV (thr->errsv)
# define ERRHV (thr->errhv)
+# define DEFSV *av_fetch(thr->threadsv, find_threadsv("_"), FALSE)
+# define SAVE_DEFSV save_threadsv(find_threadsv("_"))
#else
# define ERRSV GvSV(errgv)
# define ERRHV GvHV(errgv)
+# define DEFSV GvSV(defgv)
+# define SAVE_DEFSV SAVESPTR(GvSV(defgv))
#endif /* USE_THREADS */
#ifndef errno
int runops_debug _((void));
#endif
-#define PER_THREAD_MAGICALS "123456789&`'+/.,\\\";^-%=|~:\001\005!@"
+#define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@"
/****************/
/* Truly global */
EXT int nthreads; /* Number of threads currently */
EXT perl_mutex threads_mutex; /* Mutex for nthreads and thread list */
EXT perl_cond nthreads_cond; /* Condition variable for nthreads */
-EXT char * per_thread_magicals INIT(PER_THREAD_MAGICALS);
+EXT char * threadsv_names INIT(THREADSV_NAMES);
#ifdef FAKE_THREADS
EXT struct thread * thr; /* Currently executing (fake) thread */
#endif
if (op->op_flags & OPf_STACKED)
sv = POPs;
else {
- sv = GvSV(defgv);
+ sv = DEFSV;
EXTEND(SP,1);
}
TARG = sv_newmortal();
if (SP - MARK > 1)
do_join(TARG, &sv_no, MARK, SP);
else
- sv_setsv(TARG, (SP > MARK) ? *SP : GvSV(defgv));
+ sv_setsv(TARG, (SP > MARK) ? *SP : DEFSV);
up = SvPV_force(TARG, len);
if (len > 1) {
down = SvPVX(TARG) + len - 1;
{
djSP;
#ifdef USE_THREADS
- SV **svp = av_fetch(thr->magicals, op->op_targ, FALSE);
- if (!svp)
- croak("panic: pp_threadsv");
EXTEND(sp, 1);
if (op->op_private & OPpLVAL_INTRO)
- PUSHs(save_svref(svp));
+ PUSHs(*save_threadsv(op->op_targ));
else
- PUSHs(*svp);
+ PUSHs(*av_fetch(thr->threadsv, op->op_targ, FALSE));
#else
DIE("tried to access per-thread data in non-threaded perl");
#endif /* USE_THREADS */
ENTER; /* enter outer scope */
SAVETMPS;
- SAVESPTR(GvSV(defgv));
-
+#if 0
+ SAVE_DEFSV;
+#else
+ save_sptr(av_fetch(thr->threadsv, find_threadsv("_"), FALSE));
+#endif
ENTER; /* enter inner scope */
SAVESPTR(curpm);
src = stack_base[*markstack_ptr];
SvTEMP_off(src);
- GvSV(defgv) = src;
+ DEFSV = src;
PUTBACK;
if (op->op_type == OP_MAPSTART)
src = stack_base[markstack_ptr[-1]];
SvTEMP_off(src);
- GvSV(defgv) = src;
+ DEFSV = src;
RETURNOP(cLOGOP->op_other);
}
ENTER;
SAVETMPS;
- if (op->op_targ)
- svp = &curpad[op->op_targ]; /* "my" variable */
+#ifdef USE_THREADS
+ if (op->op_flags & OPf_SPECIAL)
+ svp = save_threadsv(op->op_targ); /* per-thread variable */
else
+#endif /* USE_THREADS */
+ if (op->op_targ) {
+ svp = &curpad[op->op_targ]; /* "my" variable */
+ SAVESPTR(*svp);
+ }
+ else {
svp = &GvSV((GV*)POPs); /* symbol table variable */
-
- SAVESPTR(*svp);
+ SAVESPTR(*svp);
+ }
ENTER;
if (op->op_flags & OPf_STACKED)
TARG = POPs;
else {
- TARG = GvSV(defgv);
+ TARG = DEFSV;
EXTEND(SP,1);
}
PUTBACK; /* EVAL blocks need stack_sp. */
if (op->op_flags & OPf_STACKED)
TARG = POPs;
else {
- TARG = GvSV(defgv);
+ TARG = DEFSV;
EXTEND(SP,1);
}
if (SvREADONLY(TARG)
src = stack_base[*markstack_ptr];
SvTEMP_off(src);
- GvSV(defgv) = src;
+ DEFSV = src;
RETURNOP(cLOGOP->op_other);
}
void fbm_compile _((SV* sv));
char* fbm_instr _((unsigned char* big, unsigned char* bigend, SV* littlesv));
#ifdef USE_THREADS
-PADOFFSET find_thread_magical _((char *name));
+PADOFFSET find_threadsv _((char *name));
#endif
OP* force_list _((OP* arg));
OP* fold_constants _((OP* arg));
void save_pptr _((char** pptr));
void save_sptr _((SV** sptr));
SV* save_svref _((SV** sptr));
+SV** save_threadsv _((PADOFFSET i));
OP* sawparens _((OP* o));
OP* scalar _((OP* o));
OP* scalarkids _((OP* o));
SSPUSHINT(SAVEt_SPTR);
}
+SV **
+save_threadsv(PADOFFSET i)
+{
+#ifdef USE_THREADS
+ dTHR;
+ SV **svp = av_fetch(thr->threadsv, i, FALSE);
+ DEBUG_L(PerlIO_printf(PerlIO_stderr(), "save_threadsv %u: %p %p:%s\n",
+ i, svp, *svp, SvPEEK(*svp)));
+ save_svref(svp);
+ return svp;
+#else
+ croak("panic: save_threadsv called in non-threaded perl");
+ return 0;
+#endif /* USE_THREADS */
+}
+
void
save_nogv(GV *gv)
{
ptr = SSPOPPTR;
restore_sv:
sv = *(SV**)ptr;
+ DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+ "restore svref: %p %p:%s -> %p:%s\n",
+ ptr, sv, SvPEEK(sv), value, SvPEEK(value)));
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) &&
SvTYPE(sv) != SVt_PVGV)
{
BEGIN { @INC = '../lib' }
use English;
use Config;
-my $threads = $Config{'ccflags'} =~ /-DUSE_THREADS\b/;
+my $threads = $Config{archname} =~ /-thread$/;
print $PID == $$ ? "ok 1\n" : "not ok 1\n";
$_ = 1;
-print $ARG == $_ ? "ok 2\n" : "not ok 2\n";
+print $ARG == $_ || $threads ? "ok 2\n" : "not ok 2\n";
sub foo {
print $ARG[0] == $_[0] || $threads ? "ok 3\n" : "not ok 3\n";
}
&foo(1);
-$ARG = "ok 4\nok 5\nok 6\n";
+if ($threads) {
+ $_ = "ok 4\nok 5\nok 6\n";
+} else {
+ $ARG = "ok 4\nok 5\nok 6\n";
+}
/ok 5\n/;
print $PREMATCH, $MATCH, $POSTMATCH;
HV * cvcache;
perl_thread self; /* Underlying thread object */
U32 flags;
- AV * magicals; /* Per-thread magicals */
+ AV * threadsv; /* Per-thread SVs ($_, $@ etc.) */
AV * specific; /* Thread-specific user data */
SV * errsv; /* Backing SV for $@ */
HV * errhv; /* HV for what was %@ in pp_ctl.c */
if (!strchr(tokenbuf,':')) {
#ifdef USE_THREADS
- /* Check for single character per-thread magicals */
+ /* Check for single character per-thread SVs */
if (tokenbuf[0] == '$' && tokenbuf[2] == '\0'
- && !isALPHA(tokenbuf[1]) /* Rule out obvious non-magicals */
- && (tmp = find_thread_magical(&tokenbuf[1])) != NOT_IN_PAD)
+ && !isALPHA(tokenbuf[1]) /* Rule out obvious non-threadsvs */
+ && (tmp = find_threadsv(&tokenbuf[1])) != NOT_IN_PAD)
{
yylval.opval = newOP(OP_THREADSV, 0);
yylval.opval->op_targ = tmp;
force_next(',');
#ifdef USE_THREADS
nextval[nexttoke].opval = newOP(OP_THREADSV, 0);
- nextval[nexttoke].opval->op_targ = find_thread_magical("\"");
+ nextval[nexttoke].opval->op_targ = find_threadsv("\"");
force_next(PRIVATEREF);
#else
force_ident("\"", '$');
curcop = &compiling;
thr->cvcache = newHV();
- thr->magicals = newAV();
+ thr->threadsv = newAV();
thr->specific = newAV();
thr->errsv = newSVpv("", 0);
thr->errhv = newHV();
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++) {
+ /* Initialise all per-thread SVs that the template thread used */
+ svp = AvARRAY(t->threadsv);
+ for (i = 0; i <= AvFILL(t->threadsv); 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);
+ av_store(thr->threadsv, i, sv);
+ sv_magic(sv, 0, 0, &threadsv_names[i], 1);
DEBUG_L(PerlIO_printf(PerlIO_stderr(),
- "new_struct_thread: copied magical %d %p->%p\n",i,
- t, thr));
+ "new_struct_thread: copied threadsv %d %p->%p\n",i, t, thr));
}
}
projects / p5sagit/p5-mst-13.2.git / commitdiff