Split CXt_LOOP into CXt_LOOP_PLAIN and CXt_LOOP_FOR, eliminating the
Nicholas Clark [Thu, 24 Jan 2008 09:36:05 +0000 (09:36 +0000)]
CXp_FOREACH flag added as part of given/when.

p4raw-id: //depot/perl@33057

cop.h
pp_ctl.c
pp_hot.c
scope.c
sv.c

diff --git a/cop.h b/cop.h
index b6e35e8..15de02f 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -500,7 +500,15 @@ struct block_loop {
 #  define CX_LOOP_NEXTOP_GET(cx)       ((cx)->blk_loop.next_op + 0)
 #endif
 
-#define PUSHLOOP(cx, dat, s)                                           \
+#define PUSHLOOP_PLAIN(cx, s)                                          \
+       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);
+
+#define PUSHLOOP_FOR(cx, dat, s)                                       \
        cx->blk_loop.resetsp = s - PL_stack_base;                       \
        cx->blk_loop.my_op = cLOOP;                                     \
        PUSHLOOP_OP_NEXT;                                               \
@@ -666,12 +674,15 @@ struct context {
 #define CXt_NULL       0
 #define CXt_SUB                1
 #define CXt_EVAL       2
-#define CXt_LOOP       3
+#define CXt_WHEN       3
 #define CXt_SUBST      4
 #define CXt_BLOCK      5
 #define CXt_FORMAT     6
 #define CXt_GIVEN      7
-#define CXt_WHEN       8
+#define CXt_LOOP_PLAIN 8
+#define CXt_LOOP_FOR   9
+#define CXt_LOOP_RES1  10
+#define CXt_LOOP_RES2  11
 
 /* private flags for CXt_SUB and CXt_NULL
    However, this is checked in many places which do not check the type, so
@@ -689,27 +700,25 @@ struct context {
 
 /* private flags for CXt_LOOP */
 #define CXp_FOR_DEF    0x10    /* foreach using $_ */
-#define CXp_FOREACH    0x20    /* a foreach loop */
 #ifdef USE_ITHREADS
-#  define CXp_PADVAR   0x40    /* itervar lives on pad, iterdata has pad
+#  define CXp_PADVAR   0x20    /* itervar lives on pad, iterdata has pad
                                   offset; if not set, iterdata holds GV* */
-#  define CxPADLOOP(c) (((c)->cx_type & (CXt_LOOP|CXp_PADVAR))         \
-                        == (CXt_LOOP|CXp_PADVAR))
+#  define CxPADLOOP(c) (CxTYPE_is_LOOP(c) && ((c)->cx_type & (CXp_PADVAR)))
 #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 CxMULTICALL(c) (((c)->cx_type & CXp_MULTICALL)                 \
                         == 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)   (((c)->cx_type & (CXTYPEMASK|CXp_FOREACH))      \
-                         == (CXt_LOOP|CXp_FOREACH))
-#define CxFOREACHDEF(c)        (((c)->cx_type & (CXTYPEMASK|CXp_FOREACH|CXp_FOR_DEF))\
-                        == (CXt_LOOP|CXp_FOREACH|CXp_FOR_DEF))
+#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 CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc()))
 
index e4c3f8f..2419f27 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1256,7 +1256,8 @@ S_dopoptolabel(pTHX_ const char *label)
            if (CxTYPE(cx) == CXt_NULL)
                return -1;
            break;
-       case CXt_LOOP:
+       case CXt_LOOP_FOR:
+       case CXt_LOOP_PLAIN:
            if ( !CxLABEL(cx) || strNE(label, CxLABEL(cx)) ) {
                DEBUG_l(Perl_deb(aTHX_ "(Skipping label #%ld %s)\n",
                        (long)i, CxLABEL(cx)));
@@ -1371,7 +1372,8 @@ S_dopoptoloop(pTHX_ I32 startingblock)
            if ((CxTYPE(cx)) == CXt_NULL)
                return -1;
            break;
-       case CXt_LOOP:
+       case CXt_LOOP_FOR:
+       case CXt_LOOP_PLAIN:
            DEBUG_l( Perl_deb(aTHX_ "(Found loop #%ld)\n", (long)i));
            return i;
        }
@@ -1392,7 +1394,10 @@ S_dopoptogiven(pTHX_ I32 startingblock)
        case CXt_GIVEN:
            DEBUG_l( Perl_deb(aTHX_ "(Found given #%ld)\n", (long)i));
            return i;
