return i;
}
+/* find the next GIVEN or FOR loop context block */
+
STATIC I32
-S_dopoptogiven(pTHX_ I32 startingblock)
+S_dopoptogivenfor(pTHX_ I32 startingblock)
{
I32 i;
for (i = startingblock; i >= 0; i--) {
default:
continue;
case CXt_GIVEN:
- DEBUG_l( Perl_deb(aTHX_ "(dopoptogiven(): found given at cx=%ld)\n", (long)i));
+ DEBUG_l( Perl_deb(aTHX_ "(dopoptogivenfor(): found given at cx=%ld)\n", (long)i));
return i;
case CXt_LOOP_PLAIN:
assert(!CxFOREACHDEF(cx));
case CXt_LOOP_LAZYSV:
case CXt_LOOP_FOR:
if (CxFOREACHDEF(cx)) {
- DEBUG_l( Perl_deb(aTHX_ "(dopoptogiven(): found foreach at cx=%ld)\n", (long)i));
+ DEBUG_l( Perl_deb(aTHX_ "(dopoptogivenfor(): found foreach at cx=%ld)\n", (long)i));
return i;
}
}
return;
while (cxstack_ix > cxix) {
- SV *sv;
PERL_CONTEXT *cx = &cxstack[cxstack_ix];
DEBUG_CX("UNWIND"); \
/* Note: we don't need to restore the base context info till the end. */
POPSUBST(cx);
continue; /* not break */
case CXt_SUB:
- POPSUB(cx,sv);
- LEAVESUB(sv);
+ POPSUB(cx);
break;
case CXt_EVAL:
POPEVAL(cx);
- LEAVE_SCOPE(cx->blk_eval.old_savestack_ix);
- PL_tmps_floor = cx->blk_eval.old_tmpsfloor;
+ PL_tmps_floor = cx->cx_u.cx_blk.blku_old_tmpsfloor;
+ break;
+ case CXt_BLOCK:
+ POPBASICBLK(cx);
break;
case CXt_LOOP_LAZYIV:
case CXt_LOOP_LAZYSV:
case CXt_LOOP_PLAIN:
POPLOOP(cx);
break;
+ case CXt_WHEN:
+ POPWHEN(cx);
+ break;
+ case CXt_GIVEN:
+ POPGIVEN(cx);
+ break;
case CXt_NULL:
break;
case CXt_FORMAT:
if (in_eval) {
I32 cxix;
- I32 gimme;
/*
* Historically, perl used to set ERRSV ($@) early in the die
SV *namesv;
PERL_CONTEXT *cx;
SV **newsp;
+ I32 gimme;
#ifdef DEBUGGING
COP *oldcop;
#endif
if (cxix < cxstack_ix)
dounwind(cxix);
- POPBLOCK(cx,PL_curpm);
+ cx = &cxstack[cxstack_ix];
+ assert(CxTYPE(cx) == CXt_EVAL);
+ newsp = PL_stack_base + cx->blk_oldsp;
+ gimme = cx->blk_gimme;
+
+ if (gimme == G_SCALAR)
+ *++newsp = &PL_sv_undef;
+ PL_stack_sp = newsp;
+
+
if (CxTYPE(cx) != CXt_EVAL) {
STRLEN msglen;
const char* message = SvPVx_const(exceptsv, msglen);
PerlIO_write(Perl_error_log, message, msglen);
my_exit(1);
}
+
+ POPBLOCK(cx,PL_curpm);
POPEVAL(cx);
namesv = cx->blk_eval.old_namesv;
#ifdef DEBUGGING
restartjmpenv = cx->blk_eval.cur_top_env;
restartop = cx->blk_eval.retop;
- if (gimme == G_SCALAR)
- *++newsp = &PL_sv_undef;
- PL_stack_sp = newsp;
-
- LEAVE_SCOPE(cx->blk_eval.old_savestack_ix);
- PL_tmps_floor = cx->blk_eval.old_tmpsfloor;
+ PL_tmps_floor = cx->cx_u.cx_blk.blku_old_tmpsfloor;
if (optype == OP_REQUIRE) {
assert (PL_curcop == oldcop);
PUSHBLOCK(cx, CXt_SUB, SP);
PUSHSUB_DB(cx);
cx->blk_sub.retop = PL_op->op_next;
- cx->blk_sub.old_savestack_ix = PL_savestack_ix;
+ cx->cx_u.cx_blk.blku_old_savestack_ix = PL_savestack_ix;
SAVEI32(PL_debug);
PL_debug = 0;
PERL_CONTEXT *cx;
I32 gimme = GIMME_V;
- ENTER_with_name("block");
-
- SAVETMPS;
PUSHBLOCK(cx, CXt_BLOCK, SP);
+ PUSHBASICBLK(cx);
RETURN;
}
cx->blk_oldpm = PL_curpm; /* fake block should preserve $1 et al */
}
- POPBLOCK(cx,newpm);
-
- gimme = OP_GIMME(PL_op, (cxstack_ix >= 0) ? gimme : G_SCALAR);
+ cx = &cxstack[cxstack_ix];
+ assert(CxTYPE(cx) == CXt_BLOCK);
+ newsp = PL_stack_base + cx->blk_oldsp;
+ gimme = cx->blk_gimme;
SP = (gimme == G_VOID)
? newsp
: leave_common(newsp, SP, newsp, gimme, SVs_PADTMP|SVs_TEMP,
PL_op->op_private & OPpLVALUE);
- PL_curpm = newpm; /* Don't pop $1 et al till now */
- LEAVE_with_name("block");
+ POPBLOCK(cx,newpm);
+ POPBASICBLK(cx);
+
+ PL_curpm = newpm; /* Don't pop $1 et al till now */
RETURN;
}
dSP; dMARK;
PERL_CONTEXT *cx;
const I32 gimme = GIMME_V;
- void *itervar; /* location of the iteration variable */
+ void *itervarp; /* GV or pad slot of the iteration variable */
+ SV *itersave; /* the old var in the iterator var slot */
U8 cxtype = CXt_LOOP_FOR;
- ENTER_with_name("loop1");
- SAVETMPS;
-
if (PL_op->op_targ) { /* "my" variable */
+ itervarp = &PAD_SVl(PL_op->op_targ);
+ itersave = *(SV**)itervarp;
+ assert(itersave);
if (PL_op->op_private & OPpLVAL_INTRO) { /* for my $x (...) */
/* the SV currently in the pad slot is never live during
* iteration (the slot is always aliased to one of the items)
* so it's always stale */
- SvPADSTALE_on(PAD_SVl(PL_op->op_targ));
+ SvPADSTALE_on(itersave);
}
- SAVEPADSVANDMORTALIZE(PL_op->op_targ);
- itervar = &PAD_SVl(PL_op->op_targ);
- }
- else if (LIKELY(isGV(TOPs))) { /* symbol table variable */
- GV * const gv = MUTABLE_GV(POPs);
- SV** svp = &GvSV(gv);
- save_pushptrptr(gv, SvREFCNT_inc(*svp), SAVEt_GVSV);
- *svp = newSV(0);
- itervar = (void *)gv;
+ SvREFCNT_inc_simple_void_NN(itersave);
+ cxtype |= CXp_FOR_PAD;
}
else {
SV * const sv = POPs;
- assert(SvTYPE(sv) == SVt_PVMG);
- assert(SvMAGIC(sv));
- assert(SvMAGIC(sv)->mg_type == PERL_MAGIC_lvref);
- itervar = (void *)sv;
- cxtype |= CXp_FOR_LVREF;
+ itervarp = (void *)sv;
+ if (LIKELY(isGV(sv))) { /* symbol table variable */
+ SV** svp = &GvSV(sv);
+ itersave = *svp;
+ if (LIKELY(itersave))
+ SvREFCNT_inc_simple_void_NN(itersave);
+ else
+ *svp = newSV(0);
+ cxtype |= CXp_FOR_GV;
+ }
+ else { /* LV ref: for \$foo (...) */
+ assert(SvTYPE(sv) == SVt_PVMG);
+ assert(SvMAGIC(sv));
+ assert(SvMAGIC(sv)->mg_type == PERL_MAGIC_lvref);
+ itersave = NULL;
+ cxtype |= CXp_FOR_LVREF;
+ }
}
if (PL_op->op_private & OPpITER_DEF)
cxtype |= CXp_FOR_DEF;
- ENTER_with_name("loop2");
-
PUSHBLOCK(cx, cxtype, SP);
- PUSHLOOP_FOR(cx, itervar, MARK);
+ PUSHLOOP_FOR(cx, itervarp, itersave, MARK);
if (PL_op->op_flags & OPf_STACKED) {
SV *maybe_ary = POPs;
if (SvTYPE(maybe_ary) != SVt_PVAV) {
PERL_CONTEXT *cx;
const I32 gimme = GIMME_V;
- ENTER_with_name("loop1");
- SAVETMPS;
- ENTER_with_name("loop2");
-
PUSHBLOCK(cx, CXt_LOOP_PLAIN, SP);
PUSHLOOP_PLAIN(cx, SP);
PMOP *newpm;
SV **mark;
- POPBLOCK(cx,newpm);
+ cx = &cxstack[cxstack_ix];
assert(CxTYPE_is_LOOP(cx));
- mark = newsp;
+ mark = PL_stack_base + cx->blk_oldsp;
newsp = PL_stack_base + cx->blk_loop.resetsp;
+ gimme = cx->blk_gimme;
SP = (gimme == G_VOID)
? newsp
PL_op->op_private & OPpLVALUE);
PUTBACK;
+ POPBLOCK(cx,newpm);
POPLOOP(cx); /* Stack values are safe: release loop vars ... */
PL_curpm = newpm; /* ... and pop $1 et al */
- LEAVE_with_name("loop2");
- LEAVE_with_name("loop1");
-
return NORMAL;
}
PMOP *newpm;
I32 gimme;
PERL_CONTEXT *cx;
- SV *sv;
bool ref;
const char *what = NULL;
- if (CxMULTICALL(&cxstack[cxstack_ix])) {
+ cx = &cxstack[cxstack_ix];
+ assert(CxTYPE(cx) == CXt_SUB);
+
+ if (CxMULTICALL(cx)) {
/* entry zero of a stack is always PL_sv_undef, which
* simplifies converting a '()' return into undef in scalar context */
assert(PL_stack_sp > PL_stack_base || *PL_stack_base == &PL_sv_undef);
return 0;
}
- POPBLOCK(cx,newpm);
- cxstack_ix++; /* preserve cx entry on stack for use by POPSUB */
+ newsp = PL_stack_base + cx->blk_oldsp;
+ gimme = cx->blk_gimme;
TAINT_NOT;
mark = newsp + 1;
ref = !!(CxLVAL(cx) & OPpENTERSUB_INARGS);
if (gimme == G_SCALAR) {
if (CxLVAL(cx) && !ref) { /* Leave it as it is if we can. */
- SV *sv;
if (MARK <= SP) {
if ((SvPADTMP(TOPs) || SvREADONLY(TOPs)) &&
!SvSMAGICAL(TOPs)) {
what = "undef";
}
croak:
- POPSUB(cx,sv);
+ POPSUB(cx);
cxstack_ix--;
- PL_curpm = newpm;
- LEAVESUB(sv);
+ PL_curpm = cx->blk_oldpm;
Perl_croak(aTHX_
"Can't return %s from lvalue subroutine", what
);
}
PUTBACK;
- POPSUB(cx,sv); /* Stack values are safe: release CV and @_ ... */
+ POPBLOCK(cx,newpm);
+ cxstack_ix++; /* preserve cx entry on stack for use by POPSUB */
+ POPSUB(cx); /* Stack values are safe: release CV and @_ ... */
cxstack_ix--;
PL_curpm = newpm; /* ... and pop $1 et al */
- LEAVESUB(sv);
return cx->blk_sub.retop;
}
* we need to set sp = oldsp so that pp_leavesub knows to push
* &PL_sv_undef onto the stack.
*/
- SV **oldsp;
- cx = &cxstack[cxix];
- oldsp = PL_stack_base + cx->blk_oldsp;
- if (oldsp != MARK) {
- SSize_t nargs = SP - MARK;
- if (nargs) {
- if (cx->blk_gimme == G_ARRAY) {
- /* shift return args to base of call stack frame */
- Move(MARK + 1, oldsp + 1, nargs, SV*);
- PL_stack_sp = oldsp + nargs;
+ SV **oldsp;
+ cx = &cxstack[cxix];
+ oldsp = PL_stack_base + cx->blk_oldsp;
+ if (oldsp != MARK) {
+ SSize_t nargs = SP - MARK;
+ if (nargs) {
+ if (cx->blk_gimme == G_ARRAY) {
+ /* shift return args to base of call stack frame */
+ Move(MARK + 1, oldsp + 1, nargs, SV*);
+ PL_stack_sp = oldsp + nargs;
+ }
}
+ else
+ PL_stack_sp = oldsp;
}
- else
- PL_stack_sp = oldsp;
- }
}
/* fall through to a normal exit */
PP(pp_last)
{
PERL_CONTEXT *cx;
- I32 gimme;
OP *nextop = NULL;
- SV **newsp;
PMOP *newpm;
S_unwind_loop(aTHX_ "last");
|| CxTYPE(cx) == CXt_LOOP_FOR
|| CxTYPE(cx) == CXt_LOOP_PLAIN
);
- newsp = PL_stack_base + cx->blk_loop.resetsp;
+ PL_stack_sp = PL_stack_base + cx->blk_loop.resetsp;
nextop = cx->blk_loop.my_op->op_lastop->op_next;
TAINT_NOT;
- PL_stack_sp = newsp;
- LEAVE_with_name("loop2");
cxstack_ix--;
/* Stack values are safe: */
POPLOOP(cx); /* release loop vars ... */
- LEAVE_with_name("loop1");
PL_curpm = newpm; /* ... and pop $1 et al */
- PERL_UNUSED_VAR(gimme);
return nextop;
}
PP(pp_next)
{
PERL_CONTEXT *cx;
- const I32 inner = PL_scopestack_ix;
S_unwind_loop(aTHX_ "next");
- /* clear off anything above the scope we're re-entering, but
- * save the rest until after a possible continue block */
TOPBLOCK(cx);
- if (PL_scopestack_ix < inner)
- leave_scope(PL_scopestack[PL_scopestack_ix]);
PL_curcop = cx->blk_oldcop;
PERL_ASYNC_CHECK();
return (cx)->blk_loop.my_op->op_nextop;
{
const I32 cxix = S_unwind_loop(aTHX_ "redo");
PERL_CONTEXT *cx;
- I32 oldsave;
OP* redo_op = cxstack[cxix].blk_loop.my_op->op_redoop;
if (redo_op->op_type == OP_ENTER) {
}
TOPBLOCK(cx);
- oldsave = PL_scopestack[PL_scopestack_ix - 1];
- LEAVE_SCOPE(oldsave);
+ CX_LEAVE_SCOPE(cx);
FREETMPS;
PL_curcop = cx->blk_oldcop;
PERL_ASYNC_CHECK();
SvREFCNT_inc_NN(sv_2mortal(MUTABLE_SV(arg)));
assert(PL_scopestack_ix == cx->blk_oldscopesp);
- LEAVE_SCOPE(cx->blk_sub.old_savestack_ix);
+ CX_LEAVE_SCOPE(cx);
if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) {
AV* av = MUTABLE_AV(PAD_SVl(0));
/* Now do some callish stuff. */
if (CvISXSUB(cv)) {
- SV **newsp;
- I32 gimme;
const SSize_t items = arg ? AvFILL(arg) + 1 : 0;
const bool m = arg ? cBOOL(SvRMAGICAL(arg)) : 0;
SV** mark;
- PERL_UNUSED_VAR(newsp);
- PERL_UNUSED_VAR(gimme);
-
ENTER;
SAVETMPS;
SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
/* pop unwanted frames */
if (ix < cxstack_ix) {
- I32 oldsave;
-
if (ix < 0)
DIE(aTHX_ "panic: docatch: illegal ix=%ld", (long)ix);
dounwind(ix);
TOPBLOCK(cx);
- oldsave = PL_scopestack[PL_scopestack_ix];
- LEAVE_SCOPE(oldsave);
}
/* push wanted frames */
yystatus = (!in_require && CATCH_GET) ? S_try_yyparse(aTHX_ GRAMPROG) : yyparse(GRAMPROG);
if (yystatus || PL_parser->error_count || !PL_eval_root) {
- SV **newsp; /* Used by POPBLOCK. */
PERL_CONTEXT *cx;
I32 optype; /* Used by POPEVAL. */
SV *namesv;
cx = NULL;
namesv = NULL;
- PERL_UNUSED_VAR(newsp);
PERL_UNUSED_VAR(optype);
/* note that if yystatus == 3, then the EVAL CX block has already
POPEVAL(cx);
namesv = cx->blk_eval.old_namesv;
/* POPBLOCK has rendered LEAVE_with_name("evalcomp") unnecessary */
- LEAVE_SCOPE(cx->blk_eval.old_savestack_ix);
- PL_tmps_floor = cx->blk_eval.old_tmpsfloor;
+ PL_tmps_floor = cx->cx_u.cx_blk.blku_old_tmpsfloor;
}
errsv = ERRSV;
/* switch to eval mode */
PUSHBLOCK(cx, CXt_EVAL, SP);
PUSHEVAL(cx, name);
- cx->blk_eval.old_savestack_ix = old_savestack_ix;
+ cx->cx_u.cx_blk.blku_old_savestack_ix = old_savestack_ix;
cx->blk_eval.retop = PL_op->op_next;
SAVECOPLINE(&PL_compiling);
PUSHBLOCK(cx, (CXt_EVAL|CXp_REAL), SP);
PUSHEVAL(cx, 0);
- cx->blk_eval.old_savestack_ix = old_savestack_ix;
+ cx->cx_u.cx_blk.blku_old_savestack_ix = old_savestack_ix;
cx->blk_eval.retop = PL_op->op_next;
/* prepare to compile string */
bool keep = cBOOL(PL_in_eval & EVAL_KEEPERR);
PERL_ASYNC_CHECK();
+
+ cx = &cxstack[cxstack_ix];
+ assert(CxTYPE(cx) == CXt_EVAL);
+ newsp = PL_stack_base + cx->blk_oldsp;
+ gimme = cx->blk_gimme;
+
+ if (gimme != G_VOID)
+ SP = leave_common(newsp, SP, newsp, gimme, SVs_TEMP, FALSE);
POPBLOCK(cx,newpm);
POPEVAL(cx);
namesv = cx->blk_eval.old_namesv;
retop = cx->blk_eval.retop;
evalcv = cx->blk_eval.cv;
- if (gimme != G_VOID)
- SP = leave_common(newsp, SP, newsp, gimme, SVs_TEMP, FALSE);
PL_curpm = newpm; /* Don't pop $1 et al till now */
#ifdef DEBUGGING
SvPVX_const(namesv),
SvUTF8(namesv) ? -(I32)SvCUR(namesv) : (I32)SvCUR(namesv),
G_DISCARD);
- LEAVE_SCOPE(cx->blk_eval.old_savestack_ix);
- PL_tmps_floor = cx->blk_eval.old_tmpsfloor;
+ PL_tmps_floor = cx->cx_u.cx_blk.blku_old_tmpsfloor;
Perl_die(aTHX_ "%"SVf" did not return a true value", SVfARG(namesv));
NOT_REACHED; /* NOTREACHED */
/* die_unwind() did LEAVE, or we won't be here */
}
else {
- LEAVE_SCOPE(cx->blk_eval.old_savestack_ix);
- PL_tmps_floor = cx->blk_eval.old_tmpsfloor;
+ PL_tmps_floor = cx->cx_u.cx_blk.blku_old_tmpsfloor;
if (!keep)
CLEAR_ERRSV();
}
void
Perl_delete_eval_scope(pTHX)
{
- SV **newsp;
PMOP *newpm;
- I32 gimme;
PERL_CONTEXT *cx;
I32 optype;
POPBLOCK(cx,newpm);
POPEVAL(cx);
PL_curpm = newpm;
- LEAVE_SCOPE(cx->blk_eval.old_savestack_ix);
- PL_tmps_floor = cx->blk_eval.old_tmpsfloor;
- PERL_UNUSED_VAR(newsp);
- PERL_UNUSED_VAR(gimme);
+ PL_tmps_floor = cx->cx_u.cx_blk.blku_old_tmpsfloor;
PERL_UNUSED_VAR(optype);
}
PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), PL_stack_sp);
PUSHEVAL(cx, 0);
- cx->blk_eval.old_savestack_ix = PL_savestack_ix;
+ cx->cx_u.cx_blk.blku_old_savestack_ix = PL_savestack_ix;
PL_in_eval = EVAL_INEVAL;
if (flags & G_KEEPERR)
OP *retop;
PERL_ASYNC_CHECK();
- POPBLOCK(cx,newpm);
- retop = cx->blk_eval.retop;
- POPEVAL(cx);
- PERL_UNUSED_VAR(optype);
+
+ cx = &cxstack[cxstack_ix];
+ assert(CxTYPE(cx) == CXt_EVAL);
+ newsp = PL_stack_base + cx->blk_oldsp;
+ gimme = cx->blk_gimme;
SP = (gimme == G_VOID)
? newsp
: leave_common(newsp, SP, newsp, gimme,
SVs_PADTMP|SVs_TEMP, FALSE);
+ POPBLOCK(cx,newpm);
+ retop = cx->blk_eval.retop;
+ POPEVAL(cx);
+ PERL_UNUSED_VAR(optype);
+
PL_curpm = newpm; /* Don't pop $1 et al till now */
- LEAVE_SCOPE(cx->blk_eval.old_savestack_ix);
- PL_tmps_floor = cx->blk_eval.old_tmpsfloor;
+ PL_tmps_floor = cx->cx_u.cx_blk.blku_old_tmpsfloor;
CLEAR_ERRSV();
RETURNOP(retop);
dSP;
PERL_CONTEXT *cx;
const I32 gimme = GIMME_V;
+ SV *origsv = DEFSV;
+ SV *newsv = POPs;
- ENTER_with_name("given");
- SAVETMPS;
-
assert(!PL_op->op_targ); /* used to be set for lexical $_ */
- SAVE_DEFSV;
- DEFSV_set(POPs);
+ GvSV(PL_defgv) = SvREFCNT_inc(newsv);
PUSHBLOCK(cx, CXt_GIVEN, SP);
- PUSHGIVEN(cx);
+ PUSHGIVEN(cx, origsv);
RETURN;
}
PMOP *newpm;
PERL_UNUSED_CONTEXT;
- POPBLOCK(cx,newpm);
+ cx = &cxstack[cxstack_ix];
assert(CxTYPE(cx) == CXt_GIVEN);
+ newsp = PL_stack_base + cx->blk_oldsp;
+ gimme = cx->blk_gimme;
SP = (gimme == G_VOID)
? newsp
: leave_common(newsp, SP, newsp, gimme,
SVs_PADTMP|SVs_TEMP, FALSE);
+ POPBLOCK(cx,newpm);
+ POPGIVEN(cx);
+ assert(CxTYPE(cx) == CXt_GIVEN);
+
PL_curpm = newpm; /* Don't pop $1 et al till now */
- LEAVE_with_name("given");
RETURN;
}
if ((0 == (PL_op->op_flags & OPf_SPECIAL)) && !SvTRUEx(POPs))
RETURNOP(cLOGOP->op_other->op_next);
- ENTER_with_name("when");
- SAVETMPS;
-
PUSHBLOCK(cx, CXt_WHEN, SP);
PUSHWHEN(cx);
PERL_CONTEXT *cx;
I32 gimme;
SV **newsp;
- PMOP *newpm;
- cxix = dopoptogiven(cxstack_ix);
+ cx = &cxstack[cxstack_ix];
+ assert(CxTYPE(cx) == CXt_WHEN);
+ gimme = cx->blk_gimme;
+
+ cxix = dopoptogivenfor(cxstack_ix);
if (cxix < 0)
/* diag_listed_as: Can't "when" outside a topicalizer */
DIE(aTHX_ "Can't \"%s\" outside a topicalizer",
PL_op->op_flags & OPf_SPECIAL ? "default" : "when");
- POPBLOCK(cx,newpm);
- assert(CxTYPE(cx) == CXt_WHEN);
-
+ newsp = PL_stack_base + cx->blk_oldsp;
SP = (gimme == G_VOID)
? newsp
: leave_common(newsp, SP, newsp, gimme,
SVs_PADTMP|SVs_TEMP, FALSE);
- PL_curpm = newpm; /* pop $1 et al */
-
- LEAVE_with_name("when");
-
- if (cxix < cxstack_ix)
- dounwind(cxix);
+ /* pop the WHEN, BLOCK and anything else before the GIVEN/FOR */
+ assert(cxix < cxstack_ix);
+ dounwind(cxix);
cx = &cxstack[cxix];
if (CxFOREACH(cx)) {
- /* clear off anything above the scope we're re-entering */
- I32 inner = PL_scopestack_ix;
-
+ /* emulate pp_next. Note that any stack(s) cleanup will be
+ * done by the pp_unstack which op_nextop should point to */
TOPBLOCK(cx);
- if (PL_scopestack_ix < inner)
- leave_scope(PL_scopestack[PL_scopestack_ix]);
PL_curcop = cx->blk_oldcop;
-
- PERL_ASYNC_CHECK();
return cx->blk_loop.my_op->op_nextop;
}
else {
PERL_ASYNC_CHECK();
+ assert(cx->blk_givwhen.leave_op->op_type == OP_LEAVEGIVEN);
RETURNOP(cx->blk_givwhen.leave_op);
}
}
dSP;
I32 cxix;
PERL_CONTEXT *cx;
- I32 gimme;
- SV **newsp;
PMOP *newpm;
- PERL_UNUSED_VAR(gimme);
cxix = dopoptowhen(cxstack_ix);
if (cxix < 0)
POPBLOCK(cx,newpm);
assert(CxTYPE(cx) == CXt_WHEN);
+ POPWHEN(cx);
- SP = newsp;
+ SP = PL_stack_base + cx->blk_oldsp;
PL_curpm = newpm; /* pop $1 et al */
- LEAVE_with_name("when");
RETURNOP(cx->blk_givwhen.leave_op->op_next);
}
I32 cxix;
PERL_CONTEXT *cx;
- cxix = dopoptogiven(cxstack_ix);
+ cxix = dopoptogivenfor(cxstack_ix);
if (cxix < 0)
DIE(aTHX_ "Can't \"break\" outside a given block");
https://perl5.git.perl.org / perl5.git / blobdiff