break;
case CXt_EVAL:
POPEVAL(cx);
- LEAVE_SCOPE(PL_scopestack[cx->blk_oldscopesp-1]);
+ LEAVE_SCOPE(cx->blk_eval.old_savestack_ix);
+ PL_tmps_floor = cx->blk_eval.old_tmpsfloor;
break;
case CXt_LOOP_LAZYIV:
case CXt_LOOP_LAZYSV:
*++newsp = &PL_sv_undef;
PL_stack_sp = newsp;
- LEAVE;
+ LEAVE_SCOPE(cx->blk_eval.old_savestack_ix);
+ PL_tmps_floor = cx->blk_eval.old_tmpsfloor;
if (optype == OP_REQUIRE) {
assert (PL_curcop == oldcop);
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->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();
gimme = OP_GIMME(PL_op, (cxstack_ix >= 0) ? gimme : G_SCALAR);
- SP = leave_common(newsp, SP, newsp, gimme, SVs_PADTMP|SVs_TEMP,
- PL_op->op_private & OPpLVALUE);
+ 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");
mark = newsp;
newsp = PL_stack_base + cx->blk_loop.resetsp;
- SP = leave_common(newsp, SP, MARK, gimme, 0,
+ SP = (gimme == G_VOID)
+ ? newsp
+ : leave_common(newsp, SP, MARK, gimme, 0,
PL_op->op_private & OPpLVALUE);
PUTBACK;
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(
* 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. */
- 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)
}
/* Now do some callish stuff. */
- SAVETMPS;
- SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
if (CvISXSUB(cv)) {
SV **newsp;
I32 gimme;
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) {
EXTEND(SP, items+1); /* @_ could have been extended. */
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;
else {
PADLIST * const padlist = CvPADLIST(cv);
+ SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
+
/* partial unrolled PUSHSUB(): */
cx->blk_sub.cv = cv;
POPBLOCK(cx,PL_curpm);
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 has rendered LEAVE_with_name("evalcomp") unnecessary */
+ LEAVE_SCOPE(cx->blk_eval.old_savestack_ix);
+ PL_tmps_floor = cx->blk_eval.old_tmpsfloor;
}
errsv = ERRSV;
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->blk_eval.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->blk_eval.old_savestack_ix = old_savestack_ix;
cx->blk_eval.retop = PL_op->op_next;
/* prepare to compile string */
retop = cx->blk_eval.retop;
evalcv = cx->blk_eval.cv;
- SP = leave_common((gimme == G_VOID) ? SP : newsp, SP, newsp,
- gimme, SVs_TEMP, FALSE);
+ 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_with_name("eval");
+ LEAVE_SCOPE(cx->blk_eval.old_savestack_ix);
+ PL_tmps_floor = cx->blk_eval.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_with_name("eval");
+ LEAVE_SCOPE(cx->blk_eval.old_savestack_ix);
+ PL_tmps_floor = cx->blk_eval.old_tmpsfloor;
if (!keep)
CLEAR_ERRSV();
}
POPBLOCK(cx,newpm);
POPEVAL(cx);
PL_curpm = newpm;
- LEAVE_with_name("eval_scope");
+ LEAVE_SCOPE(cx->blk_eval.old_savestack_ix);
+ PL_tmps_floor = cx->blk_eval.old_tmpsfloor;
PERL_UNUSED_VAR(newsp);
PERL_UNUSED_VAR(gimme);
PERL_UNUSED_VAR(optype);
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->blk_eval.old_savestack_ix = PL_savestack_ix;
PL_in_eval = EVAL_INEVAL;
if (flags & G_KEEPERR)
POPEVAL(cx);
PERL_UNUSED_VAR(optype);
- SP = leave_common(newsp, SP, newsp, gimme,
+ SP = (gimme == G_VOID)
+ ? newsp
+ : leave_common(newsp, SP, newsp, gimme,
SVs_PADTMP|SVs_TEMP, FALSE);
PL_curpm = newpm; /* Don't pop $1 et al till now */
- LEAVE_with_name("eval_scope");
+ LEAVE_SCOPE(cx->blk_eval.old_savestack_ix);
+ PL_tmps_floor = cx->blk_eval.old_tmpsfloor;
+
CLEAR_ERRSV();
RETURNOP(retop);
}
POPBLOCK(cx,newpm);
assert(CxTYPE(cx) == CXt_GIVEN);
- SP = leave_common(newsp, SP, newsp, gimme,
+ SP = (gimme == G_VOID)
+ ? newsp
+ : leave_common(newsp, SP, newsp, gimme,
SVs_PADTMP|SVs_TEMP, FALSE);
PL_curpm = newpm; /* Don't pop $1 et al till now */
POPBLOCK(cx,newpm);
assert(CxTYPE(cx) == CXt_WHEN);
- SP = leave_common(newsp, SP, newsp, gimme,
+ SP = (gimme == G_VOID)
+ ? newsp
+ : leave_common(newsp, SP, newsp, gimme,
SVs_PADTMP|SVs_TEMP, FALSE);
PL_curpm = newpm; /* pop $1 et al */
https://perl5.git.perl.org / perl5.git / blobdiff