-       case CXt_LOOP:
+       case CXt_LOOP_PLAIN:
+           assert(!CxFOREACHDEF(cx));
+           break;
+       case CXt_LOOP_FOR:
            if (CxFOREACHDEF(cx)) {
                DEBUG_l( Perl_deb(aTHX_ "(Found foreach #%ld)\n", (long)i));
                return i;
@@ -1443,7 +1448,8 @@ Perl_dounwind(pTHX_ I32 cxix)
        case CXt_EVAL:
            POPEVAL(cx);
            break;
-       case CXt_LOOP:
+       case CXt_LOOP_FOR:
+       case CXt_LOOP_PLAIN:
            POPLOOP(cx);
            break;
        case CXt_NULL:
@@ -1821,7 +1827,7 @@ PP(pp_enteriter)
     register PERL_CONTEXT *cx;
     const I32 gimme = GIMME_V;
     SV **svp;
-    U16 cxtype = CXt_LOOP | CXp_FOREACH;
+    U16 cxtype = CXt_LOOP_FOR;
 #ifdef USE_ITHREADS
     void *iterdata;
 #endif
@@ -1861,9 +1867,9 @@ PP(pp_enteriter)
 
     PUSHBLOCK(cx, cxtype, SP);
 #ifdef USE_ITHREADS
-    PUSHLOOP(cx, iterdata, MARK);
+    PUSHLOOP_FOR(cx, iterdata, MARK);
 #else
-    PUSHLOOP(cx, svp, MARK);
+    PUSHLOOP_FOR(cx, svp, MARK);
 #endif
     if (PL_op->op_flags & OPf_STACKED) {
        cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs);
@@ -1936,8 +1942,8 @@ PP(pp_enterloop)
     SAVETMPS;
     ENTER;
 
-    PUSHBLOCK(cx, CXt_LOOP, SP);
-    PUSHLOOP(cx, 0, SP);
+    PUSHBLOCK(cx, CXt_LOOP_PLAIN, SP);
+    PUSHLOOP_PLAIN(cx, SP);
 
     RETURN;
 }
@@ -1952,7 +1958,7 @@ PP(pp_leaveloop)
     SV **mark;
 
     POPBLOCK(cx,newpm);
-    assert(CxTYPE(cx) == CXt_LOOP);
+    assert(CxTYPE_is_LOOP(cx));
     mark = newsp;
     newsp = PL_stack_base + cx->blk_loop.resetsp;
 
@@ -2139,8 +2145,9 @@ PP(pp_last)
     cxstack_ix++; /* temporarily protect top context */
     mark = newsp;
     switch (CxTYPE(cx)) {
-    case CXt_LOOP:
-       pop2 = CXt_LOOP;
+    case CXt_LOOP_FOR:
+    case CXt_LOOP_PLAIN:
+       pop2 = CxTYPE(cx);
        newsp = PL_stack_base + cx->blk_loop.resetsp;
        nextop = cx->blk_loop.my_op->op_lastop->op_next;
        break;
@@ -2182,7 +2189,8 @@ PP(pp_last)
     cxstack_ix--;
     /* Stack values are safe: */
     switch (pop2) {
-    case CXt_LOOP:
+    case CXt_LOOP_PLAIN:
+    case CXt_LOOP_FOR:
        POPLOOP(cx);    /* release loop vars ... */
        LEAVE;
        break;
@@ -2540,7 +2548,8 @@ PP(pp_goto)
                    break;
                 }
                 /* else fall through */
-           case CXt_LOOP:
+           case CXt_LOOP_FOR:
+           case CXt_LOOP_PLAIN:
                gotoprobe = cx->blk_oldcop->op_sibling;
                break;
            case CXt_SUBST:
index f1bf9d4..1348f3a 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1907,7 +1907,7 @@ PP(pp_iter)
 
     EXTEND(SP, 1);
     cx = &cxstack[cxstack_ix];
-    if (CxTYPE(cx) != CXt_LOOP)
+    if (!CxTYPE_is_LOOP(cx))
        DIE(aTHX_ "panic: pp_iter");
 
     itersvp = CxITERVAR(cx);
diff --git a/scope.c b/scope.c
index 9cbd13c..74a3be0 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -1083,7 +1083,8 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx)
                PTR2UV(cx->blk_eval.retop));
        break;
 
-    case CXt_LOOP:
+    case CXt_LOOP_FOR:
+    case CXt_LOOP_PLAIN:
        PerlIO_printf(Perl_debug_log, "BLK_LOOP.LABEL = %s\n", CxLABEL(cx));
        PerlIO_printf(Perl_debug_log, "BLK_LOOP.RESETSP = %ld\n",
                (long)cx->blk_loop.resetsp);
diff --git a/sv.c b/sv.c
index a59af0d..e30140c 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -10542,7 +10542,10 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, CLONE_PARAMS* param)
                                                      param);
                ncx->blk_eval.cur_text  = sv_dup(ncx->blk_eval.cur_text, param);
                break;
-           case CXt_LOOP:
+           case CXt_LOOP_FOR:
+               ncx->blk_loop.iterary   = av_dup_inc(ncx->blk_loop.iterary,
+                                                    param);
+           case CXt_LOOP_PLAIN:
                ncx->blk_loop.iterdata  = (CxPADLOOP(ncx)
                                           ? ncx->blk_loop.iterdata
                                           : gv_dup((GV*)ncx->blk_loop.iterdata,
@@ -10554,8 +10557,6 @@ Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, CLONE_PARAMS* param)
                                                     param);
                ncx->blk_loop.iterlval  = sv_dup_inc(ncx->blk_loop.iterlval,
                                                     param);
-               ncx->blk_loop.iterary   = av_dup_inc(ncx->blk_loop.iterary,
-                                                    param);
                break;
            case CXt_FORMAT:
                ncx->blk_format.cv      = cv_dup(ncx->blk_format.cv, param);