PP(pp_rv2av)
{
dSP; dTOPss;
- const I32 gimme = GIMME_V;
+ const U8 gimme = GIMME_V;
static const char an_array[] = "an ARRAY";
static const char a_hash[] = "a HASH";
const bool is_pp_rv2av = PL_op->op_type == OP_RV2AV
SV *sv;
AV *ary;
- I32 gimme;
+ U8 gimme;
HV *hash;
SSize_t i;
int magic;
const char *truebase; /* Start of string */
REGEXP *rx = PM_GETRE(pm);
bool rxtainted;
- const I32 gimme = GIMME_V;
+ const U8 gimme = GIMME_V;
STRLEN len;
const I32 oldsave = PL_savestack_ix;
I32 had_zerolen = 0;
PerlIO *fp;
IO * const io = GvIO(PL_last_in_gv);
const I32 type = PL_op->op_type;
- const I32 gimme = GIMME_V;
+ const U8 gimme = GIMME_V;
if (io) {
const MAGIC *const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
SV **itersvp;
SV *retsv;
+ SV *sv;
+ AV *av;
+ IV ix;
+ IV inc;
+
cx = CX_CUR();
itersvp = CxITERVAR(cx);
+ assert(itersvp);
switch (CxTYPE(cx)) {
break;
}
- {
- SV *sv;
- AV *av;
- IV ix;
- IV inc;
-
case CXt_LOOP_LIST: /* for (1,2,3) */
assert(OPpITER_REVERSED == 2); /* so inc becomes -1 or 1 */
*itersvp = sv;
SvREFCNT_dec(oldsv);
break;
- }
default:
DIE(aTHX_ "panic: pp_iter, type=%u", CxTYPE(cx));
*++PL_stack_sp =retsv;
return PL_op->op_next;
-
-
}
/*
* searching for places in this sub that uses a particular var:
* iters maxiters r_flags oldsave rxtainted orig dstr targ
* s m strend rx once */
- PUSHSUBST(cx);
+ CX_PUSHSUBST(cx);
RETURNOP(cPMOP->op_pmreplrootu.op_pmreplroot);
}
first = TRUE;
/* All done yet? */
if (UNLIKELY(PL_stack_base + *PL_markstack_ptr > SP)) {
I32 items;
- const I32 gimme = GIMME_V;
+ const U8 gimme = GIMME_V;
LEAVE_with_name("grep"); /* exit outer scope */
(void)POPMARK; /* pop src */
*/
void
-Perl_leave_adjust_stacks(pTHX_ SV **from_sp, SV **to_sp, I32 gimme, int pass)
+Perl_leave_adjust_stacks(pTHX_ SV **from_sp, SV **to_sp, U8 gimme, int pass)
{
+ dVAR;
dSP;
SSize_t tmps_base; /* lowest index into tmps stack that needs freeing now */
SSize_t nargs;
EXTEND_MORTAL(nargs); /* one big extend for worst-case scenario */
tmps_basep = PL_tmps_stack + tmps_base;
- /* whether any SVs have have SvTEMP temporarily turned off,
- * indicating that they need saving below the cut */
/* process each return arg */
* 1) there is pp code similar to pp_substr that is
* returning a PADTMP instead of a mortal, and probably
* needs fixing, or
- * 2) pp_leavesub is making unwarranted assumptions
+ * 2) pp_leavesublv is making unwarranted assumptions
* about always croaking on a PADTMP
*/
if (SvPADTMP(sv) && SvSMAGICAL(sv)) {
* merely by moving the cut boundary up one, rather
* than messing with SvTEMP. If all args are 1:1 then
* we can avoid the sorting stage below completely.
+ *
+ * If there are no items above the cut on the tmps
+ * stack, then the SvTEMP must comne from an item
+ * below the cut, so there's nothing to do.
*/
- if (sv == *tmps_basep)
- tmps_basep++;
- else
- SvTEMP_off(sv);
+ if (tmps_basep <= &PL_tmps_stack[PL_tmps_ix]) {
+ if (sv == *tmps_basep)
+ tmps_basep++;
+ else
+ SvTEMP_off(sv);
+ }
}
else if (!SvPADTMP(sv)) {
/* mortalise arg to avoid it being freed during save
* stack unwinding. Pad tmps don't need mortalising as
- * they're never freed */
- SvREFCNT_inc_simple_void_NN(sv);
- /* equivalent of sv_2mortal(), except that:
+ * they're never freed. This is the equivalent of
+ * sv_2mortal(SvREFCNT_inc(sv)), except that:
* * it assumes that the temps stack has already been
* extended;
* * it puts the new item at the cut rather than at
* instead.
*/
if (!SvIMMORTAL(sv)) {
+ SvREFCNT_inc_simple_void_NN(sv);
SvTEMP_on(sv);
+ /* Note that if there's nothing above the cut,
+ * this copies the garbage one slot above
+ * PL_tmps_ix onto itself. This is harmless (the
+ * stack's already been extended), but might in
+ * theory trigger warnings from tools like ASan
+ */
PL_tmps_stack[++PL_tmps_ix] = *tmps_basep;
*tmps_basep++ = sv;
}
PP(pp_leavesub)
{
- I32 gimme;
+ U8 gimme;
PERL_CONTEXT *cx;
SV **oldsp;
OP *retop;
leave_adjust_stacks(oldsp, oldsp, gimme, 0);
CX_LEAVE_SCOPE(cx);
- CX_POPSUB(cx); /* Stack values are safe: release CV and @_ ... */
- CX_POPBLOCK(cx);
+ cx_popsub(cx); /* Stack values are safe: release CV and @_ ... */
+ cx_popblock(cx);
retop = cx->blk_sub.retop;
CX_POP(cx);
}
/* 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
+ * cx_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
+ * cx_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 */
+ assert(cv);
assert((void*)&CvROOT(cv) == (void*)&CvXSUB(cv));
while (UNLIKELY(!CvROOT(cv))) {
GV* autogv;
PADLIST *padlist;
I32 depth;
bool hasargs;
- I32 gimme;
+ U8 gimme;
/* keep PADTMP args alive throughout the call (we need to do this
* because @_ isn't refcounted). Note that we create the mortals
}
gimme = GIMME_V;
- PUSHBLOCK(cx, CXt_SUB, gimme, MARK, old_savestack_ix);
+ cx = cx_pushblock(CXt_SUB, gimme, MARK, old_savestack_ix);
hasargs = cBOOL(PL_op->op_flags & OPf_STACKED);
- PUSHSUB(cx);
- cx->blk_sub.retop = PL_op->op_next;
+ cx_pushsub(cx, cv, PL_op->op_next, hasargs);
padlist = CvPADLIST(cv);
if (UNLIKELY((depth = ++CvDEPTH(cv)) >= 2))
/* it's the responsibility of whoever leaves a sub to ensure
* that a clean, empty AV is left in pad[0]. This is normally
- * done by CX_POPSUB() */
+ * done by cx_popsub() */
assert(!AvREAL(av) && AvFILLp(av) == -1);
items = SP - MARK;
}
else {
SSize_t markix = TOPMARK;
+ bool is_scalar;
ENTER;
/* pretend we did the ENTER earlier */
PUTBACK;
if (UNLIKELY(((PL_op->op_private
- & PUSHSUB_GET_LVALUE_MASK(Perl_is_lvalue_sub)
+ & CX_PUSHSUB_GET_LVALUE_MASK(Perl_is_lvalue_sub)
) & OPpENTERSUB_LVAL_MASK) == OPpLVAL_INTRO &&
!CvLVALUE(cv)))
DIE(aTHX_ "Can't modify non-lvalue subroutine call of &%"SVf,
}
/* Do we need to open block here? XXXX */
+ /* calculate gimme here as PL_op might get changed and then not
+ * restored until the LEAVE further down */
+ is_scalar = (GIMME_V == G_SCALAR);
+
/* CvXSUB(cv) must not be NULL because newXS() refuses NULL xsub address */
assert(CvXSUB(cv));
CvXSUB(cv)(aTHX_ cv);
/* Enforce some sanity in scalar context. */
- if (GIMME_V == G_SCALAR) {
+ if (is_scalar) {
SV **svp = PL_stack_base + markix + 1;
if (svp != PL_stack_sp) {
*svp = svp > PL_stack_sp ? &PL_sv_undef : *PL_stack_sp;
https://perl5.git.perl.org / perl5.git / blobdiff