/* cop.h
*
- * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, by Larry Wall and others
+ * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
+ * 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
- * Control ops (cops) are one of the three ops OP_NEXTSTATE, OP_DBSTATE,
- * and OP_SETSTATE that (loosely speaking) are separate statements.
+ * Control ops (cops) are one of the two ops OP_NEXTSTATE and OP_DBSTATE,
+ * that (loosely speaking) are separate statements.
* They hold information important for lexical state and error reporting.
* At run time, PL_curcop is set to point to the most recently executed cop,
* and thus can be used to determine our current state.
*/
/* A jmpenv packages the state required to perform a proper non-local jump.
- * Note that there is a start_env initialized when perl starts, and top_env
- * points to this initially, so top_env should always be non-null.
+ * Note that there is a PL_start_env initialized when perl starts, and
+ * PL_top_env points to this initially, so PL_top_env should always be
+ * non-null.
*
- * Existence of a non-null top_env->je_prev implies it is valid to call
- * longjmp() at that runlevel (we make sure start_env.je_prev is always
+ * Existence of a non-null PL_top_env->je_prev implies it is valid to call
+ * longjmp() at that runlevel (we make sure PL_start_env.je_prev is always
* null to ensure this).
*
* je_mustcatch, when set at any runlevel to TRUE, means eval ops must
#define JMPENV_PUSH(v) \
STMT_START { \
- DEBUG_l(Perl_deb(aTHX_ "Setting up jumplevel %p, was %p\n", \
- (void*)&cur_env, (void*)PL_top_env)); \
+ DEBUG_l({ \
+ int i = 0; JMPENV *p = PL_top_env; \
+ while (p) { i++; p = p->je_prev; } \
+ Perl_deb(aTHX_ "JUMPENV_PUSH level=%d at %s:%d\n", \
+ i, __FILE__, __LINE__);}) \
cur_env.je_prev = PL_top_env; \
OP_REG_TO_MEM; \
cur_env.je_ret = PerlProc_setjmp(cur_env.je_buf, SCOPE_SAVES_SIGNAL_MASK); \
#define JMPENV_POP \
STMT_START { \
- DEBUG_l(Perl_deb(aTHX_ "popping jumplevel was %p, now %p\n", \
- (void*)PL_top_env, (void*)cur_env.je_prev)); \
+ DEBUG_l({ \
+ int i = -1; JMPENV *p = PL_top_env; \
+ while (p) { i++; p = p->je_prev; } \
+ Perl_deb(aTHX_ "JUMPENV_POP level=%d at %s:%d\n", \
+ i, __FILE__, __LINE__);}) \
+ assert(PL_top_env == &cur_env); \
PL_top_env = cur_env.je_prev; \
} STMT_END
#define JMPENV_JUMP(v) \
STMT_START { \
+ DEBUG_l({ \
+ int i = -1; JMPENV *p = PL_top_env; \
+ while (p) { i++; p = p->je_prev; } \
+ Perl_deb(aTHX_ "JUMPENV_JUMP(%d) level=%d at %s:%d\n", \
+ (int)v, i, __FILE__, __LINE__);}) \
OP_REG_TO_MEM; \
if (PL_top_env->je_prev) \
PerlProc_longjmp(PL_top_env->je_buf, (v)); \
} STMT_END
#define CATCH_GET (PL_top_env->je_mustcatch)
-#define CATCH_SET(v) (PL_top_env->je_mustcatch = (v))
+#define CATCH_SET(v) \
+ STMT_START { \
+ DEBUG_l( \
+ Perl_deb(aTHX_ \
+ "JUMPLEVEL set catch %d => %d (for %p) at %s:%d\n", \
+ PL_top_env->je_mustcatch, v, (void*)PL_top_env, \
+ __FILE__, __LINE__);) \
+ PL_top_env->je_mustcatch = (v); \
+ } STMT_END
#include "mydtrace.h"
/* On LP64 putting this here takes advantage of the fact that BASEOP isn't
an exact multiple of 8 bytes to save structure padding. */
line_t cop_line; /* line # of this command */
- char * cop_label; /* label for this construct */
+ /* label for this construct is now stored in cop_hints_hash */
#ifdef USE_ITHREADS
char * cop_stashpv; /* package line was compiled in */
char * cop_file; /* file name the following line # is from */
? gv_stashpv(CopSTASHPV(c),GV_ADD) : NULL)
# define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME_get(hv) : NULL)
# define CopSTASH_eq(c,hv) ((hv) && stashpv_hvname_match(c,hv))
-# define CopLABEL(c) ((c)->cop_label)
-# define CopLABEL_set(c,pv) (CopLABEL(c) = (pv))
# ifdef NETWARE
# define CopSTASH_free(c) SAVECOPSTASH_FREE(c)
# define CopFILE_free(c) SAVECOPFILE_FREE(c)
-# define CopLABEL_free(c) SAVECOPLABEL_FREE(c)
-# define CopLABEL_alloc(pv) ((pv)?savepv(pv):NULL)
# else
# define CopSTASH_free(c) PerlMemShared_free(CopSTASHPV(c))
# define CopFILE_free(c) (PerlMemShared_free(CopFILE(c)),(CopFILE(c) = NULL))
-# define CopLABEL_free(c) (PerlMemShared_free(CopLABEL(c)),(CopLABEL(c) = NULL))
-# define CopLABEL_alloc(pv) ((pv)?savesharedpv(pv):NULL)
# endif
#else
# define CopFILEGV(c) ((c)->cop_filegv)
# define CopFILE(c) (CopFILEGV(c) && GvSV(CopFILEGV(c)) \
? SvPVX(GvSV(CopFILEGV(c))) : NULL)
# define CopSTASH(c) ((c)->cop_stash)
-# define CopLABEL(c) ((c)->cop_label)
# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
# define CopSTASHPV(c) (CopSTASH(c) ? HvNAME_get(CopSTASH(c)) : NULL)
/* cop_stash is not refcounted */
# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
-# define CopLABEL_alloc(pv) ((pv)?savepv(pv):NULL)
-# define CopLABEL_set(c,pv) (CopLABEL(c) = (pv))
# define CopSTASH_free(c)
# define CopFILE_free(c) (SvREFCNT_dec(CopFILEGV(c)),(CopFILEGV(c) = NULL))
-# define CopLABEL_free(c) (Safefree(CopLABEL(c)),(CopLABEL(c) = NULL))
#endif /* USE_ITHREADS */
+#define CopLABEL(c) Perl_fetch_cop_label(aTHX_ (c)->cop_hints_hash, NULL, NULL)
+#define CopLABEL_alloc(pv) ((pv)?savepv(pv):NULL)
#define CopSTASH_ne(c,hv) (!CopSTASH_eq(c,hv))
#define CopLINE(c) ((c)->cop_line)
#define CopLINE_set(c,l) (CopLINE(c) = (l))
/* OutCopFILE() is CopFILE for output (caller, die, warn, etc.) */
-#ifdef MACOS_TRADITIONAL
-# define OutCopFILE(c) MacPerl_MPWFileName(CopFILE(c))
-#else
-# define OutCopFILE(c) CopFILE(c)
-#endif
+#define OutCopFILE(c) CopFILE(c)
/* If $[ is non-zero, it's stored in cop_hints under the key "$[", and
HINT_ARYBASE is set to indicate this.
#define CopARYBASE_set(c, b) STMT_START { \
if (b || ((c)->cop_hints & HINT_ARYBASE)) { \
(c)->cop_hints |= HINT_ARYBASE; \
- if ((c) == &PL_compiling) \
- PL_hints |= HINT_LOCALIZE_HH | HINT_ARYBASE; \
- (c)->cop_hints_hash \
- = Perl_refcounted_he_new(aTHX_ (c)->cop_hints_hash, \
+ if ((c) == &PL_compiling) { \
+ SV *val = newSViv(b); \
+ (void)hv_stores(GvHV(PL_hintgv), "$[", val); \
+ mg_set(val); \
+ PL_hints |= HINT_ARYBASE; \
+ } else { \
+ (c)->cop_hints_hash \
+ = Perl_refcounted_he_new(aTHX_ (c)->cop_hints_hash, \
newSVpvs_flags("$[", SVs_TEMP), \
sv_2mortal(newSViv(b))); \
+ } \
} \
} STMT_END
#define PUSHSUB_BASE(cx) \
ENTRY_PROBE(GvENAME(CvGV(cv)), \
- CopFILE((COP*)CvSTART(cv)), \
- CopLINE((COP*)CvSTART(cv))); \
+ CopFILE((const COP *)CvSTART(cv)), \
+ CopLINE((const COP *)CvSTART(cv))); \
\
cx->blk_sub.cv = cv; \
cx->blk_sub.olddepth = CvDEPTH(cv); \
#define POPSUB(cx,sv) \
STMT_START { \
- RETURN_PROBE(GvENAME(CvGV((CV*)cx->blk_sub.cv)), \
- CopFILE((COP*)CvSTART((CV*)cx->blk_sub.cv)), \
- CopLINE((COP*)CvSTART((CV*)cx->blk_sub.cv))); \
+ RETURN_PROBE(GvENAME(CvGV((const CV*)cx->blk_sub.cv)), \
+ CopFILE((COP*)CvSTART((const CV*)cx->blk_sub.cv)), \
+ CopLINE((COP*)CvSTART((const CV*)cx->blk_sub.cv))); \
\
if (CxHASARGS(cx)) { \
POP_SAVEARRAY(); \
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) = (SV*)cx->blk_sub.argarray; \
+ CX_CURPAD_SV(cx->blk_sub, 0) = MUTABLE_SV(cx->blk_sub.argarray); \
} \
else { \
CLEAR_ARGARRAY(cx->blk_sub.argarray); \
} \
} \
- sv = (SV*)cx->blk_sub.cv; \
- if (sv && (CvDEPTH((CV*)sv) = cx->blk_sub.olddepth)) \
+ sv = MUTABLE_SV(cx->blk_sub.cv); \
+ if (sv && (CvDEPTH((const CV*)sv) = cx->blk_sub.olddepth)) \
sv = NULL; \
} STMT_END
#define CxOLD_IN_EVAL(cx) (((cx)->blk_u16) & 0x7F)
#define CxOLD_OP_TYPE(cx) (((cx)->blk_u16) >> 7)
-#define PUSHEVAL(cx,n,fgv) \
+#define PUSHEVAL(cx,n) \
STMT_START { \
assert(!(PL_in_eval & ~0x7F)); \
assert(!(PL_op->op_type & ~0x1FF)); \
/* (except for non_ithreads we need to modify next_op in pp_ctl.c, hence
why next_op is conditionally defined below.) */
#ifdef USE_ITHREADS
- void * iterdata;
- PAD *oldcomppad;
+ PAD *oldcomppad; /* Also used for the GV, if targoffset is 0 */
+ /* This is also accesible via cx->blk_loop.my_op->op_targ */
+ PADOFFSET targoffset;
#else
OP * next_op;
SV ** itervar;
#endif
- SV * itersave;
- /* (from inspection of source code) for a .. range of strings this is the
- current string. */
- SV * iterlval;
- /* (from inspection of source code) for a foreach loop this is the array
- being iterated over. For a .. range of numbers it's the current value.
- A check is often made on the SvTYPE of iterary to determine whether
- we are iterating over an array or a range. (numbers or strings) */
- AV * iterary;
- IV iterix;
- /* (from inspection of source code) for a .. range of numbers this is the
- maximum value. */
- IV itermax;
+ 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;
+ } ary;
+ struct { /* valid if type is LOOP_LAZYIV */
+ IV cur;
+ IV end;
+ } lazyiv;
+ struct { /* valid if type if LOOP_LAZYSV */
+ SV * cur;
+ SV * end; /* maxiumum value (or minimum in reverse) */
+ } lazysv;
+ } state_u;
};
-/* It might be possible to squeeze this structure further. As best I can tell
- itermax and iterlval are never used at the same time, so it might be possible
- to make them into a union. However, I'm not confident that there are enough
- flag bits/NULLable pointers in this structure alone to encode which is
- active. There is, however, U8 of space free in struct block, which could be
- used. Right now it may not be worth squeezing this structure further, as it's
- the largest part of struct block, and currently struct block is 64 bytes on
- an ILP32 system, which will give good cache alignment.
-*/
#ifdef USE_ITHREADS
# define CxITERVAR(c) \
- ((c)->blk_loop.iterdata \
- ? (CxPADLOOP(cx) \
- ? &CX_CURPAD_SV( (c)->blk_loop, \
- INT2PTR(PADOFFSET, (c)->blk_loop.iterdata)) \
- : &GvSV((GV*)(c)->blk_loop.iterdata)) \
+ ((c)->blk_loop.oldcomppad \
+ ? (CxPADLOOP(c) \
+ ? &CX_CURPAD_SV( (c)->blk_loop, (c)->blk_loop.targoffset ) \
+ : &GvSV((GV*)(c)->blk_loop.oldcomppad)) \
: (SV**)NULL)
-# define CX_ITERDATA_SET(cx,idata) \
- CX_CURPAD_SAVE(cx->blk_loop); \
- if ((cx->blk_loop.iterdata = (idata))) \
- cx->blk_loop.itersave = SvREFCNT_inc(*CxITERVAR(cx)); \
+# define CX_ITERDATA_SET(cx,idata,o) \
+ if ((cx->blk_loop.targoffset = (o))) \
+ CX_CURPAD_SAVE(cx->blk_loop); \
else \
- cx->blk_loop.itersave = NULL;
+ cx->blk_loop.oldcomppad = (idata);
#else
# define CxITERVAR(c) ((c)->blk_loop.itervar)
-# define CX_ITERDATA_SET(cx,ivar) \
- if ((cx->blk_loop.itervar = (SV**)(ivar))) \
- cx->blk_loop.itersave = SvREFCNT_inc(*CxITERVAR(cx)); \
- else \
- cx->blk_loop.itersave = NULL;
+# define CX_ITERDATA_SET(cx,ivar,o) \
+ cx->blk_loop.itervar = (SV**)(ivar);
#endif
-#define CxLABEL(c) (0 + (c)->blk_oldcop->cop_label)
+#define CxLABEL(c) (0 + CopLABEL((c)->blk_oldcop))
#define CxHASARGS(c) (((c)->cx_type & CXp_HASARGS) == CXp_HASARGS)
#define CxLVAL(c) (0 + (c)->blk_u16)
cx->blk_loop.resetsp = s - PL_stack_base; \
cx->blk_loop.my_op = cLOOP; \
PUSHLOOP_OP_NEXT; \
- cx->blk_loop.iterlval = NULL; \
- cx->blk_loop.iterary = NULL; \
- CX_ITERDATA_SET(cx,NULL);
+ cx->blk_loop.state_u.ary.ary = NULL; \
+ cx->blk_loop.state_u.ary.ix = 0; \
+ CX_ITERDATA_SET(cx, NULL, 0);
-#define PUSHLOOP_FOR(cx, dat, s) \
+#define PUSHLOOP_FOR(cx, dat, s, offset) \
cx->blk_loop.resetsp = s - PL_stack_base; \
cx->blk_loop.my_op = cLOOP; \
PUSHLOOP_OP_NEXT; \
- cx->blk_loop.iterlval = NULL; \
- cx->blk_loop.iterary = NULL; \
- cx->blk_loop.iterix = -1; \
- CX_ITERDATA_SET(cx,dat);
+ cx->blk_loop.state_u.ary.ary = NULL; \
+ cx->blk_loop.state_u.ary.ix = 0; \
+ CX_ITERDATA_SET(cx, dat, offset);
#define POPLOOP(cx) \
- SvREFCNT_dec(cx->blk_loop.iterlval); \
- if (CxITERVAR(cx)) { \
- if (SvPADMY(cx->blk_loop.itersave)) { \
- SV ** const s_v_p = CxITERVAR(cx); \
- sv_2mortal(*s_v_p); \
- *s_v_p = cx->blk_loop.itersave; \
- } \
- else { \
- SvREFCNT_dec(cx->blk_loop.itersave); \
- } \
+ if (CxTYPE(cx) == CXt_LOOP_LAZYSV) { \
+ SvREFCNT_dec(cx->blk_loop.state_u.lazysv.cur); \
+ SvREFCNT_dec(cx->blk_loop.state_u.lazysv.end); \
} \
- if (cx->blk_loop.iterary && cx->blk_loop.iterary != PL_curstack)\
- SvREFCNT_dec(cx->blk_loop.iterary);
+ if (CxTYPE(cx) == CXt_LOOP_FOR) \
+ SvREFCNT_dec(cx->blk_loop.state_u.ary.ary);
/* given/when context */
struct block_givwhen {
#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) \
+ DEBUG_l(WITH_THX( \
+ Perl_deb(aTHX_ "CX %ld %s %s (scope %ld,%ld) at %s:%d\n", \
+ (long)cxstack_ix, \
+ action, \
+ PL_block_type[CxTYPE(&cxstack[cxstack_ix])], \
+ (long)PL_scopestack_ix, \
+ (long)(cxstack[cxstack_ix].blk_oldscopesp), \
+ __FILE__, __LINE__)));
+
/* Enter a block. */
#define PUSHBLOCK(cx,t,sp) CXINC, cx = &cxstack[cxstack_ix], \
cx->cx_type = t, \
cx->blk_oldscopesp = PL_scopestack_ix, \
cx->blk_oldpm = PL_curpm, \
cx->blk_gimme = (U8)gimme; \
- DEBUG_l( PerlIO_printf(Perl_debug_log, "Entering block %ld, type %s\n", \
- (long)cxstack_ix, PL_block_type[CxTYPE(cx)]); )
+ DEBUG_CX("PUSH");
/* Exit a block (RETURN and LAST). */
-#define POPBLOCK(cx,pm) cx = &cxstack[cxstack_ix--], \
+#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; \
- DEBUG_SCOPE("POPBLOCK"); \
- DEBUG_l( PerlIO_printf(Perl_debug_log, "Leaving block %ld, type %s\n", \
- (long)cxstack_ix+1,PL_block_type[CxTYPE(cx)]); )
+ gimme = cx->blk_gimme;
/* Continue a block elsewhere (NEXT and REDO). */
-#define TOPBLOCK(cx) cx = &cxstack[cxstack_ix], \
+#define TOPBLOCK(cx) \
+ DEBUG_CX("TOP"); \
+ cx = &cxstack[cxstack_ix], \
PL_stack_sp = PL_stack_base + cx->blk_oldsp, \
PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \
PL_scopestack_ix = cx->blk_oldscopesp, \
- PL_curpm = cx->blk_oldpm; \
- DEBUG_SCOPE("TOPBLOCK");
+ PL_curpm = cx->blk_oldpm;
/* substitution context */
struct subst {
#define sb_rxres cx_u.cx_subst.sbu_rxres
#define sb_rx cx_u.cx_subst.sbu_rx
-#define PUSHSUBST(cx) CXINC, cx = &cxstack[cxstack_ix], \
+#ifdef PERL_CORE
+# define PUSHSUBST(cx) CXINC, cx = &cxstack[cxstack_ix], \
cx->sb_iters = iters, \
cx->sb_maxiters = maxiters, \
cx->sb_rflags = r_flags, \
rxres_save(&cx->sb_rxres, rx); \
(void)ReREFCNT_inc(rx)
-#define CxONCE(cx) ((cx)->cx_type & CXp_ONCE)
-
-#define POPSUBST(cx) cx = &cxstack[cxstack_ix--]; \
+# define POPSUBST(cx) cx = &cxstack[cxstack_ix--]; \
rxres_free(&cx->sb_rxres); \
ReREFCNT_dec(cx->sb_rx)
+#endif
+
+#define CxONCE(cx) ((cx)->cx_type & CXp_ONCE)
struct context {
union {
};
#define cx_type cx_u.cx_subst.sbu_type
+/* 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_SUB 1
-#define CXt_EVAL 2
-#define CXt_WHEN 3
-#define CXt_SUBST 4
-#define CXt_BLOCK 5
-#define CXt_FORMAT 6
-#define CXt_GIVEN 7
-#define CXt_LOOP_PLAIN 8
-#define CXt_LOOP_FOR 9
-#define CXt_LOOP_RES1 10
-#define CXt_LOOP_RES2 11
+#define CXt_WHEN 1
+#define CXt_BLOCK 2
+/* When micro-optimising :-) keep GIVEN next to the LOOPs, as these 5 share a
+ jump table in pp_ctl.c
+ 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
/* private flags for CXt_LOOP */
#define CXp_FOR_DEF 0x10 /* foreach using $_ */
#ifdef USE_ITHREADS
-# define CXp_PADVAR 0x20 /* itervar lives on pad, iterdata has pad
- offset; if not set, iterdata holds GV* */
-# define CxPADLOOP(c) (CxTYPE_is_LOOP(c) && ((c)->cx_type & (CXp_PADVAR)))
+# define CxPADLOOP(c) ((c)->blk_loop.targoffset)
#endif
+
/* 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) == 0x8)
+#define CxTYPE_is_LOOP(c) (((c)->cx_type & 0xC) == 0x4)
#define CxMULTICALL(c) (((c)->cx_type & CXp_MULTICALL) \
== CXp_MULTICALL)
#define CxREALEVAL(c) (((c)->cx_type & (CXTYPEMASK|CXp_REAL)) \
#define G_METHOD 128 /* Calling method. */
#define G_FAKINGEVAL 256 /* Faking an eval context for call_sv or
fold_constants. */
+#define G_UNDEF_FILL 512 /* Fill the stack with &PL_sv_undef
+ A special case for UNSHIFT in
+ Perl_magic_methcall(). */
/* flag bits for PL_in_eval */
#define EVAL_NULL 0 /* not in an eval */
#define PUSHSTACKi(type) \
STMT_START { \
PERL_SI *next = PL_curstackinfo->si_next; \
+ DEBUG_l({ \
+ int i = 0; PERL_SI *p = PL_curstackinfo; \
+ while (p) { i++; p = p->si_prev; } \
+ Perl_deb(aTHX_ "push STACKINFO %d at %s:%d\n", \
+ i, __FILE__, __LINE__);}) \
if (!next) { \
next = new_stackinfo(32, 2048/sizeof(PERL_CONTEXT) - 1); \
next->si_prev = PL_curstackinfo; \
STMT_START { \
dSP; \
PERL_SI * const prev = PL_curstackinfo->si_prev; \
+ DEBUG_l({ \
+ int i = -1; PERL_SI *p = PL_curstackinfo; \
+ while (p) { i++; p = p->si_prev; } \
+ Perl_deb(aTHX_ "pop STACKINFO %d at %s:%d\n", \
+ i, __FILE__, __LINE__);}) \
if (!prev) { \
PerlIO_printf(Perl_error_log, "panic: POPSTACK\n"); \
my_exit(1); \
multicall_oldcatch = CATCH_GET; \
SAVETMPS; SAVEVPTR(PL_op); \
CATCH_SET(TRUE); \
+ PUSHSTACKi(PERLSI_SORT); \
PUSHBLOCK(cx, CXt_SUB|CXp_MULTICALL, PL_stack_sp); \
PUSHSUB(cx); \
if (++CvDEPTH(cv) >= 2) { \
LEAVESUB(multicall_cv); \
CvDEPTH(multicall_cv)--; \
POPBLOCK(cx,PL_curpm); \
+ POPSTACK; \
CATCH_SET(multicall_oldcatch); \
LEAVE; \
+ SPAGAIN; \
} STMT_END
/*
https://perl5.git.perl.org / perl5.git / blobdiff