X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/2c50b7edd16542f4ebaaeeeb1c34aa0bd92bfe2c..ceb12bd8658d8542570022026702734394fec792:/cop.h diff --git a/cop.h b/cop.h index d7482f9..268c24f 100644 --- a/cop.h +++ b/cop.h @@ -551,12 +551,11 @@ be zero. struct block_sub { OP * retop; /* op to execute on exit from sub */ /* Above here is the same for sub, format and eval. */ + PAD *prevcomppad; /* the caller's PL_comppad */ CV * cv; /* Above here is the same for sub and format. */ - AV * savearray; - AV * argarray; I32 olddepth; - PAD *oldcomppad; + AV *savearray; }; @@ -564,17 +563,39 @@ struct block_sub { struct block_format { OP * retop; /* op to execute on exit from sub */ /* Above here is the same for sub, format and eval. */ + PAD *prevcomppad; /* the caller's PL_comppad */ CV * cv; /* Above here is the same for sub and format. */ GV * gv; GV * dfoutgv; }; +/* return a pointer to the current context */ + +#define CX_CUR() (&cxstack[cxstack_ix]) + +/* free all savestack items back to the watermark of the specified context */ + +#define CX_LEAVE_SCOPE(cx) LEAVE_SCOPE(cx->blk_oldsaveix) + +#ifdef DEBUGGING +/* on debugging builds, poison cx afterwards so we know no code + * uses it - because after doing cxstack_ix--, any ties, exceptions etc + * may overwrite the current stack frame */ +# define CX_POP(cx) \ + assert(CX_CUR() == cx); \ + cxstack_ix--; \ + cx = NULL; +#else +# define CX_POP(cx) cxstack_ix--; +#endif + + /* base for the next two macros. Don't use directly. * The context frame holds a reference to the CV so that it can't be * freed while we're executing it */ -#define PUSHSUB_BASE(cx) \ +#define PUSHSUB_BASE(cx, cv, op, hasargs) \ ENTRY_PROBE(CvNAMED(cv) \ ? HEK_KEY(CvNAME_HEK(cv)) \ : GvENAME(CvGV(cv)), \ @@ -584,8 +605,9 @@ struct block_format { \ cx->blk_sub.cv = cv; \ cx->blk_sub.olddepth = CvDEPTH(cv); \ + cx->blk_sub.prevcomppad = PL_comppad; \ cx->cx_type |= (hasargs) ? CXp_HASARGS : 0; \ - cx->blk_sub.retop = NULL; \ + cx->blk_sub.retop = op; \ SvREFCNT_inc_simple_void_NN(cv); #define PUSHSUB_GET_LVALUE_MASK(func) \ @@ -598,34 +620,38 @@ struct block_format { ? 0 : (U8)func(aTHX) \ ) -#define PUSHSUB(cx) \ +#define PUSHSUB(cx, cv, op, hasargs) \ { \ U8 phlags = PUSHSUB_GET_LVALUE_MASK(Perl_was_lvalue_sub); \ - PUSHSUB_BASE(cx) \ + PUSHSUB_BASE(cx, cv, op, hasargs) \ cx->blk_u16 = PL_op->op_private & \ (phlags|OPpDEREF); \ } /* variant for use by OP_DBSTATE, where op_private holds hint bits */ -#define PUSHSUB_DB(cx) \ - PUSHSUB_BASE(cx) \ +#define PUSHSUB_DB(cx, cv, op, hasargs) \ + PUSHSUB_BASE(cx, cv, op, hasargs) \ cx->blk_u16 = 0; -#define PUSHFORMAT(cx, retop) \ +#define PUSHFORMAT(cx, cv, gv, retop) \ cx->blk_format.cv = cv; \ cx->blk_format.gv = gv; \ cx->blk_format.retop = (retop); \ cx->blk_format.dfoutgv = PL_defoutgv; \ + cx->blk_format.prevcomppad = PL_comppad; \ cx->blk_u16 = 0; \ SvREFCNT_inc_simple_void_NN(cv); \ CvDEPTH(cv)++; \ SvREFCNT_inc_void(cx->blk_format.dfoutgv) -#define POP_SAVEARRAY() \ +/* Restore old @_ */ +#define CX_POP_SAVEARRAY(cx) \ STMT_START { \ - SvREFCNT_dec(GvAV(PL_defgv)); \ + AV *av = GvAV(PL_defgv); \ GvAV(PL_defgv) = cx->blk_sub.savearray; \ + cx->blk_sub.savearray = NULL; \ + SvREFCNT_dec(av); \ } STMT_END /* junk in @_ spells trouble when cloning CVs and in pp_caller(), so don't @@ -637,11 +663,43 @@ struct block_format { AvFILLp(ary) = -1; \ } STMT_END -#define POPSUB(cx,sv) \ + +/* subsets of CX_POPSUB */ + +#define CX_POPSUB_COMMON(cx) \ + STMT_START { \ + CV *cv; \ + assert(CxTYPE(cx) == CXt_SUB); \ + PL_comppad = cx->blk_sub.prevcomppad; \ + PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL; \ + cv = cx->blk_sub.cv; \ + CvDEPTH(cv) = cx->blk_sub.olddepth; \ + cx->blk_sub.cv = NULL; \ + SvREFCNT_dec(cv); \ + } STMT_END + +/* handle the @_ part of leaving a sub */ + +#define CX_POPSUB_ARGS(cx) \ STMT_START { \ - const I32 olddepth = cx->blk_sub.olddepth; \ - if (!(cx->blk_u16 & CxPOPSUB_DONE)) { \ - cx->blk_u16 |= CxPOPSUB_DONE; \ + AV *av; \ + assert(CxTYPE(cx) == CXt_SUB); \ + assert(AvARRAY(MUTABLE_AV( \ + PadlistARRAY(CvPADLIST(cx->blk_sub.cv))[ \ + CvDEPTH(cx->blk_sub.cv)])) == PL_curpad); \ + CX_POP_SAVEARRAY(cx); \ + av = MUTABLE_AV(PAD_SVl(0)); \ + if (UNLIKELY(AvREAL(av))) \ + /* abandon @_ if it got reified */ \ + clear_defarray(av, 0); \ + else { \ + CLEAR_ARGARRAY(av); \ + } \ + } STMT_END + +#define CX_POPSUB(cx) \ + STMT_START { \ + assert(CxTYPE(cx) == CXt_SUB); \ RETURN_PROBE(CvNAMED(cx->blk_sub.cv) \ ? HEK_KEY(CvNAME_HEK(cx->blk_sub.cv)) \ : GvENAME(CvGV(cx->blk_sub.cv)), \ @@ -650,43 +708,25 @@ struct block_format { CopSTASHPV((COP*)CvSTART((const CV*)cx->blk_sub.cv))); \ \ if (CxHASARGS(cx)) { \ - POP_SAVEARRAY(); \ - /* abandon @_ if it got reified */ \ - if (AvREAL(cx->blk_sub.argarray)) { \ - const SSize_t fill = AvFILLp(cx->blk_sub.argarray); \ - SvREFCNT_dec_NN(cx->blk_sub.argarray); \ - cx->blk_sub.argarray = newAV(); \ - av_extend(cx->blk_sub.argarray, fill); \ - AvREIFY_only(cx->blk_sub.argarray); \ - CX_CURPAD_SV(cx->blk_sub, 0) = MUTABLE_SV(cx->blk_sub.argarray); \ - } \ - else { \ - CLEAR_ARGARRAY(cx->blk_sub.argarray); \ - } \ + CX_POPSUB_ARGS(cx); \ } \ - } \ - sv = MUTABLE_SV(cx->blk_sub.cv); \ - LEAVE_SCOPE(PL_scopestack[cx->blk_oldscopesp-1]); \ - CvDEPTH((const CV*)sv) = olddepth; \ - } STMT_END - -#define LEAVESUB(sv) \ - STMT_START { \ - SvREFCNT_dec(sv); \ + CX_POPSUB_COMMON(cx); \ } STMT_END -#define POPFORMAT(cx) \ +#define CX_POPFORMAT(cx) \ STMT_START { \ - if (!(cx->blk_u16 & CxPOPSUB_DONE)) { \ - CV * const cv = cx->blk_format.cv; \ - GV * const dfuot = cx->blk_format.dfoutgv; \ - cx->blk_u16 |= CxPOPSUB_DONE; \ - setdefout(dfuot); \ - LEAVE_SCOPE(PL_scopestack[cx->blk_oldscopesp-1]); \ + CV *cv; \ + GV * const dfout = cx->blk_format.dfoutgv; \ + assert(CxTYPE(cx) == CXt_FORMAT); \ + setdefout(dfout); \ + cx->blk_format.dfoutgv = NULL; \ + SvREFCNT_dec_NN(dfout); /* the cx->defoutgv ref */ \ + PL_comppad = cx->blk_format.prevcomppad; \ + PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL; \ + cv = cx->blk_format.cv; \ + cx->blk_format.cv = NULL;; \ --CvDEPTH(cv); \ - SvREFCNT_dec_NN(cx->blk_format.cv); \ - SvREFCNT_dec_NN(dfuot); \ - } \ + SvREFCNT_dec_NN(cv); \ } STMT_END /* eval context */ @@ -707,7 +747,7 @@ struct block_eval { #define CxOLD_IN_EVAL(cx) (((cx)->blk_u16) & 0x7F) #define CxOLD_OP_TYPE(cx) (((cx)->blk_u16) >> 7) -#define PUSHEVAL(cx,n) \ +#define PUSHEVAL(cx, op, n) \ STMT_START { \ assert(!(PL_in_eval & ~0x7F)); \ assert(!(PL_op->op_type & ~0x1FF)); \ @@ -715,114 +755,176 @@ struct block_eval { cx->blk_eval.old_namesv = (n ? newSVpv(n,0) : NULL); \ cx->blk_eval.old_eval_root = PL_eval_root; \ cx->blk_eval.cur_text = PL_parser ? PL_parser->linestr : NULL; \ - cx->blk_eval.cv = NULL; /* set by doeval(), as applicable */ \ - cx->blk_eval.retop = NULL; \ + cx->blk_eval.cv = NULL; /* set by doeval_compile() as applicable */ \ + cx->blk_eval.retop = op; \ cx->blk_eval.cur_top_env = PL_top_env; \ } STMT_END -#define POPEVAL(cx) \ +#define CX_POPEVAL(cx) \ STMT_START { \ + SV *sv; \ + assert(CxTYPE(cx) == CXt_EVAL); \ PL_in_eval = CxOLD_IN_EVAL(cx); \ - optype = CxOLD_OP_TYPE(cx); \ PL_eval_root = cx->blk_eval.old_eval_root; \ - if (cx->blk_eval.cur_text && SvSCREAM(cx->blk_eval.cur_text)) \ - SvREFCNT_dec_NN(cx->blk_eval.cur_text); \ - if (cx->blk_eval.old_namesv) \ - sv_2mortal(cx->blk_eval.old_namesv); \ + sv = cx->blk_eval.cur_text; \ + if (sv && SvSCREAM(sv)) { \ + cx->blk_eval.cur_text = NULL; \ + SvREFCNT_dec_NN(sv); \ + } \ + sv = cx->blk_eval.old_namesv; \ + if (sv && !SvTEMP(sv))/* TEMP implies CX_POPEVAL re-entrantly called */ \ + sv_2mortal(sv); \ } STMT_END /* loop context */ struct block_loop { - I32 resetsp; LOOP * my_op; /* My op, that contains redo, next and last ops. */ union { /* different ways of locating the iteration variable */ - SV **svp; - GV *gv; - PAD *oldcomppad; /* only used in ITHREADS */ + SV **svp; /* for lexicals: address of pad slot */ + GV *gv; /* for package vars */ } itervar_u; + SV *itersave; /* the original iteration var */ union { - struct { /* valid if type is LOOP_FOR or LOOP_PLAIN (but {NULL,0})*/ - AV * ary; /* use the stack if this is NULL */ - IV ix; + struct { /* CXt_LOOP_ARY, C */ + AV *ary; /* array being iterated over */ + IV ix; /* index relative to base of array */ } ary; - struct { /* valid if type is LOOP_LAZYIV */ + struct { /* CXt_LOOP_LIST, C */ + I32 basesp; /* first element of list on stack */ + IV ix; /* index relative to basesp */ + } stack; + struct { /* CXt_LOOP_LAZYIV, C */ IV cur; IV end; } lazyiv; - struct { /* valid if type if LOOP_LAZYSV */ + struct { /* CXt_LOOP_LAZYSV C */ SV * cur; SV * end; /* maxiumum value (or minimum in reverse) */ } lazysv; } state_u; -}; - #ifdef USE_ITHREADS -# define CxITERVAR_PADSV(c) \ - &CX_CURPAD_SV( (c)->blk_loop.itervar_u, (c)->blk_loop.my_op->op_targ) -#else -# define CxITERVAR_PADSV(c) ((c)->blk_loop.itervar_u.svp) + PAD *oldcomppad; /* needed to map itervar_u.svp during thread clone */ #endif +}; -#define CxITERVAR(c) \ - ((c)->blk_loop.itervar_u.oldcomppad \ - ? (CxPADLOOP(c) \ - ? CxITERVAR_PADSV(c) \ - : isGV((c)->blk_loop.itervar_u.gv) \ - ? &GvSV((c)->blk_loop.itervar_u.gv) \ - : (SV **)&(c)->blk_loop.itervar_u.gv) \ - : (SV**)NULL) +#define CxITERVAR(c) \ + (CxPADLOOP(c) \ + ? (c)->blk_loop.itervar_u.svp \ + : ((c)->cx_type & CXp_FOR_GV) \ + ? &GvSV((c)->blk_loop.itervar_u.gv) \ + : (SV **)&(c)->blk_loop.itervar_u.gv) #define CxLABEL(c) (0 + CopLABEL((c)->blk_oldcop)) #define CxLABEL_len(c,len) (0 + CopLABEL_len((c)->blk_oldcop, len)) #define CxLABEL_len_flags(c,len,flags) (0 + CopLABEL_len_flags((c)->blk_oldcop, len, flags)) #define CxHASARGS(c) (((c)->cx_type & CXp_HASARGS) == CXp_HASARGS) + +/* CxLVAL(): the lval flags of the call site: the relevant flag bits from + * the op_private field of the calling pp_entersub (or its caller's caller + * if the caller's lvalue context isn't known): + * OPpLVAL_INTRO: sub used in lvalue context, e.g. f() = 1; + * OPpENTERSUB_INARGS (in conjunction with OPpLVAL_INTRO): the + * function is being used as a sub arg or as a referent, e.g. + * g(...,f(),...) or $r = \f() + * OPpDEREF: 2-bit mask indicating e.g. f()->[0]. + * Note the contrast with CvLVALUE(), which is a property of the sub + * rather than the call site. + */ #define CxLVAL(c) (0 + ((c)->blk_u16 & 0xff)) -/* POPSUB has already been performed on this context frame */ -#define CxPOPSUB_DONE 0x100 -#define PUSHLOOP_PLAIN(cx, s) \ - cx->blk_loop.resetsp = s - PL_stack_base; \ - cx->blk_loop.my_op = cLOOP; \ - cx->blk_loop.state_u.ary.ary = NULL; \ - cx->blk_loop.state_u.ary.ix = 0; \ - cx->blk_loop.itervar_u.svp = NULL; +#define PUSHLOOP_PLAIN(cx) \ + cx->blk_loop.my_op = cLOOP; -#define PUSHLOOP_FOR(cx, ivar, s) \ - cx->blk_loop.resetsp = s - PL_stack_base; \ +#ifdef USE_ITHREADS +# define PUSHLOOP_FOR_setpad(c) (c)->blk_loop.oldcomppad = PL_comppad +#else +# define PUSHLOOP_FOR_setpad(c) NOOP +#endif + +#define PUSHLOOP_FOR(cx, ivar, isave) \ cx->blk_loop.my_op = cLOOP; \ - cx->blk_loop.state_u.ary.ary = NULL; \ - cx->blk_loop.state_u.ary.ix = 0; \ - cx->blk_loop.itervar_u.svp = (SV**)(ivar); - -#define POPLOOP(cx) \ - if (CxTYPE(cx) == CXt_LOOP_LAZYSV) { \ - SvREFCNT_dec_NN(cx->blk_loop.state_u.lazysv.cur); \ - SvREFCNT_dec_NN(cx->blk_loop.state_u.lazysv.end); \ + cx->blk_loop.itervar_u.svp = (SV**)(ivar); \ + cx->blk_loop.itersave = isave; \ + PUSHLOOP_FOR_setpad(cx); + +#define CX_POPLOOP(cx) \ + assert(CxTYPE_is_LOOP(cx)); \ + if ( CxTYPE(cx) == CXt_LOOP_ARY \ + || CxTYPE(cx) == CXt_LOOP_LAZYSV) \ + { \ + /* Free ary or cur. This assumes that state_u.ary.ary \ + * aligns with state_u.lazysv.cur. See cx_dup() */ \ + SV *sv = cx->blk_loop.state_u.lazysv.cur; \ + cx->blk_loop.state_u.lazysv.cur = NULL; \ + SvREFCNT_dec_NN(sv); \ + if (CxTYPE(cx) == CXt_LOOP_LAZYSV) { \ + sv = cx->blk_loop.state_u.lazysv.end; \ + cx->blk_loop.state_u.lazysv.end = NULL; \ + SvREFCNT_dec_NN(sv); \ + } \ } \ - if (CxTYPE(cx) == CXt_LOOP_FOR) \ - SvREFCNT_dec(cx->blk_loop.state_u.ary.ary); + if (cx->cx_type & (CXp_FOR_PAD|CXp_FOR_GV)) { \ + SV *cursv; \ + SV **svp = (cx)->blk_loop.itervar_u.svp; \ + if ((cx->cx_type & CXp_FOR_GV)) \ + svp = &GvSV((GV*)svp); \ + cursv = *svp; \ + *svp = cx->blk_loop.itersave; \ + cx->blk_loop.itersave = NULL; \ + SvREFCNT_dec(cursv); \ + } /* given/when context */ struct block_givwhen { OP *leave_op; + SV *defsv_save; /* the original $_ */ }; -#define PUSHGIVEN(cx) \ +#define PUSHWHEN(cx) \ cx->blk_givwhen.leave_op = cLOGOP->op_other; -#define PUSHWHEN PUSHGIVEN +#define PUSHGIVEN(cx, orig_var) \ + PUSHWHEN(cx); \ + cx->blk_givwhen.defsv_save = orig_var; + +#define CX_POPWHEN(cx) \ + assert(CxTYPE(cx) == CXt_WHEN); \ + NOOP; + +#define CX_POPGIVEN(cx) \ + STMT_START { \ + SV *sv = GvSV(PL_defgv); \ + assert(CxTYPE(cx) == CXt_GIVEN); \ + GvSV(PL_defgv) = cx->blk_givwhen.defsv_save; \ + cx->blk_givwhen.defsv_save = NULL; \ + SvREFCNT_dec(sv); \ + } STMT_END + + +/* basic block, i.e. pp_enter/leave */ + +#define PUSHBASICBLK(cx) \ + NOOP; + +#define CX_POPBASICBLK(cx) \ + assert(CxTYPE(cx) == CXt_BLOCK); \ + NOOP; + /* context common to subroutines, evals and loops */ struct block { U8 blku_type; /* what kind of context this is */ U8 blku_gimme; /* is this block running in list context? */ U16 blku_u16; /* used by block_sub and block_eval (so far) */ - I32 blku_oldsp; /* stack pointer to copy stuff down to */ - COP * blku_oldcop; /* old curcop pointer */ + I32 blku_oldsaveix; /* saved PL_savestack_ix */ + /* all the fields above must be aligned with same-sized fields as sbu */ + I32 blku_oldsp; /* current sp floor: where nextstate pops to */ I32 blku_oldmarksp; /* mark stack index */ - I32 blku_oldscopesp; /* scope stack index */ + COP * blku_oldcop; /* old curcop pointer */ PMOP * blku_oldpm; /* values of pattern match vars */ + SSize_t blku_old_tmpsfloor; /* saved PL_tmps_floor */ + I32 blku_oldscopesp; /* scope stack index */ union { struct block_sub blku_sub; @@ -839,59 +941,74 @@ struct block { #define blk_oldpm cx_u.cx_blk.blku_oldpm #define blk_gimme cx_u.cx_blk.blku_gimme #define blk_u16 cx_u.cx_blk.blku_u16 +#define blk_oldsaveix cx_u.cx_blk.blku_oldsaveix #define blk_sub cx_u.cx_blk.blk_u.blku_sub #define blk_format cx_u.cx_blk.blk_u.blku_format #define blk_eval cx_u.cx_blk.blk_u.blku_eval #define blk_loop cx_u.cx_blk.blk_u.blku_loop #define blk_givwhen cx_u.cx_blk.blk_u.blku_givwhen -#define DEBUG_CX(action) \ +#define CX_DEBUG(cx, action) \ DEBUG_l( \ - Perl_deb(aTHX_ "CX %ld %s %s (scope %ld,%ld) at %s:%d\n", \ + Perl_deb(aTHX_ "CX %ld %s %s (scope %ld,%ld) (save %ld,%ld) at %s:%d\n",\ (long)cxstack_ix, \ action, \ - PL_block_type[CxTYPE(&cxstack[cxstack_ix])], \ + PL_block_type[CxTYPE(cx)], \ (long)PL_scopestack_ix, \ - (long)(cxstack[cxstack_ix].blk_oldscopesp), \ + (long)(cx->blk_oldscopesp), \ + (long)PL_savestack_ix, \ + (long)(cx->blk_oldsaveix), \ __FILE__, __LINE__)); /* Enter a block. */ -#define PUSHBLOCK(cx,t,sp) CXINC, cx = &cxstack[cxstack_ix], \ +#define PUSHBLOCK(cx, t, gimme, sp, saveix) \ + CXINC, \ + cx = CX_CUR(), \ cx->cx_type = t, \ cx->blk_oldsp = sp - PL_stack_base, \ cx->blk_oldcop = PL_curcop, \ cx->blk_oldmarksp = PL_markstack_ptr - PL_markstack, \ + cx->blk_oldsaveix = saveix, \ cx->blk_oldscopesp = PL_scopestack_ix, \ cx->blk_oldpm = PL_curpm, \ cx->blk_gimme = (U8)gimme; \ - DEBUG_CX("PUSH"); + cx->cx_u.cx_blk.blku_old_tmpsfloor = PL_tmps_floor; \ + PL_tmps_floor = PL_tmps_ix; \ + CX_DEBUG(cx, "PUSH"); -/* Exit a block (RETURN and LAST). */ -#define POPBLOCK(cx,pm) \ - DEBUG_CX("POP"); \ - cx = &cxstack[cxstack_ix--], \ - newsp = PL_stack_base + cx->blk_oldsp, \ - PL_curcop = cx->blk_oldcop, \ - PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \ - PL_scopestack_ix = cx->blk_oldscopesp, \ - pm = cx->blk_oldpm, \ - gimme = cx->blk_gimme; - -/* Continue a block elsewhere (NEXT and REDO). */ -#define TOPBLOCK(cx) \ - DEBUG_CX("TOP"); \ - cx = &cxstack[cxstack_ix], \ - PL_stack_sp = PL_stack_base + cx->blk_oldsp, \ +#define _CX_POPBLOCK_COMMON(cx) \ PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \ PL_scopestack_ix = cx->blk_oldscopesp, \ - PL_curpm = cx->blk_oldpm; + PL_curpm = cx->blk_oldpm, + +/* Exit a block (RETURN and LAST). */ +#define CX_POPBLOCK(cx) \ + CX_DEBUG(cx, "POP"); \ + _CX_POPBLOCK_COMMON(cx) \ + /* LEAVE_SCOPE() should have made this true. /(?{})/ cheats + * and leaves a CX entry lying around for repeated use, so + * skip for multicall */ \ + assert( (CxTYPE(cx) == CXt_SUB && CxMULTICALL(cx)) \ + || PL_savestack_ix == cx->blk_oldsaveix); \ + PL_curcop = cx->blk_oldcop, \ + PL_tmps_floor = cx->cx_u.cx_blk.blku_old_tmpsfloor; \ + +/* Continue a block elsewhere (e.g. NEXT, REDO, GOTO). + * Whereas CX_POPBLOCK restores the state to the point just before PUSHBLOCK + * was called, CX_TOPBLOCK restores it to the point just *after* PUSHBLOCK + * was called. */ +#define CX_TOPBLOCK(cx) \ + CX_DEBUG(cx, "TOP"); \ + _CX_POPBLOCK_COMMON(cx) \ + PL_stack_sp = PL_stack_base + cx->blk_oldsp; /* substitution context */ struct subst { - U8 sbu_type; /* what kind of context this is */ + U8 sbu_type; /* same as blku_type */ U8 sbu_rflags; - U16 sbu_rxtainted; /* matches struct block */ - I32 sbu_oldsave; + U16 sbu_rxtainted; + I32 sbu_oldsaveix; /* same as blku_oldsaveix */ + /* all the fields above must be aligned with same-sized fields as blk_u */ SSize_t sbu_iters; SSize_t sbu_maxiters; char * sbu_orig; @@ -906,7 +1023,6 @@ struct subst { #define sb_iters cx_u.cx_subst.sbu_iters #define sb_maxiters cx_u.cx_subst.sbu_maxiters #define sb_rflags cx_u.cx_subst.sbu_rflags -#define sb_oldsave cx_u.cx_subst.sbu_oldsave #define sb_rxtainted cx_u.cx_subst.sbu_rxtainted #define sb_orig cx_u.cx_subst.sbu_orig #define sb_dstr cx_u.cx_subst.sbu_dstr @@ -918,11 +1034,11 @@ struct subst { #define sb_rx cx_u.cx_subst.sbu_rx #ifdef PERL_CORE -# define PUSHSUBST(cx) CXINC, cx = &cxstack[cxstack_ix], \ +# define PUSHSUBST(cx) CXINC, cx = CX_CUR(), \ + cx->blk_oldsaveix = oldsave, \ cx->sb_iters = iters, \ cx->sb_maxiters = maxiters, \ cx->sb_rflags = r_flags, \ - cx->sb_oldsave = oldsave, \ cx->sb_rxtainted = rxtainted, \ cx->sb_orig = orig, \ cx->sb_dstr = dstr, \ @@ -937,10 +1053,16 @@ struct subst { (void)ReREFCNT_inc(rx); \ SvREFCNT_inc_void_NN(targ) -# define POPSUBST(cx) cx = &cxstack[cxstack_ix--]; \ +# define CX_POPSUBST(cx) \ + STMT_START { \ + REGEXP *re; \ + assert(CxTYPE(cx) == CXt_SUBST); \ rxres_free(&cx->sb_rxres); \ - ReREFCNT_dec(cx->sb_rx); \ - SvREFCNT_dec_NN(cx->sb_targ) + re = cx->sb_rx; \ + cx->sb_rx = NULL; \ + ReREFCNT_dec(re); \ + SvREFCNT_dec_NN(cx->sb_targ); \ + } STMT_END #endif #define CxONCE(cx) ((cx)->cx_type & CXp_ONCE) @@ -956,7 +1078,7 @@ struct context { /* If you re-order these, there is also an array of uppercase names in perl.h and a static array of context names in pp_ctl.c */ #define CXTYPEMASK 0xf -#define CXt_NULL 0 +#define CXt_NULL 0 /* currently only used for sort BLOCK */ #define CXt_WHEN 1 #define CXt_BLOCK 2 /* When micro-optimising :-) keep GIVEN next to the LOOPs, as these 5 share a @@ -964,25 +1086,24 @@ struct context { The first 4 don't have a 'case' in at least one switch statement in pp_ctl.c */ #define CXt_GIVEN 3 -/* This is first so that CXt_LOOP_FOR|CXt_LOOP_LAZYIV is CXt_LOOP_LAZYIV */ -#define CXt_LOOP_FOR 4 -#define CXt_LOOP_PLAIN 5 -#define CXt_LOOP_LAZYSV 6 -#define CXt_LOOP_LAZYIV 7 -#define CXt_SUB 8 -#define CXt_FORMAT 9 -#define CXt_EVAL 10 -#define CXt_SUBST 11 -/* SUBST doesn't feature in all switch statements. */ -/* private flags for CXt_SUB and CXt_NULL - However, this is checked in many places which do not check the type, so - this bit needs to be kept clear for most everything else. For reasons I - haven't investigated, it can coexist with CXp_FOR_DEF */ -#define CXp_MULTICALL 0x10 /* part of a multicall (so don't - tear down context on exit). */ +/* be careful of the ordering of these five. Macros like CxTYPE_is_LOOP, + * CxFOREACH compare ranges */ +#define CXt_LOOP_ARY 4 /* for (@ary) {} */ +#define CXt_LOOP_LAZYSV 5 /* for ('a'..'z') {} */ +#define CXt_LOOP_LAZYIV 6 /* for (1..9) {} */ +#define CXt_LOOP_LIST 7 /* for (1,2,3) {} */ +#define CXt_LOOP_PLAIN 8 /* {} */ + +#define CXt_SUB 9 +#define CXt_FORMAT 10 +#define CXt_EVAL 11 +#define CXt_SUBST 12 +/* SUBST doesn't feature in all switch statements. */ /* private flags for CXt_SUB and CXt_FORMAT */ +#define CXp_MULTICALL 0x10 /* part of a multicall (so don't tear down + context on exit). (not CXt_FORMAT) */ #define CXp_HASARGS 0x20 #define CXp_SUB_RE 0x40 /* code called within regex, i.e. (?{}) */ #define CXp_SUB_RE_FAKE 0x80 /* fake sub CX for (?{}) in current scope */ @@ -992,24 +1113,29 @@ struct context { #define CXp_TRYBLOCK 0x40 /* eval{}, not eval'' or similar */ /* private flags for CXt_LOOP */ + +/* this is only set in conjunction with CXp_FOR_GV */ #define CXp_FOR_DEF 0x10 /* foreach using $_ */ +/* these 3 are mutually exclusive */ #define CXp_FOR_LVREF 0x20 /* foreach using \$var */ -#define CxPADLOOP(c) ((c)->blk_loop.my_op->op_targ) +#define CXp_FOR_GV 0x40 /* foreach using package var */ +#define CXp_FOR_PAD 0x80 /* foreach using lexical var */ + +#define CxPADLOOP(c) ((c)->cx_type & CXp_FOR_PAD) /* private flags for CXt_SUBST */ #define CXp_ONCE 0x10 /* What was sbu_once in struct subst */ #define CxTYPE(c) ((c)->cx_type & CXTYPEMASK) -#define CxTYPE_is_LOOP(c) (((c)->cx_type & 0xC) == 0x4) -#define CxMULTICALL(c) (((c)->cx_type & CXp_MULTICALL) \ - == CXp_MULTICALL) +#define CxTYPE_is_LOOP(c) ( CxTYPE(cx) >= CXt_LOOP_ARY \ + && CxTYPE(cx) <= CXt_LOOP_PLAIN) +#define CxMULTICALL(c) ((c)->cx_type & CXp_MULTICALL) #define CxREALEVAL(c) (((c)->cx_type & (CXTYPEMASK|CXp_REAL)) \ == (CXt_EVAL|CXp_REAL)) #define CxTRYBLOCK(c) (((c)->cx_type & (CXTYPEMASK|CXp_TRYBLOCK)) \ == (CXt_EVAL|CXp_TRYBLOCK)) -#define CxFOREACH(c) (CxTYPE_is_LOOP(c) && CxTYPE(c) != CXt_LOOP_PLAIN) -#define CxFOREACHDEF(c) ((CxTYPE_is_LOOP(c) && CxTYPE(c) != CXt_LOOP_PLAIN) \ - && ((c)->cx_type & CXp_FOR_DEF)) +#define CxFOREACH(c) ( CxTYPE(cx) >= CXt_LOOP_ARY \ + && CxTYPE(cx) <= CXt_LOOP_LIST) #define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc())) @@ -1195,11 +1321,12 @@ See L. */ #define dMULTICALL \ - SV **newsp; /* set by POPBLOCK */ \ + SV **newsp; /* set by CX_POPBLOCK */ \ PERL_CONTEXT *cx; \ CV *multicall_cv; \ OP *multicall_cop; \ bool multicall_oldcatch; \ + I32 saveix_floor; \ U8 hasargs = 0 /* used by PUSHSUB */ #define PUSH_MULTICALL(the_cv) \ @@ -1213,22 +1340,21 @@ See L. CV * const _nOnclAshIngNamE_ = the_cv; \ CV * const cv = _nOnclAshIngNamE_; \ PADLIST * const padlist = CvPADLIST(cv); \ - ENTER; \ multicall_oldcatch = CATCH_GET; \ - SAVETMPS; SAVEVPTR(PL_op); \ CATCH_SET(TRUE); \ PUSHSTACKi(PERLSI_MULTICALL); \ - PUSHBLOCK(cx, (CXt_SUB|CXp_MULTICALL|flags), PL_stack_sp); \ - PUSHSUB(cx); \ + PUSHBLOCK(cx, (CXt_SUB|CXp_MULTICALL|flags), gimme, \ + PL_stack_sp, PL_savestack_ix); \ + PUSHSUB(cx, cv, NULL, hasargs); \ + SAVEOP(); \ + saveix_floor = PL_savestack_ix; \ if (!(flags & CXp_SUB_RE_FAKE)) \ CvDEPTH(cv)++; \ - if (CvDEPTH(cv) >= 2) { \ - PERL_STACK_OVERFLOW_CHECK(); \ + if (CvDEPTH(cv) >= 2) \ Perl_pad_push(aTHX_ padlist, CvDEPTH(cv)); \ - } \ - SAVECOMPPAD(); \ PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv)); \ multicall_cv = cv; \ + PERL_UNUSED_VAR(multicall_cv); /* for API */ \ multicall_cop = CvSTART(cv); \ } STMT_END @@ -1236,17 +1362,23 @@ See L. STMT_START { \ PL_op = multicall_cop; \ CALLRUNOPS(aTHX); \ + cx = CX_CUR(); \ + LEAVE_SCOPE(saveix_floor); \ } STMT_END #define POP_MULTICALL \ STMT_START { \ - cx = &cxstack[cxstack_ix]; \ - CvDEPTH(multicall_cv) = cx->blk_sub.olddepth; \ - LEAVESUB(multicall_cv); \ - POPBLOCK(cx,PL_curpm); \ + cx = CX_CUR(); \ + CX_LEAVE_SCOPE(cx); \ + CX_POPSUB_COMMON(cx); \ + newsp = PL_stack_base + cx->blk_oldsp; \ + gimme = cx->blk_gimme; \ + PERL_UNUSED_VAR(newsp); /* for API */ \ + PERL_UNUSED_VAR(gimme); /* for API */ \ + CX_POPBLOCK(cx); \ + CX_POP(cx); \ POPSTACK; \ CATCH_SET(multicall_oldcatch); \ - LEAVE; \ SPAGAIN; \ } STMT_END @@ -1258,19 +1390,15 @@ See L. CV * const _nOnclAshIngNamE_ = the_cv; \ CV * const cv = _nOnclAshIngNamE_; \ PADLIST * const padlist = CvPADLIST(cv); \ - cx = &cxstack[cxstack_ix]; \ - assert(cx->cx_type & CXp_MULTICALL); \ - CvDEPTH(multicall_cv) = cx->blk_sub.olddepth; \ - LEAVESUB(multicall_cv); \ + cx = CX_CUR(); \ + assert(CxMULTICALL(cx)); \ + CX_POPSUB_COMMON(cx); \ cx->cx_type = (CXt_SUB|CXp_MULTICALL|flags); \ - PUSHSUB(cx); \ + PUSHSUB(cx, cv, NULL, hasargs); \ if (!(flags & CXp_SUB_RE_FAKE)) \ CvDEPTH(cv)++; \ - if (CvDEPTH(cv) >= 2) { \ - PERL_STACK_OVERFLOW_CHECK(); \ + if (CvDEPTH(cv) >= 2) \ Perl_pad_push(aTHX_ padlist, CvDEPTH(cv)); \ - } \ - SAVECOMPPAD(); \ PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv)); \ multicall_cv = cv; \ multicall_cop = CvSTART(cv); \