This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
pp_given: avoid using savestack for old var
[perl5.git] / pp_ctl.c
index 1fc7ac5..a1e7329 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1519,8 +1519,8 @@ Perl_dounwind(pTHX_ I32 cxix)
            break;
        case CXt_EVAL:
            POPEVAL(cx);
-            LEAVE_SCOPE(cx->blk_eval.old_savestack_ix);
-            PL_tmps_floor = cx->blk_eval.old_tmpsfloor;
+            LEAVE_SCOPE(cx->cx_u.cx_blk.blku_old_savestack_ix);
+            PL_tmps_floor = cx->cx_u.cx_blk.blku_old_tmpsfloor;
            break;
        case CXt_LOOP_LAZYIV:
        case CXt_LOOP_LAZYSV:
@@ -1528,6 +1528,12 @@ Perl_dounwind(pTHX_ I32 cxix)
        case CXt_LOOP_PLAIN:
            POPLOOP(cx);
            break;
+       case CXt_WHEN:
+           POPWHEN(cx);
+           break;
+       case CXt_GIVEN:
+           POPGIVEN(cx);
+           break;
        case CXt_NULL:
            break;
        case CXt_FORMAT:
@@ -1651,8 +1657,8 @@ Perl_die_unwind(pTHX_ SV *msv)
                *++newsp = &PL_sv_undef;
            PL_stack_sp = newsp;
 
-            LEAVE_SCOPE(cx->blk_eval.old_savestack_ix);
-            PL_tmps_floor = cx->blk_eval.old_tmpsfloor;
+            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);
@@ -1974,7 +1980,7 @@ PP(pp_dbstate)
            PUSHBLOCK(cx, CXt_SUB, SP);
            PUSHSUB_DB(cx);
            cx->blk_sub.retop = PL_op->op_next;
-            cx->blk_sub.old_savestack_ix = PL_savestack_ix;
+            cx->cx_u.cx_blk.blku_old_savestack_ix = PL_savestack_ix;
 
             SAVEI32(PL_debug);
             PL_debug = 0;
@@ -2117,7 +2123,7 @@ PP(pp_enteriter)
     dSP; dMARK;
     PERL_CONTEXT *cx;
     const I32 gimme = GIMME_V;
-    void *itervar; /* location of the iteration variable */
+    void *itervarp; /* GV or pad slot of the iteration variable */
     SV   *itersave; /* the old var in the iterator var slot */
     U8 cxtype = CXt_LOOP_FOR;
 
@@ -2125,31 +2131,37 @@ PP(pp_enteriter)
     SAVETMPS;
 
     if (PL_op->op_targ) {                       /* "my" variable */
-       itervar = &PAD_SVl(PL_op->op_targ);
+       itervarp = &PAD_SVl(PL_op->op_targ);
+        itersave = *(SV**)itervarp;
+        assert(itersave);
        if (PL_op->op_private & OPpLVAL_INTRO) {        /* for my $x (...) */
             /* the SV currently in the pad slot is never live during
              * iteration (the slot is always aliased to one of the items)
              * so it's always stale */
-           SvPADSTALE_on(*(SV**)itervar);
+           SvPADSTALE_on(itersave);
        }
-        itersave = SvREFCNT_inc(*(SV**)itervar);
-        assert(itersave);
-    }
-    else if (LIKELY(isGV(TOPs))) {             /* symbol table variable */
-       GV * const gv = MUTABLE_GV(POPs);
-       SV** svp = &GvSV(gv);
-        itersave = SvREFCNT_inc(*svp);
-       *svp = newSV(0);
-       itervar = (void *)gv;
+        SvREFCNT_inc_simple_void_NN(itersave);
+       cxtype |= CXp_FOR_PAD;
     }
     else {
        SV * const sv = POPs;
-       assert(SvTYPE(sv) == SVt_PVMG);
-       assert(SvMAGIC(sv));
-       assert(SvMAGIC(sv)->mg_type == PERL_MAGIC_lvref);
-       itervar = (void *)sv;
-       cxtype |= CXp_FOR_LVREF;
-        itersave = NULL;
+       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);
+            cxtype |= CXp_FOR_GV;
+        }
+        else {                          /* LV ref: for \$foo (...) */
+            assert(SvTYPE(sv) == SVt_PVMG);
+            assert(SvMAGIC(sv));
+            assert(SvMAGIC(sv)->mg_type == PERL_MAGIC_lvref);
+            itersave = NULL;
+            cxtype |= CXp_FOR_LVREF;
+        }
     }
 
     if (PL_op->op_private & OPpITER_DEF)
@@ -2158,7 +2170,7 @@ PP(pp_enteriter)
     ENTER_with_name("loop2");
 
     PUSHBLOCK(cx, cxtype, SP);
