TAINT_NOT;
CX_LEAVE_SCOPE(cx);
- POPSUBST(cx);
+ CX_POPSUBST(cx);
CX_POP(cx);
PERL_ASYNC_CHECK();
PP(pp_mapwhile)
{
dSP;
- const I32 gimme = GIMME_V;
+ const U8 gimme = GIMME_V;
I32 items = (SP - PL_stack_base) - TOPMARK; /* how many new items */
I32 count;
I32 shift;
-I32
+U8
Perl_dowantarray(pTHX)
{
- const I32 gimme = block_gimme();
+ const U8 gimme = block_gimme();
return (gimme == G_VOID) ? G_SCALAR : gimme;
}
-I32
+U8
Perl_block_gimme(pTHX)
{
const I32 cxix = dopoptosub(cxstack_ix);
return 0;
}
-/* only used by PUSHSUB */
+/* only used by cx_pushsub() */
I32
Perl_was_lvalue_sub(pTHX)
{
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.
+ * Note that it clears the savestack frame associated with each popped
+ * context entry, but doesn't free any temps.
+ * It does a cx_popblock() of the last frame that it pops, and leaves
+ * cxstack_ix equal to cxix.
+ */
+
void
Perl_dounwind(pTHX_ I32 cxix)
{
switch (CxTYPE(cx)) {
case CXt_SUBST:
- POPSUBST(cx);
+ CX_POPSUBST(cx);
break;
case CXt_SUB:
- POPSUB(cx);
+ cx_popsub(cx);
break;
case CXt_EVAL:
- POPEVAL(cx);
- break;
- case CXt_BLOCK:
- POPBASICBLK(cx);
+ cx_popeval(cx);
break;
case CXt_LOOP_PLAIN:
case CXt_LOOP_LAZYIV:
case CXt_LOOP_LAZYSV:
case CXt_LOOP_LIST:
case CXt_LOOP_ARY:
- POPLOOP(cx);
+ cx_poploop(cx);
break;
case CXt_WHEN:
- POPWHEN(cx);
+ cx_popwhen(cx);
break;
case CXt_GIVEN:
- POPGIVEN(cx);
+ cx_popgiven(cx);
break;
+ case CXt_BLOCK:
case CXt_NULL:
- /* there isn't a POPNULL ! */
+ /* these two don't have a POPFOO() */
break;
case CXt_FORMAT:
- POPFORMAT(cx);
+ cx_popformat(cx);
break;
}
+ if (cxstack_ix == cxix + 1) {
+ cx_popblock(cx);
+ }
cxstack_ix--;
}
+
}
void
if (cxix >= 0) {
SV *namesv = NULL;
PERL_CONTEXT *cx;
- SV **newsp;
- I32 gimme;
+ SV **oldsp;
+ U8 gimme;
JMPENV *restartjmpenv;
OP *restartop;
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);
- POPBLOCK(cx);
+ cx_popeval(cx);
+ cx_popblock(cx);
restartjmpenv = cx->blk_eval.cur_top_env;
restartop = cx->blk_eval.retop;
if (CxOLD_OP_TYPE(cx) == OP_REQUIRE)
dSP;
const PERL_CONTEXT *cx;
const PERL_CONTEXT *dbcx;
- I32 gimme = GIMME_V;
+ U8 gimme = GIMME_V;
const HEK *stash_hek;
I32 count = 0;
bool has_arg = MAXARG && TOPs;
PUSHs(newSVpvs_flags("(eval)", SVs_TEMP));
mPUSHi(0);
}
- gimme = (I32)cx->blk_gimme;
+ gimme = cx->blk_gimme;
if (gimme == G_VOID)
PUSHs(&PL_sv_undef);
else
{
dSP;
PERL_CONTEXT *cx;
- const I32 gimme = G_ARRAY;
+ const U8 gimme = G_ARRAY;
GV * const gv = PL_DBgv;
CV * cv = NULL;
return NORMAL;
}
else {
- U8 hasargs = 0;
- PUSHBLOCK(cx, CXt_SUB, SP);
- PUSHSUB_DB(cx);
- cx->blk_sub.retop = PL_op->op_next;
- cx->blk_oldsaveix = PL_savestack_ix;
+ cx = cx_pushblock(CXt_SUB, gimme, SP, PL_savestack_ix);
+ cx_pushsub(cx, cv, PL_op->op_next, 0);
+ /* OP_DBSTATE's op_private holds hint bits rather than
+ * the lvalue-ish flags seen in OP_ENTERSUB. So cancel
+ * any CxLVAL() flags that have now been mis-calculated */
+ cx->blk_u16 = 0;
SAVEI32(PL_debug);
PL_debug = 0;
SAVESTACK_POS();
CvDEPTH(cv)++;
- if (CvDEPTH(cv) >= 2) {
- PERL_STACK_OVERFLOW_CHECK();
+ if (CvDEPTH(cv) >= 2)
pad_push(CvPADLIST(cv), CvDEPTH(cv));
- }
PAD_SET_CUR_NOSAVE(CvPADLIST(cv), CvDEPTH(cv));
RETURNOP(CvSTART(cv));
}
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) {
- SV *sv = *SP;
-
- *++newsp = ((SvFLAGS(sv) & flags) && SvREFCNT(sv) == 1
- && !SvMAGICAL(sv))
- ? sv
- : lvalue
- ? sv_2mortal(SvREFCNT_inc_simple_NN(sv))
- : sv_mortalcopy(sv);
- }
- else {
- EXTEND(newsp, 1);
- *++newsp = &PL_sv_undef;
- }
- }
- else if (gimme == G_ARRAY) {
- /* in case LEAVE wipes old return values */
- while (++MARK <= SP) {
- SV *sv = *MARK;
- if ((SvFLAGS(sv) & flags) && SvREFCNT(sv) == 1
- && !SvMAGICAL(sv))
- *++newsp = sv;
- else {
- *++newsp = lvalue
- ? sv_2mortal(SvREFCNT_inc_simple_NN(sv))
- : sv_mortalcopy(sv);
- 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)
{
- dSP;
- PERL_CONTEXT *cx;
- I32 gimme = GIMME_V;
-
- PUSHBLOCK(cx, CXt_BLOCK, SP);
- PUSHBASICBLK(cx);
+ U8 gimme = GIMME_V;
- RETURN;
+ (void)cx_pushblock(CXt_BLOCK, gimme, PL_stack_sp, PL_savestack_ix);
+ return NORMAL;
}
+
PP(pp_leave)
{
PERL_CONTEXT *cx;
- SV **newsp;
- I32 gimme;
+ SV **oldsp;
+ U8 gimme;
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 */
+ /* fake block should preserve $1 et al; e.g. /(...)/ while ...; */
+ cx->blk_oldpm = PL_curpm;
- 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);
- POPBLOCK(cx);
+ cx_popblock(cx);
CX_POP(cx);
return NORMAL;
{
dSP; dMARK;
PERL_CONTEXT *cx;
- const I32 gimme = GIMME_V;
+ const U8 gimme = GIMME_V;
void *itervarp; /* GV or pad slot of the iteration variable */
SV *itersave; /* the old var in the iterator var slot */
U8 cxflags = 0;
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;
}
}
+ /* OPpITER_DEF (implicit $_) should only occur with a GV iter var */
+ assert((cxflags & CXp_FOR_GV) || !(PL_op->op_private & OPpITER_DEF));
- if (PL_op->op_private & OPpITER_DEF)
- cxflags |= CXp_FOR_DEF;
+ /* Note that this context is initially set as CXt_NULL. Further on
+ * down it's changed to one of the CXt_LOOP_*. Before it's changed,
+ * there mustn't be anything in the blk_loop substruct that requires
+ * freeing or undoing, in case we die in the meantime. And vice-versa.
+ */
+ cx = cx_pushblock(cxflags, gimme, MARK, PL_savestack_ix);
+ cx_pushloop_for(cx, itervarp, itersave);
- 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 :
PP(pp_enterloop)
{
- dSP;
PERL_CONTEXT *cx;
- const I32 gimme = GIMME_V;
-
- PUSHBLOCK(cx, CXt_LOOP_PLAIN, SP);
- PUSHLOOP_PLAIN(cx);
+ const U8 gimme = GIMME_V;
- RETURN;
+ cx = cx_pushblock(CXt_LOOP_PLAIN, gimme, PL_stack_sp, PL_savestack_ix);
+ cx_pushloop_plain(cx);
+ return NORMAL;
}
+
PP(pp_leaveloop)
{
PERL_CONTEXT *cx;
- I32 gimme;
- SV **newsp;
+ U8 gimme;
+ SV **oldsp;
SV **mark;
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 ... */
- POPBLOCK(cx);
+ cx_poploop(cx); /* Stack values are safe: release loop vars ... */
+ cx_popblock(cx);
CX_POP(cx);
return NORMAL;
*
* Any changes made to this function may need to be copied to pp_leavesub
* and vice-versa.
+ *
+ * also tail-called by pp_return
*/
PP(pp_leavesublv)
{
- I32 gimme;
+ U8 gimme;
PERL_CONTEXT *cx;
SV **oldsp;
OP *retop;
}
ok:
- leave_adjust_stacks(oldsp, gimme, is_lval ? 3 : 2);
+ leave_adjust_stacks(oldsp, oldsp, gimme, is_lval ? 3 : 2);
if (lval & OPpDEREF) {
/* lval_sub()->{...} and similar */
}
}
- leave_adjust_stacks(oldsp, gimme, is_lval ? 3 : 2);
+ leave_adjust_stacks(oldsp, oldsp, gimme, is_lval ? 3 : 2);
}
}
CX_LEAVE_SCOPE(cx);
- POPSUB(cx); /* Stack values are safe: release CV and @_ ... */
- POPBLOCK(cx);
+ cx_popsub(cx); /* Stack values are safe: release CV and @_ ... */
+ cx_popblock(cx);
retop = cx->blk_sub.retop;
CX_POP(cx);
}
/* There are contexts that need popping. Doing this may free the
- * return value(s), so preserve them first, e.g. popping the plain
+ * 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. 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.
+ * leaves 1,2,3,4 on the stack. Both these actions will be done by
+ * leave_adjust_stacks(), along with freeing any temps. Note that
+ * whoever we tail-call (e.g. pp_leaveeval) will also call
+ * leave_adjust_stacks(); however, the second call is likely to
+ * just see a bunch of SvTEMPs with a ref count of 1, and so just
+ * pass them through, rather than copying them again. So this
+ * isn't as inefficient as it sounds.
*/
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,
+ CxTYPE(cx) == CXt_SUB && CvLVALUE(cx->blk_sub.cv)
+ ? 3 : 0);
SPAGAIN;
dounwind(cxix);
cx = &cxstack[cxix]; /* CX stack may have been realloced */
}
}
+/* find the enclosing loop or labelled loop and dounwind() back to it. */
-static I32
-S_unwind_loop(pTHX_ const char * const opname)
+static PERL_CONTEXT *
+S_unwind_loop(pTHX)
{
I32 cxix;
if (PL_op->op_flags & OPf_SPECIAL) {
cxix = dopoptoloop(cxstack_ix);
if (cxix < 0)
/* diag_listed_as: Can't "last" outside a loop block */
- Perl_croak(aTHX_ "Can't \"%s\" outside a loop block", opname);
+ Perl_croak(aTHX_ "Can't \"%s\" outside a loop block",
+ OP_NAME(PL_op));
}
else {
dSP;
if (cxix < 0)
/* diag_listed_as: Label not found for "last %s" */
Perl_croak(aTHX_ "Label not found for \"%s %"SVf"\"",
- opname,
+ OP_NAME(PL_op),
SVfARG(PL_op->op_flags & OPf_STACKED
&& !SvGMAGICAL(TOPp1s)
? TOPp1s
}
if (cxix < cxstack_ix)
dounwind(cxix);
- return cxix;
+ return &cxstack[cxix];
}
+
PP(pp_last)
{
PERL_CONTEXT *cx;
OP* nextop;
- S_unwind_loop(aTHX_ "last");
-
- cx = CX_CUR();
+ cx = S_unwind_loop(aTHX);
assert(CxTYPE_is_LOOP(cx));
PL_stack_sp = PL_stack_base
/* Stack values are safe: */
CX_LEAVE_SCOPE(cx);
- POPLOOP(cx); /* release loop vars ... */
- POPBLOCK(cx);
+ cx_poploop(cx); /* release loop vars ... */
+ cx_popblock(cx);
nextop = cx->blk_loop.my_op->op_lastop->op_next;
CX_POP(cx);
{
PERL_CONTEXT *cx;
- S_unwind_loop(aTHX_ "next");
-
+ /* if not a bare 'next' in the main scope, search for it */
cx = CX_CUR();
- TOPBLOCK(cx);
+ if (!((PL_op->op_flags & OPf_SPECIAL) && CxTYPE_is_LOOP(cx)))
+ cx = S_unwind_loop(aTHX);
+
+ cx_topblock(cx);
PL_curcop = cx->blk_oldcop;
PERL_ASYNC_CHECK();
return (cx)->blk_loop.my_op->op_nextop;
PP(pp_redo)
{
- const I32 cxix = S_unwind_loop(aTHX_ "redo");
- PERL_CONTEXT *cx;
- OP* redo_op = cxstack[cxix].blk_loop.my_op->op_redoop;
+ PERL_CONTEXT *cx = S_unwind_loop(aTHX);
+ OP* redo_op = cx->blk_loop.my_op->op_redoop;
if (redo_op->op_type == OP_ENTER) {
/* pop one less context to avoid $x being freed in while (my $x..) */
cxstack_ix++;
- assert(CxTYPE(CX_CUR()) == CXt_BLOCK);
+ cx = CX_CUR();
+ assert(CxTYPE(cx) == CXt_BLOCK);
redo_op = redo_op->op_next;
}
- cx = CX_CUR();
- TOPBLOCK(cx);
- CX_LEAVE_SCOPE(cx);
FREETMPS;
+ CX_LEAVE_SCOPE(cx);
+ cx_topblock(cx);
PL_curcop = cx->blk_oldcop;
PERL_ASYNC_CHECK();
return redo_op;
dounwind(cxix);
}
cx = CX_CUR();
- TOPBLOCK(cx);
+ cx_topblock(cx);
SPAGAIN;
/* protect @_ during save stack unwind. */
CX_LEAVE_SCOPE(cx);
if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) {
- /* this is POPSUB_ARGS() with minor variations */
+ /* this is part of cx_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();
+ CX_POP_SAVEARRAY(cx);
}
retop = cx->blk_sub.retop;
PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL;
/* 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 */
+ * this is a cx_popblock(), less all the stuff we already did
+ * for cx_topblock() earlier */
PL_curcop = cx->blk_oldcop;
CX_POP(cx);
SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
- /* partial unrolled PUSHSUB(): */
+ /* partial unrolled cx_pushsub(): */
cx->blk_sub.cv = cv;
cx->blk_sub.olddepth = CvDEPTH(cv);
DIE(aTHX_ "panic: docatch: illegal ix=%ld", (long)ix);
dounwind(ix);
cx = CX_CUR();
- TOPBLOCK(cx);
+ cx_topblock(cx);
}
/* push wanted frames */
*/
STATIC bool
-S_doeval_compile(pTHX_ int gimme, CV* outside, U32 seq, HV *hh)
+S_doeval_compile(pTHX_ U8 gimme, CV* outside, U32 seq, HV *hh)
{
dSP;
OP * const saveop = PL_op;
SP = PL_stack_base + POPMARK; /* pop original mark */
cx = CX_CUR();
CX_LEAVE_SCOPE(cx);
- POPEVAL(cx);
- POPBLOCK(cx);
+ cx_popeval(cx);
+ cx_popblock(cx);
if (in_require)
namesv = cx->blk_eval.old_namesv;
CX_POP(cx);
#endif
const char *tryname = NULL;
SV *namesv = NULL;
- const I32 gimme = GIMME_V;
+ const U8 gimme = GIMME_V;
int filter_has_file = 0;
PerlIO *tryrsfp = NULL;
SV *filter_cache = NULL;
}
}
- LOADING_FILE_PROBE(unixname);
+ PERL_DTRACE_PROBE_FILE_LOADING(unixname);
/* prepare to compile file */
}
/* switch to eval mode */
- PUSHBLOCK(cx, CXt_EVAL, SP);
- PUSHEVAL(cx, name);
- cx->blk_oldsaveix = old_savestack_ix;
- cx->blk_eval.retop = PL_op->op_next;
+ cx = cx_pushblock(CXt_EVAL, gimme, SP, old_savestack_ix);
+ cx_pusheval(cx, PL_op->op_next, newSVpv(name, 0));
SAVECOPLINE(&PL_compiling);
CopLINE_set(&PL_compiling, 0);
else
op = PL_op->op_next;
- LOADED_FILE_PROBE(unixname);
+ PERL_DTRACE_PROBE_FILE_LOADED(unixname);
return op;
}
dSP;
PERL_CONTEXT *cx;
SV *sv;
- const I32 gimme = GIMME_V;
+ const U8 gimme = GIMME_V;
const U32 was = PL_breakable_sub_gen;
char tbuf[TYPE_DIGITS(long) + 12];
bool saved_delete = FALSE;
* to do the dirty work for us */
runcv = find_runcv(&seq);
- PUSHBLOCK(cx, (CXt_EVAL|CXp_REAL), SP);
- PUSHEVAL(cx, 0);
- cx->blk_oldsaveix = old_savestack_ix;
- cx->blk_eval.retop = PL_op->op_next;
+ cx = cx_pushblock((CXt_EVAL|CXp_REAL), gimme, SP, old_savestack_ix);
+ cx_pusheval(cx, PL_op->op_next, NULL);
/* prepare to compile string */
}
}
+
+/* also tail-called by pp_return */
+
PP(pp_leaveeval)
{
- SV **newsp;
- I32 gimme;
+ SV **oldsp;
+ U8 gimme;
PERL_CONTEXT *cx;
OP *retop;
SV *namesv = NULL;
CV *evalcv;
- /* grab this value before POPEVAL restores old PL_in_eval */
+ /* grab this value before cx_popeval restores old PL_in_eval */
bool keep = cBOOL(PL_in_eval & EVAL_KEEPERR);
PERL_ASYNC_CHECK();
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
+ /* the cx_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
PL_curcop = cx->blk_oldcop;
CX_LEAVE_SCOPE(cx);
- POPEVAL(cx);
- POPBLOCK(cx);
+ cx_popeval(cx);
+ cx_popblock(cx);
retop = cx->blk_eval.retop;
evalcv = cx->blk_eval.cv;
CX_POP(cx);
cx = CX_CUR();
CX_LEAVE_SCOPE(cx);
- POPEVAL(cx);
- POPBLOCK(cx);
+ cx_popeval(cx);
+ cx_popblock(cx);
CX_POP(cx);
}
/* Common-ish code salvaged from Perl_call_sv and pp_entertry, because it was
also needed by Perl_fold_constants. */
-PERL_CONTEXT *
-Perl_create_eval_scope(pTHX_ U32 flags)
+void
+Perl_create_eval_scope(pTHX_ OP *retop, U32 flags)
{
PERL_CONTEXT *cx;
- const I32 gimme = GIMME_V;
+ const U8 gimme = GIMME_V;
- PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), PL_stack_sp);
- PUSHEVAL(cx, 0);
- cx->blk_oldsaveix = PL_savestack_ix;
+ cx = cx_pushblock((CXt_EVAL|CXp_TRYBLOCK), gimme,
+ PL_stack_sp, PL_savestack_ix);
+ cx_pusheval(cx, retop, NULL);
PL_in_eval = EVAL_INEVAL;
if (flags & G_KEEPERR)
if (flags & G_FAKINGEVAL) {
PL_eval_root = PL_op; /* Only needed so that goto works right. */
}
- return cx;
}
PP(pp_entertry)
{
- PERL_CONTEXT * const cx = create_eval_scope(0);
- cx->blk_eval.retop = cLOGOP->op_other->op_next;
+ create_eval_scope(cLOGOP->op_other->op_next, 0);
return DOCATCH(PL_op->op_next);
}
+
+/* also tail-called by pp_return */
+
PP(pp_leavetry)
{
- SV **newsp;
- I32 gimme;
+ SV **oldsp;
+ U8 gimme;
PERL_CONTEXT *cx;
OP *retop;
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);
+ cx_popeval(cx);
+ cx_popblock(cx);
retop = cx->blk_eval.retop;
CX_POP(cx);
{
dSP;
PERL_CONTEXT *cx;
- const I32 gimme = GIMME_V;
+ const U8 gimme = GIMME_V;
SV *origsv = DEFSV;
SV *newsv = POPs;
assert(!PL_op->op_targ); /* used to be set for lexical $_ */
GvSV(PL_defgv) = SvREFCNT_inc(newsv);
- PUSHBLOCK(cx, CXt_GIVEN, SP);
- PUSHGIVEN(cx, origsv);
+ cx = cx_pushblock(CXt_GIVEN, gimme, SP, PL_savestack_ix);
+ cx_pushgiven(cx, origsv);
RETURN;
}
PP(pp_leavegiven)
{
PERL_CONTEXT *cx;
- I32 gimme;
- SV **newsp;
+ U8 gimme;
+ SV **oldsp;
PERL_UNUSED_CONTEXT;
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);
- POPBLOCK(cx);
+ cx_popgiven(cx);
+ cx_popblock(cx);
CX_POP(cx);
return NORMAL;
{
dSP;
PERL_CONTEXT *cx;
- const I32 gimme = GIMME_V;
+ const U8 gimme = GIMME_V;
/* This is essentially an optimization: if the match
fails, we don't want to push a context and then
to the op that follows the leavewhen.
RETURNOP calls PUTBACK which restores the stack pointer after the POPs.
*/
- if ((0 == (PL_op->op_flags & OPf_SPECIAL)) && !SvTRUEx(POPs))
+ if (!(PL_op->op_flags & OPf_SPECIAL) && !SvTRUEx(POPs))
RETURNOP(cLOGOP->op_other->op_next);
- PUSHBLOCK(cx, CXt_WHEN, SP);
- PUSHWHEN(cx);
+ cx = cx_pushblock(CXt_WHEN, gimme, SP, PL_savestack_ix);
+ cx_pushwhen(cx);
RETURN;
}
{
I32 cxix;
PERL_CONTEXT *cx;
- I32 gimme;
- SV **newsp;
+ U8 gimme;
+ SV **oldsp;
cx = CX_CUR();
assert(CxTYPE(cx) == CXt_WHEN);
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);
/* 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);
+ cx_topblock(cx);
PL_curcop = cx->blk_oldcop;
return cx->blk_loop.my_op->op_nextop;
}
assert(CxTYPE(cx) == CXt_WHEN);
PL_stack_sp = PL_stack_base + cx->blk_oldsp;
CX_LEAVE_SCOPE(cx);
- POPWHEN(cx);
- POPBLOCK(cx);
+ cx_popwhen(cx);
+ cx_popblock(cx);
nextop = cx->blk_givwhen.leave_op->op_next;
CX_POP(cx);
/* Restore the sp at the time we entered the given block */
cx = CX_CUR();
- TOPBLOCK(cx);
+ PL_stack_sp = PL_stack_base + cx->blk_oldsp;
return cx->blk_givwhen.leave_op;
}
https://perl5.git.perl.org / perl5.git / blobdiff