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)
}
croak("Can't use global %s in \"my\"",name);
}
- if (dowarn && AvFILL(comppad_name) >= 0) {
+ if (dowarn && AvFILLp(comppad_name) >= 0) {
SV **svp = AvARRAY(comppad_name);
- for (off = AvFILL(comppad_name); off > comppad_name_floor; off--) {
+ for (off = AvFILLp(comppad_name); off > comppad_name_floor; off--) {
if ((sv = svp[off])
&& sv != &sv_undef
&& SvIVX(sv) == 999999999 /* var is in open scope */
I32 off;
SV *sv;
register I32 i;
- register CONTEXT *cx;
+ register PERL_CONTEXT *cx;
int saweval;
for (cv = startcv; cv; cv = CvOUTSIDE(cv)) {
continue;
curname = (AV*)*svp;
svp = AvARRAY(curname);
- for (off = AvFILL(curname); off > 0; off--) {
+ for (off = AvFILLp(curname); off > 0; off--) {
if ((sv = svp[off]) &&
sv != &sv_undef &&
seq <= SvIVX(sv) &&
#endif /* USE_THREADS */
/* The one we're looking for is probably just before comppad_name_fill. */
- for (off = AvFILL(comppad_name); off > 0; off--) {
+ for (off = AvFILLp(comppad_name); off > 0; off--) {
if ((sv = svp[off]) &&
sv != &sv_undef &&
(!SvIVX(sv) ||
}
}
/* "Deintroduce" my variables that are leaving with this scope. */
- for (off = AvFILL(comppad_name); off > fill; off--) {
+ for (off = AvFILLp(comppad_name); off > fill; off--) {
if ((sv = svp[off]) && sv != &sv_undef && SvIVX(sv) == 999999999)
SvIVX(sv) = cop_seqmax;
}
pad_reset();
if (tmptype & SVs_PADMY) {
do {
- sv = *av_fetch(comppad, AvFILL(comppad) + 1, TRUE);
+ sv = *av_fetch(comppad, AvFILLp(comppad) + 1, TRUE);
} while (SvPADBUSY(sv)); /* need a fresh one */
- retval = AvFILL(comppad);
+ retval = AvFILLp(comppad);
}
else {
SV **names = AvARRAY(comppad_name);
- SSize_t names_fill = AvFILL(comppad_name);
+ SSize_t names_fill = AvFILLp(comppad_name);
for (;;) {
/*
* "foreach" index vars temporarily become aliases to non-"my"
pad_reset_pending = FALSE;
}
+#ifdef USE_THREADS
+/* find_threadsv is not reentrant */
+PADOFFSET
+find_threadsv(char *name)
+{
+ dTHR;
+ char *p;
+ PADOFFSET key;
+ SV **svp;
+ /* We currently only handle names of a single character */
+ p = strchr(threadsv_names, *name);
+ if (!p)
+ return NOT_IN_PAD;
+ key = p - threadsv_names;
+ svp = av_fetch(thr->threadsv, key, FALSE);
+ if (!svp) {
+ SV *sv = NEWSV(0, 0);
+ 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);
+ /* FALL THROUGH */
+ default:
+ sv_magic(sv, 0, 0, name, 1);
+ }
+ DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+ "find_threadsv: new SV %p for $%s%c\n",
+ sv, (*name < 32) ? "^" : "",
+ (*name < 32) ? toCTRL(*name) : *name));
+ }
+ return key;
+}
+#endif /* USE_THREADS */
+
/* Destructor */
void
case OP_ENTEREVAL:
o->op_targ = 0; /* Was holding hints. */
break;
+#ifdef USE_THREADS
+ case OP_THREADSV:
+ o->op_targ = 0; /* Was holding index into thr->threadsv AV. */
+ break;
+#endif /* USE_THREADS */
default:
if (!(o->op_flags & OPf_REF) || (check[o->op_type] != ck_ftst))
break;
/* 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;
case OP_RV2SV:
if (!type && cUNOPo->op_first->op_type != OP_GV)
croak("Can't localize through a reference");
- ref(cUNOPo->op_first, o->op_type);
+ ref(cUNOPo->op_first, o->op_type);
/* FALL THROUGH */
case OP_GV:
case OP_AV2ARYLEN:
SvPV(*av_fetch(comppad_name, o->op_targ, 4), na));
break;
+#ifdef USE_THREADS
+ case OP_THREADSV:
+ modcount++; /* XXX ??? */
+ break;
+#endif /* USE_THREADS */
+
case OP_PUSHMARK:
break;
o->op_flags |= OPf_SPECIAL;
}
break;
-
+
case OP_COND_EXPR:
for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
ref(kid, type);
}
break;
+ case OP_THREADSV:
+ o->op_flags |= OPf_MOD; /* XXX ??? */
+ break;
+
case OP_RV2AV:
case OP_RV2HV:
- o->op_flags |= OPf_REF;
+ o->op_flags |= OPf_REF;
/* FALL THROUGH */
case OP_RV2GV:
ref(cUNOPo->op_first, o->op_type);
case OP_PADAV:
case OP_PADHV:
- o->op_flags |= OPf_REF;
+ o->op_flags |= OPf_REF;
break;
-
+
case OP_SCALAR:
case OP_NULL:
if (!(o->op_flags & OPf_KIDS))
int retval = savestack_ix;
SAVEI32(comppad_name_floor);
if (full) {
- if ((comppad_name_fill = AvFILL(comppad_name)) > 0)
+ if ((comppad_name_fill = AvFILLp(comppad_name)) > 0)
comppad_name_floor = comppad_name_fill;
else
comppad_name_floor = 0;
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)
{
jmaybe(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_THREADSV, 0);
+ o2->op_targ = find_threadsv(";");
+#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;
}
}
return newSVOP(OP_CONST, 0, sv);
}
-
+
nope:
if (!(opargs[type] & OA_OTHERINT))
return o;
UNOP *unop;
if (!first)
- first = newOP(OP_STUB, 0);
+ first = newOP(OP_STUB, 0);
if (opargs[type] & OA_MARK)
first = force_list(first);
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;
register I32 j;
I32 Delete;
I32 complement;
+ I32 squash;
register short *tbl;
tbl = (short*)cPVOPo->op_pv;
complement = o->op_private & OPpTRANS_COMPLEMENT;
Delete = o->op_private & OPpTRANS_DELETE;
- /* squash = o->op_private & OPpTRANS_SQUASH; */
+ squash = o->op_private & OPpTRANS_SQUASH;
if (complement) {
Zero(tbl, 256, short);
else {
if (!rlen && !Delete) {
r = t; rlen = tlen;
+ if (!squash)
+ o->op_private |= OPpTRANS_COUNTONLY;
}
for (i = 0; i < 256; i++)
tbl[i] = -1;
pm->op_pmflags |= PMf_SKIPWHITE;
}
pm->op_pmregexp = pregcomp(p, p + plen, pm);
- if (strEQ("\\s+", pm->op_pmregexp->precomp))
+ if (strEQ("\\s+", pm->op_pmregexp->precomp))
pm->op_pmflags |= PMf_WHITE;
- hoistmust(pm);
op_free(expr);
}
else {
OP *curop;
if (pm->op_pmflags & PMf_EVAL)
curop = 0;
+#ifdef USE_THREADS
+ else if (repl->op_type == OP_THREADSV
+ && strchr("&`'123456789+",
+ threadsv_names[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_THREADSV
+ && 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 ||
newUNOP(OP_METHOD, 0, meth)));
}
}
-
+
/* Fake up an import/unimport */
if (arg && arg->op_type == OP_STUB)
imop = arg; /* no import on explicit () */
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((OP*)loop);
return Nullop; /* (listop already freed by newLOGOP) */
}
- ((LISTOP*)listop)->op_last->op_next = condop =
+ ((LISTOP*)listop)->op_last->op_next = condop =
(o == listop ? redo : LINKLIST(o));
if (!next)
next = condop;
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));
if (CvPADLIST(cv)) {
/* may be during global destruction */
if (SvREFCNT(CvPADLIST(cv))) {
- I32 i = AvFILL(CvPADLIST(cv));
+ I32 i = AvFILLp(CvPADLIST(cv));
while (i >= 0) {
SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE);
SV* sv = svp ? *svp : Nullsv;
pname = AvARRAY(pad_name);
ppad = AvARRAY(pad);
- for (ix = 1; ix <= AvFILL(pad_name); ix++) {
+ for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
if (SvPOK(pname[ix]))
PerlIO_printf(Perl_debug_log, "\t%4d. 0x%lx (%s\"%s\" %ld-%ld)\n",
ix, ppad[ix],
AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
SV** pname = AvARRAY(protopad_name);
SV** ppad = AvARRAY(protopad);
- I32 fname = AvFILL(protopad_name);
- I32 fpad = AvFILL(protopad);
+ I32 fname = AvFILLp(protopad_name);
+ I32 fpad = AvFILLp(protopad);
AV* comppadlist;
CV* cv;
av_store(comppadlist, 0, (SV*)comppad_name);
av_store(comppadlist, 1, (SV*)comppad);
CvPADLIST(cv) = comppadlist;
- av_fill(comppad, AvFILL(protopad));
+ av_fill(comppad, AvFILLp(protopad));
curpad = AvARRAY(comppad);
av = newAV(); /* will be @_ */
{
OP *o;
SV *sv;
-
+
if (!cv || !SvPOK(cv) || SvCUR(cv))
return Nullsv;
croak(not_safe);
else {
/* force display of errors found but not reported */
- sv_catpv(GvSV(errgv), not_safe);
- croak("%s", SvPVx(GvSV(errgv), na));
+ sv_catpv(ERRSV, not_safe);
+ croak("%s", SvPVx(ERRSV, na));
}
}
}
return cv;
}
- if (AvFILL(comppad_name) < AvFILL(comppad))
- av_store(comppad_name, AvFILL(comppad), Nullsv);
+ if (AvFILLp(comppad_name) < AvFILLp(comppad))
+ av_store(comppad_name, AvFILLp(comppad), Nullsv);
if (CvCLONE(cv)) {
SV **namep = AvARRAY(comppad_name);
- for (ix = AvFILL(comppad); ix > 0; ix--) {
+ for (ix = AvFILLp(comppad); ix > 0; ix--) {
SV *namesv;
if (SvIMMORTAL(curpad[ix]))
av_store(comppad, 0, (SV*)av);
AvFLAGS(av) = AVf_REIFY;
- for (ix = AvFILL(comppad); ix > 0; ix--) {
+ for (ix = AvFILLp(comppad); ix > 0; ix--) {
if (SvIMMORTAL(curpad[ix]))
continue;
if (!SvPADMY(curpad[ix]))
if (PERLDB_SUBLINE && curstash != debstash) {
SV *sv = NEWSV(0,0);
SV *tmpstr = sv_newmortal();
- static GV *db_postponed;
+ GV *db_postponed = gv_fetchpv("DB::postponed", GV_ADDMULTI, SVt_PVHV);
CV *cv;
HV *hv;
(long)subline, (long)curcop->cop_line);
gv_efullname3(tmpstr, gv, Nullch);
hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
- if (!db_postponed) {
- db_postponed = gv_fetchpv("DB::postponed", GV_ADDMULTI, SVt_PVHV);
- }
hv = GvHVn(db_postponed);
if (HvFILL(hv) > 0 && hv_exists(hv, SvPVX(tmpstr), SvCUR(tmpstr))
&& (cv = GvCV(db_postponed))) {
return cv;
}
-#ifdef DEPRECATED
-CV *
-newXSUB(name, ix, subaddr, filename)
-char *name;
-I32 ix;
-I32 (*subaddr)();
-char *filename;
-{
- CV* cv = newXS(name, (void(*)())subaddr, filename);
- CvOLDSTYLE_on(cv);
- CvXSUBANY(cv).any_i32 = ix;
- return cv;
-}
-#endif
-
CV *
newXS(char *name, void (*subaddr) (CV *), char *filename)
{
CvGV(cv) = (GV*)SvREFCNT_inc(gv);
CvFILEGV(cv) = curcop->cop_filegv;
- for (ix = AvFILL(comppad); ix > 0; ix--) {
+ for (ix = AvFILLp(comppad); ix > 0; ix--) {
if (!SvPADMY(curpad[ix]) && !SvIMMORTAL(curpad[ix]))
SvPADTMP_on(curpad[ix]);
}
o->op_ppaddr = ppaddr[OP_PADSV];
return o;
}
+ else if (o->op_type == OP_THREADSV && !(o->op_flags & OPpDONE_SVREF)) {
+ o->op_flags |= OPpDONE_SVREF;
+ return o;
+ }
return newUNOP(OP_RV2SV, 0, scalar(o));
}
!(opargs[newop->op_type] & OA_RETSCALAR) ||
newop->op_type == OP_PADAV || newop->op_type == OP_PADHV ||
newop->op_type == OP_RV2AV || newop->op_type == OP_RV2HV)) {
-
+
return o;
}
op_free(kUNOP->op_first);
enter->op_other = o;
return o;
}
+ else
+ scalar((OP*)kid);
}
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;
}
I32 numargs = 0;
int type = o->op_type;
register I32 oa = opargs[type] >> OASHIFT;
-
+
if (o->op_flags & OPf_STACKED) {
if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL))
oa &= ~OA_OPTIONAL;
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);
cLISTOPo->op_first->op_type = OP_PUSHMARK;
cLISTOPo->op_first->op_ppaddr = ppaddr[OP_PUSHMARK];
o = newUNOP(OP_ENTERSUB, OPf_STACKED,
- append_elem(OP_LIST, o,
+ append_elem(OP_LIST, o,
scalar(newUNOP(OP_RV2CV, 0,
newGVOP(OP_GV, 0, gv)))));
o = newUNOP(OP_NULL, 0, ck_subr(o));
o->op_ppaddr = ppaddr[OP_GREPSTART];
Newz(1101, gwop, 1, LOGOP);
-
+
if (o->op_flags & OPf_STACKED) {
OP* k;
o = ck_sort(o);
o = ck_fun(o);
if (error_count)
return o;
- kid = cLISTOPo->op_first->op_sibling;
+ kid = cLISTOPo->op_first->op_sibling;
if (kid->op_type != OP_NULL)
croak("panic: ck_grep");
kid = kUNOP->op_first;
ck_listiob(OP *o)
{
register OP *kid;
-
+
kid = cLISTOPo->op_first;
if (!kid) {
o = force_list(o);
}
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 (!CvUNIQUE(compcv)) {
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, !CvUNIQUE(compcv) ?
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;
o->op_next = o->op_next->op_next;
}
break;
-
+
case OP_PADHV:
if (o->op_next->op_type == OP_RV2HV
&& (o->op_next->op_flags && OPf_REF))
}
}
break;
-
+
case OP_HELEM: {
UNOP *rop;
SV *lexname;
I32 ind;
char *key;
STRLEN keylen;
-
+
if (o->op_private & (OPpDEREF_HV|OPpDEREF_AV|OPpLVAL_INTRO)
|| ((BINOP*)o)->op_last->op_type != OP_CONST)
break;
projects / p5sagit/p5-mst-13.2.git / blobdiff