-    PUSHLOOP_FOR(cx, itervar, itersave, MARK);
+    PUSHLOOP_FOR(cx, itervarp, itersave, MARK);
     if (PL_op->op_flags & OPf_STACKED) {
        SV *maybe_ary = POPs;
        if (SvTYPE(maybe_ary) != SVt_PVAV) {
@@ -2764,7 +2776,7 @@ PP(pp_goto)
                 SvREFCNT_inc_NN(sv_2mortal(MUTABLE_SV(arg)));
 
            assert(PL_scopestack_ix == cx->blk_oldscopesp);
-            LEAVE_SCOPE(cx->blk_sub.old_savestack_ix);
+            LEAVE_SCOPE(cx->cx_u.cx_blk.blku_old_savestack_ix);
 
            if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) {
                AV* av = MUTABLE_AV(PAD_SVl(0));
@@ -3452,8 +3464,8 @@ S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh)
            POPEVAL(cx);
            namesv = cx->blk_eval.old_namesv;
            /* POPBLOCK has rendered LEAVE_with_name("evalcomp") unnecessary */
-            LEAVE_SCOPE(cx->blk_eval.old_savestack_ix);
-            PL_tmps_floor = cx->blk_eval.old_tmpsfloor;
+            LEAVE_SCOPE(cx->cx_u.cx_blk.blku_old_savestack_ix);
+            PL_tmps_floor = cx->cx_u.cx_blk.blku_old_tmpsfloor;
        }
 
        errsv = ERRSV;
@@ -4104,7 +4116,7 @@ PP(pp_require)
     /* switch to eval mode */
     PUSHBLOCK(cx, CXt_EVAL, SP);
     PUSHEVAL(cx, name);
-    cx->blk_eval.old_savestack_ix = old_savestack_ix;
+    cx->cx_u.cx_blk.blku_old_savestack_ix = old_savestack_ix;
     cx->blk_eval.retop = PL_op->op_next;
 
     SAVECOPLINE(&PL_compiling);
@@ -4220,7 +4232,7 @@ PP(pp_entereval)
 
     PUSHBLOCK(cx, (CXt_EVAL|CXp_REAL), SP);
     PUSHEVAL(cx, 0);
-    cx->blk_eval.old_savestack_ix = old_savestack_ix;
+    cx->cx_u.cx_blk.blku_old_savestack_ix = old_savestack_ix;
     cx->blk_eval.retop = PL_op->op_next;
 
     /* prepare to compile string */
@@ -4302,15 +4314,15 @@ PP(pp_leaveeval)
                        SvPVX_const(namesv),
                         SvUTF8(namesv) ? -(I32)SvCUR(namesv) : (I32)SvCUR(namesv),
                        G_DISCARD);
-        LEAVE_SCOPE(cx->blk_eval.old_savestack_ix);
-        PL_tmps_floor = cx->blk_eval.old_tmpsfloor;
+        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->blk_eval.old_savestack_ix);
-        PL_tmps_floor = cx->blk_eval.old_tmpsfloor;
+        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();
     }
@@ -4332,8 +4344,8 @@ Perl_delete_eval_scope(pTHX)
     POPBLOCK(cx,newpm);
     POPEVAL(cx);
     PL_curpm = newpm;
-    LEAVE_SCOPE(cx->blk_eval.old_savestack_ix);
-    PL_tmps_floor = cx->blk_eval.old_tmpsfloor;
+    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);
     PERL_UNUSED_VAR(optype);
@@ -4349,7 +4361,7 @@ Perl_create_eval_scope(pTHX_ U32 flags)
        
     PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), PL_stack_sp);
     PUSHEVAL(cx, 0);
-    cx->blk_eval.old_savestack_ix = PL_savestack_ix;
+    cx->cx_u.cx_blk.blku_old_savestack_ix = PL_savestack_ix;
 
     PL_in_eval = EVAL_INEVAL;
     if (flags & G_KEEPERR)
@@ -4391,8 +4403,8 @@ PP(pp_leavetry)
                               SVs_PADTMP|SVs_TEMP, FALSE);
     PL_curpm = newpm;  /* Don't pop $1 et al till now */
 
-    LEAVE_SCOPE(cx->blk_eval.old_savestack_ix);
-    PL_tmps_floor = cx->blk_eval.old_tmpsfloor;
+    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);
@@ -4403,16 +4415,17 @@ PP(pp_entergiven)
     dSP;
     PERL_CONTEXT *cx;
     const I32 gimme = GIMME_V;
+    SV *origsv = DEFSV;
+    SV *newsv = POPs;
     
     ENTER_with_name("given");
     SAVETMPS;
 
     assert(!PL_op->op_targ); /* used to be set for lexical $_ */
-    SAVE_DEFSV;
-    DEFSV_set(POPs);
+    GvSV(PL_defgv) = SvREFCNT_inc(newsv);
 
     PUSHBLOCK(cx, CXt_GIVEN, SP);
-    PUSHGIVEN(cx);
+    PUSHGIVEN(cx, origsv);
 
     RETURN;
 }
@@ -4427,6 +4440,7 @@ PP(pp_leavegiven)
     PERL_UNUSED_CONTEXT;
 
     POPBLOCK(cx,newpm);
+    POPGIVEN(cx);
     assert(CxTYPE(cx) == CXt_GIVEN);
 
     SP = (gimme == G_VOID)
@@ -5014,6 +5028,7 @@ PP(pp_leavewhen)
 
     POPBLOCK(cx,newpm);
     assert(CxTYPE(cx) == CXt_WHEN);
+    POPWHEN(cx);
 
     SP = (gimme == G_VOID)
         ? newsp