Preparation Patches for Refcounted Stack Patch.

deb.c

@@ -320,7 +320,10 @@ Perl_deb_stack_all(pTHX)
                     }
                     if (CxTYPE(&(si_n->si_cxstack[i])) == CXt_SUBST)
                         continue;
-                    cx_n = &(si_n->si_cxstack[i]);
+                    if (si_n->si_cxix >= 0)
+                        cx_n = &(si_n->si_cxstack[i]);
+                    else
+                        cx_n = NULL;
                     break;
                 }
 

dump.c

@@ -536,10 +536,12 @@ Perl_sv_peek(pTHX_ SV *sv)
                 break;
             }
         }
-        if (is_tmp || SvREFCNT(sv) > 1) {
+        if (is_tmp || SvREFCNT(sv) > 1 || SvPADTMP(sv)) {
             Perl_sv_catpvf(aTHX_ t, "<");
             if (SvREFCNT(sv) > 1)
                 Perl_sv_catpvf(aTHX_ t, "%" UVuf, (UV)SvREFCNT(sv));
+            if (SvPADTMP(sv))
+                Perl_sv_catpvf(aTHX_ t, "%s",  "P");
             if (is_tmp)
                 Perl_sv_catpvf(aTHX_ t, "%s", SvTEMP(t) ? "T" : "t");
             Perl_sv_catpvf(aTHX_ t, ">");

ext/XS-APItest/APItest.xs

@@ -2566,19 +2566,27 @@ test_EXTEND(max_offset, nsv, use_ss)
     SV  *nsv;
     bool use_ss;
 PREINIT:
-    SV **sp = PL_stack_max + max_offset;
+    SV **new_sp = PL_stack_max + max_offset;
+    SSize_t new_offset = new_sp - PL_stack_base;
 PPCODE:
     if (use_ss) {
         SSize_t n = (SSize_t)SvIV(nsv);
-        EXTEND(sp, n);
-        *(sp + n) = NULL;
+        EXTEND(new_sp, n);
+        new_sp = PL_stack_base + new_offset;
+        assert(new_sp + n <= PL_stack_max);
+        if ((new_sp + n) > PL_stack_sp)
+            *(new_sp + n) = NULL;
     }
     else {
         IV n = SvIV(nsv);
-        EXTEND(sp, n);
-        *(sp + n) = NULL;
+        EXTEND(new_sp, n);
+        new_sp = PL_stack_base + new_offset;
+        assert(new_sp + n <= PL_stack_max);
+        if ((new_sp + n) > PL_stack_sp)
+            *(new_sp + n) = NULL;
     }
-    *PL_stack_max = NULL;
+    if (PL_stack_max > PL_stack_sp)
+        *PL_stack_max = NULL;
 
 
 void

ext/XS-APItest/t/magic.t

@@ -101,12 +101,17 @@ is $@, "", 'PERL_MAGIC_ext is permitted on read-only things';
             $j = "blorp";
             my_av_store(\@a,0,$j);
         };
-        my $base_refcount = 2; # not sure where these come from.
-        if (\$a[0] == \$j) {
-            # in this case we expect to have an extra 2 refcounts,
+
+        # Evaluate this boolean as a separate statement, so the two
+        # temporary \ refs are freed before we start comparing reference
+        # counts
+        my $is_same_SV = \$a[0] == \$j;
+
+        if ($is_same_SV) {
+            # in this case we expect to have 2 refcounts,
             # one from $a[0] and one from $j itself.
-            is( sv_refcnt($j), $base_refcount + 2,
-                "\$a[0] is \$j, so refcount(\$j) should be 4");
+            is( sv_refcnt($j), 2,
+                "\$a[0] is \$j, so refcount(\$j) should be 2");
         } else {
             # Note this branch isn't exercised. Whether by design
             # or not. I leave it here because it is a possible valid
@@ -115,10 +120,10 @@ is $@, "", 'PERL_MAGIC_ext is permitted on read-only things';
             diag "av_store has changed behavior - please review this test";
             TODO:{
                 local $TODO = "av_store bug stores even if it dies during magic";
-                # in this case we expect to have only 1 extra refcount,
+                # in this case we expect to have only 1 refcount,
                 # from $j itself.
-                is( sv_refcnt($j), $base_refcount + 1,
-                    "\$a[0] is not \$j, so refcount(\$j) should be 3");
+                is( sv_refcnt($j), 1,
+                    "\$a[0] is not \$j, so refcount(\$j) should be 1");
             }
         }
     }

gv.c

@@ -4079,7 +4079,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
 
   {
     dSP;
-    BINOP myop;
+    UNOP myop;
     SV* res;
     const bool oldcatch = CATCH_GET;
     I32 oldmark, nret;
@@ -4091,10 +4091,11 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
                     ? G_SCALAR : GIMME_V;
 
     CATCH_SET(TRUE);
-    Zero(&myop, 1, BINOP);
-    myop.op_last = (OP *) &myop;
-    myop.op_next = NULL;
+    Zero(&myop, 1, UNOP);
     myop.op_flags = OPf_STACKED;
+    myop.op_ppaddr = PL_ppaddr[OP_ENTERSUB];
+    myop.op_type = OP_ENTERSUB;
+
 
     switch (gimme) {
         case G_VOID:
@@ -4134,9 +4135,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
     PUSHs(MUTABLE_SV(cv));
     PUTBACK;
     oldmark = TOPMARK;
-
-    if ((PL_op = PL_ppaddr[OP_ENTERSUB](aTHX)))
-      CALLRUNOPS(aTHX);
+    CALLRUNOPS(aTHX);
     LEAVE;
     SPAGAIN;
     nret = SP - (PL_stack_base + oldmark);

inline.h

@@ -3057,6 +3057,8 @@ Perl_cx_poploop(pTHX_ PERL_CONTEXT *cx)
         cx->blk_loop.itersave = NULL;
         SvREFCNT_dec(cursv);
     }
+    if (cx->cx_type & (CXp_FOR_GV|CXp_FOR_LVREF))
+        SvREFCNT_dec(cx->blk_loop.itervar_u.svp);
 }