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)
}
/* dounwind(): pop all contexts above (but not including) cxix.
- * Leaves cxstack_ix equal to cxix. Note that for efficiency, it doesn't
- * call POPBLOCK at all; the caller should do
- * CX_LEAVE_SCOPE; POPFOO; POPBLOCK
- * or
- * TOPBLOCK
- * as appropriate.
+ * Note that it clears the savestack frame associated with each popped
+ * context entry, but doesn't free any temps.
+ * It does a POPBLOCK of the last frame that it pops, and leaves
+ * cxstack_ix equal to cxix.
*/
void
POPFORMAT(cx);
break;
}
+ if (cxstack_ix == cxix + 1) {
+ POPBLOCK(cx);
+ }
cxstack_ix--;
}
+
}
void
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;
}
}
-
- if (PL_op->op_private & OPpITER_DEF)
- cxflags |= CXp_FOR_DEF;
+ /* OPpITER_DEF (implicit $_) should only occur with a GV iter var */
+ assert((cxflags & CXp_FOR_GV) || !(PL_op->op_private & OPpITER_DEF));
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 :
PUTBACK;
if (cx->blk_gimme != G_VOID)
leave_adjust_stacks(MARK, PL_stack_base + cx->blk_oldsp,
- cx->blk_gimme, 3);
+ 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
{
PERL_CONTEXT *cx;
- S_unwind_loop(aTHX_ "next");
-
+ /* if not a bare 'next' in the main scope, search for it */
cx = CX_CUR();
+ if (!((PL_op->op_flags & OPf_SPECIAL) && CxTYPE_is_LOOP(cx)))
+ cx = S_unwind_loop(aTHX);
+
TOPBLOCK(cx);
PL_curcop = cx->blk_oldcop;
PERL_ASYNC_CHECK();
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);
if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) {
- /* this is POPSUB_ARGS() with minor variations */
+ /* this is part of 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();
+ POP_SAVEARRAY(cx);
}
retop = cx->blk_sub.retop;
/* 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