X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=de4a94cded9fb7a3aa94ebff62936564418bf2ce;hb=35ff78560a01016ce2a3dffe29f18ce851bc0b90;hp=637537f336cb7a3b76bd64d6e273242bede6429f;hpb=af702f0e61214b54e323d12ffeaff4e64bee707c;p=p5sagit%2Fp5-mst-13.2.git diff --git a/op.c b/op.c index 637537f..de4a94c 100644 --- a/op.c +++ b/op.c @@ -18,6 +18,12 @@ #include "EXTERN.h" #include "perl.h" +#ifdef PERL_OBJECT +#define CHECKCALL this->*check +#else +#define CHECKCALL *check +#endif + /* * In the following definition, the ", Nullop" is just to make the compiler * think the expression is of the right type: croak actually does a Siglongjmp. @@ -27,21 +33,25 @@ ? ( op_free((OP*)o), \ croak("%s trapped by operation mask", op_desc[type]), \ Nullop ) \ - : (*check[type])((OP*)o)) + : (CHECKCALL[type])((OP*)o)) +static bool scalar_mod_type _((OP *o, I32 type)); +#ifndef PERL_OBJECT static I32 list_assignment _((OP *o)); static void bad_type _((I32 n, char *t, char *name, OP *kid)); static OP *modkids _((OP *o, I32 type)); static OP *no_fh_allowed _((OP *o)); -static bool scalar_mod_type _((OP *o, I32 type)); static OP *scalarboolean _((OP *o)); static OP *too_few_arguments _((OP *o, char* name)); 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)); +#endif -static char* +STATIC char* gv_ename(GV *gv) { SV* tmpsv = sv_newmortal(); @@ -49,7 +59,7 @@ gv_ename(GV *gv) return SvPV(tmpsv,na); } -static OP * +STATIC OP * no_fh_allowed(OP *o) { yyerror(form("Missing comma after first argument to %s function", @@ -57,21 +67,21 @@ no_fh_allowed(OP *o) return o; } -static OP * +STATIC OP * too_few_arguments(OP *o, char *name) { yyerror(form("Not enough arguments for %s", name)); return o; } -static OP * +STATIC OP * too_many_arguments(OP *o, char *name) { yyerror(form("Too many arguments for %s", name)); return o; } -static void +STATIC void bad_type(I32 n, char *t, char *name, OP *kid) { yyerror(form("Type of arg %d to %s must be %s (not %s)", @@ -84,9 +94,18 @@ assertref(OP *o) int type = o->op_type; if (type != OP_AELEM && type != OP_HELEM) { yyerror(form("Can't use subscript on %s", op_desc[type])); - if (type == OP_ENTERSUB || type == OP_RV2HV || type == OP_PADHV) - warn("(Did you mean $ or @ instead of %c?)\n", - type == OP_ENTERSUB ? '&' : '%'); + if (type == OP_ENTERSUB || type == OP_RV2HV || type == OP_PADHV) { + dTHR; + SV *msg = sv_2mortal( + newSVpvf("(Did you mean $ or @ instead of %c?)\n", + type == OP_ENTERSUB ? '&' : '%')); + if (in_eval & 2) + warn("%_", msg); + else if (in_eval) + sv_catsv(GvSV(errgv), msg); + else + PerlIO_write(PerlIO_stderr(), SvPVX(msg), SvCUR(msg)); + } } } @@ -107,9 +126,9 @@ pad_allocmy(char *name) } 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 */ @@ -146,24 +165,15 @@ pad_allocmy(char *name) return off; } -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 +STATIC PADOFFSET 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)) { @@ -175,7 +185,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) && @@ -235,7 +245,7 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix) warn("Variable \"%s\" will not stay shared", name); } } - av_store(comppad, newoff, oldsv ? SvREFCNT_inc(oldsv) : 0); + av_store(comppad, newoff, SvREFCNT_inc(oldsv)); return newoff; } } @@ -306,7 +316,7 @@ pad_findmy(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) || @@ -344,7 +354,7 @@ pad_leavemy(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; } @@ -363,13 +373,13 @@ pad_alloc(I32 optype, 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" @@ -392,19 +402,15 @@ pad_alloc(I32 optype, 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 @@ -413,18 +419,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) @@ -437,7 +439,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]); @@ -446,12 +449,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) @@ -462,7 +460,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); @@ -471,9 +470,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(void) { +#ifdef USE_BROKEN_PAD_RESET dTHR; register I32 po; @@ -483,7 +489,8 @@ pad_reset(void) 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--) { @@ -492,31 +499,59 @@ pad_reset(void) } padix = padix_floor; } +#endif pad_reset_pending = FALSE; } #ifdef USE_THREADS +/* find_threadsv is not reentrant */ PADOFFSET -find_thread_magical(name) -char *name; +find_threadsv(char *name) { dTHR; char *p; PADOFFSET key; - /* We currently only handle single character magicals */ - p = strchr(per_thread_magicals, *name); + SV **svp; + /* We currently only handle names of a single character */ + p = strchr(threadsv_names, *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); - sv_magic(sv, 0, 0, name, 1); + 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 */ + + /* XXX %! tied to Errno.pm needs to be added here. + * See gv_fetchpv(). */ + /* case '!': */ + + default: + 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_threadsv: new SV %p for $%s%c\n", + sv, (*name < 32) ? "^" : "", + (*name < 32) ? toCTRL(*name) : *name)); } return key; } @@ -546,8 +581,14 @@ op_free(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)) + if (!(o->op_flags & OPf_REF) + || (check[o->op_type] != FUNC_NAME_TO_PTR(ck_ftst))) break; /* FALL THROUGH */ case OP_GVSV: @@ -578,8 +619,7 @@ op_free(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; } @@ -589,10 +629,10 @@ op_free(OP *o) Safefree(o); } -static void +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; @@ -638,7 +678,7 @@ scalarkids(OP *o) return o; } -static OP * +STATIC OP * scalarboolean(OP *o) { if (dowarn && @@ -1008,7 +1048,7 @@ scalarseq(OP *o) return o; } -static OP * +STATIC OP * modkids(OP *o, I32 type) { OP *kid; @@ -1019,8 +1059,6 @@ modkids(OP *o, I32 type) return o; } -static I32 modcount; - OP * mod(OP *o, I32 type) { @@ -1131,10 +1169,11 @@ mod(OP *o, I32 type) 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: + hints |= HINT_BLOCK_SCOPE; case OP_SASSIGN: case OP_AELEMFAST: modcount++; @@ -1149,13 +1188,18 @@ mod(OP *o, 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_THREADSV: + modcount++; /* XXX ??? */ + break; +#endif /* USE_THREADS */ + case OP_PUSHMARK: break; @@ -1209,6 +1253,7 @@ mod(OP *o, I32 type) else if (!type) { o->op_private |= OPpLVAL_INTRO; o->op_flags &= ~OPf_SPECIAL; + hints |= HINT_BLOCK_SCOPE; } else if (type != OP_GREPSTART && type != OP_ENTERSUB) o->op_flags |= OPf_REF; @@ -1289,7 +1334,7 @@ ref(OP *o, 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); @@ -1306,13 +1351,13 @@ ref(OP *o, I32 type) } break; - case OP_SPECIFIC: + 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); @@ -1320,9 +1365,9 @@ ref(OP *o, 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)) @@ -1368,8 +1413,9 @@ my(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 o; + } else if (type != OP_PADSV && type != OP_PADAV && type != OP_PADHV && type != OP_PUSHMARK) @@ -1471,7 +1517,7 @@ block_start(int full) 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; @@ -1503,6 +1549,18 @@ block_end(I32 floor, 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(OP *o) { @@ -1528,7 +1586,7 @@ newPROG(OP *o) CV *cv = perl_get_cv("DB::postponed", FALSE); if (cv) { dSP; - PUSHMARK(sp); + PUSHMARK(SP); XPUSHs((SV*)compiling.cop_filegv); PUTBACK; perl_call_sv((SV*)cv, G_DISCARD); @@ -1543,7 +1601,6 @@ 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++) ; @@ -1563,10 +1620,14 @@ OP * 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; } @@ -1596,6 +1657,12 @@ fold_constants(register OP *o) 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; } @@ -1616,7 +1683,7 @@ fold_constants(register OP *o) curop = LINKLIST(o); o->op_next = 0; op = curop; - runops(); + CALLRUNOPS(); sv = *(stack_sp--); if (o->op_targ && sv == PAD_SV(o->op_targ)) /* grab pad temp? */ pad_swipe(o->op_targ); @@ -1628,9 +1695,12 @@ fold_constants(register OP *o) if (type == OP_RV2GV) return newGVOP(OP_GV, 0, (GV*)sv); else { - if ((SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) == SVf_NOK) { + /* try to smush double to int, but don't smush -2.0 to -2 */ + if ((SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) == SVf_NOK && + type != OP_NEGATE) + { IV iv = SvIV(sv); - if ((double)iv == SvNV(sv)) { /* can we smush double to int */ + if ((double)iv == SvNV(sv)) { SvREFCNT_dec(sv); sv = newSViv(iv); } @@ -1639,7 +1709,7 @@ fold_constants(register OP *o) } return newSVOP(OP_CONST, 0, sv); } - + nope: if (!(opargs[type] & OA_OTHERINT)) return o; @@ -1678,7 +1748,7 @@ gen_constant_list(register OP *o) op = curop = LINKLIST(o); o->op_next = 0; pp_pushmark(ARGS); - runops(); + CALLRUNOPS(); op = curop; pp_anonlist(ARGS); tmps_floor = oldtmps_floor; @@ -1879,7 +1949,7 @@ 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); @@ -1889,7 +1959,12 @@ newUNOP(I32 type, I32 flags, 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; @@ -1941,12 +2016,13 @@ pmtrans(OP *o, OP *expr, OP *repl) 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); @@ -1970,6 +2046,8 @@ pmtrans(OP *o, OP *expr, OP *repl) else { if (!rlen && !Delete) { r = t; rlen = tlen; + if (!squash) + o->op_private |= OPpTRANS_COUNTONLY; } for (i = 0; i < 256; i++) tbl[i] = -1; @@ -2038,9 +2116,8 @@ pmruntime(OP *o, OP *expr, 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 { @@ -2073,17 +2150,32 @@ pmruntime(OP *o, OP *expr, 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 || @@ -2096,8 +2188,7 @@ pmruntime(OP *o, OP *expr, 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 @@ -2248,7 +2339,7 @@ utilize(int aver, I32 floor, OP *version, OP *id, 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 () */ @@ -2294,7 +2385,7 @@ newSLICEOP(I32 flags, OP *subscript, OP *listval) list(force_list(listval)) ); } -static I32 +STATIC I32 list_assignment(register OP *o) { if (!o) @@ -2346,6 +2437,7 @@ newASSIGNOP(I32 flags, OP *left, I32 optype, OP *right) } if (list_assignment(left)) { + dTHR; modcount = 0; eval_start = right; /* Grandfathering $[ assignment here. Bletch.*/ left = mod(left, OP_AASSIGN); @@ -2361,7 +2453,6 @@ newASSIGNOP(I32 flags, OP *left, I32 optype, OP *right) list(force_list(left)) ); o->op_private = 0 | (flags >> 8); if (!(left->op_private & OPpLVAL_INTRO)) { - static int generation = 100; OP *curop; OP *lastop = o; generation++; @@ -2534,9 +2625,17 @@ intro_my(void) OP * 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)); @@ -2550,7 +2649,7 @@ newLOGOP(I32 type, I32 flags, OP *first, 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; @@ -2562,10 +2661,12 @@ newLOGOP(I32 type, I32 flags, OP *first, 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; } } @@ -2584,7 +2685,7 @@ newLOGOP(I32 type, I32 flags, OP *first, OP *other) case OP_NULL: if (k2 && k2->op_type == OP_READLINE && (k2->op_flags & OPf_STACKED) - && (k1->op_type == OP_RV2SV || k1->op_type == OP_PADSV)) + && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR)) warnop = k2->op_type; break; @@ -2745,14 +2846,33 @@ newLOOPOP(I32 flags, I32 debuggable, OP *expr, OP *block) 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) ); + } else if (expr->op_flags & OPf_KIDS) { + OP *k1 = ((UNOP*)expr)->op_first; + OP *k2 = (k1) ? k1->op_sibling : NULL; + switch (expr->op_type) { + case OP_NULL: + if (k2 && k2->op_type == OP_READLINE + && (k2->op_flags & OPf_STACKED) + && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR)) + expr = newUNOP(OP_DEFINED, 0, expr); + break; + + case OP_SASSIGN: + if (k1->op_type == OP_READDIR + || k1->op_type == OP_GLOB + || k1->op_type == OP_EACH) + expr = newUNOP(OP_DEFINED, 0, expr); + break; + } } } 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; @@ -2779,7 +2899,25 @@ newWHILEOP(I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *expr, OP *b 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) ); + } else if (expr && (expr->op_flags & OPf_KIDS)) { + OP *k1 = ((UNOP*)expr)->op_first; + OP *k2 = (k1) ? k1->op_sibling : NULL; + switch (expr->op_type) { + case OP_NULL: + if (k2 && k2->op_type == OP_READLINE + && (k2->op_flags & OPf_STACKED) + && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR)) + expr = newUNOP(OP_DEFINED, 0, expr); + break; + + case OP_SASSIGN: + if (k1->op_type == OP_READDIR + || k1->op_type == OP_GLOB + || k1->op_type == OP_EACH) + expr = newUNOP(OP_DEFINED, 0, expr); + break; + } } if (!block) @@ -2800,14 +2938,17 @@ newWHILEOP(I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *expr, OP *b 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; } @@ -2838,18 +2979,7 @@ newWHILEOP(I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *expr, OP *b } 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; @@ -2866,11 +2996,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)); @@ -2893,10 +3034,14 @@ 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 { @@ -2947,7 +3092,7 @@ cv_undef(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; @@ -2968,7 +3113,7 @@ cv_undef(CV *cv) } #ifdef DEBUG_CLOSURES -static void +STATIC void cv_dump(cv) CV* cv; { @@ -3001,7 +3146,7 @@ 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%lx (%s\"%s\" %ld-%ld)\n", ix, ppad[ix], @@ -3013,7 +3158,7 @@ CV* cv; } #endif /* DEBUG_CLOSURES */ -static CV * +STATIC CV * cv_clone2(CV *proto, CV *outside) { dTHR; @@ -3024,8 +3169,8 @@ cv_clone2(CV *proto, 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; @@ -3070,7 +3215,7 @@ cv_clone2(CV *proto, 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 @_ */ @@ -3179,7 +3324,7 @@ cv_const_sv(CV *cv) { OP *o; SV *sv; - + if (!cv || !SvPOK(cv) || SvCUR(cv)) return Nullsv; @@ -3214,7 +3359,8 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block) { dTHR; char *name = o ? SvPVx(cSVOPo->op_sv, na) : Nullch; - GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV); + GV *gv = gv_fetchpv(name ? name : "__ANON__", + GV_ADDMULTI | (block ? 0 : GV_NOINIT), SVt_PVCV); char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, na) : Nullch; register CV *cv; I32 ix; @@ -3224,6 +3370,23 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block) if (proto) SAVEFREEOP(proto); + if (SvTYPE(gv) != SVt_PVGV) { /* Prototype now, and had + maximum a prototype before. */ + if (SvTYPE(gv) > SVt_NULL) { + if (!SvPOK((SV*)gv) && !(SvIOK((SV*)gv) && SvIVX((SV*)gv) == -1)) + warn("Runaway prototype"); + cv_ckproto((CV*)gv, NULL, ps); + } + if (ps) + sv_setpv((SV*)gv, ps); + else + sv_setiv((SV*)gv, -1); + SvREFCNT_dec(compcv); + compcv = NULL; + sub_generation++; + goto noblock; + } + if (!name || GvCVGEN(gv)) cv = Nullcv; else if (cv = GvCV(gv)) { @@ -3237,10 +3400,13 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block) goto done; } /* ahem, death to those who redefine active sort subs */ - if (curstack == sortstack && sortcop == CvSTART(cv)) + if (curstackinfo->si_type == SI_SORT && sortcop == CvSTART(cv)) croak("Can't redefine active sort subroutine %s", name); const_sv = cv_const_sv(cv); - if (const_sv || dowarn) { + if (const_sv || dowarn && !(CvGV(cv) && GvSTASH(CvGV(cv)) + && HvNAME(GvSTASH(CvGV(cv))) + && strEQ(HvNAME(GvSTASH(CvGV(cv))), + "autouse"))) { line_t oldline = curcop->cop_line; curcop->cop_line = copline; warn(const_sv ? "Constant subroutine %s redefined" @@ -3295,24 +3461,25 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block) 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)); } } } } if (!block) { + noblock: copline = NOLINE; LEAVE_SCOPE(floor); 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])) @@ -3338,7 +3505,7 @@ newSUB(I32 floor, OP *o, OP *proto, 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])) @@ -3357,7 +3524,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block) 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; @@ -3366,14 +3533,11 @@ newSUB(I32 floor, OP *o, OP *proto, 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))) { dSP; - PUSHMARK(sp); + PUSHMARK(SP); XPUSHs(tmpstr); PUTBACK; perl_call_sv((SV*)cv, G_DISCARD); @@ -3389,7 +3553,6 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block) ENTER; SAVESPTR(compiling.cop_filegv); SAVEI16(compiling.cop_line); - SAVEI32(perldb); save_svref(&rs); sv_setsv(rs, nrs); @@ -3423,23 +3586,35 @@ newSUB(I32 floor, OP *o, OP *proto, 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; +void +newCONSTSUB(HV *stash, char *name, SV *sv) +{ + dTHR; + U32 oldhints = hints; + HV *old_cop_stash = curcop->cop_stash; + HV *old_curstash = curstash; + line_t oldline = curcop->cop_line; + curcop->cop_line = copline; + + hints &= ~HINT_BLOCK_SCOPE; + if(stash) + curstash = curcop->cop_stash = stash; + + newSUB( + start_subparse(FALSE, 0), + newSVOP(OP_CONST, 0, newSVpv(name,0)), + newSVOP(OP_CONST, 0, &sv_no), /* SvPV(&sv_no) == "" -- GMB */ + newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv)) + ); + + hints = oldhints; + curcop->cop_stash = old_cop_stash; + curstash = old_curstash; + curcop->cop_line = oldline; } -#endif CV * -newXS(char *name, void (*subaddr) (CV *), char *filename) +newXS(char *name, void (*subaddr) (CV * _CPERLproto), char *filename) { dTHR; GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV); @@ -3453,7 +3628,9 @@ newXS(char *name, void (*subaddr) (CV *), char *filename) } else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) { /* already defined (or promised) */ - if (dowarn) { + if (dowarn && !(CvGV(cv) && GvSTASH(CvGV(cv)) + && HvNAME(GvSTASH(CvGV(cv))) + && strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) { line_t oldline = curcop->cop_line; curcop->cop_line = copline; warn("Subroutine %s redefined",name); @@ -3545,7 +3722,7 @@ newFORM(I32 floor, OP *o, 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]); } @@ -3678,8 +3855,10 @@ newSVREF(OP *o) o->op_ppaddr = ppaddr[OP_PADSV]; return o; } - else if (o->op_type == OP_SPECIFIC) + 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)); } @@ -3735,7 +3914,7 @@ ck_spair(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); @@ -3810,10 +3989,12 @@ ck_eval(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; @@ -3887,17 +4068,16 @@ ck_rvconst(register OP *o) "Can't use bareword (\"%s\") as %s ref while \"strict refs\" in use", name, badthing); } - kid->op_type = OP_GV; + /* + * This is a little tricky. We only want to add the symbol if we + * didn't add it in the lexer. Otherwise we get duplicate strict + * warnings. But if we didn't add it in the lexer, we must at + * least pretend like we wanted to add it even if it existed before, + * or we get possible typo warnings. OPpCONST_ENTERED says + * whether the lexer already added THIS instance of this symbol. + */ iscv = (o->op_type == OP_RV2CV) * 2; - for (gv = 0; !gv; iscv++) { - /* - * This is a little tricky. We only want to add the symbol if we - * didn't add it in the lexer. Otherwise we get duplicate strict - * warnings. But if we didn't add it in the lexer, we must at - * least pretend like we wanted to add it even if it existed before, - * or we get possible typo warnings. OPpCONST_ENTERED says - * whether the lexer already added THIS instance of this symbol. - */ + do { gv = gv_fetchpv(name, iscv | !(kid->op_private & OPpCONST_ENTERED), iscv @@ -3909,9 +4089,12 @@ ck_rvconst(register OP *o) : o->op_type == OP_RV2HV ? SVt_PVHV : SVt_PVGV); + } while (!gv && !(kid->op_private & OPpCONST_ENTERED) && !iscv++); + if (gv) { + kid->op_type = OP_GV; + SvREFCNT_dec(kid->op_sv); + kid->op_sv = SvREFCNT_inc(gv); } - SvREFCNT_dec(kid->op_sv); - kid->op_sv = SvREFCNT_inc(gv); } return o; } @@ -3941,7 +4124,7 @@ ck_ftst(OP *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; } @@ -3956,7 +4139,7 @@ ck_fun(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; @@ -3974,7 +4157,7 @@ ck_fun(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++; @@ -4072,7 +4255,7 @@ ck_fun(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) { @@ -4090,7 +4273,7 @@ ck_glob(OP *o) 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); @@ -4105,7 +4288,7 @@ ck_glob(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))))); o = newUNOP(OP_NULL, 0, ck_subr(o)); @@ -4128,7 +4311,7 @@ ck_grep(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); @@ -4147,7 +4330,7 @@ ck_grep(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; @@ -4176,7 +4359,7 @@ ck_index(OP *o) if (o->op_flags & OPf_KIDS) { OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */ if (kid && kid->op_type == OP_CONST) - fbm_compile(((SVOP*)kid)->op_sv); + fbm_compile(((SVOP*)kid)->op_sv, 0); } return ck_fun(o); } @@ -4206,7 +4389,7 @@ OP * ck_listiob(OP *o) { register OP *kid; - + kid = cLISTOPo->op_first; if (!kid) { o = force_list(o); @@ -4227,7 +4410,7 @@ ck_listiob(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); @@ -4350,7 +4533,7 @@ ck_shift(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 @_ */ } @@ -4361,7 +4544,7 @@ ck_shift(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)); @@ -4422,8 +4605,7 @@ OP * ck_split(OP *o) { register OP *kid; - PMOP* pm; - + if (o->op_flags & OPf_STACKED) return no_fh_allowed(o); @@ -4447,18 +4629,13 @@ ck_split(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); @@ -4538,10 +4715,11 @@ ck_subr(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 '\\': @@ -4570,9 +4748,10 @@ ck_subr(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; @@ -4655,7 +4834,7 @@ peep(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; @@ -4667,7 +4846,7 @@ peep(register OP *o) goto nothin; case OP_NULL: if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE) - curcop = ((COP*)op); + curcop = ((COP*)o); goto nothin; case OP_SCALAR: case OP_LINESEQ: @@ -4725,7 +4904,7 @@ peep(register OP *o) 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)) @@ -4740,6 +4919,8 @@ peep(register OP *o) 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; @@ -4766,6 +4947,8 @@ peep(register OP *o) o->op_seq = op_seqmax++; if (dowarn && o->op_next && o->op_next->op_type == OP_NEXTSTATE) { if (o->op_next->op_sibling && + o->op_next->op_sibling->op_type != OP_EXIT && + o->op_next->op_sibling->op_type != OP_WARN && o->op_next->op_sibling->op_type != OP_DIE) { line_t oldline = curcop->cop_line; @@ -4776,7 +4959,7 @@ peep(register OP *o) } } break; - + case OP_HELEM: { UNOP *rop; SV *lexname; @@ -4785,7 +4968,7 @@ peep(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;