/* PL_tainted must be correctly set for this mg_set */
SvSETMAGIC(TARG);
TAINT_NOT;
- LEAVE_SCOPE(cx->sb_oldsave);
+
+ CX_LEAVE_SCOPE(cx);
POPSUBST(cx);
+ CX_POP(cx);
+
PERL_ASYNC_CHECK();
RETURNOP(pm->op_next);
NOT_REACHED; /* NOTREACHED */
/* diag_listed_as: Exiting subroutine via %s */
Perl_ck_warner(aTHX_ packWARN(WARN_EXITING), "Exiting %s via %s",
context_name[CxTYPE(cx)], OP_NAME(PL_op));
- if (CxTYPE(cx) == CXt_NULL)
+ if (CxTYPE(cx) == CXt_NULL) /* sort BLOCK */
return -1;
break;
case CXt_LOOP_LAZYIV:
/* diag_listed_as: Exiting subroutine via %s */
Perl_ck_warner(aTHX_ packWARN(WARN_EXITING), "Exiting %s via %s",
context_name[CxTYPE(cx)], OP_NAME(PL_op));
- if ((CxTYPE(cx)) == CXt_NULL)
+ if ((CxTYPE(cx)) == CXt_NULL) /* sort BLOCK */
return -1;
break;
case CXt_LOOP_LAZYIV:
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;
}
}
void
Perl_dounwind(pTHX_ I32 cxix)
{
- I32 optype;
-
if (!PL_curstackinfo) /* can happen if die during thread cloning */
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. */
+
+ CX_LEAVE_SCOPE(cx);
+
switch (CxTYPE(cx)) {
case CXt_SUBST:
POPSUBST(cx);
- continue; /* not break */
+ break;
case CXt_SUB:
- POPSUB(cx,sv);
- LEAVESUB(sv);
+ POPSUB(cx);
break;
case CXt_EVAL:
POPEVAL(cx);
- LEAVE_SCOPE(PL_scopestack[cx->blk_oldscopesp-1]);
+ 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:
+ /* there isn't a POPNULL ! */
break;
case CXt_FORMAT:
POPFORMAT(cx);
}
cxstack_ix--;
}
- PERL_UNUSED_VAR(optype);
}
void
++PL_parser->error_count;
}
+
+
+/* pop the cx, undef or delete the %INC entry, then croak.
+ * require0 indicates that the require didn't return a true value */
+
+void
+S_undo_inc_then_croak(pTHX_ PERL_CONTEXT *cx, SV *err, bool require0)
+{
+ const char *fmt;
+ HV *inc_hv = GvHVn(PL_incgv);
+ SV *namesv = cx->blk_eval.old_namesv;
+ I32 klen = SvUTF8(namesv) ? -(I32)SvCUR(namesv) : (I32)SvCUR(namesv);
+ const char *key = SvPVX_const(namesv);
+
+ CX_POP(cx);
+
+ if (require0) {
+ (void)hv_delete(inc_hv, key, klen, G_DISCARD);
+ fmt = "%"SVf" did not return a true value";
+ err = namesv;
+ }
+ else {
+ (void)hv_store(inc_hv, key, klen, &PL_sv_undef, 0);
+ fmt = "%"SVf"Compilation failed in require";
+ err = err ? err : newSVpvs_flags("Unknown error\n", SVs_TEMP);
+ }
+
+ /* note that unlike pp_entereval, pp_require isn't
+ * supposed to trap errors. So now that we've popped the
+ * EVAL that pp_require pushed, and processed the error
+ * message, rethrow the error */
+ Perl_croak(aTHX_ fmt, SVfARG(err));
+}
+
+
void
Perl_die_unwind(pTHX_ SV *msv)
{
if (in_eval) {
I32 cxix;
- I32 gimme;
/*
* Historically, perl used to set ERRSV ($@) early in the die
}
if (cxix >= 0) {
- I32 optype;
- SV *namesv;
PERL_CONTEXT *cx;
SV **newsp;
-#ifdef DEBUGGING
- COP *oldcop;
-#endif
+ I32 gimme;
JMPENV *restartjmpenv;
OP *restartop;
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);
}
+
+ CX_LEAVE_SCOPE(cx);
POPEVAL(cx);
- namesv = cx->blk_eval.old_namesv;
-#ifdef DEBUGGING
- oldcop = cx->blk_oldcop;
-#endif
+ POPBLOCK(cx);
+
restartjmpenv = cx->blk_eval.cur_top_env;
restartop = cx->blk_eval.retop;
+ if (CxOLD_OP_TYPE(cx) == OP_REQUIRE) {
+ S_undo_inc_then_croak(aTHX_ cx, exceptsv, FALSE);
+ NOT_REACHED; /* NOTREACHED */
+ }
+ CX_POP(cx);
- if (gimme == G_SCALAR)
- *++newsp = &PL_sv_undef;
- PL_stack_sp = newsp;
-
- LEAVE;
-
- if (optype == OP_REQUIRE) {
- assert (PL_curcop == oldcop);
- (void)hv_store(GvHVn(PL_incgv),
- SvPVX_const(namesv),
- SvUTF8(namesv) ? -(I32)SvCUR(namesv) : (I32)SvCUR(namesv),
- &PL_sv_undef, 0);
- /* note that unlike pp_entereval, pp_require isn't
- * supposed to trap errors. So now that we've popped the
- * EVAL that pp_require pushed, and processed the error
- * message, rethrow the error */
- Perl_croak(aTHX_ "%"SVf"Compilation failed in require",
- SVfARG(exceptsv ? exceptsv : newSVpvs_flags("Unknown error\n",
- SVs_TEMP)));
- }
if (!(in_eval & EVAL_KEEPERR))
sv_setsv(ERRSV, exceptsv);
PL_restartjmpenv = restartjmpenv;
dSP;
PERL_CONTEXT *cx;
const I32 gimme = G_ARRAY;
- U8 hasargs;
GV * const gv = PL_DBgv;
CV * cv = NULL;
/* don't do recursive DB::DB call */
return NORMAL;
- ENTER;
- SAVETMPS;
-
- SAVEI32(PL_debug);
- SAVESTACK_POS();
- PL_debug = 0;
- hasargs = 0;
- SPAGAIN;
-
if (CvISXSUB(cv)) {
+ ENTER;
+ SAVEI32(PL_debug);
+ PL_debug = 0;
+ SAVESTACK_POS();
+ SAVETMPS;
PUSHMARK(SP);
(void)(*CvXSUB(cv))(aTHX_ cv);
FREETMPS;
return NORMAL;
}
else {
+ U8 hasargs = 0;
PUSHBLOCK(cx, CXt_SUB, SP);
PUSHSUB_DB(cx);
cx->blk_sub.retop = PL_op->op_next;
+ cx->cx_old_savestack_ix = PL_savestack_ix;
+
+ SAVEI32(PL_debug);
+ PL_debug = 0;
+ SAVESTACK_POS();
CvDEPTH(cv)++;
if (CvDEPTH(cv) >= 2) {
PERL_STACK_OVERFLOW_CHECK();
}
/* S_leave_common: Common code that many functions in this file use on
- scope exit. */
+ scope exit.
-/* SVs on the stack that have any of the flags passed in are left as is.
- Other SVs are protected via the mortals stack if lvalue is true, and
- copied otherwise.
+ 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 SV **
-S_leave_common(pTHX_ SV **newsp, SV **sp, SV **mark, I32 gimme,
+STATIC void
+S_leave_common(pTHX_ SV **newsp, SV **mark, I32 gimme,
U32 flags, bool lvalue)
{
- bool padtmp = 0;
+ dSP;
PERL_ARGS_ASSERT_LEAVE_COMMON;
TAINT_NOT;
- if (flags & SVs_PADTMP) {
- flags &= ~SVs_PADTMP;
- padtmp = 1;
- }
if (gimme == G_SCALAR) {
if (MARK < SP)
- *++newsp = ((SvFLAGS(*SP) & flags) || (padtmp && SvPADTMP(*SP)))
+ *++newsp = (SvFLAGS(*SP) & flags)
? *SP
: lvalue
? sv_2mortal(SvREFCNT_inc_simple_NN(*SP))
: sv_mortalcopy(*SP);
else {
- /* MEXTEND() only updates MARK, so reuse it instead of newsp. */
- MARK = newsp;
- MEXTEND(MARK, 1);
- *++MARK = &PL_sv_undef;
- return MARK;
+ 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) || (padtmp && SvPADTMP(*MARK)))
+ if (SvFLAGS(*MARK) & flags)
*++newsp = *MARK;
else {
*++newsp = lvalue
* point with SP == newsp. */
}
- return newsp;
+ PL_stack_sp = newsp;
}
+
PP(pp_enter)
{
dSP;
PERL_CONTEXT *cx;
I32 gimme = GIMME_V;
- ENTER_with_name("block");
-
- SAVETMPS;
PUSHBLOCK(cx, CXt_BLOCK, SP);
+ PUSHBASICBLK(cx);
RETURN;
}
PP(pp_leave)
{
- dSP;
PERL_CONTEXT *cx;
SV **newsp;
- PMOP *newpm;
I32 gimme;
- if (PL_op->op_flags & OPf_SPECIAL) {
- cx = &cxstack[cxstack_ix];
- cx->blk_oldpm = PL_curpm; /* fake block should preserve $1 et al */
- }
+ cx = &cxstack[cxstack_ix];
+ assert(CxTYPE(cx) == CXt_BLOCK);
- POPBLOCK(cx,newpm);
+ if (PL_op->op_flags & OPf_SPECIAL)
+ cx->blk_oldpm = PL_curpm; /* fake block should preserve $1 et al */
- gimme = OP_GIMME(PL_op, (cxstack_ix >= 0) ? gimme : G_SCALAR);
+ newsp = PL_stack_base + cx->blk_oldsp;
+ gimme = cx->blk_gimme;
- SP = 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 */
+ if (gimme == G_VOID)
+ PL_stack_sp = newsp;
+ else
+ leave_common(newsp, newsp, gimme, SVs_PADTMP|SVs_TEMP,
+ PL_op->op_private & OPpLVALUE);
- LEAVE_with_name("block");
+ CX_LEAVE_SCOPE(cx);
+ POPBASICBLK(cx);
+ POPBLOCK(cx);
+ CX_POP(cx);
- RETURN;
+ return NORMAL;
}
static bool
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 (...) */
- SvPADSTALE_off(PAD_SVl(PL_op->op_targ));
- SAVESETSVFLAGS(PAD_SVl(PL_op->op_targ),
- SVs_PADSTALE, SVs_PADSTALE);
+ /* 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(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);
PP(pp_leaveloop)
{
- dSP;
PERL_CONTEXT *cx;
I32 gimme;
SV **newsp;
- 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 = leave_common(newsp, SP, MARK, gimme, 0,
+ if (gimme == G_VOID)
+ PL_stack_sp = newsp;
+ else
+ leave_common(newsp, MARK, gimme, SVs_PADTMP|SVs_TEMP,
PL_op->op_private & OPpLVALUE);
- PUTBACK;
+ CX_LEAVE_SCOPE(cx);
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");
+ POPBLOCK(cx);
+ CX_POP(cx);
return NORMAL;
}
dSP;
SV **newsp;
SV **mark;
- PMOP *newpm;
I32 gimme;
PERL_CONTEXT *cx;
- SV *sv;
bool ref;
const char *what = NULL;
+ OP *retop;
+
+ cx = &cxstack[cxstack_ix];
+ assert(CxTYPE(cx) == CXt_SUB);
- if (CxMULTICALL(&cxstack[cxstack_ix])) {
+ 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) {
- assert(MARK == SP);
if ((SvPADTMP(TOPs) || SvREADONLY(TOPs)) &&
!SvSMAGICAL(TOPs)) {
what =
what = "undef";
}
croak:
- LEAVE;
- POPSUB(cx,sv);
- cxstack_ix--;
- PL_curpm = newpm;
- LEAVESUB(sv);
Perl_croak(aTHX_
"Can't return %s from lvalue subroutine", what
);
}
PUTBACK;
- LEAVE;
- POPSUB(cx,sv); /* Stack values are safe: release CV and @_ ... */
- cxstack_ix--;
- PL_curpm = newpm; /* ... and pop $1 et al */
- LEAVESUB(sv);
+ CX_LEAVE_SCOPE(cx);
+ POPSUB(cx); /* Stack values are safe: release CV and @_ ... */
+ POPBLOCK(cx);
+ retop = cx->blk_sub.retop;
+ CX_POP(cx);
- return cx->blk_sub.retop;
+ return retop;
}
{
dSP; dMARK;
PERL_CONTEXT *cx;
- SV **oldsp;
const I32 cxix = dopoptosub(cxstack_ix);
assert(cxstack_ix >= 0);
if (cxix < cxstack_ix) {
if (cxix < 0) {
- if (CxMULTICALL(cxstack)) { /* In this case we must be in a
- * sort block, which is a CXt_NULL
- * not a CXt_SUB */
- dounwind(0);
- /* if we were in list context, we would have to splice out
- * any junk before the return args, like we do in the general
- * pp_return case, e.g.
- * sub f { for (junk1, junk2) { return arg1, arg2 }}
- */
+ if (!( PL_curstackinfo->si_type == PERLSI_SORT
+ || ( PL_curstackinfo->si_type == PERLSI_MULTICALL
+ && (cxstack[0].cx_type & CXp_SUB_RE_FAKE))
+ )
+ )
+ DIE(aTHX_ "Can't return outside a subroutine");
+ /* We must be in:
+ * a sort block, which is a CXt_NULL not a CXt_SUB;
+ * or a /(?{...})/ block.
+ * Handle specially. */
+ assert(CxTYPE(&cxstack[0]) == CXt_NULL
+ || ( CxTYPE(&cxstack[0]) == CXt_SUB
+ && (cxstack[0].cx_type & CXp_SUB_RE_FAKE)));
+ if (cxstack_ix > 0) {
+ /* See comment below about context popping. Since we know
+ * we're scalar and not lvalue, we can preserve the return
+ * value in a simpler fashion than there. */
+ SV *sv = *SP;
assert(cxstack[0].blk_gimme == G_SCALAR);
- return 0;
+ if ( (sp != PL_stack_base)
+ && !(SvFLAGS(sv) & (SVs_TEMP|SVs_PADTMP))
+ )
+ *SP = sv_mortalcopy(sv);
+ dounwind(0);
}
- else
- DIE(aTHX_ "Can't return outside a subroutine");
+ /* caller responsible for popping cxstack[0] */
+ return 0;
}
- dounwind(cxix);
- }
-
- cx = &cxstack[cxix];
- oldsp = PL_stack_base + cx->blk_oldsp;
- if (oldsp != MARK) {
- /* Handle extra junk on the stack. For example,
+ /* There are contexts that need popping. Doing this may free the
+ * 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. In list context we
- * have to splice out the 1,2; In scalar context for
+ * 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.
+ */
+ cx = &cxstack[cxix];
+ PUTBACK;
+ leave_common(PL_stack_base + cx->blk_oldsp, MARK,
+ cx->blk_gimme, SVs_TEMP|SVs_PADTMP, TRUE);
+ SPAGAIN;
+ dounwind(cxix);
+ }
+ else {
+ /* Like in the branch above, we need to handle any extra junk on
+ * the stack. But because we're not also popping extra contexts, we
+ * don't have to worry about prematurely freeing args. So we just
+ * need to do the bare minimum to handle junk, and leave the main
+ * arg processing in the function we tail call, e.g. pp_leavesub.
+ * In list context we have to splice out the junk; in scalar
+ * context we can leave as-is (pp_leavesub will later return the
+ * top stack element). But for an empty arg list, e.g.
* for (1,2) { return }
- * we need to set sp = oldsp so that pp_leavesub knows
- * to push &PL_sv_undef onto the stack.
- * Note that in pp_return we only do the extra processing
- * required to handle junk; everything else we leave to
- * pp_leavesub.
+ * we need to set sp = oldsp so that pp_leavesub knows to push
+ * &PL_sv_undef onto the stack.
*/
- 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;
+ OP* nextop;
S_unwind_loop(aTHX_ "last");
- POPBLOCK(cx,newpm);
- cxstack_ix++; /* temporarily protect top context */
+ cx = &cxstack[cxstack_ix];
+
assert(
CxTYPE(cx) == CXt_LOOP_LAZYIV
|| CxTYPE(cx) == CXt_LOOP_LAZYSV
|| CxTYPE(cx) == CXt_LOOP_FOR
|| CxTYPE(cx) == CXt_LOOP_PLAIN
);
- newsp = PL_stack_base + cx->blk_loop.resetsp;
- nextop = cx->blk_loop.my_op->op_lastop->op_next;
+ PL_stack_sp = PL_stack_base + cx->blk_loop.resetsp;
TAINT_NOT;
- PL_stack_sp = newsp;
- LEAVE;
- cxstack_ix--;
/* Stack values are safe: */
+ CX_LEAVE_SCOPE(cx);
POPLOOP(cx); /* release loop vars ... */
- LEAVE;
- PL_curpm = newpm; /* ... and pop $1 et al */
+ POPBLOCK(cx);
+ nextop = cx->blk_loop.my_op->op_lastop->op_next;
+ CX_POP(cx);
- 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();
PERL_CONTEXT *cx;
CV *cv = MUTABLE_CV(SvRV(sv));
AV *arg = GvAV(PL_defgv);
- I32 oldsave;
while (!CvROOT(cv) && !CvXSUB(cv)) {
const GV * const gv = CvGV(cv);
DIE(aTHX_ "Goto undefined subroutine");
}
- /* First do some returnish stuff. */
- SvREFCNT_inc_simple_void(cv); /* avoid premature free during unwind */
- FREETMPS;
cxix = dopoptosub(cxstack_ix);
- if (cxix < cxstack_ix) {
- if (cxix < 0) {
- SvREFCNT_dec(cv);
- DIE(aTHX_ "Can't goto subroutine outside a subroutine");
- }
- dounwind(cxix);
+ if (cxix < 0) {
+ DIE(aTHX_ "Can't goto subroutine outside a subroutine");
}
- TOPBLOCK(cx);
- SPAGAIN;
+ cx = &cxstack[cxix];
/* ban goto in eval: see <20050521150056.GC20213@iabyn.com> */
if (CxTYPE(cx) == CXt_EVAL) {
- SvREFCNT_dec(cv);
if (CxREALEVAL(cx))
/* diag_listed_as: Can't goto subroutine from an eval-%s */
DIE(aTHX_ "Can't goto subroutine from an eval-string");
DIE(aTHX_ "Can't goto subroutine from an eval-block");
}
else if (CxMULTICALL(cx))
- {
- SvREFCNT_dec(cv);
DIE(aTHX_ "Can't goto subroutine from a sort sub (or similar callback)");
- }
- /* partial unrolled POPSUB(): */
+ /* First do some returnish stuff. */
+
+ SvREFCNT_inc_simple_void(cv); /* avoid premature free during unwind */
+ FREETMPS;
+ if (cxix < cxstack_ix) {
+ dounwind(cxix);
+ }
+ TOPBLOCK(cx);
+ SPAGAIN;
+
+ /* protect @_ during save stack unwind. */
+ if (arg)
+ SvREFCNT_inc_NN(sv_2mortal(MUTABLE_SV(arg)));
+
+ assert(PL_scopestack_ix == cx->blk_oldscopesp);
+ CX_LEAVE_SCOPE(cx);
if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) {
+ /* this is POPSUB_ARGS() with minor variations */
AV* av = MUTABLE_AV(PAD_SVl(0));
assert(AvARRAY(MUTABLE_AV(
PadlistARRAY(CvPADLIST(cx->blk_sub.cv))[
* unless pad[0] and @_ differ (e.g. if the old sub did
* local *_ = []); in which case clear the old pad[0]
* array in the usual way */
- if (av == arg || AvREAL(av)) {
- SvREFCNT_dec(av);
- av = newAV();
- AvREIFY_only(av);
- PAD_SVl(0) = (SV*)av;
- }
+ if (av == arg || AvREAL(av))
+ clear_defarray(av, av == arg);
else CLEAR_ARGARRAY(av);
}
- /* protect @_ during save stack unwind. We donate this
- * refcount later to the callee’s pad for the non-XS case;
- * otherwise we decrement it later. */
- SvREFCNT_inc_simple_void(arg);
-
- assert(PL_scopestack_ix == cx->blk_oldscopesp);
- oldsave = PL_scopestack[cx->blk_oldscopesp - 1];
- LEAVE_SCOPE(oldsave);
-
/* don't restore PL_comppad here. It won't be needed if the
* sub we're going to is non-XS, but restoring it early then
* croaking (e.g. the "Goto undefined subroutine" below)
* our precious cv. See bug #99850. */
if (!CvROOT(cv) && !CvXSUB(cv)) {
const GV * const gv = CvGV(cv);
- SvREFCNT_dec(arg);
if (gv) {
SV * const tmpstr = sv_newmortal();
gv_efullname3(tmpstr, gv, NULL);
}
/* Now do some callish stuff. */
- SAVETMPS;
- SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
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 */
/* put GvAV(defgv) back onto stack */
if (items) {
}
}
SP += items;
- SvREFCNT_dec(arg);
if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) {
/* Restore old @_ */
POP_SAVEARRAY();
retop = cx->blk_sub.retop;
PL_comppad = cx->blk_sub.prevcomppad;
PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL;
- /* XS subs don't have a CxSUB, so pop it */
- POPBLOCK(cx, PL_curpm);
+
+ /* 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 */
+ PL_curcop = cx->blk_oldcop;
+ CX_POP(cx);
+
/* Push a mark for the start of arglist */
PUSHMARK(mark);
PUTBACK;
else {
PADLIST * const padlist = CvPADLIST(cv);
+ SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
+
/* partial unrolled PUSHSUB(): */
cx->blk_sub.cv = cv;
if (arg) {
SvREFCNT_dec(PAD_SVl(0));
PAD_SVl(0) = (SV *)arg;
+ SvREFCNT_inc_simple_void_NN(arg);
}
/* GvAV(PL_defgv) might have been modified on scope
SvREFCNT_dec(av);
}
}
- else SvREFCNT_dec(arg);
+
if (PERLDB_SUB) { /* Checking curstash breaks DProf. */
Perl_get_db_sub(aTHX_ NULL, cv);
if (PERLDB_GOTO) {
/* 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;
- SV *errsv = NULL;
-
- cx = NULL;
- namesv = NULL;
- PERL_UNUSED_VAR(newsp);
- PERL_UNUSED_VAR(optype);
+ SV *errsv;
+ PL_op = saveop;
/* note that if yystatus == 3, then the EVAL CX block has already
* been popped, and various vars restored */
- PL_op = saveop;
if (yystatus != 3) {
if (PL_eval_root) {
op_free(PL_eval_root);
PL_eval_root = NULL;
}
SP = PL_stack_base + POPMARK; /* pop original mark */
- POPBLOCK(cx,PL_curpm);
+ cx = &cxstack[cxstack_ix];
+ CX_LEAVE_SCOPE(cx);
POPEVAL(cx);
- namesv = cx->blk_eval.old_namesv;
- /* POPBLOCK renders LEAVE_with_name("evalcomp") unnecessary. */
- LEAVE_with_name("eval"); /* pp_entereval knows about this LEAVE. */
+ POPBLOCK(cx);
+ if (in_require) {
+ S_undo_inc_then_croak(aTHX_ cx, ERRSV, FALSE);
+ NOT_REACHED; /* NOTREACHED */
+ }
+ CX_POP(cx);
}
errsv = ERRSV;
if (in_require) {
- if (!cx) {
- /* If cx is still NULL, it means that we didn't go in the
- * POPEVAL branch. */
- cx = &cxstack[cxstack_ix];
- assert(CxTYPE(cx) == CXt_EVAL);
- namesv = cx->blk_eval.old_namesv;
- }
- (void)hv_store(GvHVn(PL_incgv),
- SvPVX_const(namesv),
- SvUTF8(namesv) ? -(I32)SvCUR(namesv) : (I32)SvCUR(namesv),
- &PL_sv_undef, 0);
- Perl_croak(aTHX_ "%"SVf"Compilation failed in require",
- SVfARG(errsv
- ? errsv
- : newSVpvs_flags("Unknown error\n", SVs_TEMP)));
- }
- else {
- if (!*(SvPV_nolen_const(errsv))) {
- sv_setpvs(errsv, "Compilation error");
- }
+ assert(yystatus == 3);
+ cx = &cxstack[cxstack_ix];
+ assert(CxTYPE(cx) == CXt_EVAL);
+ S_undo_inc_then_croak(aTHX_ cx, errsv, FALSE);
+ NOT_REACHED; /* NOTREACHED */
}
+
+ if (!*(SvPV_nolen_const(errsv)))
+ sv_setpvs(errsv, "Compilation error");
+
if (gimme != G_ARRAY) PUSHs(&PL_sv_undef);
PUTBACK;
return FALSE;
OP *op;
int saved_errno;
bool path_searchable;
+ I32 old_savestack_ix;
sv = POPs;
SvGETMAGIC(sv);
unixname, unixlen, SvREFCNT_inc_simple(hook_sv), 0 );
}
- ENTER_with_name("eval");
- SAVETMPS;
+ old_savestack_ix = PL_savestack_ix;
SAVECOPFILE_FREE(&PL_compiling);
CopFILE_set(&PL_compiling, tryname);
lex_start(NULL, tryrsfp, 0);
/* switch to eval mode */
PUSHBLOCK(cx, CXt_EVAL, SP);
PUSHEVAL(cx, name);
+ cx->cx_old_savestack_ix = old_savestack_ix;
cx->blk_eval.retop = PL_op->op_next;
SAVECOPLINE(&PL_compiling);
U32 seq, lex_flags = 0;
HV *saved_hh = NULL;
const bool bytes = PL_op->op_private & OPpEVAL_BYTES;
+ I32 old_savestack_ix;
if (PL_op->op_private & OPpEVAL_HAS_HH) {
saved_hh = MUTABLE_HV(SvREFCNT_inc(POPs));
TAINT_IF(SvTAINTED(sv));
TAINT_PROPER("eval");
- ENTER_with_name("eval");
+ old_savestack_ix = PL_savestack_ix;
+
lex_start(sv, NULL, lex_flags | (PL_op->op_private & OPpEVAL_UNICODE
? LEX_IGNORE_UTF8_HINTS
: bytes ? LEX_EVALBYTES : LEX_START_SAME_FILTER
)
);
- SAVETMPS;
/* switch to eval mode */
PUSHBLOCK(cx, (CXt_EVAL|CXp_REAL), SP);
PUSHEVAL(cx, 0);
+ cx->cx_old_savestack_ix = old_savestack_ix;
cx->blk_eval.retop = PL_op->op_next;
/* prepare to compile string */
{
dSP;
SV **newsp;
- PMOP *newpm;
I32 gimme;
PERL_CONTEXT *cx;
OP *retop;
I32 optype;
- SV *namesv;
CV *evalcv;
/* grab this value before POPEVAL restores old PL_in_eval */
bool keep = cBOOL(PL_in_eval & EVAL_KEEPERR);
PERL_ASYNC_CHECK();
- POPBLOCK(cx,newpm);
+
+ cx = &cxstack[cxstack_ix];
+ assert(CxTYPE(cx) == CXt_EVAL);
+ newsp = PL_stack_base + cx->blk_oldsp;
+ gimme = cx->blk_gimme;
+
+ if (gimme != G_VOID) {
+ PUTBACK;
+ leave_common(newsp, newsp, gimme, SVs_TEMP, FALSE);
+ SPAGAIN;
+ }
+ /* the 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
+ * to get the current hints. So restore it early.
+ */
+ PL_curcop = cx->blk_oldcop;
+ CX_LEAVE_SCOPE(cx);
POPEVAL(cx);
- namesv = cx->blk_eval.old_namesv;
+ POPBLOCK(cx);
retop = cx->blk_eval.retop;
evalcv = cx->blk_eval.cv;
+ optype = CxOLD_OP_TYPE(cx);
- SP = leave_common((gimme == G_VOID) ? SP : newsp, SP, newsp,
- gimme, SVs_TEMP, FALSE);
- PL_curpm = newpm; /* Don't pop $1 et al till now */
#ifdef DEBUGGING
assert(CvDEPTH(evalcv) == 1);
!(gimme == G_SCALAR ? SvTRUE(*SP) : SP > newsp))
{
/* Unassume the success we assumed earlier. */
- (void)hv_delete(GvHVn(PL_incgv),
- SvPVX_const(namesv),
- SvUTF8(namesv) ? -(I32)SvCUR(namesv) : (I32)SvCUR(namesv),
- G_DISCARD);
- LEAVE_with_name("eval");
- Perl_die(aTHX_ "%"SVf" did not return a true value", SVfARG(namesv));
+ S_undo_inc_then_croak(aTHX_ cx, NULL, TRUE);
NOT_REACHED; /* NOTREACHED */
- /* die_unwind() did LEAVE, or we won't be here */
- }
- else {
- LEAVE_with_name("eval");
- if (!keep)
- CLEAR_ERRSV();
}
+ CX_POP(cx);
+
+ if (!keep)
+ CLEAR_ERRSV();
+
RETURNOP(retop);
}
void
Perl_delete_eval_scope(pTHX)
{
- SV **newsp;
- PMOP *newpm;
- I32 gimme;
PERL_CONTEXT *cx;
- I32 optype;
- POPBLOCK(cx,newpm);
+ cx = &cxstack[cxstack_ix];
+ CX_LEAVE_SCOPE(cx);
POPEVAL(cx);
- PL_curpm = newpm;
- LEAVE_with_name("eval_scope");
- PERL_UNUSED_VAR(newsp);
- PERL_UNUSED_VAR(gimme);
- PERL_UNUSED_VAR(optype);
+ POPBLOCK(cx);
+ CX_POP(cx);
}
/* Common-ish code salvaged from Perl_call_sv and pp_entertry, because it was
PERL_CONTEXT *cx;
const I32 gimme = GIMME_V;
- ENTER_with_name("eval_scope");
- SAVETMPS;
-
PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), PL_stack_sp);
PUSHEVAL(cx, 0);
+ cx->cx_old_savestack_ix = PL_savestack_ix;
PL_in_eval = EVAL_INEVAL;
if (flags & G_KEEPERR)
PP(pp_leavetry)
{
- dSP;
SV **newsp;
- PMOP *newpm;
I32 gimme;
PERL_CONTEXT *cx;
- I32 optype;
OP *retop;
PERL_ASYNC_CHECK();
- POPBLOCK(cx,newpm);
- retop = cx->blk_eval.retop;
- POPEVAL(cx);
- PERL_UNUSED_VAR(optype);
- SP = leave_common(newsp, SP, newsp, gimme,
- SVs_PADTMP|SVs_TEMP, FALSE);
- PL_curpm = newpm; /* Don't pop $1 et al till now */
+ cx = &cxstack[cxstack_ix];
+ assert(CxTYPE(cx) == CXt_EVAL);
+ newsp = PL_stack_base + cx->blk_oldsp;
+ gimme = cx->blk_gimme;
+
+ if (gimme == G_VOID)
+ PL_stack_sp = newsp;
+ else
+ leave_common(newsp, newsp, gimme, SVs_PADTMP|SVs_TEMP, FALSE);
+ CX_LEAVE_SCOPE(cx);
+ POPEVAL(cx);
+ POPBLOCK(cx);
+ retop = cx->blk_eval.retop;
+ CX_POP(cx);
- LEAVE_with_name("eval_scope");
CLEAR_ERRSV();
- RETURNOP(retop);
+ return retop;
}
PP(pp_entergiven)
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;
}
PP(pp_leavegiven)
{
- dSP;
PERL_CONTEXT *cx;
I32 gimme;
SV **newsp;
- 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;
+
+ if (gimme == G_VOID)
+ PL_stack_sp = newsp;
+ else
+ leave_common(newsp, newsp, gimme, SVs_PADTMP|SVs_TEMP, FALSE);
- SP = leave_common(newsp, SP, newsp, gimme,
- SVs_PADTMP|SVs_TEMP, FALSE);
- PL_curpm = newpm; /* Don't pop $1 et al till now */
+ CX_LEAVE_SCOPE(cx);
+ POPGIVEN(cx);
+ POPBLOCK(cx);
+ CX_POP(cx);
- LEAVE_with_name("given");
- RETURN;
+ return NORMAL;
}
/* Helper routines used by pp_smartmatch */
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);
PP(pp_leavewhen)
{
- dSP;
I32 cxix;
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);
-
- SP = 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);
+ newsp = PL_stack_base + cx->blk_oldsp;
+ if (gimme == G_VOID)
+ PL_stack_sp = newsp;
+ else
+ leave_common(newsp, newsp, gimme, SVs_PADTMP|SVs_TEMP, FALSE);
+ /* 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();
- RETURNOP(cx->blk_givwhen.leave_op);
+ assert(cx->blk_givwhen.leave_op->op_type == OP_LEAVEGIVEN);
+ return cx->blk_givwhen.leave_op;
}
}
PP(pp_continue)
{
- dSP;
I32 cxix;
PERL_CONTEXT *cx;
- I32 gimme;
- SV **newsp;
- PMOP *newpm;
-
- PERL_UNUSED_VAR(gimme);
+ OP *nextop;
cxix = dopoptowhen(cxstack_ix);
if (cxix < 0)
if (cxix < cxstack_ix)
dounwind(cxix);
- POPBLOCK(cx,newpm);
+ cx = &cxstack[cxstack_ix];
assert(CxTYPE(cx) == CXt_WHEN);
+ PL_stack_sp = PL_stack_base + cx->blk_oldsp;
+ CX_LEAVE_SCOPE(cx);
+ POPWHEN(cx);
+ POPBLOCK(cx);
+ nextop = cx->blk_givwhen.leave_op->op_next;
+ CX_POP(cx);
- SP = newsp;
- PL_curpm = newpm; /* pop $1 et al */
-
- LEAVE_with_name("when");
- RETURNOP(cx->blk_givwhen.leave_op->op_next);
+ return nextop;
}
PP(pp_break)
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