X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=3e3df86a27bbfa793b1db7eaa39266fc05063c21;hb=6250ba0abb669fbb694bb58699aa811bdf9bfa1f;hp=d3b03440c73344b09388c013e059bbd238f8602c;hpb=69969c6f8dad38fedd2ed2c653a7948030e5ecf8;p=p5sagit%2Fp5-mst-13.2.git diff --git a/op.c b/op.c index d3b0344..3e3df86 100644 --- a/op.c +++ b/op.c @@ -26,8 +26,10 @@ * think the expression is of the right type: croak actually does a Siglongjmp. */ #define CHECKOP(type,op) \ - ((op_mask && op_mask[type]) \ - ? (croak("%s trapped by operation mask", op_desc[type]), (OP*)op) \ + ((op_mask && op_mask[type]) \ + ? ( op_free((OP*)op), \ + croak("%s trapped by operation mask", op_desc[type]), \ + Nullop ) \ : (*check[type])((OP*)op)) #else #define CHECKOP(type,op) (*check[type])(op) @@ -41,7 +43,7 @@ static OP *scalarboolean _((OP *op)); static OP *too_few_arguments _((OP *op, char* name)); static OP *too_many_arguments _((OP *op, char* name)); static void null _((OP* op)); -static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, I32 seq, +static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)); static char* @@ -104,9 +106,9 @@ OP *op; if (type != OP_AELEM && type != OP_HELEM) { sprintf(tokenbuf, "Can't use subscript on %s", op_desc[type]); yyerror(tokenbuf); - if (type == OP_RV2HV || type == OP_ENTERSUB) + if (type == OP_ENTERSUB || type == OP_RV2HV || type == OP_PADHV) warn("(Did you mean $ or @ instead of %c?)\n", - type == OP_RV2HV ? '%' : '&'); + type == OP_ENTERSUB ? '&' : '%'); } } @@ -120,8 +122,8 @@ char *name; SV *sv; if (!(isALPHA(name[1]) || name[1] == '_' && (int)strlen(name) > 2)) { - if (!isprint(name[1])) - sprintf(name+1, "^%c", name[1] ^ 64); /* XXX is tokenbuf, really */ + if (!isPRINT(name[1])) + sprintf(name+1, "^%c", toCTRL(name[1])); /* XXX tokenbuf, really */ croak("Can't use global %s in \"my\"",name); } if (AvFILL(comppad_name) >= 0) { @@ -160,11 +162,11 @@ static PADOFFSET pad_findlex(name, newoff, seq, startcv, cx_ix) char *name; PADOFFSET newoff; -I32 seq; +U32 seq; CV* startcv; I32 cx_ix; #else -pad_findlex(char *name, PADOFFSET newoff, I32 seq, CV* startcv, I32 cx_ix) +pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix) #endif { CV *cv; @@ -186,12 +188,21 @@ pad_findlex(char *name, PADOFFSET newoff, I32 seq, CV* startcv, I32 cx_ix) if ((sv = svp[off]) && sv != &sv_undef && seq <= SvIVX(sv) && - seq > (I32)SvNVX(sv) && + seq > I_32(SvNVX(sv)) && strEQ(SvPVX(sv), name)) { - I32 depth = CvDEPTH(cv) ? CvDEPTH(cv) : 1; - AV *oldpad = (AV*)*av_fetch(curlist, depth, FALSE); - SV *oldsv = *av_fetch(oldpad, off, TRUE); + I32 depth; + AV *oldpad; + SV *oldsv; + + depth = CvDEPTH(cv); + if (!depth) { + if (newoff && !CvUNIQUE(cv)) + return 0; /* don't clone inactive sub's stack frame */ + depth = 1; + } + oldpad = (AV*)*av_fetch(curlist, depth, FALSE); + oldsv = *av_fetch(oldpad, off, TRUE); if (!newoff) { /* Not a mere clone operation. */ SV *sv = NEWSV(1103,0); newoff = pad_alloc(OP_PADSV, SVs_PADMY); @@ -201,9 +212,31 @@ pad_findlex(char *name, PADOFFSET newoff, I32 seq, CV* startcv, I32 cx_ix) SvNVX(sv) = (double)curcop->cop_seq; SvIVX(sv) = 999999999; /* A ref, intro immediately */ SvFLAGS(sv) |= SVf_FAKE; + if (CvANON(compcv)) { + /* "It's closures all the way down." */ + CvCLONE_on(compcv); + if (cv != startcv) { + CV *bcv; + for (bcv = startcv; + bcv && bcv != cv && !CvCLONE(bcv); + bcv = CvOUTSIDE(bcv)) { + if (CvANON(bcv)) + CvCLONE_on(bcv); + else { + if (dowarn) + warn("Value of %s may be unavailable", + name); + break; + } + } + } + } + else { + if (dowarn && !CvUNIQUE(cv)) + warn("Value of %s will not stay shared", name); + } } av_store(comppad, newoff, SvREFCNT_inc(oldsv)); - CvCLONE_on(compcv); return newoff; } } @@ -253,14 +286,14 @@ char *name; I32 off; SV *sv; SV **svp = AvARRAY(comppad_name); - I32 seq = cop_seqmax; + U32 seq = cop_seqmax; /* The one we're looking for is probably just before comppad_name_fill. */ for (off = AvFILL(comppad_name); off > 0; off--) { if ((sv = svp[off]) && sv != &sv_undef && seq <= SvIVX(sv) && - seq > (I32)SvNVX(sv) && + seq > I_32(SvNVX(sv)) && strEQ(SvPVX(sv), name)) { return (PADOFFSET)off; @@ -314,9 +347,21 @@ U32 tmptype; retval = AvFILL(comppad); } else { - do { - sv = *av_fetch(comppad, ++padix, TRUE); - } while (SvFLAGS(sv) & (SVs_PADTMP|SVs_PADMY)); + SV **names = AvARRAY(comppad_name); + SSize_t names_fill = AvFILL(comppad_name); + for (;;) { + /* + * "foreach" index vars temporarily become aliases to non-"my" + * values. Thus we must skip, not just pad values that are + * marked as current pad values, but also those with names. + */ + if (++padix <= names_fill && + (sv = names[padix]) && sv != &sv_undef) + continue; + sv = *av_fetch(comppad, padix, TRUE); + if (!(SvFLAGS(sv) & (SVs_PADTMP|SVs_PADMY))) + break; + } retval = padix; } SvFLAGS(sv) |= tmptype; @@ -423,15 +468,20 @@ OP *op; case OP_ENTEREVAL: op->op_targ = 0; /* Was holding hints. */ break; + default: + if (!(op->op_flags & OPf_REF) || (check[op->op_type] != ck_ftst)) + break; + /* FALL THROUGH */ case OP_GVSV: case OP_GV: + case OP_AELEMFAST: SvREFCNT_dec(cGVOP->op_gv); break; case OP_NEXTSTATE: case OP_DBSTATE: + Safefree(cCOP->cop_label); SvREFCNT_dec(cCOP->cop_filegv); break; - /* case OP_ANONCODE: XXX breaks eval of anon subs in closures (cf. Opcode) */ case OP_CONST: SvREFCNT_dec(cSVOP->op_sv); break; @@ -453,8 +503,6 @@ OP *op; pregfree(cPMOP->op_pmregexp); SvREFCNT_dec(cPMOP->op_pmshort); break; - default: - break; } if (op->op_targ > 0) @@ -538,7 +586,8 @@ OP *op; OP *kid; /* assumes no premature commitment */ - if (!op || (op->op_flags & OPf_KNOW) || error_count) + if (!op || (op->op_flags & OPf_KNOW) || op->op_type == OP_RETURN + || error_count) return op; op->op_flags &= ~OPf_LIST; @@ -609,6 +658,8 @@ OP *op; default: if (!(opargs[op->op_type] & OA_FOLDCONST)) break; + /* FALL THROUGH */ + case OP_REPEAT: if (op->op_flags & OPf_STACKED) break; /* FALL THROUGH */ @@ -727,11 +778,6 @@ OP *op; op->op_ppaddr = ppaddr[OP_PREDEC]; break; - case OP_REPEAT: - scalarvoid(cBINOP->op_first); - useless = op_desc[op->op_type]; - break; - case OP_OR: case OP_AND: case OP_COND_EXPR: @@ -792,7 +838,8 @@ OP *op; OP *kid; /* assumes no premature commitment */ - if (!op || (op->op_flags & OPf_KNOW) || error_count) + if (!op || (op->op_flags & OPf_KNOW) || op->op_type == OP_RETURN + || error_count) return op; op->op_flags |= (OPf_KNOW | OPf_LIST); @@ -889,7 +936,6 @@ I32 type; { OP *kid; SV *sv; - char mtype; if (!op || error_count) return op; @@ -911,6 +957,10 @@ I32 type; else croak("That use of $[ is unsupported"); break; + case OP_STUB: + if (op->op_flags & OPf_PARENS) + break; + goto nomod; case OP_ENTERSUB: if ((type == OP_UNDEF || type == OP_REFGEN) && !(op->op_flags & OPf_STACKED)) { @@ -1013,23 +1063,13 @@ I32 type; case OP_KEYS: if (type != OP_SASSIGN) goto nomod; - mtype = 'k'; - goto makelv; + /* FALL THROUGH */ case OP_POS: - mtype = '.'; - goto makelv; case OP_VEC: - mtype = 'v'; - goto makelv; case OP_SUBSTR: - mtype = 'x'; - makelv: pad_free(op->op_targ); op->op_targ = pad_alloc(op->op_type, SVs_PADMY); - sv = PAD_SV(op->op_targ); - sv_upgrade(sv, SVt_PVLV); - sv_magic(sv, Nullsv, mtype, Nullch, 0); - curpad[op->op_targ] = sv; + assert(SvTYPE(PAD_SV(op->op_targ)) == SVt_NULL); if (op->op_flags & OPf_KIDS) mod(cBINOP->op_first->op_sibling, type); break; @@ -1116,8 +1156,10 @@ I32 type; ref(cUNOP->op_first, op->op_type); /* FALL THROUGH */ case OP_PADSV: - if (type == OP_RV2AV || type == OP_RV2HV) { - op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV); + if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) { + op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV + : type == OP_RV2HV ? OPpDEREF_HV + : OPpDEREF_SV); op->op_flags |= OPf_MOD; } break; @@ -1144,8 +1186,10 @@ I32 type; case OP_AELEM: case OP_HELEM: ref(cBINOP->op_first, op->op_type); - if (type == OP_RV2AV || type == OP_RV2HV) { - op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV); + if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) { + op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV + : type == OP_RV2HV ? OPpDEREF_HV + : OPpDEREF_SV); op->op_flags |= OPf_MOD; } break; @@ -1269,41 +1313,42 @@ OP *o; } int -block_start() +block_start(full) +int full; { int retval = savestack_ix; - SAVEINT(comppad_name_floor); - if ((comppad_name_fill = AvFILL(comppad_name)) > 0) - comppad_name_floor = comppad_name_fill; - else - comppad_name_floor = 0; - SAVEINT(min_intro_pending); - SAVEINT(max_intro_pending); + SAVEI32(comppad_name_floor); + if (full) { + if ((comppad_name_fill = AvFILL(comppad_name)) > 0) + comppad_name_floor = comppad_name_fill; + else + comppad_name_floor = 0; + } + SAVEI32(min_intro_pending); + SAVEI32(max_intro_pending); min_intro_pending = 0; - SAVEINT(comppad_name_fill); - SAVEINT(padix_floor); + SAVEI32(comppad_name_fill); + SAVEI32(padix_floor); padix_floor = padix; pad_reset_pending = FALSE; - SAVEINT(hints); + SAVEI32(hints); hints &= ~HINT_BLOCK_SCOPE; return retval; } OP* -block_end(line, floor, seq) -int line; -int floor; +block_end(floor, seq) +I32 floor; OP* seq; { int needblockscope = hints & HINT_BLOCK_SCOPE; OP* retval = scalarseq(seq); - if (copline > (line_t)line) - copline = line; LEAVE_SCOPE(floor); pad_reset_pending = FALSE; if (needblockscope) hints |= HINT_BLOCK_SCOPE; /* propagate out */ pad_leavemy(comppad_name_fill); + cop_seqmax++; return retval; } @@ -1821,6 +1866,9 @@ I32 flags; pmop->op_flags = flags; pmop->op_private = 0 | (flags >> 8); + if (hints & HINT_LOCALE) + pmop->op_pmpermflags = (pmop->op_pmflags |= PMf_LOCALE); + /* link into pm list */ if (type != OP_TRANS && curstash) { pmop->op_pmnext = HvPMROOT(curstash); @@ -2299,23 +2347,9 @@ I32 flags; char *label; OP *op; { + U32 seq = intro_my(); register COP *cop; - /* Introduce my variables. */ - if (min_intro_pending) { - SV **svp = AvARRAY(comppad_name); - I32 i; - SV *sv; - for (i = min_intro_pending; i <= max_intro_pending; i++) { - if ((sv = svp[i]) && sv != &sv_undef && !SvIVX(sv)) { - SvIVX(sv) = 999999999; /* Don't know scope end yet. */ - SvNVX(sv) = (double)cop_seqmax; - } - } - min_intro_pending = 0; - comppad_name_fill = max_intro_pending; /* Needn't search higher */ - } - Newz(1101, cop, 1, COP); if (perldb && curcop->cop_line && curstash != debstash) { cop->op_type = OP_DBSTATE; @@ -2333,7 +2367,7 @@ OP *op; cop->cop_label = label; hints |= HINT_BLOCK_SCOPE; } - cop->cop_seq = cop_seqmax++; + cop->cop_seq = seq; cop->cop_arybase = curcop->cop_arybase; if (copline == NOLINE) @@ -2357,6 +2391,29 @@ OP *op; return prepend_elem(OP_LINESEQ, (OP*)cop, op); } +/* "Introduce" my variables to visible status. */ +U32 +intro_my() +{ + SV **svp; + SV *sv; + I32 i; + + if (! min_intro_pending) + return cop_seqmax; + + svp = AvARRAY(comppad_name); + for (i = min_intro_pending; i <= max_intro_pending; i++) { + if ((sv = svp[i]) && sv != &sv_undef && !SvIVX(sv)) { + SvIVX(sv) = 999999999; /* Don't know scope end yet. */ + SvNVX(sv) = (double)cop_seqmax; + } + } + min_intro_pending = 0; + comppad_name_fill = max_intro_pending; /* Needn't search higher */ + return cop_seqmax++; +} + OP * newLOGOP(type, flags, first, other) I32 type; @@ -2404,6 +2461,32 @@ OP* other; else scalar(other); } + else if (dowarn && (first->op_flags & OPf_KIDS)) { + OP *k1 = ((UNOP*)first)->op_first; + OP *k2 = k1->op_sibling; + OPCODE warnop = 0; + switch (first->op_type) + { + 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)) + warnop = k2->op_type; + break; + + case OP_SASSIGN: + if (k1->op_type == OP_READDIR || k1->op_type == OP_GLOB) + warnop = k1->op_type; + break; + } + if (warnop) { + line_t oldline = curcop->cop_line; + curcop->cop_line = copline; + warn("Value of %s construct can be \"0\"; test with defined()", + op_desc[warnop]); + curcop->cop_line = oldline; + } + } if (!other) return first; @@ -2674,7 +2757,7 @@ newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont else { sv = newGVOP(OP_GV, 0, defgv); } - if (expr->op_type == OP_RV2AV) { + if (expr->op_type == OP_RV2AV || expr->op_type == OP_PADAV) { expr = scalar(ref(expr, OP_ITER)); iterflags |= OPf_STACKED; } @@ -2732,30 +2815,73 @@ CV *cv; SvREFCNT_dec(CvOUTSIDE(cv)); CvOUTSIDE(cv) = Nullcv; if (CvPADLIST(cv)) { - I32 i = AvFILL(CvPADLIST(cv)); - while (i >= 0) { - SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE); - if (svp) - SvREFCNT_dec(*svp); + /* may be during global destruction */ + if (SvREFCNT(CvPADLIST(cv))) { + I32 i = AvFILL(CvPADLIST(cv)); + while (i >= 0) { + SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE); + if (svp) + SvREFCNT_dec(*svp); + } + SvREFCNT_dec((SV*)CvPADLIST(cv)); } - SvREFCNT_dec((SV*)CvPADLIST(cv)); CvPADLIST(cv) = Nullav; } } -CV * -cv_clone(proto) +#ifdef DEBUG_CLOSURES +static void +cv_dump(cv) +CV* cv; +{ + CV *outside = CvOUTSIDE(cv); + AV* padlist = CvPADLIST(cv); + AV* pad_name = (AV*)*av_fetch(padlist, 0, FALSE); + AV* pad = (AV*)*av_fetch(padlist, 1, FALSE); + SV** pname = AvARRAY(pad_name); + SV** ppad = AvARRAY(pad); + I32 ix; + + PerlIO_printf(Perl_debug_log, "\tCV=0x%p (%s), OUTSIDE=0x%p (%s)\n", + cv, + (CvANON(cv) ? "ANON" + : (cv == main_cv) ? "MAIN" + : CvUNIQUE(outside) ? "UNIQUE" + : CvGV(cv) ? GvNAME(CvGV(cv)) : "?mystery?"), + outside, + (!outside ? "null" + : CvANON(outside) ? "ANON" + : (outside == main_cv) ? "MAIN" + : CvUNIQUE(outside) ? "UNIQUE" + : CvGV(outside) ? GvNAME(CvGV(outside)) : "?mystery?")); + + for (ix = 1; ix <= AvFILL(pad); ix++) { + if (SvPOK(pname[ix])) + PerlIO_printf(Perl_debug_log, "\t%4d. 0x%p (\"%s\" %ld-%ld)\n", + ix, ppad[ix], SvPVX(pname[ix]), + (long)I_32(SvNVX(pname[ix])), + (long)SvIVX(pname[ix])); + } +} +#endif /* DEBUG_CLOSURES */ + +static CV * +cv_clone2(proto, outside) CV* proto; +CV* outside; { AV* av; I32 ix; AV* protopadlist = CvPADLIST(proto); AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE); AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE); - SV** svp = AvARRAY(protopad); + SV** pname = AvARRAY(protopad_name); + SV** ppad = AvARRAY(protopad); AV* comppadlist; CV* cv; + assert(!CvUNIQUE(proto)); + ENTER; SAVESPTR(curpad); SAVESPTR(comppad); @@ -2764,14 +2890,16 @@ CV* proto; cv = compcv = (CV*)NEWSV(1104,0); sv_upgrade((SV *)cv, SVt_PVCV); CvCLONED_on(cv); + if (CvANON(proto)) + CvANON_on(cv); CvFILEGV(cv) = CvFILEGV(proto); CvGV(cv) = GvREFCNT_inc(CvGV(proto)); CvSTASH(cv) = CvSTASH(proto); CvROOT(cv) = CvROOT(proto); CvSTART(cv) = CvSTART(proto); - if (CvOUTSIDE(proto)) - CvOUTSIDE(cv) = (CV*)SvREFCNT_inc((SV*)CvOUTSIDE(proto)); + if (outside) + CvOUTSIDE(cv) = (CV*)SvREFCNT_inc(outside); comppad = newAV(); @@ -2780,7 +2908,7 @@ CV* proto; av_store(comppadlist, 0, SvREFCNT_inc((SV*)protopad_name)); av_store(comppadlist, 1, (SV*)comppad); CvPADLIST(cv) = comppadlist; - av_extend(comppad, AvFILL(protopad)); + av_fill(comppad, AvFILL(protopad)); curpad = AvARRAY(comppad); av = newAV(); /* will be @_ */ @@ -2788,37 +2916,77 @@ CV* proto; av_store(comppad, 0, (SV*)av); AvFLAGS(av) = AVf_REIFY; - svp = AvARRAY(protopad_name); - for ( ix = AvFILL(protopad); ix > 0; ix--) { - SV *sv; - if (svp[ix] != &sv_undef) { - char *name = SvPVX(svp[ix]); /* XXX */ - if (SvFLAGS(svp[ix]) & SVf_FAKE) { /* lexical from outside? */ - I32 off = pad_findlex(name,ix,curcop->cop_seq, CvOUTSIDE(proto), - cxstack_ix); - if (off != ix) + for (ix = AvFILL(protopad); ix > 0; ix--) { + SV* sv; + if (pname[ix] != &sv_undef) { + char *name = SvPVX(pname[ix]); /* XXX */ + if (SvFLAGS(pname[ix]) & SVf_FAKE) { /* lexical from outside? */ + I32 off = pad_findlex(name, ix, SvIVX(pname[ix]), + CvOUTSIDE(cv), cxstack_ix); + if (!off) + curpad[ix] = SvREFCNT_inc(ppad[ix]); + else if (off != ix) croak("panic: cv_clone: %s", name); } else { /* our own lexical */ - if (*name == '@') - av_store(comppad, ix, sv = (SV*)newAV()); + if (*name == '&') { + /* anon code -- we'll come back for it */ + sv = SvREFCNT_inc(ppad[ix]); + } + else if (*name == '@') + sv = (SV*)newAV(); else if (*name == '%') - av_store(comppad, ix, sv = (SV*)newHV()); + sv = (SV*)newHV(); else - av_store(comppad, ix, sv = NEWSV(0,0)); - SvPADMY_on(sv); + sv = NEWSV(0,0); + if (!SvPADBUSY(sv)) + SvPADMY_on(sv); + curpad[ix] = sv; } } else { - av_store(comppad, ix, sv = NEWSV(0,0)); + sv = NEWSV(0,0); SvPADTMP_on(sv); + curpad[ix] = sv; + } + } + + /* Now that vars are all in place, clone nested closures. */ + + for (ix = AvFILL(protopad); ix > 0; ix--) { + if (pname[ix] != &sv_undef + && !(SvFLAGS(pname[ix]) & SVf_FAKE) + && *SvPVX(pname[ix]) == '&' + && CvCLONE(ppad[ix])) + { + CV *kid = cv_clone2((CV*)ppad[ix], cv); + SvREFCNT_dec(ppad[ix]); + CvCLONE_on(kid); + SvPADMY_on(kid); + curpad[ix] = (SV*)kid; } } +#ifdef DEBUG_CLOSURES + PerlIO_printf(Perl_debug_log, "Cloned inside:\n"); + cv_dump(outside); + PerlIO_printf(Perl_debug_log, " from:\n"); + cv_dump(proto); + PerlIO_printf(Perl_debug_log, " to:\n"); + cv_dump(cv); +#endif + LEAVE; return cv; } +CV * +cv_clone(proto) +CV* proto; +{ + return cv_clone2(proto, CvOUTSIDE(proto)); +} + SV * cv_const_sv(cv) CV *cv; @@ -2854,17 +3022,22 @@ OP *block; char *name = op ? SvPVx(cSVOP->op_sv, na) : "__ANON__"; GV* gv = gv_fetchpv(name, GV_ADDMULTI, SVt_PVCV); AV* av; - char *s; I32 ix; - if (op) + if (op) { + SAVEFREEOP(op); sub_generation++; + } if (cv = GvCV(gv)) { - if (GvCVGEN(gv)) - cv = 0; /* just a cached method */ + if (GvCVGEN(gv)) { + /* just a cached method */ + SvREFCNT_dec(cv); + cv = 0; + } else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) { - SV* const_sv = cv_const_sv(cv); + /* already defined (or promised) */ + SV* const_sv = cv_const_sv(cv); char *p = proto ? SvPVx(((SVOP*)proto)->op_sv, na) : Nullch; if((!proto != !SvPOK(cv)) || (p && strNE(SvPV((SV*)cv,na), p))) { @@ -2872,8 +3045,7 @@ OP *block; SvPOK(cv) ? SvPV((SV*)cv,na) : "none", p ? p : "none"); } - - if ((const_sv || dowarn) && strNE(name, "BEGIN")) {/* already defined (or promised)? */ + if ((const_sv || dowarn) && strNE(name, "BEGIN")) { line_t oldline = curcop->cop_line; curcop->cop_line = copline; @@ -2887,6 +3059,7 @@ OP *block; } if (cv) { /* must reuse cv if autoloaded */ cv_undef(cv); + CvFLAGS(cv) = (CvFLAGS(cv)&~CVf_CLONE) | (CvFLAGS(compcv)&CVf_CLONE); CvOUTSIDE(cv) = CvOUTSIDE(compcv); CvOUTSIDE(compcv) = 0; CvPADLIST(cv) = CvPADLIST(compcv); @@ -2916,7 +3089,6 @@ OP *block; } if (!block) { CvROOT(cv) = 0; - op_free(op); copline = NOLINE; LEAVE_SCOPE(floor); return cv; @@ -2939,43 +3111,46 @@ OP *block; CvSTART(cv) = LINKLIST(CvROOT(cv)); CvROOT(cv)->op_next = 0; peep(CvSTART(cv)); - if (s = strrchr(name,':')) - s++; - else - s = name; - if (strEQ(s, "BEGIN") && !error_count) { - line_t oldline = compiling.cop_line; - SV *oldrs = rs; - ENTER; - SAVESPTR(compiling.cop_filegv); - SAVEI32(perldb); - if (!beginav) - beginav = newAV(); - av_push(beginav, (SV *)cv); - DEBUG_x( dump_sub(gv) ); - rs = SvREFCNT_inc(nrs); - SvREFCNT_inc(cv); - calllist(beginav); - if (GvCV(gv) == cv) { /* Detach it. */ - SvREFCNT_dec(cv); - GvCV(gv) = 0; /* Was above calllist, why? IZ */ + if (op) { + char *s = strrchr(name,':'); + if (s) + s++; + else + s = name; + if (strEQ(s, "BEGIN") && !error_count) { + ENTER; + SAVESPTR(compiling.cop_filegv); + SAVEI16(compiling.cop_line); + SAVEI32(perldb); + save_svref(&rs); + sv_setsv(rs, nrs); + + if (!beginav) + beginav = newAV(); + DEBUG_x( dump_sub(gv) ); + av_push(beginav, (SV *)cv); + GvCV(gv) = 0; + calllist(beginav); + + curcop = &compiling; + LEAVE; + } + else if (strEQ(s, "END") && !error_count) { + if (!endav) + endav = newAV(); + av_unshift(endav, 1); + av_store(endav, 0, (SV *)cv); + GvCV(gv) = 0; } - SvREFCNT_dec(rs); - rs = oldrs; - curcop = &compiling; - curcop->cop_line = oldline; /* might have recursed to yylex */ - LEAVE; - } - else if (strEQ(s, "END") && !error_count) { - if (!endav) - endav = newAV(); - av_unshift(endav, 1); - av_store(endav, 0, SvREFCNT_inc(cv)); } + if (perldb && curstash != debstash) { SV *sv; SV *tmpstr = sv_newmortal(); + static GV *db_postponed; + CV *cv; + HV *hv; sprintf(buf,"%s:%ld",SvPVX(GvSV(curcop->cop_filegv)), (long)subline); sv = newSVpv(buf,0); @@ -2984,14 +3159,25 @@ OP *block; sv_catpv(sv,buf); gv_efullname3(tmpstr, gv, Nullch); hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0); + if (!db_postponed) { + db_postponed = gv_fetchpv("DB::postponed", TRUE, SVt_PVHV); + } + hv = GvHVn(db_postponed); + if (HvFILL(hv) >= 0 && hv_exists(hv, SvPVX(tmpstr), SvCUR(tmpstr)) + && (cv = GvCV(db_postponed))) { + dSP; + PUSHMARK(sp); + XPUSHs(tmpstr); + PUTBACK; + perl_call_sv((SV*)cv, G_DISCARD); + } } - op_free(op); + + if (!op) + GvCV(gv) = 0; /* Will remember in SVOP instead. */ + copline = NOLINE; LEAVE_SCOPE(floor); - if (!op) { - GvCV(gv) = 0; /* Will remember in SVOP instead. */ - CvANON_on(cv); - } return cv; } @@ -3018,7 +3204,6 @@ char *filename; { register CV *cv; GV *gv = gv_fetchpv((name ? name : "__ANON__"), GV_ADDMULTI, SVt_PVCV); - char *s; if (name) sub_generation++; @@ -3050,24 +3235,25 @@ char *filename; GvCVGEN(gv) = 0; CvFILEGV(cv) = gv_fetchfile(filename); CvXSUB(cv) = subaddr; - if (!name) - s = "__ANON__"; - else if (s = strrchr(name,':')) - s++; - else - s = name; - if (strEQ(s, "BEGIN")) { - if (!beginav) - beginav = newAV(); - av_push(beginav, SvREFCNT_inc(gv)); - } - else if (strEQ(s, "END")) { - if (!endav) - endav = newAV(); - av_unshift(endav, 1); - av_store(endav, 0, SvREFCNT_inc(gv)); - } - if (!name) { + if (name) { + char *s = strrchr(name,':'); + if (s) + s++; + else + s = name; + if (strEQ(s, "BEGIN")) { + if (!beginav) + beginav = newAV(); + av_push(beginav, SvREFCNT_inc(gv)); + } + else if (strEQ(s, "END")) { + if (!endav) + endav = newAV(); + av_unshift(endav, 1); + av_store(endav, 0, SvREFCNT_inc(gv)); + } + } + else { GvCV(gv) = 0; /* Will remember elsewhere instead. */ CvANON_on(cv); } @@ -3261,6 +3447,35 @@ OP *o; /* Check routines. */ OP * +ck_anoncode(op) +OP *op; +{ + PADOFFSET ix; + SV* name; + + name = NEWSV(1106,0); + sv_upgrade(name, SVt_PVNV); + sv_setpvn(name, "&", 1); + SvIVX(name) = -1; + SvNVX(name) = 1; + ix = pad_alloc(op->op_type, SVs_PADMY); + av_store(comppad_name, ix, name); + av_store(comppad, ix, cSVOP->op_sv); + SvPADMY_on(cSVOP->op_sv); + cSVOP->op_sv = Nullsv; + cSVOP->op_targ = ix; + return op; +} + +OP * +ck_bitop(op) +OP *op; +{ + op->op_private = hints; + return op; +} + +OP * ck_concat(op) OP *op; { @@ -3276,7 +3491,8 @@ OP *op; if (op->op_flags & OPf_KIDS) { OP* newop; OP* kid; - op = modkids(ck_fun(op), op->op_type); + OPCODE type = op->op_type; + op = modkids(ck_fun(op), type); kid = cUNOP->op_first; newop = kUNOP->op_first->op_sibling; if (newop && @@ -3299,10 +3515,14 @@ ck_delete(op) OP *op; { op = ck_fun(op); + op->op_private = 0; if (op->op_flags & OPf_KIDS) { OP *kid = cUNOP->op_first; - if (kid->op_type != OP_HELEM) - croak("%s argument is not a HASH element", op_desc[op->op_type]); + if (kid->op_type == OP_HSLICE) + op->op_private |= OPpSLICE; + else if (kid->op_type != OP_HELEM) + croak("%s argument is not a HASH element or slice", + op_desc[op->op_type]); null(kid); } return op; @@ -3384,6 +3604,20 @@ OP *op; } OP * +ck_exists(op) +OP *op; +{ + op = ck_fun(op); + if (op->op_flags & OPf_KIDS) { + OP *kid = cUNOP->op_first; + if (kid->op_type != OP_HELEM) + croak("%s argument is not a HASH element", op_desc[op->op_type]); + null(kid); + } + return op; +} + +OP * ck_gvconst(o) register OP *o; { @@ -3432,13 +3666,6 @@ register OP *op; } OP * -ck_formline(op) -OP *op; -{ - return ck_fun(op); -} - -OP * ck_ftst(op) OP *op; { @@ -3687,7 +3914,7 @@ OP *op; if (op->op_flags & OPf_KIDS) { OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */ if (kid && kid->op_type == OP_CONST) - fbm_compile(((SVOP*)kid)->op_sv, 0); + fbm_compile(((SVOP*)kid)->op_sv); } return ck_fun(op); } @@ -3704,14 +3931,16 @@ OP * ck_lfun(op) OP *op; { - return modkids(ck_fun(op), op->op_type); + OPCODE type = op->op_type; + return modkids(ck_fun(op), type); } OP * ck_rfun(op) OP *op; { - return refkids(ck_fun(op), op->op_type); + OPCODE type = op->op_type; + return refkids(ck_fun(op), type); } OP * @@ -3742,7 +3971,43 @@ OP *op; if (!kid) append_elem(op->op_type, op, newSVREF(newGVOP(OP_GV, 0, defgv)) ); - return listkids(op); + op = listkids(op); + + op->op_private = 0; +#ifdef USE_LOCALE + if (hints & HINT_LOCALE) + op->op_private |= OPpLOCALE; +#endif + + return op; +} + +OP * +ck_fun_locale(op) +OP *op; +{ + op = ck_fun(op); + + op->op_private = 0; +#ifdef USE_LOCALE + if (hints & HINT_LOCALE) + op->op_private |= OPpLOCALE; +#endif + + return op; +} + +OP * +ck_scmp(op) +OP *op; +{ + op->op_private = 0; +#ifdef USE_LOCALE + if (hints & HINT_LOCALE) + op->op_private |= OPpLOCALE; +#endif + + return op; } OP * @@ -3847,6 +4112,12 @@ OP * ck_sort(op) OP *op; { + op->op_private = 0; +#ifdef USE_LOCALE + if (hints & HINT_LOCALE) + op->op_private |= OPpLOCALE; +#endif + if (op->op_flags & OPf_STACKED) { OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */ OP *k; @@ -3883,6 +4154,7 @@ OP *op; op->op_flags |= OPf_SPECIAL; } } + return op; } @@ -3964,7 +4236,7 @@ OP *op; null(cvop); /* disable rv2cv */ tmpop = (SVOP*)((UNOP*)cvop)->op_first; if (tmpop->op_type == OP_GV) { - cv = GvCV(tmpop->op_sv); + cv = GvCVu(tmpop->op_sv); if (cv && SvPOK(cv) && !(op->op_private & OPpENTERSUB_AMPER)) proto = SvPV((SV*)cv,na); } @@ -4149,7 +4421,7 @@ register OP* o; case OP_GV: if (o->op_next->op_type == OP_RV2SV) { - if (!(o->op_next->op_private & (OPpDEREF_HV|OPpDEREF_AV))) { + if (!(o->op_next->op_private & OPpDEREF)) { null(o->op_next); o->op_private |= o->op_next->op_private & OPpLVAL_INTRO; o->op_next = o->op_next->op_next; @@ -4163,8 +4435,7 @@ register OP* o; if (pop->op_type == OP_CONST && (op = pop->op_next) && pop->op_next->op_type == OP_AELEM && - !(pop->op_next->op_private & - (OPpDEREF_HV|OPpDEREF_AV|OPpLVAL_INTRO)) && + !(pop->op_next->op_private & (OPpDEREF|OPpLVAL_INTRO)) && (i = SvIV(((SVOP*)pop)->op_sv) - compiling.cop_arybase) <= 255 && i >= 0) @@ -4178,7 +4449,7 @@ register OP* o; o->op_type = OP_AELEMFAST; o->op_ppaddr = ppaddr[OP_AELEMFAST]; o->op_private = (U8)i; - GvAVn((GV*)(((SVOP*)o)->op_sv)); + GvAVn(((GVOP*)o)->op_gv); } } o->op_seq = op_seqmax++;