diff options
| -rw-r--r-- | cop.h | 51 | ||||
| -rw-r--r-- | embed.fnc | 6 | ||||
| -rw-r--r-- | embed.h | 3 | ||||
| -rw-r--r-- | ext/XS-APItest/APItest.xs | 2 | ||||
| -rw-r--r-- | inline.h | 72 | ||||
| -rw-r--r-- | op.c | 2 | ||||
| -rw-r--r-- | perl.c | 2 | ||||
| -rw-r--r-- | pp_ctl.c | 59 | ||||
| -rw-r--r-- | pp_hot.c | 4 | ||||
| -rw-r--r-- | pp_sort.c | 4 | ||||
| -rw-r--r-- | pp_sys.c | 4 | ||||
| -rw-r--r-- | proto.h | 9 |
12 files changed, 135 insertions, 83 deletions
@@ -951,47 +951,7 @@ struct block { (long)(cx->blk_oldsaveix), \ __FILE__, __LINE__)); -/* Enter a block. */ -#define CX_PUSHBLOCK(cx, t, gimme, sp, saveix) \ - CXINC, \ - cx = CX_CUR(), \ - cx->cx_type = t, \ - cx->blk_oldsp = sp - PL_stack_base, \ - cx->blk_oldcop = PL_curcop, \ - cx->blk_oldmarksp = PL_markstack_ptr - PL_markstack, \ - cx->blk_oldsaveix = saveix, \ - cx->blk_oldscopesp = PL_scopestack_ix, \ - cx->blk_oldpm = PL_curpm, \ - cx->blk_gimme = (U8)gimme; \ - cx->cx_u.cx_blk.blku_old_tmpsfloor = PL_tmps_floor; \ - PL_tmps_floor = PL_tmps_ix; \ - CX_DEBUG(cx, "PUSH"); - -#define _CX_POPBLOCK_COMMON(cx) \ - PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \ - PL_scopestack_ix = cx->blk_oldscopesp, \ - PL_curpm = cx->blk_oldpm, - -/* Exit a block (RETURN and LAST). */ -#define CX_POPBLOCK(cx) \ - CX_DEBUG(cx, "POP"); \ - _CX_POPBLOCK_COMMON(cx) \ - /* LEAVE_SCOPE() should have made this true. /(?{})/ cheats - * and leaves a CX entry lying around for repeated use, so - * skip for multicall */ \ - assert( (CxTYPE(cx) == CXt_SUB && CxMULTICALL(cx)) \ - || PL_savestack_ix == cx->blk_oldsaveix); \ - PL_curcop = cx->blk_oldcop, \ - PL_tmps_floor = cx->cx_u.cx_blk.blku_old_tmpsfloor; \ - -/* Continue a block elsewhere (e.g. NEXT, REDO, GOTO). - * Whereas CX_POPBLOCK restores the state to the point just before PUSHBLOCK - * was called, CX_TOPBLOCK restores it to the point just *after* PUSHBLOCK - * was called. */ -#define CX_TOPBLOCK(cx) \ - CX_DEBUG(cx, "TOP"); \ - _CX_POPBLOCK_COMMON(cx) \ - PL_stack_sp = PL_stack_base + cx->blk_oldsp; + /* substitution context */ struct subst { @@ -1291,6 +1251,9 @@ typedef struct stackinfo PERL_SI; #define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling) #define IN_PERL_RUNTIME (PL_curcop != &PL_compiling) + + + /* =head1 Multicall Functions @@ -1312,7 +1275,7 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>. */ #define dMULTICALL \ - SV **newsp; /* set by CX_POPBLOCK */ \ + SV **newsp; /* set by cx_popblock */ \ PERL_CONTEXT *cx; \ CV *multicall_cv; \ OP *multicall_cop; \ @@ -1334,7 +1297,7 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>. multicall_oldcatch = CATCH_GET; \ CATCH_SET(TRUE); \ PUSHSTACKi(PERLSI_MULTICALL); \ - CX_PUSHBLOCK(cx, (CXt_SUB|CXp_MULTICALL|flags), gimme, \ + cx = cx_pushblock((CXt_SUB|CXp_MULTICALL|flags), gimme, \ PL_stack_sp, PL_savestack_ix); \ CX_PUSHSUB(cx, cv, NULL, hasargs); \ SAVEOP(); \ @@ -1366,7 +1329,7 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>. gimme = cx->blk_gimme; \ PERL_UNUSED_VAR(newsp); /* for API */ \ PERL_UNUSED_VAR(gimme); /* for API */ \ - CX_POPBLOCK(cx); \ + cx_popblock(cx); \ CX_POP(cx); \ POPSTACK; \ CATCH_SET(multicall_oldcatch); \ @@ -2880,4 +2880,10 @@ Xp |void |clear_defarray |NN AV* av|bool abandon ApM |void |leave_adjust_stacks|NN SV **from_sp|NN SV **to_sp \ |I32 gimme|int filter +#ifndef PERL_NO_INLINE_FUNCTIONS +AiM |PERL_CONTEXT * |cx_pushblock|U8 type|U8 gimme|NN SV** sp|I32 saveix +AiM |void |cx_popblock|NN PERL_CONTEXT *cx +AiM |void |cx_topblock|NN PERL_CONTEXT *cx +#endif + : ex: set ts=8 sts=4 sw=4 noet: @@ -777,6 +777,9 @@ #define _is_utf8_char_slow S__is_utf8_char_slow #define append_utf8_from_native_byte S_append_utf8_from_native_byte #define av_top_index(a) S_av_top_index(aTHX_ a) +#define cx_popblock(a) S_cx_popblock(aTHX_ a) +#define cx_pushblock(a,b,c,d) S_cx_pushblock(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) #endif #if (!defined(HAS_MEMCPY) && !defined(HAS_BCOPY)) || (!defined(HAS_MEMMOVE) && !defined(HAS_SAFE_MEMCPY) && !defined(HAS_SAFE_BCOPY)) diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 06ff223e42..3e2d071068 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -3727,7 +3727,7 @@ CODE: POPSTACK_TO(PL_mainstack); if (cxstack_ix >= 0) { dounwind(-1); - CX_POPBLOCK(cxstack); + cx_popblock(cxstack); } LEAVE_SCOPE(0); PL_scopestack_ix = oldscope; @@ -401,6 +401,78 @@ S_sv_only_taint_gmagic(SV *sv) { return TRUE; } +/* ------------------ cop.h ------------------------------------------- */ + + +/* Enter a block. Push a new base context and return its address. */ + +PERL_STATIC_INLINE PERL_CONTEXT * +S_cx_pushblock(pTHX_ U8 type, U8 gimme, SV** sp, I32 saveix) +{ + PERL_CONTEXT * cx; + + PERL_ARGS_ASSERT_CX_PUSHBLOCK; + + CXINC; + cx = CX_CUR(); + cx->cx_type = type; + cx->blk_gimme = gimme; + cx->blk_oldsaveix = saveix; + cx->blk_oldsp = sp - PL_stack_base; + cx->blk_oldcop = PL_curcop; + cx->blk_oldmarksp = PL_markstack_ptr - PL_markstack; + cx->blk_oldscopesp = PL_scopestack_ix; + cx->blk_oldpm = PL_curpm; + cx->cx_u.cx_blk.blku_old_tmpsfloor = PL_tmps_floor; + + PL_tmps_floor = PL_tmps_ix; + CX_DEBUG(cx, "PUSH"); + return cx; +} + + +/* Exit a block (RETURN and LAST). */ + +PERL_STATIC_INLINE void +S_cx_popblock(pTHX_ PERL_CONTEXT *cx) +{ + PERL_ARGS_ASSERT_CX_POPBLOCK; + + CX_DEBUG(cx, "POP"); + /* these 3 are common to cx_popblock and cx_topblock */ + PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp; + PL_scopestack_ix = cx->blk_oldscopesp; + PL_curpm = cx->blk_oldpm; + + /* LEAVE_SCOPE() should have made this true. /(?{})/ cheats + * and leaves a CX entry lying around for repeated use, so + * skip for multicall */ \ + assert( (CxTYPE(cx) == CXt_SUB && CxMULTICALL(cx)) + || PL_savestack_ix == cx->blk_oldsaveix); + PL_curcop = cx->blk_oldcop; + PL_tmps_floor = cx->cx_u.cx_blk.blku_old_tmpsfloor; +} + +/* Continue a block elsewhere (e.g. NEXT, REDO, GOTO). + * Whereas cx_popblock() restores the state to the point just before + * cx_pushblock() was called, cx_topblock() restores it to the point just + * *after* cx_pushblock() was called. */ + +PERL_STATIC_INLINE void +S_cx_topblock(pTHX_ PERL_CONTEXT *cx) +{ + PERL_ARGS_ASSERT_CX_TOPBLOCK; + + CX_DEBUG(cx, "TOP"); + /* these 3 are common to cx_popblock and cx_topblock */ + PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp; + PL_scopestack_ix = cx->blk_oldscopesp; + PL_curpm = cx->blk_oldpm; + + PL_stack_sp = PL_stack_base + cx->blk_oldsp; +} + + /* * ex: set ts=8 sts=4 sw=4 et: */ @@ -7105,7 +7105,7 @@ Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block) o->op_flags |= flags; o = op_scope(o); - o->op_flags |= OPf_SPECIAL; /* suppress CX_POPBLOCK curpm restoration*/ + o->op_flags |= OPf_SPECIAL; /* suppress cx_popblock() curpm restoration*/ return o; } @@ -5086,7 +5086,7 @@ S_my_exit_jump(pTHX) POPSTACK_TO(PL_mainstack); if (cxstack_ix >= 0) { dounwind(-1); - CX_POPBLOCK(cxstack); + cx_popblock(cxstack); } LEAVE_SCOPE(0); @@ -1508,7 +1508,7 @@ S_dopoptowhen(pTHX_ I32 startingblock) /* dounwind(): pop all contexts above (but not including) cxix. * Note that it clears the savestack frame associated with each popped * context entry, but doesn't free any temps. - * It does a CX_POPBLOCK of the last frame that it pops, and leaves + * It does a cx_popblock() of the last frame that it pops, and leaves * cxstack_ix equal to cxix. */ @@ -1558,7 +1558,7 @@ Perl_dounwind(pTHX_ I32 cxix) break; } if (cxstack_ix == cxix + 1) { - CX_POPBLOCK(cx); + cx_popblock(cx); } cxstack_ix--; } @@ -1693,7 +1693,7 @@ Perl_die_unwind(pTHX_ SV *msv) CX_LEAVE_SCOPE(cx); CX_POPEVAL(cx); - CX_POPBLOCK(cx); + cx_popblock(cx); restartjmpenv = cx->blk_eval.cur_top_env; restartop = cx->blk_eval.retop; if (CxOLD_OP_TYPE(cx) == OP_REQUIRE) @@ -2011,7 +2011,7 @@ PP(pp_dbstate) return NORMAL; } else { - CX_PUSHBLOCK(cx, CXt_SUB, gimme, SP, PL_savestack_ix); + cx = cx_pushblock(CXt_SUB, gimme, SP, PL_savestack_ix); CX_PUSHSUB_DB(cx, cv, PL_op->op_next, 0); SAVEI32(PL_debug); @@ -2032,10 +2032,9 @@ PP(pp_dbstate) PP(pp_enter) { dSP; - PERL_CONTEXT *cx; I32 gimme = GIMME_V; - CX_PUSHBLOCK(cx, CXt_BLOCK, gimme, SP, PL_savestack_ix); + (void)cx_pushblock(CXt_BLOCK, gimme, SP, PL_savestack_ix); RETURN; } @@ -2062,7 +2061,7 @@ PP(pp_leave) PL_op->op_private & OPpLVALUE ? 3 : 1); CX_LEAVE_SCOPE(cx); - CX_POPBLOCK(cx); + cx_popblock(cx); CX_POP(cx); return NORMAL; @@ -2138,7 +2137,7 @@ PP(pp_enteriter) * there mustn't be anything in the blk_loop substruct that requires * freeing or undoing, in case we die in the meantime. And vice-versa. */ - CX_PUSHBLOCK(cx, cxflags, gimme, MARK, PL_savestack_ix); + cx = cx_pushblock(cxflags, gimme, MARK, PL_savestack_ix); CX_PUSHLOOP_FOR(cx, itervarp, itersave); if (PL_op->op_flags & OPf_STACKED) { @@ -2213,7 +2212,7 @@ PP(pp_enterloop) PERL_CONTEXT *cx; const I32 gimme = GIMME_V; - CX_PUSHBLOCK(cx, CXt_LOOP_PLAIN, gimme, SP, PL_savestack_ix); + cx = cx_pushblock(CXt_LOOP_PLAIN, gimme, SP, PL_savestack_ix); CX_PUSHLOOP_PLAIN(cx); RETURN; @@ -2242,7 +2241,7 @@ PP(pp_leaveloop) CX_LEAVE_SCOPE(cx); CX_POPLOOP(cx); /* Stack values are safe: release loop vars ... */ - CX_POPBLOCK(cx); + cx_popblock(cx); CX_POP(cx); return NORMAL; @@ -2349,7 +2348,7 @@ PP(pp_leavesublv) CX_LEAVE_SCOPE(cx); CX_POPSUB(cx); /* Stack values are safe: release CV and @_ ... */ - CX_POPBLOCK(cx); + cx_popblock(cx); retop = cx->blk_sub.retop; CX_POP(cx); @@ -2531,7 +2530,7 @@ PP(pp_last) /* Stack values are safe: */ CX_LEAVE_SCOPE(cx); CX_POPLOOP(cx); /* release loop vars ... */ - CX_POPBLOCK(cx); + cx_popblock(cx); nextop = cx->blk_loop.my_op->op_lastop->op_next; CX_POP(cx); @@ -2547,7 +2546,7 @@ PP(pp_next) if (!((PL_op->op_flags & OPf_SPECIAL) && CxTYPE_is_LOOP(cx))) cx = S_unwind_loop(aTHX); - CX_TOPBLOCK(cx); + cx_topblock(cx); PL_curcop = cx->blk_oldcop; PERL_ASYNC_CHECK(); return (cx)->blk_loop.my_op->op_nextop; @@ -2568,7 +2567,7 @@ PP(pp_redo) FREETMPS; CX_LEAVE_SCOPE(cx); - CX_TOPBLOCK(cx); + cx_topblock(cx); PL_curcop = cx->blk_oldcop; PERL_ASYNC_CHECK(); return redo_op; @@ -2713,7 +2712,7 @@ PP(pp_goto) dounwind(cxix); } cx = CX_CUR(); - CX_TOPBLOCK(cx); + cx_topblock(cx); SPAGAIN; /* protect @_ during save stack unwind. */ @@ -2807,8 +2806,8 @@ PP(pp_goto) PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL; /* XS subs don't have a CXt_SUB, so pop it; - * this is a CX_POPBLOCK(), less all the stuff we already did - * for CX_TOPBLOCK() earlier */ + * this is a cx_popblock(), less all the stuff we already did + * for cx_topblock() earlier */ PL_curcop = cx->blk_oldcop; CX_POP(cx); @@ -2996,7 +2995,7 @@ PP(pp_goto) DIE(aTHX_ "panic: docatch: illegal ix=%ld", (long)ix); dounwind(ix); cx = CX_CUR(); - CX_TOPBLOCK(cx); + cx_topblock(cx); } /* push wanted frames */ @@ -3398,7 +3397,7 @@ S_doeval_compile(pTHX_ int gimme, CV* outside, U32 seq, HV *hh) cx = CX_CUR(); CX_LEAVE_SCOPE(cx); CX_POPEVAL(cx); - CX_POPBLOCK(cx); + cx_popblock(cx); if (in_require) namesv = cx->blk_eval.old_namesv; CX_POP(cx); @@ -4042,7 +4041,7 @@ PP(pp_require) } /* switch to eval mode */ - CX_PUSHBLOCK(cx, CXt_EVAL, gimme, SP, old_savestack_ix); + cx = cx_pushblock(CXt_EVAL, gimme, SP, old_savestack_ix); CX_PUSHEVAL(cx, PL_op->op_next, newSVpv(name, 0)); SAVECOPLINE(&PL_compiling); @@ -4156,7 +4155,7 @@ PP(pp_entereval) * to do the dirty work for us */ runcv = find_runcv(&seq); - CX_PUSHBLOCK(cx, (CXt_EVAL|CXp_REAL), gimme, SP, old_savestack_ix); + cx = cx_pushblock((CXt_EVAL|CXp_REAL), gimme, SP, old_savestack_ix); CX_PUSHEVAL(cx, PL_op->op_next, NULL); /* prepare to compile string */ @@ -4242,7 +4241,7 @@ PP(pp_leaveeval) CX_LEAVE_SCOPE(cx); CX_POPEVAL(cx); - CX_POPBLOCK(cx); + cx_popblock(cx); retop = cx->blk_eval.retop; evalcv = cx->blk_eval.cv; CX_POP(cx); @@ -4274,7 +4273,7 @@ Perl_delete_eval_scope(pTHX) cx = CX_CUR(); CX_LEAVE_SCOPE(cx); CX_POPEVAL(cx); - CX_POPBLOCK(cx); + cx_popblock(cx); CX_POP(cx); } @@ -4286,7 +4285,7 @@ Perl_create_eval_scope(pTHX_ OP *retop, U32 flags) PERL_CONTEXT *cx; const I32 gimme = GIMME_V; - CX_PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), gimme, + cx = cx_pushblock((CXt_EVAL|CXp_TRYBLOCK), gimme, PL_stack_sp, PL_savestack_ix); CX_PUSHEVAL(cx, retop, NULL); @@ -4326,7 +4325,7 @@ PP(pp_leavetry) leave_adjust_stacks(oldsp, oldsp, gimme, 1); CX_LEAVE_SCOPE(cx); CX_POPEVAL(cx); - CX_POPBLOCK(cx); + cx_popblock(cx); retop = cx->blk_eval.retop; CX_POP(cx); @@ -4345,7 +4344,7 @@ PP(pp_entergiven) assert(!PL_op->op_targ); /* used to be set for lexical $_ */ GvSV(PL_defgv) = SvREFCNT_inc(newsv); - CX_PUSHBLOCK(cx, CXt_GIVEN, gimme, SP, PL_savestack_ix); + cx = cx_pushblock(CXt_GIVEN, gimme, SP, PL_savestack_ix); CX_PUSHGIVEN(cx, origsv); RETURN; @@ -4370,7 +4369,7 @@ PP(pp_leavegiven) CX_LEAVE_SCOPE(cx); CX_POPGIVEN(cx); - CX_POPBLOCK(cx); + cx_popblock(cx); CX_POP(cx); return NORMAL; @@ -4925,7 +4924,7 @@ PP(pp_enterwhen) if ((0 == (PL_op->op_flags & OPf_SPECIAL)) && !SvTRUEx(POPs)) RETURNOP(cLOGOP->op_other->op_next); - CX_PUSHBLOCK(cx, CXt_WHEN, gimme, SP, PL_savestack_ix); + cx = cx_pushblock(CXt_WHEN, gimme, SP, PL_savestack_ix); CX_PUSHWHEN(cx); RETURN; @@ -4964,7 +4963,7 @@ PP(pp_leavewhen) /* emulate pp_next. Note that any stack(s) cleanup will be * done by the pp_unstack which op_nextop should point to */ cx = CX_CUR(); - CX_TOPBLOCK(cx); + cx_topblock(cx); PL_curcop = cx->blk_oldcop; return cx->blk_loop.my_op->op_nextop; } @@ -4993,7 +4992,7 @@ PP(pp_continue) PL_stack_sp = PL_stack_base + cx->blk_oldsp; CX_LEAVE_SCOPE(cx); CX_POPWHEN(cx); - CX_POPBLOCK(cx); + cx_popblock(cx); nextop = cx->blk_givwhen.leave_op->op_next; CX_POP(cx); @@ -3640,7 +3640,7 @@ PP(pp_leavesub) CX_LEAVE_SCOPE(cx); CX_POPSUB(cx); /* Stack values are safe: release CV and @_ ... */ - CX_POPBLOCK(cx); + cx_popblock(cx); retop = cx->blk_sub.retop; CX_POP(cx); @@ -3852,7 +3852,7 @@ PP(pp_entersub) } gimme = GIMME_V; - CX_PUSHBLOCK(cx, CXt_SUB, gimme, MARK, old_savestack_ix); + cx = cx_pushblock(CXt_SUB, gimme, MARK, old_savestack_ix); hasargs = cBOOL(PL_op->op_flags & OPf_STACKED); CX_PUSHSUB(cx, cv, PL_op->op_next, hasargs); @@ -1668,7 +1668,7 @@ PP(pp_sort) } gimme = G_SCALAR; - CX_PUSHBLOCK(cx, CXt_NULL, gimme, PL_stack_base, old_savestack_ix); + cx = cx_pushblock(CXt_NULL, gimme, PL_stack_base, old_savestack_ix); if (!(flags & OPf_SPECIAL)) { cx->cx_type = CXt_SUB|CXp_MULTICALL; CX_PUSHSUB(cx, cv, NULL, hasargs); @@ -1709,7 +1709,7 @@ PP(pp_sort) assert(CxTYPE(cx) == CXt_NULL); /* there isn't a POPNULL ! */ - CX_POPBLOCK(cx); + cx_popblock(cx); CX_POP(cx); POPSTACK; CATCH_SET(oldcatch); @@ -1389,7 +1389,7 @@ S_doform(pTHX_ CV *cv, GV *gv, OP *retop) if (CvCLONE(cv)) cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv)))); - CX_PUSHBLOCK(cx, CXt_FORMAT, gimme, PL_stack_sp, PL_savestack_ix); + cx = cx_pushblock(CXt_FORMAT, gimme, PL_stack_sp, PL_savestack_ix); CX_PUSHFORMAT(cx, cv, gv, retop); if (CvDEPTH(cv) >= 2) pad_push(CvPADLIST(cv), CvDEPTH(cv)); @@ -1526,7 +1526,7 @@ PP(pp_leavewrite) SP = PL_stack_base + cx->blk_oldsp; /* ignore retval of formline */ CX_LEAVE_SCOPE(cx); CX_POPFORMAT(cx); - CX_POPBLOCK(cx); + cx_popblock(cx); retop = cx->blk_sub.retop; CX_POP(cx); @@ -3718,6 +3718,15 @@ PERL_STATIC_INLINE SSize_t S_av_top_index(pTHX_ AV *av) #define PERL_ARGS_ASSERT_AV_TOP_INDEX \ assert(av) +PERL_STATIC_INLINE void S_cx_popblock(pTHX_ PERL_CONTEXT *cx); +#define PERL_ARGS_ASSERT_CX_POPBLOCK \ + assert(cx) +PERL_STATIC_INLINE PERL_CONTEXT * S_cx_pushblock(pTHX_ U8 type, U8 gimme, SV** sp, I32 saveix); +#define PERL_ARGS_ASSERT_CX_PUSHBLOCK \ + assert(sp) +PERL_STATIC_INLINE void S_cx_topblock(pTHX_ PERL_CONTEXT *cx); +#define PERL_ARGS_ASSERT_CX_TOPBLOCK \ + assert(cx) PERL_STATIC_INLINE bool S_is_safe_syscall(pTHX_ const char *pv, STRLEN len, const char *what, const char *op_name) __attribute__warn_unused_result__; #define PERL_ARGS_ASSERT_IS_SAFE_SYSCALL \ |