summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--cop.h41
-rw-r--r--embed.fnc4
-rw-r--r--embed.h3
-rw-r--r--inline.h69
-rw-r--r--pp_ctl.c10
-rw-r--r--proto.h9
6 files changed, 90 insertions, 46 deletions
diff --git a/cop.h b/cop.h
index 6e90d89115..d346d87fc7 100644
--- a/cop.h
+++ b/cop.h
@@ -700,47 +700,6 @@ struct block_loop {
#define CxLVAL(c) (0 + ((c)->blk_u16 & 0xff))
-#define CX_PUSHLOOP_PLAIN(cx) \
- cx->blk_loop.my_op = cLOOP;
-
-#ifdef USE_ITHREADS
-# define CX_PUSHLOOP_FOR_setpad(c) (c)->blk_loop.oldcomppad = PL_comppad
-#else
-# define CX_PUSHLOOP_FOR_setpad(c) NOOP
-#endif
-
-#define CX_PUSHLOOP_FOR(cx, ivar, isave) \
- CX_PUSHLOOP_PLAIN(cx); \
- cx->blk_loop.itervar_u.svp = (SV**)(ivar); \
- cx->blk_loop.itersave = isave; \
- CX_PUSHLOOP_FOR_setpad(cx);
-
-#define CX_POPLOOP(cx) \
- assert(CxTYPE_is_LOOP(cx)); \
- if ( CxTYPE(cx) == CXt_LOOP_ARY \
- || CxTYPE(cx) == CXt_LOOP_LAZYSV) \
- { \
- /* Free ary or cur. This assumes that state_u.ary.ary \
- * aligns with state_u.lazysv.cur. See cx_dup() */ \
- SV *sv = cx->blk_loop.state_u.lazysv.cur; \
- cx->blk_loop.state_u.lazysv.cur = NULL; \
- SvREFCNT_dec_NN(sv); \
- if (CxTYPE(cx) == CXt_LOOP_LAZYSV) { \
- sv = cx->blk_loop.state_u.lazysv.end; \
- cx->blk_loop.state_u.lazysv.end = NULL; \
- SvREFCNT_dec_NN(sv); \
- } \
- } \
- if (cx->cx_type & (CXp_FOR_PAD|CXp_FOR_GV)) { \
- SV *cursv; \
- SV **svp = (cx)->blk_loop.itervar_u.svp; \
- if ((cx->cx_type & CXp_FOR_GV)) \
- svp = &GvSV((GV*)svp); \
- cursv = *svp; \
- *svp = cx->blk_loop.itersave; \
- cx->blk_loop.itersave = NULL; \
- SvREFCNT_dec(cursv); \
- }
/* given/when context */
struct block_givwhen {
diff --git a/embed.fnc b/embed.fnc
index bd0ae356df..61a4bad47a 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -2895,6 +2895,10 @@ AiM |void |cx_popformat |NN PERL_CONTEXT *cx
AiM |void |cx_pusheval |NN PERL_CONTEXT *cx \
|NULLOK OP *retop|NULLOK SV *namesv
AiM |void |cx_popeval |NN PERL_CONTEXT *cx
+AiM |void |cx_pushloop_plain|NN PERL_CONTEXT *cx
+AiM |void |cx_pushloop_for |NN PERL_CONTEXT *cx \
+ |NN void *itervarp|NULLOK SV *itersave
+AiM |void |cx_poploop |NN PERL_CONTEXT *cx
#endif
: ex: set ts=8 sts=4 sw=4 noet:
diff --git a/embed.h b/embed.h
index a48e96c6ab..a3943332f6 100644
--- a/embed.h
+++ b/embed.h
@@ -781,12 +781,15 @@
#define cx_popblock(a) S_cx_popblock(aTHX_ a)
#define cx_popeval(a) S_cx_popeval(aTHX_ a)
#define cx_popformat(a) S_cx_popformat(aTHX_ a)
+#define cx_poploop(a) S_cx_poploop(aTHX_ a)
#define cx_popsub(a) S_cx_popsub(aTHX_ a)
#define cx_popsub_args(a) S_cx_popsub_args(aTHX_ a)
#define cx_popsub_common(a) S_cx_popsub_common(aTHX_ a)
#define cx_pushblock(a,b,c,d) S_cx_pushblock(aTHX_ a,b,c,d)
#define cx_pusheval(a,b,c) S_cx_pusheval(aTHX_ a,b,c)
#define cx_pushformat(a,b,c,d) S_cx_pushformat(aTHX_ a,b,c,d)
+#define cx_pushloop_for(a,b,c) S_cx_pushloop_for(aTHX_ a,b,c)
+#define cx_pushloop_plain(a) S_cx_pushloop_plain(aTHX_ a)
#define cx_pushsub(a,b,c,d) S_cx_pushsub(aTHX_ a,b,c,d)
#define cx_topblock(a) S_cx_topblock(aTHX_ a)
#define is_safe_syscall(a,b,c,d) S_is_safe_syscall(aTHX_ a,b,c,d)
diff --git a/inline.h b/inline.h
index f71e28e60d..99fe4adb32 100644
--- a/inline.h
+++ b/inline.h
@@ -639,6 +639,75 @@ S_cx_popeval(pTHX_ PERL_CONTEXT *cx)
}
+/* push a plain loop, i.e.
+ * { block }
+ * while (cond) { block }
+ * for (init;cond;continue) { block }
+ * This loop can be last/redo'ed etc.
+ */
+
+PERL_STATIC_INLINE void
+S_cx_pushloop_plain(pTHX_ PERL_CONTEXT *cx)
+{
+ PERL_ARGS_ASSERT_CX_PUSHLOOP_PLAIN;
+ cx->blk_loop.my_op = cLOOP;
+}
+
+
+/* push a true for loop, i.e.
+ * for var (list) { block }
+ */
+
+PERL_STATIC_INLINE void
+S_cx_pushloop_for(pTHX_ PERL_CONTEXT *cx, void *itervarp, SV* itersave)
+{
+ PERL_ARGS_ASSERT_CX_PUSHLOOP_FOR;
+
+ /* this one line is common with cx_pushloop_plain */
+ cx->blk_loop.my_op = cLOOP;
+
+ cx->blk_loop.itervar_u.svp = (SV**)itervarp;
+ cx->blk_loop.itersave = itersave;
+#ifdef USE_ITHREADS
+ cx->blk_loop.oldcomppad = PL_comppad;
+#endif
+}
+
+
+/* pop all loop types, including plain */
+
+PERL_STATIC_INLINE void
+S_cx_poploop(pTHX_ PERL_CONTEXT *cx)
+{
+ PERL_ARGS_ASSERT_CX_POPLOOP;
+
+ assert(CxTYPE_is_LOOP(cx));
+ if ( CxTYPE(cx) == CXt_LOOP_ARY
+ || CxTYPE(cx) == CXt_LOOP_LAZYSV)
+ {
+ /* Free ary or cur. This assumes that state_u.ary.ary
+ * aligns with state_u.lazysv.cur. See cx_dup() */
+ SV *sv = cx->blk_loop.state_u.lazysv.cur;
+ cx->blk_loop.state_u.lazysv.cur = NULL;
+ SvREFCNT_dec_NN(sv);
+ if (CxTYPE(cx) == CXt_LOOP_LAZYSV) {
+ sv = cx->blk_loop.state_u.lazysv.end;
+ cx->blk_loop.state_u.lazysv.end = NULL;
+ SvREFCNT_dec_NN(sv);
+ }
+ }
+ if (cx->cx_type & (CXp_FOR_PAD|CXp_FOR_GV)) {
+ SV *cursv;
+ SV **svp = (cx)->blk_loop.itervar_u.svp;
+ if ((cx->cx_type & CXp_FOR_GV))
+ svp = &GvSV((GV*)svp);
+ cursv = *svp;
+ *svp = cx->blk_loop.itersave;
+ cx->blk_loop.itersave = NULL;
+ SvREFCNT_dec(cursv);
+ }
+}
+
/*
* ex: set ts=8 sts=4 sw=4 et:
*/
diff --git a/pp_ctl.c b/pp_ctl.c
index 8a259d443e..113c2c434b 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1541,7 +1541,7 @@ Perl_dounwind(pTHX_ I32 cxix)
case CXt_LOOP_LAZYSV:
case CXt_LOOP_LIST:
case CXt_LOOP_ARY:
- CX_POPLOOP(cx);
+ cx_poploop(cx);
break;
case CXt_WHEN:
CX_POPWHEN(cx);
@@ -2142,7 +2142,7 @@ PP(pp_enteriter)
* freeing or undoing, in case we die in the meantime. And vice-versa.
*/
cx = cx_pushblock(cxflags, gimme, MARK, PL_savestack_ix);
- CX_PUSHLOOP_FOR(cx, itervarp, itersave);
+ cx_pushloop_for(cx, itervarp, itersave);
if (PL_op->op_flags & OPf_STACKED) {
/* OPf_STACKED implies either a single array: for(@), with a
@@ -2217,7 +2217,7 @@ PP(pp_enterloop)
const I32 gimme = GIMME_V;
cx = cx_pushblock(CXt_LOOP_PLAIN, gimme, SP, PL_savestack_ix);
- CX_PUSHLOOP_PLAIN(cx);
+ cx_pushloop_plain(cx);
RETURN;
}
@@ -2244,7 +2244,7 @@ PP(pp_leaveloop)
PL_op->op_private & OPpLVALUE ? 3 : 1);
CX_LEAVE_SCOPE(cx);
- CX_POPLOOP(cx); /* Stack values are safe: release loop vars ... */
+ cx_poploop(cx); /* Stack values are safe: release loop vars ... */
cx_popblock(cx);
CX_POP(cx);
@@ -2533,7 +2533,7 @@ PP(pp_last)
/* Stack values are safe: */
CX_LEAVE_SCOPE(cx);
- CX_POPLOOP(cx); /* release loop vars ... */
+ cx_poploop(cx); /* release loop vars ... */
cx_popblock(cx);
nextop = cx->blk_loop.my_op->op_lastop->op_next;
CX_POP(cx);
diff --git a/proto.h b/proto.h
index 052e766308..ebbd4e7bbe 100644
--- a/proto.h
+++ b/proto.h
@@ -3727,6 +3727,9 @@ PERL_STATIC_INLINE void S_cx_popeval(pTHX_ PERL_CONTEXT *cx);
PERL_STATIC_INLINE void S_cx_popformat(pTHX_ PERL_CONTEXT *cx);
#define PERL_ARGS_ASSERT_CX_POPFORMAT \
assert(cx)
+PERL_STATIC_INLINE void S_cx_poploop(pTHX_ PERL_CONTEXT *cx);
+#define PERL_ARGS_ASSERT_CX_POPLOOP \
+ assert(cx)
PERL_STATIC_INLINE void S_cx_popsub(pTHX_ PERL_CONTEXT *cx);
#define PERL_ARGS_ASSERT_CX_POPSUB \
assert(cx)
@@ -3745,6 +3748,12 @@ PERL_STATIC_INLINE void S_cx_pusheval(pTHX_ PERL_CONTEXT *cx, OP *retop, SV *nam
PERL_STATIC_INLINE void S_cx_pushformat(pTHX_ PERL_CONTEXT *cx, CV *cv, OP *retop, GV *gv);
#define PERL_ARGS_ASSERT_CX_PUSHFORMAT \
assert(cx); assert(cv)
+PERL_STATIC_INLINE void S_cx_pushloop_for(pTHX_ PERL_CONTEXT *cx, void *itervarp, SV *itersave);
+#define PERL_ARGS_ASSERT_CX_PUSHLOOP_FOR \
+ assert(cx); assert(itervarp)
+PERL_STATIC_INLINE void S_cx_pushloop_plain(pTHX_ PERL_CONTEXT *cx);
+#define PERL_ARGS_ASSERT_CX_PUSHLOOP_PLAIN \
+ assert(cx)
PERL_STATIC_INLINE void S_cx_pushsub(pTHX_ PERL_CONTEXT *cx, CV *cv, OP *retop, bool hasargs);
#define PERL_ARGS_ASSERT_CX_PUSHSUB \
assert(cx); assert(cv)