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)
I32 off;
SV *sv;
register I32 i;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
int saweval;
for (cv = startcv; cv; cv = CvOUTSIDE(cv)) {
}
#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));
}
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. */
+ case OP_THREADSV:
+ o->op_targ = 0; /* Was holding index into thr->threadsv AV. */
break;
#endif /* USE_THREADS */
default:
/* FALL THROUGH */
case OP_PUSHRE:
case OP_MATCH:
- pregfree(cPMOPo->op_pmregexp);
- SvREFCNT_dec(cPMOPo->op_pmshort);
+ ReREFCNT_dec(cPMOPo->op_pmregexp);
break;
}
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;
break;
#ifdef USE_THREADS
- case OP_SPECIFIC:
+ case OP_THREADSV:
modcount++; /* XXX ??? */
-#if 0
- if (!type)
- croak("Can't localize thread-specific variable");
-#endif
break;
#endif /* USE_THREADS */
o->op_flags |= OPf_MOD;
}
break;
-
- case OP_SPECIFIC:
+
+ case OP_THREADSV:
o->op_flags |= OPf_MOD; /* XXX ??? */
break;
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)
{
if (o->op_type == OP_LIST) {
OP *o2;
#ifdef USE_THREADS
- o2 = newOP(OP_SPECIFIC, 0);
- o2->op_targ = find_thread_magical(";");
+ o2 = newOP(OP_THREADSV, 0);
+ o2->op_targ = find_threadsv(";");
#else
o2 = newSVREF(newGVOP(OP_GV, 0, gv_fetchpv(";", TRUE, SVt_PV))),
#endif /* USE_THREADS */
unop->op_first = first;
unop->op_flags = flags | OPf_KIDS;
unop->op_private = 1 | (flags >> 8);
-
+#if 1
+ if(type == OP_STUDY && first->op_type == OP_MATCH) {
+ first->op_type = OP_PUSHRE;
+ first->op_ppaddr = ppaddr[OP_PUSHRE];
+ }
+#endif
unop = (UNOP*) CHECKOP(type, unop);
if (unop->op_next)
return (OP*)unop;
pm->op_pmregexp = pregcomp(p, p + plen, pm);
if (strEQ("\\s+", pm->op_pmregexp->precomp))
pm->op_pmflags |= PMf_WHITE;
- hoistmust(pm);
op_free(expr);
}
else {
if (pm->op_pmflags & PMf_EVAL)
curop = 0;
#ifdef USE_THREADS
- else if (repl->op_type == OP_SPECIFIC
+ else if (repl->op_type == OP_THREADSV
&& strchr("&`'123456789+",
- per_thread_magicals[repl->op_targ]))
+ threadsv_names[repl->op_targ]))
{
curop = 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
+ if (curop->op_type == OP_THREADSV
&& strchr("&`'123456789+", curop->op_private)) {
break;
}
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));
croak(not_safe);
else {
/* force display of errors found but not reported */
- sv_catpv(errsv, not_safe);
- croak("%s", SvPV(errsv, na));
+ sv_catpv(ERRSV, not_safe);
+ croak("%s", SvPVx(ERRSV, na));
}
}
}
CV *cv;
HV *hv;
- sv_setpvf(sv, "%_:%ld-%ld",
- GvSV(curcop->cop_filegv),
- (long)subline, (long)curcop->cop_line);
+ sv_setpvf(sv, "%_:%ld-%ld", GvSV(curcop->cop_filegv),
+ (long)(subline < 0 ? -subline : subline),
+ (long)curcop->cop_line);
gv_efullname3(tmpstr, gv, Nullch);
hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
if (!db_postponed) {
o->op_ppaddr = ppaddr[OP_PADSV];
return o;
}
- else if (o->op_type == OP_SPECIFIC)
+ else if (o->op_type == OP_THREADSV)
return o;
return newUNOP(OP_RV2SV, 0, scalar(o));
}
}
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);
op_free(o);
#ifdef USE_THREADS
- if (subline) {
+ if (subline > 0) {
argop = newOP(OP_PADAV, OPf_REF);
argop->op_targ = 0; /* curpad[0] is @_ */
}
}
#else
argop = newUNOP(OP_RV2AV, 0,
- scalar(newGVOP(OP_GV, 0, subline ?
+ scalar(newGVOP(OP_GV, 0, subline > 0 ?
defgv : gv_fetchpv("ARGV", TRUE, SVt_PVAV))));
#endif /* USE_THREADS */
return newUNOP(type, 0, scalar(argop));
ck_split(OP *o)
{
register OP *kid;
- PMOP* pm;
if (o->op_flags & OPf_STACKED)
return no_fh_allowed(o);
cLISTOPo->op_first = kid;
kid->op_sibling = sibl;
}
- pm = (PMOP*)kid;
- if (pm->op_pmshort && !(pm->op_pmflags & PMf_ALL)) {
- SvREFCNT_dec(pm->op_pmshort); /* can't use substring to optimize */
- pm->op_pmshort = 0;
- }
kid->op_type = OP_PUSHRE;
kid->op_ppaddr = ppaddr[OP_PUSHRE];
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);
case OP_LC:
case OP_LCFIRST:
case OP_QUOTEMETA:
- if (o->op_next->op_type == OP_STRINGIFY)
+ if (o->op_next && o->op_next->op_type == OP_STRINGIFY)
null(o->op_next);
o->op_seq = op_seqmax++;
break;
projects / p5sagit/p5-mst-13.2.git / blobdiff