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);
- /* FALLTHROUGH */
+ break;
case CXt_BLOCK:
POPBASICBLK(cx);
break;
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);
}
+
POPEVAL(cx);
+ POPBLOCK(cx,PL_curpm);
+ cxstack_ix--;
namesv = cx->blk_eval.old_namesv;
#ifdef DEBUGGING
oldcop = cx->blk_oldcop;
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->cx_u.cx_blk.blku_old_savestack_ix);
- PL_tmps_floor = cx->cx_u.cx_blk.blku_old_tmpsfloor;
-
if (optype == OP_REQUIRE) {
assert (PL_curcop == oldcop);
(void)hv_store(GvHVn(PL_incgv),
/* 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..sp) based on
- context, with any final args starting at newsp+1. Returns the new
- top-of-stack position
+ 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
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)
{
+ dSP;
PERL_ARGS_ASSERT_LEAVE_COMMON;
TAINT_NOT;
? 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) {
* point with SP == newsp. */
}
- return newsp;
+ PL_stack_sp = newsp;
}
+
PP(pp_enter)
{
dSP;
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 = (gimme == G_VOID)
- ? newsp
- : leave_common(newsp, SP, newsp, gimme, SVs_PADTMP|SVs_TEMP,
+ if (gimme == G_VOID)
+ PL_stack_sp = newsp;
+ else
+ leave_common(newsp, newsp, gimme, SVs_PADTMP|SVs_TEMP,
PL_op->op_private & OPpLVALUE);
POPBASICBLK(cx);
-
+ POPBLOCK(cx,newpm);
PL_curpm = newpm; /* Don't pop $1 et al till now */
+ cxstack_ix--;
- RETURN;
+ return NORMAL;
}
static bool
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 = (gimme == G_VOID)
- ? newsp
- : leave_common(newsp, SP, MARK, gimme, SVs_PADTMP|SVs_TEMP,
+ if (gimme == G_VOID)
+ PL_stack_sp = newsp;
+ else
+ leave_common(newsp, MARK, gimme, SVs_PADTMP|SVs_TEMP,
PL_op->op_private & OPpLVALUE);
- PUTBACK;
POPLOOP(cx); /* Stack values are safe: release loop vars ... */
+ POPBLOCK(cx,newpm);
PL_curpm = newpm; /* ... and pop $1 et al */
+ cxstack_ix--;
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 @_ ... */
- cxstack_ix--;
+ POPSUB(cx); /* Stack values are safe: release CV and @_ ... */
+ POPBLOCK(cx,newpm);
PL_curpm = newpm; /* ... and pop $1 et al */
- LEAVESUB(sv);
+ cxstack_ix--;
return cx->blk_sub.retop;
}
* return.
*/
cx = &cxstack[cxix];
- SP = leave_common(PL_stack_base + cx->blk_oldsp, SP, MARK,
- cx->blk_gimme, SVs_TEMP|SVs_PADTMP, TRUE);
PUTBACK;
+ leave_common(PL_stack_base + cx->blk_oldsp, MARK,
+ cx->blk_gimme, SVs_TEMP|SVs_PADTMP, TRUE);
+ SPAGAIN;
dounwind(cxix);
}
else {
PP(pp_last)
{
PERL_CONTEXT *cx;
- I32 gimme;
- OP *nextop = NULL;
- SV **newsp;
PMOP *newpm;
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;
- cxstack_ix--;
/* Stack values are safe: */
POPLOOP(cx); /* release loop vars ... */
+ POPBLOCK(cx,newpm);
PL_curpm = newpm; /* ... and pop $1 et al */
+ cxstack_ix--;
- PERL_UNUSED_VAR(gimme);
- return nextop;
+ return cx->blk_loop.my_op->op_lastop->op_next;
}
PP(pp_next)
}
TOPBLOCK(cx);
- LEAVE_SCOPE(cx->cx_u.cx_blk.blku_old_savestack_ix);
+ 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->cx_u.cx_blk.blku_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 */
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
PL_eval_root = NULL;
}
SP = PL_stack_base + POPMARK; /* pop original mark */
- POPBLOCK(cx,PL_curpm);
+ cx = &cxstack[cxstack_ix];
POPEVAL(cx);
+ POPBLOCK(cx,PL_curpm);
+ cxstack_ix--;
namesv = cx->blk_eval.old_namesv;
- /* POPBLOCK has rendered LEAVE_with_name("evalcomp") unnecessary */
- LEAVE_SCOPE(cx->cx_u.cx_blk.blku_old_savestack_ix);
- PL_tmps_floor = cx->cx_u.cx_blk.blku_old_tmpsfloor;
}
errsv = ERRSV;
bool keep = cBOOL(PL_in_eval & EVAL_KEEPERR);
PERL_ASYNC_CHECK();
- POPBLOCK(cx,newpm);
- if (gimme != G_VOID)
- SP = leave_common(newsp, SP, newsp, gimme, SVs_TEMP, FALSE);
+
+ 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;
POPEVAL(cx);
+ POPBLOCK(cx,newpm);
+ PL_curpm = newpm; /* Don't pop $1 et al till now */
+ cxstack_ix--;
namesv = cx->blk_eval.old_namesv;
retop = cx->blk_eval.retop;
evalcv = cx->blk_eval.cv;
- PL_curpm = newpm; /* Don't pop $1 et al till now */
#ifdef DEBUGGING
assert(CvDEPTH(evalcv) == 1);
SvPVX_const(namesv),
SvUTF8(namesv) ? -(I32)SvCUR(namesv) : (I32)SvCUR(namesv),
G_DISCARD);
- LEAVE_SCOPE(cx->cx_u.cx_blk.blku_old_savestack_ix);
- 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->cx_u.cx_blk.blku_old_savestack_ix);
- 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);
+ cx = &cxstack[cxstack_ix];
POPEVAL(cx);
+ POPBLOCK(cx,newpm);
PL_curpm = newpm;
- LEAVE_SCOPE(cx->cx_u.cx_blk.blku_old_savestack_ix);
- PL_tmps_floor = cx->cx_u.cx_blk.blku_old_tmpsfloor;
- PERL_UNUSED_VAR(newsp);
- PERL_UNUSED_VAR(gimme);
+ cxstack_ix--;
PERL_UNUSED_VAR(optype);
}
PP(pp_leavetry)
{
- dSP;
SV **newsp;
PMOP *newpm;
I32 gimme;
OP *retop;
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)
+ PL_stack_sp = newsp;
+ else
+ leave_common(newsp, newsp, gimme, SVs_PADTMP|SVs_TEMP, FALSE);
+ POPEVAL(cx);
POPBLOCK(cx,newpm);
+ cxstack_ix--;
retop = cx->blk_eval.retop;
- SP = (gimme == G_VOID)
- ? newsp
- : leave_common(newsp, SP, newsp, gimme,
- SVs_PADTMP|SVs_TEMP, FALSE);
- POPEVAL(cx);
PERL_UNUSED_VAR(optype);
PL_curpm = newpm; /* Don't pop $1 et al till now */
- LEAVE_SCOPE(cx->cx_u.cx_blk.blku_old_savestack_ix);
- PL_tmps_floor = cx->cx_u.cx_blk.blku_old_tmpsfloor;
-
CLEAR_ERRSV();
- RETURNOP(retop);
+ return retop;
}
PP(pp_entergiven)
PP(pp_leavegiven)
{
- dSP;
PERL_CONTEXT *cx;
I32 gimme;
SV **newsp;
PMOP *newpm;
PERL_UNUSED_CONTEXT;
- POPBLOCK(cx,newpm);
- SP = (gimme == G_VOID)
- ? newsp
- : leave_common(newsp, SP, newsp, gimme,
- SVs_PADTMP|SVs_TEMP, FALSE);
- POPGIVEN(cx);
+ 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);
+ POPGIVEN(cx);
+ POPBLOCK(cx,newpm);
PL_curpm = newpm; /* Don't pop $1 et al till now */
+ cxstack_ix--;
- RETURN;
+ return NORMAL;
}
/* Helper routines used by pp_smartmatch */
PP(pp_leavewhen)
{
- dSP;
I32 cxix;
PERL_CONTEXT *cx;
I32 gimme;
PL_op->op_flags & OPf_SPECIAL ? "default" : "when");
newsp = PL_stack_base + cx->blk_oldsp;
- SP = (gimme == G_VOID)
- ? newsp
- : leave_common(newsp, SP, newsp, gimme,
- SVs_PADTMP|SVs_TEMP, FALSE);
+ 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);
else {
PERL_ASYNC_CHECK();
assert(cx->blk_givwhen.leave_op->op_type == OP_LEAVEGIVEN);
- RETURNOP(cx->blk_givwhen.leave_op);
+ 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);
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;
POPWHEN(cx);
-
- SP = newsp;
+ POPBLOCK(cx,newpm);
PL_curpm = newpm; /* pop $1 et al */
+ cxstack_ix--;
- RETURNOP(cx->blk_givwhen.leave_op->op_next);
+ return cx->blk_givwhen.leave_op->op_next;
}
PP(pp_break)
https://perl5.git.perl.org / perl5.git / blobdiff