X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/6d4ff0d2f86d3c242b3f29bee3c2734df9ab8a3a..dab48698179b4e8606409875b7121f225bcf46be:/op.c diff --git a/op.c b/op.c index 20e1384..f6857af 100644 --- a/op.c +++ b/op.c @@ -40,10 +40,11 @@ static OP *too_many_arguments _((OP *o, char* name)); 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 OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp)); static char* -gv_ename(gv) -GV* gv; +gv_ename(GV *gv) { SV* tmpsv = sv_newmortal(); gv_efullname3(tmpsv, gv, Nullch); @@ -51,8 +52,7 @@ GV* gv; } static OP * -no_fh_allowed(o) -OP *o; +no_fh_allowed(OP *o) { yyerror(form("Missing comma after first argument to %s function", op_desc[o->op_type])); @@ -60,37 +60,28 @@ OP *o; } static OP * -too_few_arguments(o, name) -OP* o; -char* name; +too_few_arguments(OP *o, char *name) { yyerror(form("Not enough arguments for %s", name)); return o; } static OP * -too_many_arguments(o, name) -OP *o; -char* name; +too_many_arguments(OP *o, char *name) { yyerror(form("Too many arguments for %s", name)); return o; } static void -bad_type(n, t, name, kid) -I32 n; -char *t; -char *name; -OP *kid; +bad_type(I32 n, char *t, char *name, OP *kid) { yyerror(form("Type of arg %d to %s must be %s (not %s)", (int)n, name, t, op_desc[kid->op_type])); } void -assertref(o) -OP *o; +assertref(OP *o) { int type = o->op_type; if (type != OP_AELEM && type != OP_HELEM) { @@ -104,8 +95,7 @@ OP *o; /* "register" allocation */ PADOFFSET -pad_allocmy(name) -char *name; +pad_allocmy(char *name) { dTHR; PADOFFSET off; @@ -119,9 +109,9 @@ char *name; } croak("Can't use global %s in \"my\"",name); } - if (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 */ @@ -159,23 +149,14 @@ char *name; } static PADOFFSET -#ifndef CAN_PROTOTYPE -pad_findlex(name, newoff, seq, startcv, cx_ix) -char *name; -PADOFFSET newoff; -U32 seq; -CV* startcv; -I32 cx_ix; -#else pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix) -#endif { dTHR; CV *cv; I32 off; SV *sv; register I32 i; - register CONTEXT *cx; + register PERL_CONTEXT *cx; int saweval; for (cv = startcv; cv; cv = CvOUTSIDE(cv)) { @@ -187,7 +168,7 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix) 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) && @@ -295,8 +276,7 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix) } PADOFFSET -pad_findmy(name) -char *name; +pad_findmy(char *name) { dTHR; I32 off; @@ -319,7 +299,7 @@ char *name; #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) || @@ -345,8 +325,7 @@ char *name; } void -pad_leavemy(fill) -I32 fill; +pad_leavemy(I32 fill) { I32 off; SV **svp = AvARRAY(comppad_name); @@ -358,16 +337,14 @@ I32 fill; } } /* "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; } } PADOFFSET -pad_alloc(optype,tmptype) -I32 optype; -U32 tmptype; +pad_alloc(I32 optype, U32 tmptype) { dTHR; SV *sv; @@ -379,13 +356,13 @@ U32 tmptype; 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" @@ -408,19 +385,15 @@ U32 tmptype; (unsigned long) thr, (unsigned long) curpad, (long) retval, op_name[optype])); #else - DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad alloc %ld for %s\n", + DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx alloc %ld for %s\n", + (unsigned long) curpad, (long) retval, op_name[optype])); #endif /* USE_THREADS */ return (PADOFFSET)retval; } SV * -#ifndef CAN_PROTOTYPE -pad_sv(po) -PADOFFSET po; -#else pad_sv(PADOFFSET po) -#endif /* CAN_PROTOTYPE */ { dTHR; #ifdef USE_THREADS @@ -429,18 +402,14 @@ pad_sv(PADOFFSET po) #else if (!po) croak("panic: pad_sv po"); - DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad sv %d\n", po)); + DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx sv %d\n", + (unsigned long) curpad, po)); #endif /* USE_THREADS */ return curpad[po]; /* eventually we'll turn this into a macro */ } void -#ifndef CAN_PROTOTYPE -pad_free(po) -PADOFFSET po; -#else pad_free(PADOFFSET po) -#endif /* CAN_PROTOTYPE */ { dTHR; if (!curpad) @@ -453,7 +422,8 @@ pad_free(PADOFFSET po) DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx free %d\n", (unsigned long) thr, (unsigned long) curpad, po)); #else - DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad free %d\n", po)); + DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx free %d\n", + (unsigned long) curpad, po)); #endif /* USE_THREADS */ if (curpad[po] && curpad[po] != &sv_undef) SvPADTMP_off(curpad[po]); @@ -462,12 +432,7 @@ pad_free(PADOFFSET po) } void -#ifndef CAN_PROTOTYPE -pad_swipe(po) -PADOFFSET po; -#else pad_swipe(PADOFFSET po) -#endif /* CAN_PROTOTYPE */ { dTHR; if (AvARRAY(comppad) != curpad) @@ -478,7 +443,8 @@ pad_swipe(PADOFFSET po) DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx swipe %d\n", (unsigned long) thr, (unsigned long) curpad, po)); #else - DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad swipe %d\n", po)); + DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx swipe %d\n", + (unsigned long) curpad, po)); #endif /* USE_THREADS */ SvPADTMP_off(curpad[po]); curpad[po] = NEWSV(1107,0); @@ -487,9 +453,16 @@ pad_swipe(PADOFFSET po) padix = po - 1; } +/* XXX pad_reset() is currently disabled because it results in serious bugs. + * It causes pad temp TARGs to be shared between OPs. Since TARGs are pushed + * on the stack by OPs that use them, there are several ways to get an alias + * to a shared TARG. Such an alias will change randomly and unpredictably. + * We avoid doing this until we can think of a Better Way. + * GSAR 97-10-29 */ void -pad_reset() +pad_reset(void) { +#ifdef USE_BROKEN_PAD_RESET dTHR; register I32 po; @@ -499,7 +472,8 @@ pad_reset() DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx reset\n", (unsigned long) thr, (unsigned long) curpad)); #else - DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad reset\n")); + DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx reset\n", + (unsigned long) curpad)); #endif /* USE_THREADS */ if (!tainting) { /* Can't mix tainted and non-tainted temporaries. */ for (po = AvMAX(comppad); po > padix_floor; po--) { @@ -508,14 +482,63 @@ pad_reset() } padix = padix_floor; } +#endif 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); + thr->threadsvp = AvARRAY(thr->threadsv); + /* + * 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 -op_free(o) -OP *o; +op_free(OP *o) { register OP *kid, *nextkid; @@ -536,6 +559,11 @@ OP *o; 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; @@ -568,8 +596,7 @@ OP *o; /* FALL THROUGH */ case OP_PUSHRE: case OP_MATCH: - pregfree(cPMOPo->op_pmregexp); - SvREFCNT_dec(cPMOPo->op_pmshort); + ReREFCNT_dec(cPMOPo->op_pmregexp); break; } @@ -580,10 +607,9 @@ OP *o; } static void -null(o) -OP* o; +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; @@ -595,8 +621,7 @@ OP* o; #define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist((OP*)o)) OP * -linklist(o) -OP *o; +linklist(OP *o) { register OP *kid; @@ -620,8 +645,7 @@ OP *o; } OP * -scalarkids(o) -OP *o; +scalarkids(OP *o) { OP *kid; if (o && o->op_flags & OPf_KIDS) { @@ -632,11 +656,11 @@ OP *o; } static OP * -scalarboolean(o) -OP *o; +scalarboolean(OP *o) { if (dowarn && o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) { + dTHR; line_t oldline = curcop->cop_line; if (copline != NOLINE) @@ -648,8 +672,7 @@ OP *o; } OP * -scalar(o) -OP *o; +scalar(OP *o) { OP *kid; @@ -697,7 +720,7 @@ OP *o; else scalar(kid); } - curcop = &compiling; + WITH_THR(curcop = &compiling); break; case OP_SCOPE: case OP_LINESEQ: @@ -708,15 +731,14 @@ OP *o; else scalar(kid); } - curcop = &compiling; + WITH_THR(curcop = &compiling); break; } return o; } OP * -scalarvoid(o) -OP *o; +scalarvoid(OP *o) { OP *kid; char* useless = 0; @@ -821,7 +843,7 @@ OP *o; case OP_NEXTSTATE: case OP_DBSTATE: - curcop = ((COP*)o); /* for warning below */ + WITH_THR(curcop = ((COP*)o)); /* for warning below */ break; case OP_CONST: @@ -860,7 +882,7 @@ OP *o; case OP_NULL: if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE) - curcop = ((COP*)o); /* for warning below */ + WITH_THR(curcop = ((COP*)o)); /* for warning below */ if (o->op_flags & OPf_STACKED) break; /* FALL THROUGH */ @@ -899,8 +921,7 @@ OP *o; } OP * -listkids(o) -OP *o; +listkids(OP *o) { OP *kid; if (o && o->op_flags & OPf_KIDS) { @@ -911,8 +932,7 @@ OP *o; } OP * -list(o) -OP *o; +list(OP *o) { OP *kid; @@ -957,7 +977,7 @@ OP *o; else list(kid); } - curcop = &compiling; + WITH_THR(curcop = &compiling); break; case OP_SCOPE: case OP_LINESEQ: @@ -967,7 +987,7 @@ OP *o; else list(kid); } - curcop = &compiling; + WITH_THR(curcop = &compiling); break; case OP_REQUIRE: /* all requires must return a boolean value */ @@ -978,8 +998,7 @@ OP *o; } OP * -scalarseq(o) -OP *o; +scalarseq(OP *o) { OP *kid; @@ -989,6 +1008,7 @@ OP *o; o->op_type == OP_LEAVE || o->op_type == OP_LEAVETRY) { + dTHR; for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) { if (kid->op_sibling) { scalarvoid(kid); @@ -1006,9 +1026,7 @@ OP *o; } static OP * -modkids(o, type) -OP *o; -I32 type; +modkids(OP *o, I32 type) { OP *kid; if (o && o->op_flags & OPf_KIDS) { @@ -1021,9 +1039,7 @@ I32 type; static I32 modcount; OP * -mod(o, type) -OP *o; -I32 type; +mod(OP *o, I32 type) { dTHR; OP *kid; @@ -1034,6 +1050,7 @@ I32 type; switch (o->op_type) { case OP_UNDEF: + modcount++; return o; case OP_CONST: if (!(o->op_private & (OPpCONST_ARYBASE))) @@ -1107,6 +1124,8 @@ I32 type; case OP_RV2AV: case OP_RV2HV: + if (!type && cUNOPo->op_first->op_type != OP_GV) + croak("Can't localize through a reference"); if (type == OP_REFGEN && o->op_flags & OPf_PARENS) { modcount = 10000; return o; /* Treat \(@foo) like ordinary list. */ @@ -1128,11 +1147,12 @@ I32 type; break; case OP_RV2SV: if (!type && cUNOPo->op_first->op_type != OP_GV) - croak("Can't localize a reference"); - ref(cUNOPo->op_first, o->op_type); + croak("Can't localize through a reference"); + ref(cUNOPo->op_first, o->op_type); /* FALL THROUGH */ case OP_GV: case OP_AV2ARYLEN: + hints |= HINT_BLOCK_SCOPE; case OP_SASSIGN: case OP_AELEMFAST: modcount++; @@ -1153,6 +1173,12 @@ I32 type; 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; @@ -1213,9 +1239,7 @@ I32 type; } static bool -scalar_mod_type(o, type) -OP *o; -I32 type; +scalar_mod_type(OP *o, I32 type) { switch (type) { case OP_SASSIGN: @@ -1259,9 +1283,7 @@ I32 type; } OP * -refkids(o, type) -OP *o; -I32 type; +refkids(OP *o, I32 type) { OP *kid; if (o && o->op_flags & OPf_KIDS) { @@ -1272,9 +1294,7 @@ I32 type; } OP * -ref(o, type) -OP *o; -I32 type; +ref(OP *o, I32 type) { OP *kid; @@ -1283,7 +1303,7 @@ I32 type; switch (o->op_type) { case OP_ENTERSUB: - if ((type == OP_DEFINED) && + if ((type == OP_DEFINED || type == OP_LOCK) && !(o->op_flags & OPf_STACKED)) { o->op_type = OP_RV2CV; /* entersub => rv2cv */ o->op_ppaddr = ppaddr[OP_RV2CV]; @@ -1292,7 +1312,7 @@ I32 type; 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); @@ -1309,9 +1329,13 @@ I32 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); @@ -1319,9 +1343,9 @@ I32 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)) @@ -1355,8 +1379,7 @@ I32 type; } OP * -my(o) -OP *o; +my(OP *o) { OP *kid; I32 type; @@ -1368,8 +1391,9 @@ OP *o; if (type == OP_LIST) { for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) my(kid); - } - else if (type != OP_PADSV && + } else if (type == OP_UNDEF) { + return op; + } else if (type != OP_PADSV && type != OP_PADAV && type != OP_PADHV && type != OP_PUSHMARK) @@ -1383,8 +1407,7 @@ OP *o; } OP * -sawparens(o) -OP *o; +sawparens(OP *o) { if (o) o->op_flags |= OPf_PARENS; @@ -1392,10 +1415,7 @@ OP *o; } OP * -bind_match(type, left, right) -I32 type; -OP *left; -OP *right; +bind_match(I32 type, OP *left, OP *right) { OP *o; @@ -1433,8 +1453,7 @@ OP *right; } OP * -invert(o) -OP *o; +invert(OP *o) { if (!o) return o; @@ -1443,11 +1462,10 @@ OP *o; } OP * -scope(o) -OP *o; +scope(OP *o) { if (o) { - if (o->op_flags & OPf_PARENS || perldb || tainting) { + if (o->op_flags & OPf_PARENS || PERLDB_NOOPT || tainting) { o = prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o); o->op_type = OP_LEAVE; o->op_ppaddr = ppaddr[OP_LEAVE]; @@ -1471,14 +1489,13 @@ OP *o; } int -block_start(full) -int full; +block_start(int full) { dTHR; 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; @@ -1496,9 +1513,7 @@ int full; } OP* -block_end(floor, seq) -I32 floor; -OP* seq; +block_end(I32 floor, OP *seq) { dTHR; int needblockscope = hints & HINT_BLOCK_SCOPE; @@ -1512,9 +1527,20 @@ OP* seq; 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(o) -OP *o; +newPROG(OP *o) { dTHR; if (in_eval) { @@ -1534,7 +1560,7 @@ OP *o; compcv = 0; /* Register with debugger */ - if (perldb) { + if (PERLDB_INTER) { CV *cv = perl_get_cv("DB::postponed", FALSE); if (cv) { dSP; @@ -1548,14 +1574,11 @@ OP *o; } OP * -localize(o, lex) -OP *o; -I32 lex; +localize(OP *o, I32 lex) { if (o->op_flags & OPf_PARENS) list(o); else { - scalar(o); if (dowarn && bufptr > oldbufptr && bufptr[-1] == ',') { char *s; for (s = bufptr; *s && (isALNUM(*s) || strchr("@$%, ",*s)); s++) ; @@ -1572,21 +1595,23 @@ I32 lex; } OP * -jmaybe(o) -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; } OP * -fold_constants(o) -register OP *o; +fold_constants(register OP *o) { dTHR; register OP *curop; @@ -1604,6 +1629,22 @@ register OP *o; if (!(opargs[type] & OA_FOLDCONST)) goto nope; + switch (type) { + case OP_SPRINTF: + case OP_UCFIRST: + case OP_LCFIRST: + case OP_UC: + case OP_LC: + case OP_SLT: + case OP_SGT: + case OP_SLE: + case OP_SGE: + case OP_SCMP: + + if (o->op_private & OPpLOCALE) + goto nope; + } + if (error_count) goto nope; /* Don't try to run w/ errors */ @@ -1643,7 +1684,7 @@ register OP *o; } return newSVOP(OP_CONST, 0, sv); } - + nope: if (!(opargs[type] & OA_OTHERINT)) return o; @@ -1669,8 +1710,7 @@ register OP *o; } OP * -gen_constant_list(o) -register OP *o; +gen_constant_list(register OP *o) { dTHR; register OP *curop; @@ -1698,10 +1738,7 @@ register OP *o; } OP * -convert(type, flags, o) -I32 type; -I32 flags; -OP* o; +convert(I32 type, I32 flags, OP *o) { OP *kid; OP *last = 0; @@ -1735,10 +1772,7 @@ OP* o; /* List constructors */ OP * -append_elem(type, first, last) -I32 type; -OP* first; -OP* last; +append_elem(I32 type, OP *first, OP *last) { if (!first) return last; @@ -1761,10 +1795,7 @@ OP* last; } OP * -append_list(type, first, last) -I32 type; -LISTOP* first; -LISTOP* last; +append_list(I32 type, LISTOP *first, LISTOP *last) { if (!first) return (OP*)last; @@ -1789,10 +1820,7 @@ LISTOP* last; } OP * -prepend_elem(type, first, last) -I32 type; -OP* first; -OP* last; +prepend_elem(I32 type, OP *first, OP *last) { if (!first) return last; @@ -1823,14 +1851,13 @@ OP* last; /* Constructors */ OP * -newNULLLIST() +newNULLLIST(void) { return newOP(OP_STUB, 0); } OP * -force_list(o) -OP *o; +force_list(OP *o) { if (!o || o->op_type != OP_LIST) o = newLISTOP(OP_LIST, 0, o, Nullop); @@ -1839,11 +1866,7 @@ OP *o; } OP * -newLISTOP(type, flags, first, last) -I32 type; -I32 flags; -OP* first; -OP* last; +newLISTOP(I32 type, I32 flags, OP *first, OP *last) { LISTOP *listop; @@ -1878,9 +1901,7 @@ OP* last; } OP * -newOP(type, flags) -I32 type; -I32 flags; +newOP(I32 type, I32 flags) { OP *o; Newz(1101, o, 1, OP); @@ -1898,15 +1919,12 @@ I32 flags; } OP * -newUNOP(type, flags, first) -I32 type; -I32 flags; -OP* first; +newUNOP(I32 type, I32 flags, OP *first) { UNOP *unop; if (!first) - first = newOP(OP_STUB, 0); + first = newOP(OP_STUB, 0); if (opargs[type] & OA_MARK) first = force_list(first); @@ -1916,7 +1934,12 @@ OP* 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; @@ -1925,11 +1948,7 @@ OP* first; } OP * -newBINOP(type, flags, first, last) -I32 type; -I32 flags; -OP* first; -OP* last; +newBINOP(I32 type, I32 flags, OP *first, OP *last) { BINOP *binop; Newz(1101, binop, 1, BINOP); @@ -1960,10 +1979,7 @@ OP* last; } OP * -pmtrans(o, expr, repl) -OP *o; -OP *expr; -OP *repl; +pmtrans(OP *o, OP *expr, OP *repl) { SV *tstr = ((SVOP*)expr)->op_sv; SV *rstr = ((SVOP*)repl)->op_sv; @@ -1973,14 +1989,15 @@ OP *repl; register U8 *r = (U8*)SvPV(rstr, rlen); register I32 i; register I32 j; - I32 delete; + 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; */ + Delete = o->op_private & OPpTRANS_DELETE; + squash = o->op_private & OPpTRANS_SQUASH; if (complement) { Zero(tbl, 256, short); @@ -1989,7 +2006,7 @@ OP *repl; for (i = 0, j = 0; i < 256; i++) { if (!tbl[i]) { if (j >= rlen) { - if (delete) + if (Delete) tbl[i] = -2; else if (rlen) tbl[i] = r[j-1]; @@ -2002,14 +2019,16 @@ OP *repl; } } else { - if (!rlen && !delete) { + if (!rlen && !Delete) { r = t; rlen = tlen; + if (!squash) + o->op_private |= OPpTRANS_COUNTONLY; } for (i = 0; i < 256; i++) tbl[i] = -1; for (i = 0, j = 0; i < tlen; i++,j++) { if (j >= rlen) { - if (delete) { + if (Delete) { if (tbl[t[i]] == -1) tbl[t[i]] = -2; continue; @@ -2027,9 +2046,7 @@ OP *repl; } OP * -newPMOP(type, flags) -I32 type; -I32 flags; +newPMOP(I32 type, I32 flags) { dTHR; PMOP *pmop; @@ -2053,10 +2070,7 @@ I32 flags; } OP * -pmruntime(o, expr, repl) -OP *o; -OP *expr; -OP *repl; +pmruntime(OP *o, OP *expr, OP *repl) { PMOP *pm; LOGOP *rcop; @@ -2064,6 +2078,7 @@ OP *repl; if (o->op_type == OP_TRANS) return pmtrans(o, expr, repl); + hints |= HINT_BLOCK_SCOPE; pm = (PMOP*)o; if (expr->op_type == OP_CONST) { @@ -2076,9 +2091,8 @@ OP *repl; 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 { @@ -2111,17 +2125,32 @@ OP *repl; 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 || @@ -2171,10 +2200,7 @@ OP *repl; } OP * -newSVOP(type, flags, sv) -I32 type; -I32 flags; -SV *sv; +newSVOP(I32 type, I32 flags, SV *sv) { SVOP *svop; Newz(1101, svop, 1, SVOP); @@ -2191,10 +2217,7 @@ SV *sv; } OP * -newGVOP(type, flags, gv) -I32 type; -I32 flags; -GV *gv; +newGVOP(I32 type, I32 flags, GV *gv) { dTHR; GVOP *gvop; @@ -2212,10 +2235,7 @@ GV *gv; } OP * -newPVOP(type, flags, pv) -I32 type; -I32 flags; -char *pv; +newPVOP(I32 type, I32 flags, char *pv) { PVOP *pvop; Newz(1101, pvop, 1, PVOP); @@ -2232,8 +2252,7 @@ char *pv; } void -package(o) -OP *o; +package(OP *o) { dTHR; SV *sv; @@ -2258,12 +2277,7 @@ OP *o; } void -utilize(aver, floor, version, id, arg) -int aver; -I32 floor; -OP *version; -OP *id; -OP *arg; +utilize(int aver, I32 floor, OP *version, OP *id, OP *arg) { OP *pack; OP *meth; @@ -2300,7 +2314,7 @@ OP *arg; newUNOP(OP_METHOD, 0, meth))); } } - + /* Fake up an import/unimport */ if (arg && arg->op_type == OP_STUB) imop = arg; /* no import on explicit () */ @@ -2339,10 +2353,7 @@ OP *arg; } OP * -newSLICEOP(flags, subscript, listval) -I32 flags; -OP *subscript; -OP *listval; +newSLICEOP(I32 flags, OP *subscript, OP *listval) { return newBINOP(OP_LSLICE, flags, list(force_list(subscript)), @@ -2350,8 +2361,7 @@ OP *listval; } static I32 -list_assignment(o) -register OP *o; +list_assignment(register OP *o) { if (!o) return TRUE; @@ -2385,11 +2395,7 @@ register OP *o; } OP * -newASSIGNOP(flags, left, optype, right) -I32 flags; -OP *left; -I32 optype; -OP *right; +newASSIGNOP(I32 flags, OP *left, I32 optype, OP *right) { OP *o; @@ -2518,17 +2524,14 @@ OP *right; } OP * -newSTATEOP(flags, label, o) -I32 flags; -char *label; -OP *o; +newSTATEOP(I32 flags, char *label, OP *o) { dTHR; U32 seq = intro_my(); register COP *cop; Newz(1101, cop, 1, COP); - if (perldb && curcop->cop_line && curstash != debstash) { + if (PERLDB_LINE && curcop->cop_line && curstash != debstash) { cop->op_type = OP_DBSTATE; cop->op_ppaddr = ppaddr[ OP_DBSTATE ]; } @@ -2559,7 +2562,7 @@ OP *o; cop->cop_filegv = (GV*)SvREFCNT_inc(curcop->cop_filegv); cop->cop_stash = curstash; - if (perldb && curstash != debstash) { + if (PERLDB_LINE && curstash != debstash) { SV **svp = av_fetch(GvAV(curcop->cop_filegv),(I32)cop->cop_line, FALSE); if (svp && *svp != &sv_undef && !SvIOK(*svp)) { (void)SvIOK_on(*svp); @@ -2573,7 +2576,7 @@ OP *o; /* "Introduce" my variables to visible status. */ U32 -intro_my() +intro_my(void) { SV **svp; SV *sv; @@ -2595,15 +2598,19 @@ intro_my() } OP * -newLOGOP(type, flags, first, other) -I32 type; -I32 flags; -OP* first; -OP* other; +newLOGOP(I32 type, I32 flags, OP *first, OP *other) +{ + return new_logop(type, flags, &first, &other); +} + +static OP * +new_logop(I32 type, I32 flags, OP** firstp, OP** otherp) { dTHR; LOGOP *logop; OP *o; + OP *first = *firstp; + OP *other = *otherp; if (type == OP_XOR) /* Not short circuit, but here by precedence. */ return newBINOP(type, flags, scalar(first), scalar(other)); @@ -2617,7 +2624,7 @@ OP* other; else type = OP_AND; o = first; - first = cUNOPo->op_first; + first = *firstp = cUNOPo->op_first; if (o->op_next) first->op_next = o->op_next; cUNOPo->op_first = Nullop; @@ -2629,10 +2636,12 @@ OP* other; warn("Probable precedence problem on %s", op_desc[type]); if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) { op_free(first); + *firstp = Nullop; return other; } else { op_free(other); + *otherp = Nullop; return first; } } @@ -2700,11 +2709,7 @@ OP* other; } OP * -newCONDOP(flags, first, trueop, falseop) -I32 flags; -OP* first; -OP* trueop; -OP* falseop; +newCONDOP(I32 flags, OP *first, OP *trueop, OP *falseop) { dTHR; CONDOP *condop; @@ -2757,10 +2762,7 @@ OP* falseop; } OP * -newRANGE(flags, left, right) -I32 flags; -OP *left; -OP *right; +newRANGE(I32 flags, OP *left, OP *right) { dTHR; CONDOP *condop; @@ -2805,11 +2807,7 @@ OP *right; } OP * -newLOOPOP(flags, debuggable, expr, block) -I32 flags; -I32 debuggable; -OP *expr; -OP *block; +newLOOPOP(I32 flags, I32 debuggable, OP *expr, OP *block) { dTHR; OP* listop; @@ -2820,16 +2818,18 @@ OP *block; if (expr) { if (once && expr->op_type == OP_CONST && !SvTRUE(((SVOP*)expr)->op_sv)) return block; /* do {} while 0 does once */ - if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB) { + 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) ); } } listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0)); - o = newLOGOP(OP_AND, 0, expr, listop); + o = new_logop(OP_AND, 0, &expr, &listop); - ((LISTOP*)listop)->op_last->op_next = LINKLIST(o); + if (listop) + ((LISTOP*)listop)->op_last->op_next = LINKLIST(o); if (once && o != listop) o->op_next = ((LOGOP*)cUNOPo->op_first)->op_other; @@ -2844,13 +2844,7 @@ OP *block; } OP * -newWHILEOP(flags, debuggable, loop, expr, block, cont) -I32 flags; -I32 debuggable; -LOOP *loop; -OP *expr; -OP *block; -OP *cont; +newWHILEOP(I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *expr, OP *block, OP *cont) { dTHR; OP *redo; @@ -2859,9 +2853,10 @@ OP *cont; OP *o; OP *condop; - if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)) { + 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) @@ -2869,21 +2864,30 @@ OP *cont; if (cont) next = LINKLIST(cont); - if (expr) + if (expr) { cont = append_elem(OP_LINESEQ, cont, newOP(OP_UNSTACK, 0)); + if ((line_t)whileline != NOLINE) { + copline = whileline; + cont = append_elem(OP_LINESEQ, cont, + newSTATEOP(0, Nullch, Nullop)); + } + } listop = append_list(OP_LINESEQ, (LISTOP*)block, (LISTOP*)cont); redo = LINKLIST(listop); if (expr) { - o = newLOGOP(OP_AND, 0, expr, scalar(listop)); + copline = whileline; + scalar(listop); + o = new_logop(OP_AND, 0, &expr, &listop); if (o == expr && o->op_type == OP_CONST && !SvTRUE(cSVOPo->op_sv)) { op_free(expr); /* oops, it's a while (0) */ op_free((OP*)loop); - return Nullop; /* (listop already freed by newLOGOP) */ + return Nullop; /* listop already freed by new_logop */ } - ((LISTOP*)listop)->op_last->op_next = condop = - (o == listop ? redo : LINKLIST(o)); + if (listop) + ((LISTOP*)listop)->op_last->op_next = condop = + (o == listop ? redo : LINKLIST(o)); if (!next) next = condop; } @@ -2914,24 +2918,13 @@ OP *cont; } OP * -#ifndef CAN_PROTOTYPE -newFOROP(flags,label,forline,sv,expr,block,cont) -I32 flags; -char *label; -line_t forline; -OP* sv; -OP* expr; -OP*block; -OP*cont; -#else newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont) -#endif /* CAN_PROTOTYPE */ { LOOP *loop; + OP *wop; int padoff = 0; I32 iterflags = 0; - copline = forline; if (sv) { if (sv->op_type == OP_RV2SV) { /* symbol table variable */ sv->op_type = OP_RV2GV; @@ -2942,11 +2935,22 @@ newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont 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)); @@ -2958,22 +2962,25 @@ newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont assert(!loop->op_next); Renew(loop, 1, LOOP); loop->op_targ = padoff; - return newSTATEOP(0, label, newWHILEOP(flags, 1, loop, - newOP(OP_ITER, 0), block, cont)); + wop = newWHILEOP(flags, 1, loop, forline, newOP(OP_ITER, 0), block, cont); + copline = forline; + return newSTATEOP(0, label, wop); } OP* -newLOOPEX(type, label) -I32 type; -OP* label; +newLOOPEX(I32 type, OP *label) { dTHR; OP *o; if (type != OP_GOTO || label->op_type == OP_CONST) { - o = newPVOP(type, 0, savepv( - label->op_type == OP_CONST - ? SvPVx(((SVOP*)label)->op_sv, na) - : "" )); + /* "last()" means "last" */ + if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS)) + o = newOP(type, OPf_SPECIAL); + else { + o = newPVOP(type, 0, savepv(label->op_type == OP_CONST + ? SvPVx(((SVOP*)label)->op_sv, na) + : "")); + } op_free(label); } else { @@ -2986,8 +2993,7 @@ OP* label; } void -cv_undef(cv) -CV *cv; +cv_undef(CV *cv) { dTHR; #ifdef USE_THREADS @@ -2996,11 +3002,6 @@ CV *cv; Safefree(CvMUTEXP(cv)); CvMUTEXP(cv) = 0; } - if (CvCONDP(cv)) { - COND_DESTROY(CvCONDP(cv)); - Safefree(CvCONDP(cv)); - CvCONDP(cv) = 0; - } #endif /* USE_THREADS */ if (!CvXSUB(cv) && CvROOT(cv)) { @@ -3030,7 +3031,7 @@ CV *cv; 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; @@ -3063,7 +3064,7 @@ CV* cv; SV** ppad; I32 ix; - PerlIO_printf(Perl_debug_log, "\tCV=0x%p (%s), OUTSIDE=0x%p (%s)\n", + PerlIO_printf(Perl_debug_log, "\tCV=0x%lx (%s), OUTSIDE=0x%lx (%s)\n", cv, (CvANON(cv) ? "ANON" : (cv == main_cv) ? "MAIN" @@ -3084,9 +3085,9 @@ CV* cv; 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%p (%s\"%s\" %ld-%ld)\n", + PerlIO_printf(Perl_debug_log, "\t%4d. 0x%lx (%s\"%s\" %ld-%ld)\n", ix, ppad[ix], SvFAKE(pname[ix]) ? "FAKE " : "", SvPVX(pname[ix]), @@ -3097,9 +3098,7 @@ CV* cv; #endif /* DEBUG_CLOSURES */ static CV * -cv_clone2(proto, outside) -CV* proto; -CV* outside; +cv_clone2(CV *proto, CV *outside) { dTHR; AV* av; @@ -3109,8 +3108,8 @@ CV* outside; 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; @@ -3129,10 +3128,8 @@ CV* outside; CvANON_on(cv); #ifdef USE_THREADS - New(666, CvMUTEXP(cv), 1, pthread_mutex_t); + New(666, CvMUTEXP(cv), 1, perl_mutex); MUTEX_INIT(CvMUTEXP(cv)); - New(666, CvCONDP(cv), 1, pthread_cond_t); - COND_INIT(CvCONDP(cv)); CvOWNER(cv) = 0; #endif /* USE_THREADS */ CvFILEGV(cv) = CvFILEGV(proto); @@ -3157,7 +3154,7 @@ CV* outside; 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 @_ */ @@ -3233,17 +3230,13 @@ CV* outside; } CV * -cv_clone(proto) -CV* proto; +cv_clone(CV *proto) { return cv_clone2(proto, CvOUTSIDE(proto)); } void -cv_ckproto(cv, gv, p) -CV* cv; -GV* gv; -char* p; +cv_ckproto(CV *cv, GV *gv, char *p) { if ((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX(cv)))) { SV* msg = sv_newmortal(); @@ -3266,12 +3259,11 @@ char* p; } SV * -cv_const_sv(cv) -CV* cv; +cv_const_sv(CV *cv) { OP *o; SV *sv; - + if (!cv || !SvPOK(cv) || SvCUR(cv)) return Nullsv; @@ -3302,11 +3294,7 @@ CV* cv; } CV * -newSUB(floor,o,proto,block) -I32 floor; -OP *o; -OP *proto; -OP *block; +newSUB(I32 floor, OP *o, OP *proto, OP *block) { dTHR; char *name = o ? SvPVx(cSVOPo->op_sv, na) : Nullch; @@ -3371,10 +3359,8 @@ OP *block; CvSTASH(cv) = curstash; #ifdef USE_THREADS CvOWNER(cv) = 0; - New(666, CvMUTEXP(cv), 1, pthread_mutex_t); + New(666, CvMUTEXP(cv), 1, perl_mutex); MUTEX_INIT(CvMUTEXP(cv)); - New(666, CvCONDP(cv), 1, pthread_cond_t); - COND_INIT(CvCONDP(cv)); #endif /* USE_THREADS */ if (ps) @@ -3393,8 +3379,8 @@ OP *block; 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)); } } } @@ -3405,12 +3391,12 @@ OP *block; 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])) @@ -3436,7 +3422,7 @@ OP *block; 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])) @@ -3452,10 +3438,10 @@ OP *block; if (name) { char *s; - if (perldb && curstash != debstash) { + 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; @@ -3464,9 +3450,6 @@ OP *block; (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))) { @@ -3508,10 +3491,10 @@ OP *block; av_store(endav, 0, (SV *)cv); GvCV(gv) = 0; } - else if (strEQ(s, "RESTART") && !error_count) { - if (!restartav) - restartav = newAV(); - av_push(restartav, SvREFCNT_inc(cv)); + else if (strEQ(s, "INIT") && !error_count) { + if (!initav) + initav = newAV(); + av_push(initav, SvREFCNT_inc(cv)); } } @@ -3521,26 +3504,8 @@ OP *block; 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(name, subaddr, filename) -char *name; -void (*subaddr) _((CV*)); -char *filename; +newXS(char *name, void (*subaddr) (CV *), char *filename) { dTHR; GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV); @@ -3578,10 +3543,8 @@ char *filename; } CvGV(cv) = (GV*)SvREFCNT_inc(gv); #ifdef USE_THREADS - New(666, CvMUTEXP(cv), 1, pthread_mutex_t); + New(666, CvMUTEXP(cv), 1, perl_mutex); MUTEX_INIT(CvMUTEXP(cv)); - New(666, CvCONDP(cv), 1, pthread_cond_t); - COND_INIT(CvCONDP(cv)); CvOWNER(cv) = 0; #endif /* USE_THREADS */ CvFILEGV(cv) = gv_fetchfile(filename); @@ -3606,10 +3569,10 @@ char *filename; av_store(endav, 0, (SV *)cv); GvCV(gv) = 0; } - else if (strEQ(s, "RESTART")) { - if (!restartav) - restartav = newAV(); - av_push(restartav, (SV *)cv); + else if (strEQ(s, "INIT")) { + if (!initav) + initav = newAV(); + av_push(initav, (SV *)cv); } } else @@ -3619,10 +3582,7 @@ char *filename; } void -newFORM(floor,o,block) -I32 floor; -OP *o; -OP *block; +newFORM(I32 floor, OP *o, OP *block) { dTHR; register CV *cv; @@ -3651,7 +3611,7 @@ OP *block; 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]); } @@ -3666,34 +3626,28 @@ OP *block; } OP * -newANONLIST(o) -OP* o; +newANONLIST(OP *o) { return newUNOP(OP_REFGEN, 0, mod(list(convert(OP_ANONLIST, 0, o)), OP_REFGEN)); } OP * -newANONHASH(o) -OP* o; +newANONHASH(OP *o) { return newUNOP(OP_REFGEN, 0, mod(list(convert(OP_ANONHASH, 0, o)), OP_REFGEN)); } OP * -newANONSUB(floor, proto, block) -I32 floor; -OP *proto; -OP *block; +newANONSUB(I32 floor, OP *proto, OP *block) { return newUNOP(OP_REFGEN, 0, newSVOP(OP_ANONCODE, 0, (SV*)newSUB(floor, 0, proto, block))); } OP * -oopsAV(o) -OP *o; +oopsAV(OP *o) { switch (o->op_type) { case OP_PADSV: @@ -3715,8 +3669,7 @@ OP *o; } OP * -oopsHV(o) -OP *o; +oopsHV(OP *o) { switch (o->op_type) { case OP_PADSV: @@ -3740,8 +3693,7 @@ OP *o; } OP * -newAVREF(o) -OP *o; +newAVREF(OP *o) { if (o->op_type == OP_PADANY) { o->op_type = OP_PADAV; @@ -3752,9 +3704,7 @@ OP *o; } OP * -newGVREF(type,o) -I32 type; -OP *o; +newGVREF(I32 type, OP *o) { if (type == OP_MAPSTART) return newUNOP(OP_NULL, 0, o); @@ -3762,8 +3712,7 @@ OP *o; } OP * -newHVREF(o) -OP *o; +newHVREF(OP *o) { if (o->op_type == OP_PADANY) { o->op_type = OP_PADHV; @@ -3774,8 +3723,7 @@ OP *o; } OP * -oopsCV(o) -OP *o; +oopsCV(OP *o) { croak("NOT IMPL LINE %d",__LINE__); /* STUB */ @@ -3783,30 +3731,30 @@ OP *o; } OP * -newCVREF(flags, o) -I32 flags; -OP *o; +newCVREF(I32 flags, OP *o) { return newUNOP(OP_RV2CV, flags, scalar(o)); } OP * -newSVREF(o) -OP *o; +newSVREF(OP *o) { if (o->op_type == OP_PADANY) { o->op_type = OP_PADSV; 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)); } /* Check routines. */ OP * -ck_anoncode(o) -OP *o; +ck_anoncode(OP *o) { PADOFFSET ix; SV* name; @@ -3826,16 +3774,14 @@ OP *o; } OP * -ck_bitop(o) -OP *o; +ck_bitop(OP *o) { o->op_private = hints; return o; } OP * -ck_concat(o) -OP *o; +ck_concat(OP *o) { if (cUNOPo->op_first->op_type == OP_CONCAT) o->op_flags |= OPf_STACKED; @@ -3843,8 +3789,7 @@ OP *o; } OP * -ck_spair(o) -OP *o; +ck_spair(OP *o) { if (o->op_flags & OPf_KIDS) { OP* newop; @@ -3858,7 +3803,7 @@ OP *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); @@ -3869,8 +3814,7 @@ OP *o; } OP * -ck_delete(o) -OP *o; +ck_delete(OP *o) { o = ck_fun(o); o->op_private = 0; @@ -3887,8 +3831,7 @@ OP *o; } OP * -ck_eof(o) -OP *o; +ck_eof(OP *o) { I32 type = o->op_type; @@ -3896,7 +3839,7 @@ OP *o; if (cLISTOPo->op_first->op_type == OP_STUB) { op_free(o); o = newUNOP(type, OPf_SPECIAL, - newGVOP(OP_GV, 0, gv_fetchpv("main'ARGV", TRUE, SVt_PVAV))); + newGVOP(OP_GV, 0, gv_fetchpv("main::ARGV", TRUE, SVt_PVAV))); } return ck_fun(o); } @@ -3904,8 +3847,7 @@ OP *o; } OP * -ck_eval(o) -OP *o; +ck_eval(OP *o) { hints |= HINT_BLOCK_SCOPE; if (o->op_flags & OPf_KIDS) { @@ -3936,18 +3878,19 @@ OP *o; 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; } OP * -ck_exec(o) -OP *o; +ck_exec(OP *o) { OP *kid; if (o->op_flags & OPf_STACKED) { @@ -3962,8 +3905,7 @@ OP *o; } OP * -ck_exists(o) -OP *o; +ck_exists(OP *o) { o = ck_fun(o); if (o->op_flags & OPf_KIDS) { @@ -3976,8 +3918,7 @@ OP *o; } OP * -ck_gvconst(o) -register OP *o; +ck_gvconst(register OP *o) { o = fold_constants(o); if (o->op_type == OP_CONST) @@ -3986,8 +3927,7 @@ register OP *o; } OP * -ck_rvconst(o) -register OP *o; +ck_rvconst(register OP *o) { dTHR; SVOP *kid = (SVOP*)cUNOPo->op_first; @@ -4047,8 +3987,7 @@ register OP *o; } OP * -ck_ftst(o) -OP *o; +ck_ftst(OP *o) { dTHR; I32 type = o->op_type; @@ -4069,17 +4008,16 @@ OP *o; else { op_free(o); if (type == OP_FTTTY) - return newGVOP(type, OPf_REF, gv_fetchpv("main'STDIN", TRUE, + 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; } OP * -ck_fun(o) -OP *o; +ck_fun(OP *o) { dTHR; register OP *kid; @@ -4088,7 +4026,7 @@ OP *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; @@ -4106,7 +4044,7 @@ OP *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++; @@ -4204,7 +4142,7 @@ OP *o; } 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) { @@ -4217,10 +4155,15 @@ OP *o; } OP * -ck_glob(o) -OP *o; +ck_glob(OP *o) { - GV *gv = gv_fetchpv("glob", FALSE, SVt_PVCV); + GV *gv; + + if ((o->op_flags & OPf_KIDS) && !cLISTOPo->op_first->op_sibling) + 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 (gv && GvIMPORTED_CV(gv)) { static int glob_index; @@ -4232,13 +4175,13 @@ OP *o; 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))))); - return ck_subr(o); + o = newUNOP(OP_NULL, 0, ck_subr(o)); + o->op_targ = OP_GLOB; /* hint at what it used to be */ + return o; } - if ((o->op_flags & OPf_KIDS) && !cLISTOPo->op_first->op_sibling) - append_elem(OP_GLOB, o, newSVREF(newGVOP(OP_GV, 0, defgv))); gv = newGVgen("main"); gv_IOadd(gv); append_elem(OP_GLOB, o, newGVOP(OP_GV, 0, gv)); @@ -4247,8 +4190,7 @@ OP *o; } OP * -ck_grep(o) -OP *o; +ck_grep(OP *o) { LOGOP *gwop; OP *kid; @@ -4256,7 +4198,7 @@ OP *o; o->op_ppaddr = ppaddr[OP_GREPSTART]; Newz(1101, gwop, 1, LOGOP); - + if (o->op_flags & OPf_STACKED) { OP* k; o = ck_sort(o); @@ -4275,7 +4217,7 @@ OP *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; @@ -4299,8 +4241,7 @@ OP *o; } OP * -ck_index(o) -OP *o; +ck_index(OP *o) { if (o->op_flags & OPf_KIDS) { OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */ @@ -4311,35 +4252,31 @@ OP *o; } OP * -ck_lengthconst(o) -OP *o; +ck_lengthconst(OP *o) { /* XXX length optimization goes here */ return ck_fun(o); } OP * -ck_lfun(o) -OP *o; +ck_lfun(OP *o) { OPCODE type = o->op_type; return modkids(ck_fun(o), type); } OP * -ck_rfun(o) -OP *o; +ck_rfun(OP *o) { OPCODE type = o->op_type; return refkids(ck_fun(o), type); } OP * -ck_listiob(o) -OP *o; +ck_listiob(OP *o) { register OP *kid; - + kid = cLISTOPo->op_first; if (!kid) { o = force_list(o); @@ -4360,7 +4297,7 @@ OP *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); @@ -4374,8 +4311,7 @@ OP *o; } OP * -ck_fun_locale(o) -OP *o; +ck_fun_locale(OP *o) { o = ck_fun(o); @@ -4389,8 +4325,7 @@ OP *o; } OP * -ck_scmp(o) -OP *o; +ck_scmp(OP *o) { o->op_private = 0; #ifdef USE_LOCALE @@ -4402,23 +4337,20 @@ OP *o; } OP * -ck_match(o) -OP *o; +ck_match(OP *o) { o->op_private |= OPpRUNTIME; return o; } OP * -ck_null(o) -OP *o; +ck_null(OP *o) { return o; } OP * -ck_repeat(o) -OP *o; +ck_repeat(OP *o) { if (cBINOPo->op_first->op_flags & OPf_PARENS) { o->op_private |= OPpREPEAT_DOLIST; @@ -4430,8 +4362,7 @@ OP *o; } OP * -ck_require(o) -OP *o; +ck_require(OP *o) { if (o->op_flags & OPf_KIDS) { /* Shall we supply missing .pm? */ SVOP *kid = (SVOP*)cUNOPo->op_first; @@ -4452,8 +4383,7 @@ OP *o; } OP * -ck_retarget(o) -OP *o; +ck_retarget(OP *o) { croak("NOT IMPL LINE %d",__LINE__); /* STUB */ @@ -4461,8 +4391,7 @@ OP *o; } OP * -ck_select(o) -OP *o; +ck_select(OP *o) { OP* kid; if (o->op_flags & OPf_KIDS) { @@ -4482,8 +4411,7 @@ OP *o; } OP * -ck_shift(o) -OP *o; +ck_shift(OP *o) { I32 type = o->op_type; @@ -4492,7 +4420,7 @@ OP *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 @_ */ } @@ -4503,7 +4431,7 @@ OP *o; } #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)); @@ -4512,8 +4440,7 @@ OP *o; } OP * -ck_sort(o) -OP *o; +ck_sort(OP *o) { o->op_private = 0; #ifdef USE_LOCALE @@ -4562,12 +4489,10 @@ OP *o; } OP * -ck_split(o) -OP *o; +ck_split(OP *o) { register OP *kid; - PMOP* pm; - + if (o->op_flags & OPf_STACKED) return no_fh_allowed(o); @@ -4591,18 +4516,13 @@ OP *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); @@ -4620,8 +4540,7 @@ OP *o; } OP * -ck_subr(o) -OP *o; +ck_subr(OP *o) { dTHR; OP *prev = ((cUNOPo->op_first->op_sibling) @@ -4649,7 +4568,7 @@ OP *o; } } o->op_private |= (hints & HINT_STRICT_REFS); - if (perldb && curstash != debstash) + if (PERLDB_SUB && curstash != debstash) o->op_private |= OPpENTERSUB_DB; while (o2 != cvop) { if (proto) { @@ -4683,10 +4602,11 @@ OP *o; goto wrapref; { OP* kid = o2; - o2 = newUNOP(OP_RV2GV, 0, kid); - o2->op_sibling = kid->op_sibling; + OP* sib = kid->op_sibling; kid->op_sibling = 0; - prev->op_sibling = o; + o2 = newUNOP(OP_RV2GV, 0, kid); + o2->op_sibling = sib; + prev->op_sibling = o2; } goto wrapref; case '\\': @@ -4715,9 +4635,10 @@ OP *o; wrapref: { OP* kid = o2; - o2 = newUNOP(OP_REFGEN, 0, kid); - o2->op_sibling = kid->op_sibling; + OP* sib = kid->op_sibling; kid->op_sibling = 0; + o2 = newUNOP(OP_REFGEN, 0, kid); + o2->op_sibling = sib; prev->op_sibling = o2; } break; @@ -4739,22 +4660,21 @@ OP *o; prev = o2; o2 = o2->op_sibling; } - if (proto && !optional && *proto == '$') + if (proto && !optional && + (*proto && *proto != '@' && *proto != '%' && *proto != ';')) return too_few_arguments(o, gv_ename(namegv)); return o; } OP * -ck_svconst(o) -OP *o; +ck_svconst(OP *o) { SvREADONLY_on(cSVOPo->op_sv); return o; } OP * -ck_trunc(o) -OP *o; +ck_trunc(OP *o) { if (o->op_flags & OPf_KIDS) { SVOP *kid = (SVOP*)cUNOPo->op_first; @@ -4771,8 +4691,7 @@ OP *o; /* A peephole optimizer. We visit the ops in the order they're to execute. */ void -peep(o) -register OP* o; +peep(register OP *o) { dTHR; register OP* oldop = 0; @@ -4802,7 +4721,7 @@ register OP* o; 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; @@ -4864,11 +4783,31 @@ register OP* o; o->op_seq = op_seqmax++; break; + case OP_PADAV: + if (o->op_next->op_type == OP_RV2AV + && (o->op_next->op_flags && OPf_REF)) + { + null(o->op_next); + 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)) + { + null(o->op_next); + o->op_next = o->op_next->op_next; + } + break; + case OP_MAPWHILE: case OP_GREPWHILE: case OP_AND: case OP_OR: o->op_seq = op_seqmax++; + while (cLOGOP->op_other->op_type == OP_NULL) + cLOGOP->op_other = cLOGOP->op_other->op_next; peep(cLOGOP->op_other); break; @@ -4905,7 +4844,7 @@ register OP* o; } } break; - + case OP_HELEM: { UNOP *rop; SV *lexname; @@ -4914,7 +4853,7 @@ register OP* o; 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;