PP(pp_substcont)
{
dSP;
- PERL_CONTEXT *cx = &cxstack[cxstack_ix];
+ PERL_CONTEXT *cx = CX_CUR();
PMOP * const pm = (PMOP*) cLOGOP->op_other;
SV * const dstr = cx->sb_dstr;
char *s = cx->sb_s;
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)
return i;
}
+/* 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.
+ */
+
void
Perl_dounwind(pTHX_ I32 cxix)
{
return;
while (cxstack_ix > cxix) {
- PERL_CONTEXT *cx = &cxstack[cxstack_ix];
- DEBUG_CX("UNWIND"); \
+ PERL_CONTEXT *cx = CX_CUR();
+
+ CX_DEBUG(cx, "UNWIND");
/* Note: we don't need to restore the base context info till the end. */
CX_LEAVE_SCOPE(cx);
if (cxix >= 0) {
SV *namesv = NULL;
PERL_CONTEXT *cx;
- SV **newsp;
+ SV **oldsp;
I32 gimme;
JMPENV *restartjmpenv;
OP *restartop;
if (cxix < cxstack_ix)
dounwind(cxix);
- cx = &cxstack[cxstack_ix];
+ cx = CX_CUR();
assert(CxTYPE(cx) == CXt_EVAL);
/* return false to the caller of eval */
- newsp = PL_stack_base + cx->blk_oldsp;
+ oldsp = PL_stack_base + cx->blk_oldsp;
gimme = cx->blk_gimme;
if (gimme == G_SCALAR)
- *++newsp = &PL_sv_undef;
- PL_stack_sp = newsp;
+ *++oldsp = &PL_sv_undef;
+ PL_stack_sp = oldsp;
CX_LEAVE_SCOPE(cx);
POPEVAL(cx);
RETURN;
}
- DEBUG_CX("CALLER");
+ CX_DEBUG(cx, "CALLER");
assert(CopSTASH(cx->blk_oldcop));
stash_hek = SvTYPE(CopSTASH(cx->blk_oldcop)) == SVt_PVHV
? HvNAME_HEK((HV*)CopSTASH(cx->blk_oldcop))
{
PL_curcop = (COP*)PL_op;
TAINT_NOT; /* Each statement is presumed innocent */
- PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
+ PL_stack_sp = PL_stack_base + CX_CUR()->blk_oldsp;
FREETMPS;
PERL_ASYNC_CHECK();
PUSHBLOCK(cx, CXt_SUB, SP);
PUSHSUB_DB(cx);
cx->blk_sub.retop = PL_op->op_next;
- cx->cx_old_savestack_ix = PL_savestack_ix;
+ cx->blk_oldsaveix = PL_savestack_ix;
SAVEI32(PL_debug);
PL_debug = 0;
return NORMAL;
}
-/* S_leave_common: Common code that many functions in this file use on
- scope exit.
-
- Process the return args on the stack in the range (mark+1..PL_stack_sp)
- based on context, with any final args starting at newsp+1.
- Args are mortal copied (or mortalied if lvalue) unless its safe to use
- as-is, based on whether it has the specified flags. Note that most
- callers specify flags as (SVs_PADTMP|SVs_TEMP), while leaveeval skips
- SVs_PADTMP since its optree gets immediately freed, freeing its padtmps
- at the same time.
-
- Also, taintedness is cleared.
-*/
-
-STATIC void
-S_leave_common(pTHX_ SV **newsp, SV **mark, I32 gimme,
- U32 flags, bool lvalue)
-{
- dSP;
- PERL_ARGS_ASSERT_LEAVE_COMMON;
-
- TAINT_NOT;
- if (gimme == G_SCALAR) {
- if (MARK < SP)
- *++newsp = (SvFLAGS(*SP) & flags)
- ? *SP
- : lvalue
- ? sv_2mortal(SvREFCNT_inc_simple_NN(*SP))
- : sv_mortalcopy(*SP);
- else {
- EXTEND(newsp, 1);
- *++newsp = &PL_sv_undef;
- }
- }
- else if (gimme == G_ARRAY) {
- /* in case LEAVE wipes old return values */
- while (++MARK <= SP) {
- if (SvFLAGS(*MARK) & flags)
- *++newsp = *MARK;
- else {
- *++newsp = lvalue
- ? sv_2mortal(SvREFCNT_inc_simple_NN(*MARK))
- : sv_mortalcopy(*MARK);
- TAINT_NOT; /* Each item is independent */
- }
- }
- /* When this function was called with MARK == newsp, we reach this
- * point with SP == newsp. */
- }
-
- PL_stack_sp = newsp;
-}
-
PP(pp_enter)
{
PP(pp_leave)
{
PERL_CONTEXT *cx;
- SV **newsp;
+ SV **oldsp;
I32 gimme;
- cx = &cxstack[cxstack_ix];
+ 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 */
- newsp = PL_stack_base + cx->blk_oldsp;
+ oldsp = PL_stack_base + cx->blk_oldsp;
gimme = cx->blk_gimme;
if (gimme == G_VOID)
- PL_stack_sp = newsp;
+ PL_stack_sp = oldsp;
else
- leave_common(newsp, newsp, gimme, SVs_PADTMP|SVs_TEMP,
- PL_op->op_private & OPpLVALUE);
+ leave_adjust_stacks(oldsp, oldsp, gimme,
+ PL_op->op_private & OPpLVALUE ? 3 : 1);
CX_LEAVE_SCOPE(cx);
POPBASICBLK(cx);
SV * const sv = POPs;
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);
+ 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);
cxflags = CXp_FOR_LVREF;
}
}
-
- if (PL_op->op_private & OPpITER_DEF)
- cxflags |= CXp_FOR_DEF;
+ /* OPpITER_DEF (implicit $_) should only occur with a GV iter var */
+ assert((cxflags & CXp_FOR_GV) || !(PL_op->op_private & OPpITER_DEF));
PUSHBLOCK(cx, cxflags, MARK);
PUSHLOOP_FOR(cx, itervarp, itersave);
+
if (PL_op->op_flags & OPf_STACKED) {
+ /* OPf_STACKED implies either a single array: for(@), with a
+ * single AV on the stack, or a range: for (1..5), with 1 and 5 on
+ * the stack */
SV *maybe_ary = POPs;
if (SvTYPE(maybe_ary) != SVt_PVAV) {
+ /* range */
dPOPss;
SV * const right = maybe_ary;
if (UNLIKELY(cxflags & CXp_FOR_LVREF))
cx->cx_type |= CXt_LOOP_LAZYSV;
cx->blk_loop.state_u.lazysv.cur = newSVsv(sv);
cx->blk_loop.state_u.lazysv.end = right;
- SvREFCNT_inc(right);
+ SvREFCNT_inc_simple_void_NN(right);
(void) SvPV_force_nolen(cx->blk_loop.state_u.lazysv.cur);
/* This will do the upgrade to SVt_PV, and warn if the value
is uninitialised. */
}
}
else /* SvTYPE(maybe_ary) == SVt_PVAV */ {
+ /* for (@array) {} */
cx->cx_type |= CXt_LOOP_ARY;
cx->blk_loop.state_u.ary.ary = MUTABLE_AV(maybe_ary);
- SvREFCNT_inc(maybe_ary);
+ SvREFCNT_inc_simple_void_NN(maybe_ary);
cx->blk_loop.state_u.ary.ix =
(PL_op->op_private & OPpITER_REVERSED) ?
AvFILL(cx->blk_loop.state_u.ary.ary) + 1 :
{
PERL_CONTEXT *cx;
I32 gimme;
- SV **newsp;
+ SV **oldsp;
SV **mark;
- cx = &cxstack[cxstack_ix];
+ cx = CX_CUR();
assert(CxTYPE_is_LOOP(cx));
mark = PL_stack_base + cx->blk_oldsp;
- newsp = CxTYPE(cx) == CXt_LOOP_LIST
+ oldsp = CxTYPE(cx) == CXt_LOOP_LIST
? PL_stack_base + cx->blk_loop.state_u.stack.basesp
: mark;
gimme = cx->blk_gimme;
if (gimme == G_VOID)
- PL_stack_sp = newsp;
+ PL_stack_sp = oldsp;
else
- leave_common(newsp, MARK, gimme, SVs_PADTMP|SVs_TEMP,
- PL_op->op_private & OPpLVALUE);
+ leave_adjust_stacks(MARK, oldsp, gimme,
+ PL_op->op_private & OPpLVALUE ? 3 : 1);
CX_LEAVE_SCOPE(cx);
POPLOOP(cx); /* Stack values are safe: release loop vars ... */
PP(pp_leavesublv)
{
- dSP;
- SV **newsp;
- SV **mark;
I32 gimme;
PERL_CONTEXT *cx;
- bool ref;
- const char *what = NULL;
+ SV **oldsp;
OP *retop;
- cx = &cxstack[cxstack_ix];
+ cx = CX_CUR();
assert(CxTYPE(cx) == CXt_SUB);
if (CxMULTICALL(cx)) {
return 0;
}
- newsp = PL_stack_base + cx->blk_oldsp;
gimme = cx->blk_gimme;
- TAINT_NOT;
+ oldsp = PL_stack_base + cx->blk_oldsp; /* last arg of previous frame */
- mark = newsp + 1;
-
- ref = !!(CxLVAL(cx) & OPpENTERSUB_INARGS);
- if (gimme == G_SCALAR) {
- if (CxLVAL(cx) && !ref) { /* Leave it as it is if we can. */
- if (MARK <= SP) {
- if ((SvPADTMP(TOPs) || SvREADONLY(TOPs)) &&
- !SvSMAGICAL(TOPs)) {
- what =
- SvREADONLY(TOPs) ? (TOPs == &PL_sv_undef) ? "undef"
- : "a readonly value" : "a temporary";
- }
- else goto copy_sv;
- }
- else {
- /* sub:lvalue{} will take us here. */
- what = "undef";
- }
- croak:
- Perl_croak(aTHX_
- "Can't return %s from lvalue subroutine", what
- );
- }
- if (MARK <= SP) {
- copy_sv:
- if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) {
- if (!SvPADTMP(*SP)) {
- *MARK = SvREFCNT_inc(*SP);
- FREETMPS;
- sv_2mortal(*MARK);
- }
- else {
- /* FREETMPS could clobber it */
- SV *sv = SvREFCNT_inc(*SP);
- FREETMPS;
- *MARK = sv_mortalcopy(sv);
- SvREFCNT_dec(sv);
- }
- }
- else
- *MARK =
- SvPADTMP(*SP)
- ? sv_mortalcopy(*SP)
- : !SvTEMP(*SP)
- ? sv_2mortal(SvREFCNT_inc_simple_NN(*SP))
- : *SP;
- }
- else {
- MEXTEND(MARK, 0);
- *MARK = &PL_sv_undef;
- }
- SP = MARK;
+ if (gimme == G_VOID)
+ PL_stack_sp = oldsp;
+ else {
+ U8 lval = CxLVAL(cx);
+ bool is_lval = (lval && !(lval & OPpENTERSUB_INARGS));
+ const char *what = NULL;
+
+ if (gimme == G_SCALAR) {
+ if (is_lval) {
+ /* check for bad return arg */
+ if (oldsp < PL_stack_sp) {
+ SV *sv = *PL_stack_sp;
+ if ((SvPADTMP(sv) || SvREADONLY(sv))) {
+ what =
+ SvREADONLY(sv) ? (sv == &PL_sv_undef) ? "undef"
+ : "a readonly value" : "a temporary";
+ }
+ else goto ok;
+ }
+ else {
+ /* sub:lvalue{} will take us here. */
+ what = "undef";
+ }
+ croak:
+ Perl_croak(aTHX_
+ "Can't return %s from lvalue subroutine", what);
+ }
- if (CxLVAL(cx) & OPpDEREF) {
- SvGETMAGIC(TOPs);
- if (!SvOK(TOPs)) {
- TOPs = vivify_ref(TOPs, CxLVAL(cx) & OPpDEREF);
- }
- }
- }
- else if (gimme == G_ARRAY) {
- assert (!(CxLVAL(cx) & OPpDEREF));
- if (ref || !CxLVAL(cx))
- for (; MARK <= SP; MARK++)
- *MARK =
- SvFLAGS(*MARK) & SVs_PADTMP
- ? sv_mortalcopy(*MARK)
- : SvTEMP(*MARK)
- ? *MARK
- : sv_2mortal(SvREFCNT_inc_simple_NN(*MARK));
- else for (; MARK <= SP; MARK++) {
- if (*MARK != &PL_sv_undef
- && (SvPADTMP(*MARK) || SvREADONLY(*MARK))
- ) {
- /* Might be flattened array after $#array = */
- what = SvREADONLY(*MARK)
- ? "a readonly value" : "a temporary";
- goto croak;
- }
- else if (!SvTEMP(*MARK))
- *MARK = sv_2mortal(SvREFCNT_inc_simple_NN(*MARK));
- }
+ ok:
+ leave_adjust_stacks(oldsp, oldsp, gimme, is_lval ? 3 : 2);
+
+ if (lval & OPpDEREF) {
+ /* lval_sub()->{...} and similar */
+ dSP;
+ SvGETMAGIC(TOPs);
+ if (!SvOK(TOPs)) {
+ TOPs = vivify_ref(TOPs, CxLVAL(cx) & OPpDEREF);
+ }
+ PUTBACK;
+ }
+ }
+ else {
+ assert(gimme == G_ARRAY);
+ assert (!(lval & OPpDEREF));
+
+ if (is_lval) {
+ /* scan for bad return args */
+ SV **p;
+ for (p = PL_stack_sp; p > oldsp; p--) {
+ SV *sv = *p;
+ /* the PL_sv_undef exception is to allow things like
+ * this to work, where PL_sv_undef acts as 'skip'
+ * placeholder on the LHS of list assigns:
+ * sub foo :lvalue { undef }
+ * ($a, undef, foo(), $b) = 1..4;
+ */
+ if (sv != &PL_sv_undef && (SvPADTMP(sv) || SvREADONLY(sv)))
+ {
+ /* Might be flattened array after $#array = */
+ what = SvREADONLY(sv)
+ ? "a readonly value" : "a temporary";
+ goto croak;
+ }
+ }
+ }
+
+ leave_adjust_stacks(oldsp, oldsp, gimme, is_lval ? 3 : 2);
+ }
}
- PUTBACK;
CX_LEAVE_SCOPE(cx);
POPSUB(cx); /* Stack values are safe: release CV and @_ ... */
* 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_common(). By calling it with lvalue=TRUE, we just bump
- * the ref count and mortalise the args that need it. 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.
+ * 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.
*/
cx = &cxstack[cxix];
PUTBACK;
- leave_common(PL_stack_base + cx->blk_oldsp, MARK,
- cx->blk_gimme, SVs_TEMP|SVs_PADTMP, TRUE);
+ if (cx->blk_gimme != G_VOID)
+ leave_adjust_stacks(MARK, PL_stack_base + cx->blk_oldsp,
+ cx->blk_gimme, 3);
SPAGAIN;
dounwind(cxix);
cx = &cxstack[cxix]; /* CX stack may have been realloced */
S_unwind_loop(aTHX_ "last");
- cx = &cxstack[cxstack_ix];
+ cx = CX_CUR();
assert(CxTYPE_is_LOOP(cx));
PL_stack_sp = PL_stack_base
S_unwind_loop(aTHX_ "next");
+ cx = CX_CUR();
TOPBLOCK(cx);
PL_curcop = cx->blk_oldcop;
PERL_ASYNC_CHECK();
if (redo_op->op_type == OP_ENTER) {
/* pop one less context to avoid $x being freed in while (my $x..) */
cxstack_ix++;
- assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_BLOCK);
+ assert(CxTYPE(CX_CUR()) == CXt_BLOCK);
redo_op = redo_op->op_next;
}
+ cx = CX_CUR();
TOPBLOCK(cx);
CX_LEAVE_SCOPE(cx);
FREETMPS;
if (cxix < cxstack_ix) {
dounwind(cxix);
}
+ cx = CX_CUR();
TOPBLOCK(cx);
SPAGAIN;
CX_LEAVE_SCOPE(cx);
if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) {
- /* this is POPSUB_ARGS() with minor variations */
+ /* this is part of POPSUB_ARGS() */
AV* av = MUTABLE_AV(PAD_SVl(0));
assert(AvARRAY(MUTABLE_AV(
PadlistARRAY(CvPADLIST(cx->blk_sub.cv))[
SP += items;
if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) {
/* Restore old @_ */
- POP_SAVEARRAY();
+ POP_SAVEARRAY(cx);
}
retop = cx->blk_sub.retop;
if (ix < 0)
DIE(aTHX_ "panic: docatch: illegal ix=%ld", (long)ix);
dounwind(ix);
+ cx = CX_CUR();
TOPBLOCK(cx);
}
switch (ret) {
case 0:
assert(cxstack_ix >= 0);
- assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL);
- cxstack[cxstack_ix].blk_eval.cur_top_env = PL_top_env;
+ assert(CxTYPE(CX_CUR()) == CXt_EVAL);
+ CX_CUR()->blk_eval.cur_top_env = PL_top_env;
redo_body:
CALLRUNOPS(aTHX);
break;
int ret;
dJMPENV;
- assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL);
+ assert(CxTYPE(CX_CUR()) == CXt_EVAL);
JMPENV_PUSH(ret);
switch (ret) {
case 0:
evalcv = MUTABLE_CV(newSV_type(SVt_PVCV));
CvEVAL_on(evalcv);
- assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL);
- cxstack[cxstack_ix].blk_eval.cv = evalcv;
- cxstack[cxstack_ix].blk_gimme = gimme;
+ assert(CxTYPE(CX_CUR()) == CXt_EVAL);
+ CX_CUR()->blk_eval.cv = evalcv;
+ CX_CUR()->blk_gimme = gimme;
CvOUTSIDE_SEQ(evalcv) = seq;
CvOUTSIDE(evalcv) = MUTABLE_CV(SvREFCNT_inc_simple(outside));
PL_eval_root = NULL;
}
SP = PL_stack_base + POPMARK; /* pop original mark */
- cx = &cxstack[cxstack_ix];
+ cx = CX_CUR();
CX_LEAVE_SCOPE(cx);
POPEVAL(cx);
POPBLOCK(cx);
errsv = ERRSV;
if (in_require) {
if (yystatus == 3) {
- cx = &cxstack[cxstack_ix];
+ cx = CX_CUR();
assert(CxTYPE(cx) == CXt_EVAL);
namesv = cx->blk_eval.old_namesv;
}
/* switch to eval mode */
PUSHBLOCK(cx, CXt_EVAL, SP);
PUSHEVAL(cx, name);
- cx->cx_old_savestack_ix = old_savestack_ix;
+ cx->blk_oldsaveix = 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->cx_old_savestack_ix = old_savestack_ix;
+ cx->blk_oldsaveix = old_savestack_ix;
cx->blk_eval.retop = PL_op->op_next;
/* prepare to compile string */
PP(pp_leaveeval)
{
- SV **newsp;
+ SV **oldsp;
I32 gimme;
PERL_CONTEXT *cx;
OP *retop;
PERL_ASYNC_CHECK();
- cx = &cxstack[cxstack_ix];
+ cx = CX_CUR();
assert(CxTYPE(cx) == CXt_EVAL);
- newsp = PL_stack_base + cx->blk_oldsp;
+ oldsp = PL_stack_base + cx->blk_oldsp;
gimme = cx->blk_gimme;
/* did require return a false value? */
if ( CxOLD_OP_TYPE(cx) == OP_REQUIRE
&& !(gimme == G_SCALAR
? SvTRUE(*PL_stack_sp)
- : PL_stack_sp > newsp)
+ : PL_stack_sp > oldsp)
)
namesv = cx->blk_eval.old_namesv;
if (gimme == G_VOID)
- PL_stack_sp = newsp;
+ PL_stack_sp = oldsp;
else
- leave_common(newsp, newsp, gimme, SVs_TEMP, FALSE);
+ leave_adjust_stacks(oldsp, oldsp, gimme, 0);
/* the POPEVAL does a leavescope, which frees the optree associated
* with eval, which if it frees the nextstate associated with
{
PERL_CONTEXT *cx;
- cx = &cxstack[cxstack_ix];
+ cx = CX_CUR();
CX_LEAVE_SCOPE(cx);
POPEVAL(cx);
POPBLOCK(cx);
PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), PL_stack_sp);
PUSHEVAL(cx, 0);
- cx->cx_old_savestack_ix = PL_savestack_ix;
+ cx->blk_oldsaveix = PL_savestack_ix;
PL_in_eval = EVAL_INEVAL;
if (flags & G_KEEPERR)
PP(pp_leavetry)
{
- SV **newsp;
+ SV **oldsp;
I32 gimme;
PERL_CONTEXT *cx;
OP *retop;
PERL_ASYNC_CHECK();
- cx = &cxstack[cxstack_ix];
+ cx = CX_CUR();
assert(CxTYPE(cx) == CXt_EVAL);
- newsp = PL_stack_base + cx->blk_oldsp;
+ oldsp = PL_stack_base + cx->blk_oldsp;
gimme = cx->blk_gimme;
if (gimme == G_VOID)
- PL_stack_sp = newsp;
+ PL_stack_sp = oldsp;
else
- leave_common(newsp, newsp, gimme, SVs_PADTMP|SVs_TEMP, FALSE);
+ leave_adjust_stacks(oldsp, oldsp, gimme, 1);
CX_LEAVE_SCOPE(cx);
POPEVAL(cx);
POPBLOCK(cx);
{
PERL_CONTEXT *cx;
I32 gimme;
- SV **newsp;
+ SV **oldsp;
PERL_UNUSED_CONTEXT;
- cx = &cxstack[cxstack_ix];
+ cx = CX_CUR();
assert(CxTYPE(cx) == CXt_GIVEN);
- newsp = PL_stack_base + cx->blk_oldsp;
+ oldsp = PL_stack_base + cx->blk_oldsp;
gimme = cx->blk_gimme;
if (gimme == G_VOID)
- PL_stack_sp = newsp;
+ PL_stack_sp = oldsp;
else
- leave_common(newsp, newsp, gimme, SVs_PADTMP|SVs_TEMP, FALSE);
+ leave_adjust_stacks(oldsp, oldsp, gimme, 1);
CX_LEAVE_SCOPE(cx);
POPGIVEN(cx);
I32 cxix;
PERL_CONTEXT *cx;
I32 gimme;
- SV **newsp;
+ SV **oldsp;
- cx = &cxstack[cxstack_ix];
+ cx = CX_CUR();
assert(CxTYPE(cx) == CXt_WHEN);
gimme = cx->blk_gimme;
DIE(aTHX_ "Can't \"%s\" outside a topicalizer",
PL_op->op_flags & OPf_SPECIAL ? "default" : "when");
- newsp = PL_stack_base + cx->blk_oldsp;
+ oldsp = PL_stack_base + cx->blk_oldsp;
if (gimme == G_VOID)
- PL_stack_sp = newsp;
+ PL_stack_sp = oldsp;
else
- leave_common(newsp, newsp, gimme, SVs_PADTMP|SVs_TEMP, FALSE);
+ leave_adjust_stacks(oldsp, oldsp, gimme, 1);
+
/* pop the WHEN, BLOCK and anything else before the GIVEN/FOR */
assert(cxix < cxstack_ix);
dounwind(cxix);
if (CxFOREACH(cx)) {
/* 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);
PL_curcop = cx->blk_oldcop;
return cx->blk_loop.my_op->op_nextop;
if (cxix < cxstack_ix)
dounwind(cxix);
- cx = &cxstack[cxstack_ix];
+ cx = CX_CUR();
assert(CxTYPE(cx) == CXt_WHEN);
PL_stack_sp = PL_stack_base + cx->blk_oldsp;
CX_LEAVE_SCOPE(cx);
dounwind(cxix);
/* Restore the sp at the time we entered the given block */
- TOPBLOCK(cx);
+ cx = CX_CUR();
+ PL_stack_sp = PL_stack_base + cx->blk_oldsp;
return cx->blk_givwhen.leave_op;
}
https://perl5.git.perl.org / perl5.git / blobdiff