diff options
-rw-r--r-- | cop.h | 41 | ||||
-rw-r--r-- | embed.fnc | 4 | ||||
-rw-r--r-- | embed.h | 3 | ||||
-rw-r--r-- | inline.h | 69 | ||||
-rw-r--r-- | pp_ctl.c | 10 | ||||
-rw-r--r-- | proto.h | 9 |
6 files changed, 90 insertions, 46 deletions
@@ -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 { @@ -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: @@ -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) @@ -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: */ @@ -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); @@ -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) |