X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/6fb05a88b585ff8c2ecf0a3f089acceca1bae5b7..acab2422b2372f4b4d6e2542e9b9cf3dc0b83e92:/pp_ctl.c?ds=sidebyside diff --git a/pp_ctl.c b/pp_ctl.c index bc8b778..99ff59a 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -287,7 +287,7 @@ PP(pp_substcont) TAINT_NOT; CX_LEAVE_SCOPE(cx); - POPSUBST(cx); + CX_POPSUBST(cx); CX_POP(cx); PERL_ASYNC_CHECK(); @@ -965,7 +965,7 @@ PP(pp_grepstart) PP(pp_mapwhile) { dSP; - const I32 gimme = GIMME_V; + const U8 gimme = GIMME_V; I32 items = (SP - PL_stack_base) - TOPMARK; /* how many new items */ I32 count; I32 shift; @@ -1332,14 +1332,14 @@ S_dopoptolabel(pTHX_ const char *label, STRLEN len, U32 flags) -I32 +U8 Perl_dowantarray(pTHX) { - const I32 gimme = block_gimme(); + const U8 gimme = block_gimme(); return (gimme == G_VOID) ? G_SCALAR : gimme; } -I32 +U8 Perl_block_gimme(pTHX) { const I32 cxix = dopoptosub(cxstack_ix); @@ -1366,7 +1366,7 @@ Perl_is_lvalue_sub(pTHX) return 0; } -/* only used by PUSHSUB */ +/* only used by cx_pushsub() */ I32 Perl_was_lvalue_sub(pTHX) { @@ -1458,7 +1458,7 @@ S_dopoptoloop(pTHX_ I32 startingblock) return i; } -/* find the next GIVEN or FOR loop context block */ +/* find the next GIVEN or FOR (with implicit $_) loop context block */ STATIC I32 S_dopoptogivenfor(pTHX_ I32 startingblock) @@ -1506,12 +1506,10 @@ S_dopoptowhen(pTHX_ I32 startingblock) } /* dounwind(): pop all contexts above (but not including) cxix. - * Leaves cxstack_ix equal to cxix. Note that for efficiency, it doesn't - * call POPBLOCK at all; the caller should do - * CX_LEAVE_SCOPE; POPFOO; POPBLOCK - * or - * TOPBLOCK - * as appropriate. + * 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 + * cxstack_ix equal to cxix. */ void @@ -1530,39 +1528,41 @@ Perl_dounwind(pTHX_ I32 cxix) switch (CxTYPE(cx)) { case CXt_SUBST: - POPSUBST(cx); + CX_POPSUBST(cx); break; case CXt_SUB: - POPSUB(cx); + cx_popsub(cx); break; case CXt_EVAL: - POPEVAL(cx); - break; - case CXt_BLOCK: - POPBASICBLK(cx); + cx_popeval(cx); break; case CXt_LOOP_PLAIN: case CXt_LOOP_LAZYIV: case CXt_LOOP_LAZYSV: case CXt_LOOP_LIST: case CXt_LOOP_ARY: - POPLOOP(cx); + cx_poploop(cx); break; case CXt_WHEN: - POPWHEN(cx); + cx_popwhen(cx); break; case CXt_GIVEN: - POPGIVEN(cx); + cx_popgiven(cx); break; + case CXt_BLOCK: case CXt_NULL: - /* there isn't a POPNULL ! */ + /* these two don't have a POPFOO() */ break; case CXt_FORMAT: - POPFORMAT(cx); + cx_popformat(cx); break; } + if (cxstack_ix == cxix + 1) { + cx_popblock(cx); + } cxstack_ix--; } + } void @@ -1674,7 +1674,7 @@ Perl_die_unwind(pTHX_ SV *msv) SV *namesv = NULL; PERL_CONTEXT *cx; SV **oldsp; - I32 gimme; + U8 gimme; JMPENV *restartjmpenv; OP *restartop; @@ -1692,8 +1692,8 @@ Perl_die_unwind(pTHX_ SV *msv) PL_stack_sp = oldsp; CX_LEAVE_SCOPE(cx); - POPEVAL(cx); - POPBLOCK(cx); + cx_popeval(cx); + cx_popblock(cx); restartjmpenv = cx->blk_eval.cur_top_env; restartop = cx->blk_eval.retop; if (CxOLD_OP_TYPE(cx) == OP_REQUIRE) @@ -1800,7 +1800,7 @@ PP(pp_caller) dSP; const PERL_CONTEXT *cx; const PERL_CONTEXT *dbcx; - I32 gimme = GIMME_V; + U8 gimme = GIMME_V; const HEK *stash_hek; I32 count = 0; bool has_arg = MAXARG && TOPs; @@ -1870,7 +1870,7 @@ PP(pp_caller) PUSHs(newSVpvs_flags("(eval)", SVs_TEMP)); mPUSHi(0); } - gimme = (I32)cx->blk_gimme; + gimme = cx->blk_gimme; if (gimme == G_VOID) PUSHs(&PL_sv_undef); else @@ -1984,7 +1984,7 @@ PP(pp_dbstate) { dSP; PERL_CONTEXT *cx; - const I32 gimme = G_ARRAY; + const U8 gimme = G_ARRAY; GV * const gv = PL_DBgv; CV * cv = NULL; @@ -2011,20 +2011,19 @@ PP(pp_dbstate) return NORMAL; } else { - U8 hasargs = 0; - PUSHBLOCK(cx, CXt_SUB, SP); - PUSHSUB_DB(cx); - cx->blk_sub.retop = PL_op->op_next; - cx->blk_oldsaveix = PL_savestack_ix; + cx = cx_pushblock(CXt_SUB, gimme, SP, PL_savestack_ix); + cx_pushsub(cx, cv, PL_op->op_next, 0); + /* OP_DBSTATE's op_private holds hint bits rather than + * the lvalue-ish flags seen in OP_ENTERSUB. So cancel + * any CxLVAL() flags that have now been mis-calculated */ + cx->blk_u16 = 0; SAVEI32(PL_debug); PL_debug = 0; SAVESTACK_POS(); CvDEPTH(cv)++; - if (CvDEPTH(cv) >= 2) { - PERL_STACK_OVERFLOW_CHECK(); + if (CvDEPTH(cv) >= 2) pad_push(CvPADLIST(cv), CvDEPTH(cv)); - } PAD_SET_CUR_NOSAVE(CvPADLIST(cv), CvDEPTH(cv)); RETURNOP(CvSTART(cv)); } @@ -2036,27 +2035,25 @@ PP(pp_dbstate) PP(pp_enter) { - dSP; - PERL_CONTEXT *cx; - I32 gimme = GIMME_V; - - PUSHBLOCK(cx, CXt_BLOCK, SP); - PUSHBASICBLK(cx); + U8 gimme = GIMME_V; - RETURN; + (void)cx_pushblock(CXt_BLOCK, gimme, PL_stack_sp, PL_savestack_ix); + return NORMAL; } + PP(pp_leave) { PERL_CONTEXT *cx; SV **oldsp; - I32 gimme; + U8 gimme; cx = CX_CUR(); assert(CxTYPE(cx) == CXt_BLOCK); if (PL_op->op_flags & OPf_SPECIAL) - cx->blk_oldpm = PL_curpm; /* fake block should preserve $1 et al */ + /* fake block should preserve $1 et al; e.g. /(...)/ while ...; */ + cx->blk_oldpm = PL_curpm; oldsp = PL_stack_base + cx->blk_oldsp; gimme = cx->blk_gimme; @@ -2068,8 +2065,7 @@ PP(pp_leave) PL_op->op_private & OPpLVALUE ? 3 : 1); CX_LEAVE_SCOPE(cx); - POPBASICBLK(cx); - POPBLOCK(cx); + cx_popblock(cx); CX_POP(cx); return NORMAL; @@ -2101,7 +2097,7 @@ PP(pp_enteriter) { dSP; dMARK; PERL_CONTEXT *cx; - const I32 gimme = GIMME_V; + const U8 gimme = GIMME_V; void *itervarp; /* GV or pad slot of the iteration variable */ SV *itersave; /* the old var in the iterator var slot */ U8 cxflags = 0; @@ -2126,6 +2122,8 @@ PP(pp_enteriter) itersave = GvSV(sv); SvREFCNT_inc_simple_void(itersave); cxflags = CXp_FOR_GV; + if (PL_op->op_private & OPpITER_DEF) + cxflags |= CXp_FOR_DEF; } else { /* LV ref: for \$foo (...) */ assert(SvTYPE(sv) == SVt_PVMG); @@ -2135,12 +2133,16 @@ PP(pp_enteriter) cxflags = CXp_FOR_LVREF; } } + /* OPpITER_DEF (implicit $_) should only occur with a GV iter var */ + assert((cxflags & CXp_FOR_GV) || !(PL_op->op_private & OPpITER_DEF)); - if (PL_op->op_private & OPpITER_DEF) - cxflags |= CXp_FOR_DEF; - - PUSHBLOCK(cx, cxflags, MARK); - PUSHLOOP_FOR(cx, itervarp, itersave); + /* Note that this context is initially set as CXt_NULL. Further on + * down it's changed to one of the CXt_LOOP_*. Before it's changed, + * 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 = cx_pushblock(cxflags, gimme, MARK, PL_savestack_ix); + cx_pushloop_for(cx, itervarp, itersave); if (PL_op->op_flags & OPf_STACKED) { /* OPf_STACKED implies either a single array: for(@), with a @@ -2210,20 +2212,19 @@ PP(pp_enteriter) PP(pp_enterloop) { - dSP; PERL_CONTEXT *cx; - const I32 gimme = GIMME_V; - - PUSHBLOCK(cx, CXt_LOOP_PLAIN, SP); - PUSHLOOP_PLAIN(cx); + const U8 gimme = GIMME_V; - RETURN; + cx = cx_pushblock(CXt_LOOP_PLAIN, gimme, PL_stack_sp, PL_savestack_ix); + cx_pushloop_plain(cx); + return NORMAL; } + PP(pp_leaveloop) { PERL_CONTEXT *cx; - I32 gimme; + U8 gimme; SV **oldsp; SV **mark; @@ -2242,8 +2243,8 @@ PP(pp_leaveloop) PL_op->op_private & OPpLVALUE ? 3 : 1); CX_LEAVE_SCOPE(cx); - POPLOOP(cx); /* Stack values are safe: release loop vars ... */ - POPBLOCK(cx); + cx_poploop(cx); /* Stack values are safe: release loop vars ... */ + cx_popblock(cx); CX_POP(cx); return NORMAL; @@ -2256,11 +2257,13 @@ PP(pp_leaveloop) * * Any changes made to this function may need to be copied to pp_leavesub * and vice-versa. + * + * also tail-called by pp_return */ PP(pp_leavesublv) { - I32 gimme; + U8 gimme; PERL_CONTEXT *cx; SV **oldsp; OP *retop; @@ -2349,8 +2352,8 @@ PP(pp_leavesublv) } CX_LEAVE_SCOPE(cx); - POPSUB(cx); /* Stack values are safe: release CV and @_ ... */ - POPBLOCK(cx); + cx_popsub(cx); /* Stack values are safe: release CV and @_ ... */ + cx_popblock(cx); retop = cx->blk_sub.retop; CX_POP(cx); @@ -2397,26 +2400,26 @@ PP(pp_return) } /* There are contexts that need popping. Doing this may free the - * return value(s), so preserve them first, e.g. popping the plain + * return value(s), so preserve them first: e.g. popping the plain * loop here would free $x: * sub f { { my $x = 1; return $x } } * We may also need to shift the args down; for example, * for (1,2) { return 3,4 } - * leaves 1,2,3,4 on the stack. Both these actions can be done by - * leave_adjust_stacks(). By calling it with and lvalue "pass - * all" action, we just bump the ref count and mortalise the args - * that need it, do a FREETMPS. The "scan the args and maybe copy - * them" process will be repeated by whoever we tail-call (e.g. - * pp_leaveeval), where any copying etc will be done. That is to - * say, in this code path two scans of the args will be done; the - * first just shifts and preserves; the second is the "real" arg - * processing, based on the type of return. + * leaves 1,2,3,4 on the stack. Both these actions will be done by + * leave_adjust_stacks(), along with freeing any temps. Note that + * whoever we tail-call (e.g. pp_leaveeval) will also call + * leave_adjust_stacks(); however, the second call is likely to + * just see a bunch of SvTEMPs with a ref count of 1, and so just + * pass them through, rather than copying them again. So this + * isn't as inefficient as it sounds. */ cx = &cxstack[cxix]; PUTBACK; if (cx->blk_gimme != G_VOID) leave_adjust_stacks(MARK, PL_stack_base + cx->blk_oldsp, - cx->blk_gimme, 3); + cx->blk_gimme, + CxTYPE(cx) == CXt_SUB && CvLVALUE(cx->blk_sub.cv) + ? 3 : 0); SPAGAIN; dounwind(cxix); cx = &cxstack[cxix]; /* CX stack may have been realloced */ @@ -2468,16 +2471,18 @@ PP(pp_return) } } +/* find the enclosing loop or labelled loop and dounwind() back to it. */ -static I32 -S_unwind_loop(pTHX_ const char * const opname) +static PERL_CONTEXT * +S_unwind_loop(pTHX) { I32 cxix; if (PL_op->op_flags & OPf_SPECIAL) { cxix = dopoptoloop(cxstack_ix); if (cxix < 0) /* diag_listed_as: Can't "last" outside a loop block */ - Perl_croak(aTHX_ "Can't \"%s\" outside a loop block", opname); + Perl_croak(aTHX_ "Can't \"%s\" outside a loop block", + OP_NAME(PL_op)); } else { dSP; @@ -2495,7 +2500,7 @@ S_unwind_loop(pTHX_ const char * const opname) if (cxix < 0) /* diag_listed_as: Label not found for "last %s" */ Perl_croak(aTHX_ "Label not found for \"%s %"SVf"\"", - opname, + OP_NAME(PL_op), SVfARG(PL_op->op_flags & OPf_STACKED && !SvGMAGICAL(TOPp1s) ? TOPp1s @@ -2505,17 +2510,16 @@ S_unwind_loop(pTHX_ const char * const opname) } if (cxix < cxstack_ix) dounwind(cxix); - return cxix; + return &cxstack[cxix]; } + PP(pp_last) { PERL_CONTEXT *cx; OP* nextop; - S_unwind_loop(aTHX_ "last"); - - cx = CX_CUR(); + cx = S_unwind_loop(aTHX); assert(CxTYPE_is_LOOP(cx)); PL_stack_sp = PL_stack_base @@ -2528,8 +2532,8 @@ PP(pp_last) /* Stack values are safe: */ CX_LEAVE_SCOPE(cx); - POPLOOP(cx); /* release loop vars ... */ - POPBLOCK(cx); + cx_poploop(cx); /* release loop vars ... */ + cx_popblock(cx); nextop = cx->blk_loop.my_op->op_lastop->op_next; CX_POP(cx); @@ -2540,10 +2544,12 @@ PP(pp_next) { PERL_CONTEXT *cx; - S_unwind_loop(aTHX_ "next"); - + /* if not a bare 'next' in the main scope, search for it */ cx = CX_CUR(); - TOPBLOCK(cx); + if (!((PL_op->op_flags & OPf_SPECIAL) && CxTYPE_is_LOOP(cx))) + cx = S_unwind_loop(aTHX); + + cx_topblock(cx); PL_curcop = cx->blk_oldcop; PERL_ASYNC_CHECK(); return (cx)->blk_loop.my_op->op_nextop; @@ -2551,21 +2557,20 @@ PP(pp_next) PP(pp_redo) { - const I32 cxix = S_unwind_loop(aTHX_ "redo"); - PERL_CONTEXT *cx; - OP* redo_op = cxstack[cxix].blk_loop.my_op->op_redoop; + PERL_CONTEXT *cx = S_unwind_loop(aTHX); + OP* redo_op = cx->blk_loop.my_op->op_redoop; if (redo_op->op_type == OP_ENTER) { /* pop one less context to avoid $x being freed in while (my $x..) */ cxstack_ix++; - assert(CxTYPE(CX_CUR()) == CXt_BLOCK); + cx = CX_CUR(); + assert(CxTYPE(cx) == CXt_BLOCK); redo_op = redo_op->op_next; } - cx = CX_CUR(); - TOPBLOCK(cx); - CX_LEAVE_SCOPE(cx); FREETMPS; + CX_LEAVE_SCOPE(cx); + cx_topblock(cx); PL_curcop = cx->blk_oldcop; PERL_ASYNC_CHECK(); return redo_op; @@ -2710,7 +2715,7 @@ PP(pp_goto) dounwind(cxix); } cx = CX_CUR(); - TOPBLOCK(cx); + cx_topblock(cx); SPAGAIN; /* protect @_ during save stack unwind. */ @@ -2721,7 +2726,7 @@ PP(pp_goto) CX_LEAVE_SCOPE(cx); if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) { - /* this is part of POPSUB_ARGS() */ + /* this is part of cx_popsub_args() */ AV* av = MUTABLE_AV(PAD_SVl(0)); assert(AvARRAY(MUTABLE_AV( PadlistARRAY(CvPADLIST(cx->blk_sub.cv))[ @@ -2796,7 +2801,7 @@ PP(pp_goto) SP += items; if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) { /* Restore old @_ */ - POP_SAVEARRAY(cx); + CX_POP_SAVEARRAY(cx); } retop = cx->blk_sub.retop; @@ -2804,8 +2809,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 POPBLOCK(), less all the stuff we already did - * for 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); @@ -2821,7 +2826,7 @@ PP(pp_goto) SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */ - /* partial unrolled PUSHSUB(): */ + /* partial unrolled cx_pushsub(): */ cx->blk_sub.cv = cv; cx->blk_sub.olddepth = CvDEPTH(cv); @@ -2993,7 +2998,7 @@ PP(pp_goto) DIE(aTHX_ "panic: docatch: illegal ix=%ld", (long)ix); dounwind(ix); cx = CX_CUR(); - TOPBLOCK(cx); + cx_topblock(cx); } /* push wanted frames */ @@ -3254,7 +3259,7 @@ S_try_yyparse(pTHX_ int gramtype) */ STATIC bool -S_doeval_compile(pTHX_ int gimme, CV* outside, U32 seq, HV *hh) +S_doeval_compile(pTHX_ U8 gimme, CV* outside, U32 seq, HV *hh) { dSP; OP * const saveop = PL_op; @@ -3394,8 +3399,8 @@ S_doeval_compile(pTHX_ int gimme, CV* outside, U32 seq, HV *hh) SP = PL_stack_base + POPMARK; /* pop original mark */ cx = CX_CUR(); CX_LEAVE_SCOPE(cx); - POPEVAL(cx); - POPBLOCK(cx); + cx_popeval(cx); + cx_popblock(cx); if (in_require) namesv = cx->blk_eval.old_namesv; CX_POP(cx); @@ -3594,7 +3599,7 @@ PP(pp_require) #endif const char *tryname = NULL; SV *namesv = NULL; - const I32 gimme = GIMME_V; + const U8 gimme = GIMME_V; int filter_has_file = 0; PerlIO *tryrsfp = NULL; SV *filter_cache = NULL; @@ -3716,7 +3721,7 @@ PP(pp_require) } } - LOADING_FILE_PROBE(unixname); + PERL_DTRACE_PROBE_FILE_LOADING(unixname); /* prepare to compile file */ @@ -4039,10 +4044,8 @@ PP(pp_require) } /* switch to eval mode */ - PUSHBLOCK(cx, CXt_EVAL, SP); - PUSHEVAL(cx, name); - cx->blk_oldsaveix = old_savestack_ix; - cx->blk_eval.retop = PL_op->op_next; + cx = cx_pushblock(CXt_EVAL, gimme, SP, old_savestack_ix); + cx_pusheval(cx, PL_op->op_next, newSVpv(name, 0)); SAVECOPLINE(&PL_compiling); CopLINE_set(&PL_compiling, 0); @@ -4054,7 +4057,7 @@ PP(pp_require) else op = PL_op->op_next; - LOADED_FILE_PROBE(unixname); + PERL_DTRACE_PROBE_FILE_LOADED(unixname); return op; } @@ -4076,7 +4079,7 @@ PP(pp_entereval) dSP; PERL_CONTEXT *cx; SV *sv; - const I32 gimme = GIMME_V; + const U8 gimme = GIMME_V; const U32 was = PL_breakable_sub_gen; char tbuf[TYPE_DIGITS(long) + 12]; bool saved_delete = FALSE; @@ -4155,10 +4158,8 @@ PP(pp_entereval) * to do the dirty work for us */ runcv = find_runcv(&seq); - PUSHBLOCK(cx, (CXt_EVAL|CXp_REAL), SP); - PUSHEVAL(cx, 0); - cx->blk_oldsaveix = old_savestack_ix; - cx->blk_eval.retop = PL_op->op_next; + cx = cx_pushblock((CXt_EVAL|CXp_REAL), gimme, SP, old_savestack_ix); + cx_pusheval(cx, PL_op->op_next, NULL); /* prepare to compile string */ @@ -4201,15 +4202,18 @@ PP(pp_entereval) } } + +/* also tail-called by pp_return */ + PP(pp_leaveeval) { SV **oldsp; - I32 gimme; + U8 gimme; PERL_CONTEXT *cx; OP *retop; SV *namesv = NULL; CV *evalcv; - /* grab this value before POPEVAL restores old PL_in_eval */ + /* grab this value before cx_popeval restores old PL_in_eval */ bool keep = cBOOL(PL_in_eval & EVAL_KEEPERR); PERL_ASYNC_CHECK(); @@ -4233,7 +4237,7 @@ PP(pp_leaveeval) else leave_adjust_stacks(oldsp, oldsp, gimme, 0); - /* the POPEVAL does a leavescope, which frees the optree associated + /* the cx_popeval does a leavescope, which frees the optree associated * with eval, which if it frees the nextstate associated with * PL_curcop, sets PL_curcop to NULL. Which can mess up freeing a * regex when running under 'use re Debug' because it needs PL_curcop @@ -4242,8 +4246,8 @@ PP(pp_leaveeval) PL_curcop = cx->blk_oldcop; CX_LEAVE_SCOPE(cx); - POPEVAL(cx); - POPBLOCK(cx); + cx_popeval(cx); + cx_popblock(cx); retop = cx->blk_eval.retop; evalcv = cx->blk_eval.cv; CX_POP(cx); @@ -4274,22 +4278,22 @@ Perl_delete_eval_scope(pTHX) cx = CX_CUR(); CX_LEAVE_SCOPE(cx); - POPEVAL(cx); - POPBLOCK(cx); + cx_popeval(cx); + cx_popblock(cx); CX_POP(cx); } /* Common-ish code salvaged from Perl_call_sv and pp_entertry, because it was also needed by Perl_fold_constants. */ -PERL_CONTEXT * -Perl_create_eval_scope(pTHX_ U32 flags) +void +Perl_create_eval_scope(pTHX_ OP *retop, U32 flags) { PERL_CONTEXT *cx; - const I32 gimme = GIMME_V; + const U8 gimme = GIMME_V; - PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), PL_stack_sp); - PUSHEVAL(cx, 0); - cx->blk_oldsaveix = PL_savestack_ix; + cx = cx_pushblock((CXt_EVAL|CXp_TRYBLOCK), gimme, + PL_stack_sp, PL_savestack_ix); + cx_pusheval(cx, retop, NULL); PL_in_eval = EVAL_INEVAL; if (flags & G_KEEPERR) @@ -4299,20 +4303,21 @@ Perl_create_eval_scope(pTHX_ U32 flags) if (flags & G_FAKINGEVAL) { PL_eval_root = PL_op; /* Only needed so that goto works right. */ } - return cx; } PP(pp_entertry) { - PERL_CONTEXT * const cx = create_eval_scope(0); - cx->blk_eval.retop = cLOGOP->op_other->op_next; + create_eval_scope(cLOGOP->op_other->op_next, 0); return DOCATCH(PL_op->op_next); } + +/* also tail-called by pp_return */ + PP(pp_leavetry) { SV **oldsp; - I32 gimme; + U8 gimme; PERL_CONTEXT *cx; OP *retop; @@ -4328,8 +4333,8 @@ PP(pp_leavetry) else leave_adjust_stacks(oldsp, oldsp, gimme, 1); CX_LEAVE_SCOPE(cx); - POPEVAL(cx); - POPBLOCK(cx); + cx_popeval(cx); + cx_popblock(cx); retop = cx->blk_eval.retop; CX_POP(cx); @@ -4341,15 +4346,15 @@ PP(pp_entergiven) { dSP; PERL_CONTEXT *cx; - const I32 gimme = GIMME_V; + const U8 gimme = GIMME_V; SV *origsv = DEFSV; SV *newsv = POPs; assert(!PL_op->op_targ); /* used to be set for lexical $_ */ GvSV(PL_defgv) = SvREFCNT_inc(newsv); - PUSHBLOCK(cx, CXt_GIVEN, SP); - PUSHGIVEN(cx, origsv); + cx = cx_pushblock(CXt_GIVEN, gimme, SP, PL_savestack_ix); + cx_pushgiven(cx, origsv); RETURN; } @@ -4357,7 +4362,7 @@ PP(pp_entergiven) PP(pp_leavegiven) { PERL_CONTEXT *cx; - I32 gimme; + U8 gimme; SV **oldsp; PERL_UNUSED_CONTEXT; @@ -4372,8 +4377,8 @@ PP(pp_leavegiven) leave_adjust_stacks(oldsp, oldsp, gimme, 1); CX_LEAVE_SCOPE(cx); - POPGIVEN(cx); - POPBLOCK(cx); + cx_popgiven(cx); + cx_popblock(cx); CX_POP(cx); return NORMAL; @@ -4917,7 +4922,7 @@ PP(pp_enterwhen) { dSP; PERL_CONTEXT *cx; - const I32 gimme = GIMME_V; + const U8 gimme = GIMME_V; /* This is essentially an optimization: if the match fails, we don't want to push a context and then @@ -4925,11 +4930,11 @@ PP(pp_enterwhen) to the op that follows the leavewhen. RETURNOP calls PUTBACK which restores the stack pointer after the POPs. */ - if ((0 == (PL_op->op_flags & OPf_SPECIAL)) && !SvTRUEx(POPs)) + if (!(PL_op->op_flags & OPf_SPECIAL) && !SvTRUEx(POPs)) RETURNOP(cLOGOP->op_other->op_next); - PUSHBLOCK(cx, CXt_WHEN, SP); - PUSHWHEN(cx); + cx = cx_pushblock(CXt_WHEN, gimme, SP, PL_savestack_ix); + cx_pushwhen(cx); RETURN; } @@ -4938,7 +4943,7 @@ PP(pp_leavewhen) { I32 cxix; PERL_CONTEXT *cx; - I32 gimme; + U8 gimme; SV **oldsp; cx = CX_CUR(); @@ -4967,7 +4972,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(); - TOPBLOCK(cx); + cx_topblock(cx); PL_curcop = cx->blk_oldcop; return cx->blk_loop.my_op->op_nextop; } @@ -4995,8 +5000,8 @@ PP(pp_continue) assert(CxTYPE(cx) == CXt_WHEN); PL_stack_sp = PL_stack_base + cx->blk_oldsp; CX_LEAVE_SCOPE(cx); - POPWHEN(cx); - POPBLOCK(cx); + cx_popwhen(cx); + cx_popblock(cx); nextop = cx->blk_givwhen.leave_op->op_next; CX_POP(cx); @@ -5021,7 +5026,7 @@ PP(pp_break) /* Restore the sp at the time we entered the given block */ cx = CX_CUR(); - TOPBLOCK(cx); + PL_stack_sp = PL_stack_base + cx->blk_oldsp; return cx->blk_givwhen.leave_op; }