From: Nicholas Clark <nick@ccl4.org>
Date: Thu, 24 Jan 2008 10:44:25 +0000 (+0000)
Subject: Split out foreach iterations of temporary lists on the stack to
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a28356daf92caa7f638e39190a3f2c5a3cd8acfe;p=p5sagit%2Fp5-mst-13.2.git

Split out foreach iterations of temporary lists on the stack to
CXt_LOOP_STACK. Don't use cx->blk_loop.iterary to store PL_curstack.

p4raw-id: //depot/perl@33059
---

diff --git a/cop.h b/cop.h
index 15de02f..9129002 100644
--- a/cop.h
+++ b/cop.h
@@ -529,7 +529,7 @@ struct block_loop {
 		SvREFCNT_dec(cx->blk_loop.itersave);			\
 	    }								\
 	}								\
-	if (cx->blk_loop.iterary && cx->blk_loop.iterary != PL_curstack)\
+	if ((CxTYPE(cx) != CXt_LOOP_STACK) && cx->blk_loop.iterary)	\
 	    SvREFCNT_dec(cx->blk_loop.iterary);
 
 /* given/when context */
@@ -681,7 +681,8 @@ struct context {
 #define CXt_GIVEN	7
 #define CXt_LOOP_PLAIN	8
 #define CXt_LOOP_FOR	9
-#define CXt_LOOP_RES1	10
+/* Foreach on a temporary list on the stack */
+#define CXt_LOOP_STACK	10
 #define CXt_LOOP_RES2	11
 
 /* private flags for CXt_SUB and CXt_NULL
diff --git a/pp_ctl.c b/pp_ctl.c
index 2419f27..c857916 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1256,6 +1256,7 @@ S_dopoptolabel(pTHX_ const char *label)
 	    if (CxTYPE(cx) == CXt_NULL)
 		return -1;
 	    break;
+	case CXt_LOOP_STACK:
 	case CXt_LOOP_FOR:
 	case CXt_LOOP_PLAIN:
 	    if ( !CxLABEL(cx) || strNE(label, CxLABEL(cx)) ) {
@@ -1372,6 +1373,7 @@ S_dopoptoloop(pTHX_ I32 startingblock)
 	    if ((CxTYPE(cx)) == CXt_NULL)
 		return -1;
 	    break;
+	case CXt_LOOP_STACK:
 	case CXt_LOOP_FOR:
 	case CXt_LOOP_PLAIN:
 	    DEBUG_l( Perl_deb(aTHX_ "(Found loop #%ld)\n", (long)i));
@@ -1397,6 +1399,7 @@ S_dopoptogiven(pTHX_ I32 startingblock)
 	case CXt_LOOP_PLAIN:
 	    assert(!CxFOREACHDEF(cx));
 	    break;
+	case CXt_LOOP_STACK:
 	case CXt_LOOP_FOR:
 	    if (CxFOREACHDEF(cx)) {
 		DEBUG_l( Perl_deb(aTHX_ "(Found foreach #%ld)\n", (long)i));
@@ -1448,6 +1451,7 @@ Perl_dounwind(pTHX_ I32 cxix)
 	case CXt_EVAL:
 	    POPEVAL(cx);
 	    break;
+	case CXt_LOOP_STACK:
 	case CXt_LOOP_FOR:
 	case CXt_LOOP_PLAIN:
 	    POPLOOP(cx);
@@ -1827,7 +1831,7 @@ PP(pp_enteriter)
     register PERL_CONTEXT *cx;
     const I32 gimme = GIMME_V;
     SV **svp;
-    U16 cxtype = CXt_LOOP_FOR;
+    U16 cxtype = 0;
 #ifdef USE_ITHREADS
     void *iterdata;
 #endif
@@ -1865,6 +1869,7 @@ PP(pp_enteriter)
 
     ENTER;
 
+    cxtype |= (PL_op->op_flags & OPf_STACKED) ? CXt_LOOP_FOR : CXt_LOOP_STACK;
     PUSHBLOCK(cx, cxtype, SP);
 #ifdef USE_ITHREADS
     PUSHLOOP_FOR(cx, iterdata, MARK);
@@ -1919,7 +1924,7 @@ PP(pp_enteriter)
 	}
     }
     else {
-	cx->blk_loop.iterary = PL_curstack;
+	cx->blk_loop.iterary = (SV*)0xDEADBEEF;
 	if (PL_op->op_private & OPpITER_REVERSED) {
 	    cx->blk_loop.itermax = MARK - PL_stack_base + 1;
 	    cx->blk_loop.iterix = cx->blk_oldsp + 1;
@@ -2145,6 +2150,7 @@ PP(pp_last)
     cxstack_ix++; /* temporarily protect top context */
     mark = newsp;
     switch (CxTYPE(cx)) {
+    case CXt_LOOP_STACK:
     case CXt_LOOP_FOR:
     case CXt_LOOP_PLAIN:
 	pop2 = CxTYPE(cx);
@@ -2190,6 +2196,7 @@ PP(pp_last)
     /* Stack values are safe: */
     switch (pop2) {
     case CXt_LOOP_PLAIN:
+    case CXt_LOOP_STACK:
     case CXt_LOOP_FOR:
 	POPLOOP(cx);	/* release loop vars ... */
 	LEAVE;
@@ -2548,6 +2555,7 @@ PP(pp_goto)
 		    break;
                 }
                 /* else fall through */
+	    case CXt_LOOP_STACK:
 	    case CXt_LOOP_FOR:
 	    case CXt_LOOP_PLAIN:
 		gotoprobe = cx->blk_oldcop->op_sibling;
diff --git a/pp_hot.c b/pp_hot.c
index 1348f3a..14a3e08 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1911,7 +1911,7 @@ PP(pp_iter)
 	DIE(aTHX_ "panic: pp_iter");
 
     itersvp = CxITERVAR(cx);
-    av = cx->blk_loop.iterary;
+    av = CxTYPE(cx) == CXt_LOOP_STACK ? PL_curstack : cx->blk_loop.iterary;
     if (SvTYPE(av) != SVt_PVAV) {
 	/* iterate ($min .. $max) */
 	if (cx->blk_loop.iterlval) {
diff --git a/sv.c b/sv.c
index e30140c..1feaa3e 100644
--- a/sv.c
+++ b/sv.c
@@ -10545,6 +10545,7 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, CLONE_PARAMS* param)
 	    case CXt_LOOP_FOR:
 		ncx->blk_loop.iterary	= av_dup_inc(ncx->blk_loop.iterary,
 						     param);
+	    case CXt_LOOP_STACK:
 	    case CXt_LOOP_PLAIN:
 		ncx->blk_loop.iterdata	= (CxPADLOOP(ncx)
 					   ? ncx->blk_loop.iterdata