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;
};
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)), \
\
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) \
? 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
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)), \
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 */
#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)); \
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<for (@ary)> */
+ 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<for (list)> */
+ I32 basesp; /* first element of list on stack */
+ IV ix; /* index relative to basesp */
+ } stack;
+ struct { /* CXt_LOOP_LAZYIV, C<for (1..9)> */
IV cur;
IV end;
} lazyiv;
- struct { /* valid if type if LOOP_LAZYSV */
+ struct { /* CXt_LOOP_LAZYSV C<for ('a'..'z')> */
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;
#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;
#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
#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, \
(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)
/* 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
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 */
#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()))
*/
#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) \
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
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
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); \
https://perl5.git.perl.org / perl5.git / blobdiff