X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/d28d780685cbd952928da9c691e2b5bae129457a..45f6403b40da58011eab17ad0159b353c7d92509:/cop.h

diff --git a/cop.h b/cop.h
index ca9dae2..e5370c4 100644
--- a/cop.h
+++ b/cop.h
@@ -1,24 +1,25 @@
 /*    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
@@ -99,8 +100,11 @@ typedef struct jmpenv JMPENV;
 
 #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);		\
@@ -112,13 +116,22 @@ typedef struct jmpenv JMPENV;
 
 #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));		\
@@ -129,7 +142,15 @@ typedef struct jmpenv JMPENV;
     } 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"
@@ -139,7 +160,7 @@ struct cop {
     /* 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 */
@@ -191,18 +212,12 @@ struct cop {
 				 ? 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)
@@ -219,19 +234,17 @@ struct cop {
 #  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)
@@ -240,11 +253,7 @@ struct cop {
 #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.
@@ -258,12 +267,17 @@ struct cop {
 #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
 
@@ -306,8 +320,8 @@ struct block_format {
 
 #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);				\
@@ -355,9 +369,9 @@ struct block_format {
 
 #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();						\
@@ -368,14 +382,14 @@ struct block_format {
 		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
 
@@ -407,7 +421,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,fgv)						\
+#define PUSHEVAL(cx,n)							\
     STMT_START {							\
 	assert(!(PL_in_eval & ~0x7F));					\
 	assert(!(PL_op->op_type & ~0x1FF));				\
@@ -436,13 +450,13 @@ struct block_loop {
     /* (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;
     union {
 	struct { /* valid if type is LOOP_FOR or LOOP_PLAIN (but {NULL,0})*/
 	    AV * ary; /* use the stack if this is NULL */
@@ -461,28 +475,22 @@ struct block_loop {
 
 #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)) && SvPADMY(*CxITERVAR(cx))) \
-	    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))			\
-	    && SvPADMY(*CxITERVAR(cx)))					\
-	    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)
 
@@ -500,27 +508,21 @@ struct block_loop {
 	PUSHLOOP_OP_NEXT;						\
 	cx->blk_loop.state_u.ary.ary = NULL;				\
 	cx->blk_loop.state_u.ary.ix = 0;				\
-	CX_ITERDATA_SET(cx,NULL);
+	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.state_u.ary.ary = NULL;				\
 	cx->blk_loop.state_u.ary.ix = 0;				\
-	CX_ITERDATA_SET(cx,dat);
+	CX_ITERDATA_SET(cx, dat, offset);
 
 #define POPLOOP(cx)							\
 	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.itersave) {					\
-	    SV ** const s_v_p = CxITERVAR(cx);				\
-	    assert(SvPADMY(cx->blk_loop.itersave));			\
-	    sv_2mortal(*s_v_p);						\
-	    *s_v_p = cx->blk_loop.itersave;				\
-	}								\
 	if (CxTYPE(cx) == CXt_LOOP_FOR)					\
 	    SvREFCNT_dec(cx->blk_loop.state_u.ary.ary);
 
@@ -566,6 +568,16 @@ struct block {
 #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(								\
+	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,					\
@@ -575,28 +587,27 @@ struct block {
 	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 {
@@ -630,7 +641,8 @@ 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,				\
@@ -648,11 +660,12 @@ struct subst {
 	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 {
@@ -662,20 +675,27 @@ struct context {
 };
 #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_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	8
-#define CXt_LOOP_PLAIN	9
-#define CXt_LOOP_LAZYSV	10
-#define CXt_LOOP_LAZYIV	11
+#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
@@ -694,15 +714,14 @@ struct context {
 /* 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))		\
@@ -759,11 +778,14 @@ L<perlcall>.
 				   hash actions codes defined in hv.h */
 #define G_EVAL		8	/* Assume eval {} around subroutine call. */
 #define G_NOARGS       16	/* Don't construct a @_ array. */
-#define G_KEEPERR      32	/* Append errors to $@, don't overwrite it */
+#define G_KEEPERR      32	/* Warn for errors, don't overwrite $@ */
 #define G_NODEBUG      64	/* Disable debugging at toplevel.  */
 #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 */
@@ -817,6 +839,11 @@ typedef struct stackinfo PERL_SI;
 #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;				\
@@ -838,6 +865,11 @@ typedef struct stackinfo PERL_SI;
     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);							\
@@ -895,6 +927,7 @@ See L<perlcall/Lightweight Callbacks>.
  	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) {					\
@@ -918,8 +951,10 @@ See L<perlcall/Lightweight Callbacks>.
 	LEAVESUB(multicall_cv);						\
 	CvDEPTH(multicall_cv)--;					\
 	POPBLOCK(cx,PL_curpm);						\
+	POPSTACK;							\
 	CATCH_SET(multicall_oldcatch);					\
 	LEAVE;								\
+	SPAGAIN;							\
     } STMT_END
 
 /*