CXp_FOREACH flag added as part of given/when.
p4raw-id: //depot/perl@33057
# 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; \
#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
/* 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()))
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)));
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;
}
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;
case CXt_EVAL:
POPEVAL(cx);
break;
- case CXt_LOOP:
+ case CXt_LOOP_FOR:
+ case CXt_LOOP_PLAIN:
POPLOOP(cx);
break;
case CXt_NULL:
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
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);
SAVETMPS;
ENTER;
- PUSHBLOCK(cx, CXt_LOOP, SP);
- PUSHLOOP(cx, 0, SP);
+ PUSHBLOCK(cx, CXt_LOOP_PLAIN, SP);
+ PUSHLOOP_PLAIN(cx, SP);
RETURN;
}
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;
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;
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;
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:
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);
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);
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,
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);