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 CX_PUSHSUB */
+/* only used by cx_pushsub() */
I32
Perl_was_lvalue_sub(pTHX)
{
CX_POPSUBST(cx);
break;
case CXt_SUB:
- CX_POPSUB(cx);
+ cx_popsub(cx);
break;
case CXt_EVAL:
- CX_POPEVAL(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:
- CX_POPLOOP(cx);
+ cx_poploop(cx);
break;
case CXt_WHEN:
- CX_POPWHEN(cx);
+ cx_popwhen(cx);
break;
case CXt_GIVEN:
- CX_POPGIVEN(cx);
+ cx_popgiven(cx);
break;
case CXt_BLOCK:
case CXt_NULL:
/* these two don't have a POPFOO() */
break;
case CXt_FORMAT:
- CX_POPFORMAT(cx);
+ cx_popformat(cx);
break;
}
if (cxstack_ix == cxix + 1) {
SV *namesv = NULL;
PERL_CONTEXT *cx;
SV **oldsp;
- I32 gimme;
+ U8 gimme;
JMPENV *restartjmpenv;
OP *restartop;
PL_stack_sp = oldsp;
CX_LEAVE_SCOPE(cx);
- CX_POPEVAL(cx);
+ cx_popeval(cx);
cx_popblock(cx);
restartjmpenv = cx->blk_eval.cur_top_env;
restartop = cx->blk_eval.retop;
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;
}
else {
cx = cx_pushblock(CXt_SUB, gimme, SP, PL_savestack_ix);
- CX_PUSHSUB_DB(cx, cv, PL_op->op_next, 0);
+ 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;
PP(pp_enter)
{
- dSP;
- I32 gimme = GIMME_V;
+ U8 gimme = GIMME_V;
- (void)cx_pushblock(CXt_BLOCK, gimme, SP, PL_savestack_ix);
-
- RETURN;
+ (void)cx_pushblock(CXt_BLOCK, gimme, PL_stack_sp, PL_savestack_ix);
+ return NORMAL;
}
+
PP(pp_leave)
{
PERL_CONTEXT *cx;
SV **oldsp;
- I32 gimme;
+ 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;
oldsp = PL_stack_base + cx->blk_oldsp;
gimme = cx->blk_gimme;
{
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;
* 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);
+ cx_pushloop_for(cx, itervarp, itersave);
if (PL_op->op_flags & OPf_STACKED) {
/* OPf_STACKED implies either a single array: for(@), with a
PP(pp_enterloop)
{
- dSP;
PERL_CONTEXT *cx;
- const I32 gimme = GIMME_V;
+ const U8 gimme = GIMME_V;
- cx = cx_pushblock(CXt_LOOP_PLAIN, gimme, SP, PL_savestack_ix);
- CX_PUSHLOOP_PLAIN(cx);
-
- 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;
+ U8 gimme;
SV **oldsp;
SV **mark;
PL_op->op_private & OPpLVALUE ? 3 : 1);
CX_LEAVE_SCOPE(cx);
- CX_POPLOOP(cx); /* Stack values are safe: release loop vars ... */
+ cx_poploop(cx); /* Stack values are safe: release loop vars ... */
cx_popblock(cx);
CX_POP(cx);
*
* 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;
}
CX_LEAVE_SCOPE(cx);
- CX_POPSUB(cx); /* Stack values are safe: release CV and @_ ... */
+ 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_adjust_stacks(). By calling it with and lvalue "pass
- * all" action, we just bump the ref count and mortalise the args
- * that need it, do a FREETMPS. 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;
/* Stack values are safe: */
CX_LEAVE_SCOPE(cx);
- CX_POPLOOP(cx); /* release loop vars ... */
+ cx_poploop(cx); /* release loop vars ... */
cx_popblock(cx);
nextop = cx->blk_loop.my_op->op_lastop->op_next;
CX_POP(cx);
CX_LEAVE_SCOPE(cx);
if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) {
- /* this is part of CX_POPSUB_ARGS() */
+ /* this is part of cx_popsub_args() */
AV* av = MUTABLE_AV(PAD_SVl(0));
assert(AvARRAY(MUTABLE_AV(
PadlistARRAY(CvPADLIST(cx->blk_sub.cv))[
SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
- /* partial unrolled CX_PUSHSUB(): */
+ /* partial unrolled cx_pushsub(): */
cx->blk_sub.cv = cv;
cx->blk_sub.olddepth = CvDEPTH(cv);
*/
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);
- CX_POPEVAL(cx);
+ cx_popeval(cx);
cx_popblock(cx);
if (in_require)
namesv = cx->blk_eval.old_namesv;
#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 */
cx = cx_pushblock(CXt_EVAL, gimme, SP, old_savestack_ix);
- CX_PUSHEVAL(cx, PL_op->op_next, newSVpv(name, 0));
+ 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;
runcv = find_runcv(&seq);
cx = cx_pushblock((CXt_EVAL|CXp_REAL), gimme, SP, old_savestack_ix);
- CX_PUSHEVAL(cx, PL_op->op_next, NULL);
+ cx_pusheval(cx, PL_op->op_next, NULL);
/* prepare to compile string */
}
}
+
+/* also tail-called by pp_return */
+
PP(pp_leaveeval)
{
SV **oldsp;
- I32 gimme;
+ U8 gimme;
PERL_CONTEXT *cx;
OP *retop;
SV *namesv = NULL;
CV *evalcv;
- /* grab this value before CX_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();
else
leave_adjust_stacks(oldsp, oldsp, gimme, 0);
- /* the CX_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);
- CX_POPEVAL(cx);
+ cx_popeval(cx);
cx_popblock(cx);
retop = cx->blk_eval.retop;
evalcv = cx->blk_eval.cv;
cx = CX_CUR();
CX_LEAVE_SCOPE(cx);
- CX_POPEVAL(cx);
+ cx_popeval(cx);
cx_popblock(cx);
CX_POP(cx);
}
Perl_create_eval_scope(pTHX_ OP *retop, U32 flags)
{
PERL_CONTEXT *cx;
- const I32 gimme = GIMME_V;
+ const U8 gimme = GIMME_V;
cx = cx_pushblock((CXt_EVAL|CXp_TRYBLOCK), gimme,
PL_stack_sp, PL_savestack_ix);
- CX_PUSHEVAL(cx, retop, NULL);
+ cx_pusheval(cx, retop, NULL);
PL_in_eval = EVAL_INEVAL;
if (flags & G_KEEPERR)
return DOCATCH(PL_op->op_next);
}
+
+/* also tail-called by pp_return */
+
PP(pp_leavetry)
{
SV **oldsp;
- I32 gimme;
+ U8 gimme;
PERL_CONTEXT *cx;
OP *retop;
else
leave_adjust_stacks(oldsp, oldsp, gimme, 1);
CX_LEAVE_SCOPE(cx);
- CX_POPEVAL(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;
GvSV(PL_defgv) = SvREFCNT_inc(newsv);
cx = cx_pushblock(CXt_GIVEN, gimme, SP, PL_savestack_ix);
- CX_PUSHGIVEN(cx, origsv);
+ cx_pushgiven(cx, origsv);
RETURN;
}
PP(pp_leavegiven)
{
PERL_CONTEXT *cx;
- I32 gimme;
+ U8 gimme;
SV **oldsp;
PERL_UNUSED_CONTEXT;
leave_adjust_stacks(oldsp, oldsp, gimme, 1);
CX_LEAVE_SCOPE(cx);
- CX_POPGIVEN(cx);
+ cx_popgiven(cx);
cx_popblock(cx);
CX_POP(cx);
{
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);
cx = cx_pushblock(CXt_WHEN, gimme, SP, PL_savestack_ix);
- CX_PUSHWHEN(cx);
+ cx_pushwhen(cx);
RETURN;
}
{
I32 cxix;
PERL_CONTEXT *cx;
- I32 gimme;
+ U8 gimme;
SV **oldsp;
cx = CX_CUR();
assert(CxTYPE(cx) == CXt_WHEN);
PL_stack_sp = PL_stack_base + cx->blk_oldsp;
CX_LEAVE_SCOPE(cx);
- CX_POPWHEN(cx);
+ cx_popwhen(cx);
cx_popblock(cx);
nextop = cx->blk_givwhen.leave_op->op_next;
CX_POP(cx);
https://perl5.git.perl.org / perl5.git / blobdiff