/* Above here is the same for sub and format. */
AV * savearray;
I32 olddepth;
+ I32 old_savestack_ix; /* saved PL_savestack_ix (also CXt_NULL) */
PAD *prevcomppad; /* the caller's PL_comppad */
SSize_t old_tmpsfloor; /* also used in CXt_NULL sort block */
};
#define POPSUB(cx,sv) \
STMT_START { \
const I32 olddepth = cx->blk_sub.olddepth; \
+ LEAVE_SCOPE(cx->blk_sub.old_savestack_ix); \
if (!(cx->blk_u16 & CxPOPSUB_DONE)) { \
cx->blk_u16 |= CxPOPSUB_DONE; \
RETURN_PROBE(CvNAMED(cx->blk_sub.cv) \
} \
} \
sv = MUTABLE_SV(cx->blk_sub.cv); \
- LEAVE_SCOPE(PL_scopestack[cx->blk_oldscopesp-1]); \
PL_tmps_floor = cx->blk_sub.old_tmpsfloor; \
PL_comppad = cx->blk_sub.prevcomppad; \
PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL; \
CV * const _nOnclAshIngNamE_ = the_cv; \
CV * const cv = _nOnclAshIngNamE_; \
PADLIST * const padlist = CvPADLIST(cv); \
- ENTER; \
multicall_oldcatch = CATCH_GET; \
- SAVEVPTR(PL_op); \
CATCH_SET(TRUE); \
PUSHSTACKi(PERLSI_MULTICALL); \
PUSHBLOCK(cx, (CXt_SUB|CXp_MULTICALL|flags), PL_stack_sp); \
PUSHSUB(cx); \
+ cx->blk_sub.old_savestack_ix = PL_savestack_ix; \
+ SAVEVPTR(PL_op); \
if (!(flags & CXp_SUB_RE_FAKE)) \
CvDEPTH(cv)++; \
if (CvDEPTH(cv) >= 2) { \
LEAVESUB(multicall_cv); \
POPBLOCK(cx,PL_curpm); \
/* includes partial unrolled POPSUB(): */ \
- LEAVE_SCOPE(PL_scopestack[cx->blk_oldscopesp-1]); \
+ LEAVE_SCOPE(cx->blk_sub.old_savestack_ix); \
PL_comppad = cx->blk_sub.prevcomppad; \
PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL; \
POPSTACK; \
CATCH_SET(multicall_oldcatch); \
- LEAVE; \
SPAGAIN; \
} STMT_END
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;
-
- 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);
return NORMAL;
}
else {
+ U8 hasargs = 0;
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;
+
+ SAVEI32(PL_debug);
+ PL_debug = 0;
+ SAVESTACK_POS();
CvDEPTH(cv)++;
if (CvDEPTH(cv) >= 2) {
PERL_STACK_OVERFLOW_CHECK();
what = "undef";
}
croak:
- LEAVE;
POPSUB(cx,sv);
cxstack_ix--;
PL_curpm = newpm;
}
PUTBACK;
- LEAVE;
POPSUB(cx,sv); /* Stack values are safe: release CV and @_ ... */
cxstack_ix--;
PL_curpm = newpm; /* ... and pop $1 et al */
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);
/* partial unrolled POPSUB(): */
+ /* protect @_ during save stack unwind. */
+ if (arg)
+ SvREFCNT_inc_NN(sv_2mortal(MUTABLE_SV(arg)));
+
+ assert(PL_scopestack_ix == cx->blk_oldscopesp);
+ LEAVE_SCOPE(cx->blk_sub.old_savestack_ix);
+
if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) {
AV* av = MUTABLE_AV(PAD_SVl(0));
assert(AvARRAY(MUTABLE_AV(
else CLEAR_ARGARRAY(av);
}
- /* protect @_ during save stack unwind. */
- if (arg)
- SvREFCNT_inc_NN(sv_2mortal(MUTABLE_SV(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)
PERL_UNUSED_VAR(newsp);
PERL_UNUSED_VAR(gimme);
+ ENTER;
SAVETMPS;
SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
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;
+ cxstack_ix--;
+
/* Push a mark for the start of arglist */
PUSHMARK(mark);
PUTBACK;
}
PUTBACK;
- LEAVE;
POPSUB(cx,sv); /* Stack values are safe: release CV and @_ ... */
cxstack_ix--;
PL_curpm = newpm; /* ... and pop $1 et al */
PERL_CONTEXT *cx;
I32 gimme;
const bool hasargs = (PL_op->op_flags & OPf_STACKED) != 0;
+ I32 old_savestack_ix;
if (UNLIKELY(!sv))
DIE(aTHX_ "Not a CODE reference");
cv = sv_2cv(sv, &stash, &gv, 0);
}
if (!cv) {
- ENTER;
+ old_savestack_ix = PL_savestack_ix;
goto try_autoload;
}
break;
}
}
- ENTER;
+ /* At this point we want to save PL_savestack_ix, either by doing a
+ * PUSHSUB, or for XS, doing an ENTER. But we don't yet know the final
+ * CV we will be using (so we don't know whether its XS, so we can't
+ * PUSHSUB or ENTER yet), and determining cv may itself push stuff on
+ * the save stack. So remember where we are currently on the save
+ * stack, and later update the CX or scopestack entry accordingly. */
+ old_savestack_ix = PL_savestack_ix;
/* these two fields are in a union. If they ever become separate,
* we have to test for both of them being null below */
PUSHBLOCK(cx, CXt_SUB, MARK);
PUSHSUB(cx);
-
cx->blk_sub.retop = PL_op->op_next;
+ cx->blk_sub.old_savestack_ix = old_savestack_ix;
+
if (UNLIKELY((depth = ++CvDEPTH(cv)) >= 2)) {
PERL_STACK_OVERFLOW_CHECK();
pad_push(padlist, depth);
else {
SSize_t markix = TOPMARK;
+ ENTER;
+ /* pretend we did the ENTER earlier */
+ PL_scopestack[PL_scopestack_ix - 1] = old_savestack_ix;
+
SAVETMPS;
PUTBACK;
PERL_CONTEXT *cx;
SV** newsp;
const bool oldcatch = CATCH_GET;
+ I32 old_savestack_ix = PL_savestack_ix;
SAVEOP();
cx->blk_sub.old_tmpsfloor = PL_tmps_floor;
PL_tmps_floor = PL_tmps_ix;
}
+ cx->blk_sub.old_savestack_ix = old_savestack_ix;
cx->cx_type |= CXp_MULTICALL;
}
f();
- local $::TODO = "sub unwinding not safe yet";
::is($y, 7, "tie_exception");
}