add SAVEt_CLEARPADRANGE

Add a new save type that does the equivalent of multiple SAVEt_CLEARSV's
for a given target range. This makes the new padange op more efficient.

diff --git a/op.c b/op.c
index bf1a4c6..af6a6b0 100644 (file)
--- a/op.c
+++ b/op.c
@@ -11007,6 +11007,12 @@ Perl_rpeep(pTHX_ register OP *o)
                 if (count >= OPpPADRANGE_COUNTMASK)
                     break;
 
+                /* there's a biggest base we can fit into a
+                 * SAVEt_CLEARPADRANGE in pp_padrange */
+                if (intro && base >
+                        (UV_MAX >> (OPpPADRANGE_COUNTSHIFT+SAVE_TIGHT_SHIFT)))
+                    break;
+
                 /* Success! We've got another valid pad op to optimise away */
                 count++;
                 followop = p->op_next;

diff --git a/op.h b/op.h
index 67f2b33..07ad34c 100644 (file)
--- a/op.h
+++ b/op.h
@@ -237,7 +237,8 @@ Deprecated.  Use C<GIMME_V> instead.
 
   /* OP_PADRANGE only */
   /* bit 7 is OPpLVAL_INTRO */
-#define OPpPADRANGE_COUNTMASK  127     /* bits 6..0 hold target range */
+#define OPpPADRANGE_COUNTMASK  127     /* bits 6..0 hold target range, */
+#define OPpPADRANGE_COUNTSHIFT 7       /* 7 bits in total */
 
   /* OP_RV2GV only */
 #define OPpDONT_INIT_GV                4       /* Call gv_fetchpv with GV_NOINIT */

diff --git a/pp_hot.c b/pp_hot.c
index e5ea2cc..0ef64f3 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -322,8 +322,18 @@ PP(pp_padrange)
             *++SP = PAD_SV(base+i);
     }
     if (PL_op->op_private & OPpLVAL_INTRO) {
+        SV **svp = &(PAD_SVl(base));
+        const UV payload = (UV)(
+                      (base << (OPpPADRANGE_COUNTSHIFT + SAVE_TIGHT_SHIFT))
+                    | (count << SAVE_TIGHT_SHIFT)
+                    | SAVEt_CLEARPADRANGE);
+        assert(OPpPADRANGE_COUNTMASK + 1 == (1 <<OPpPADRANGE_COUNTSHIFT));
+        assert((payload >> (OPpPADRANGE_COUNTSHIFT+SAVE_TIGHT_SHIFT)) == base);
+        SSCHECK(1);
+        SSPUSHUV(payload);
+
         for (i = 0; i <count; i++)
-            SAVECLEARSV(PAD_SVl(base+i));
+            SvPADSTALE_off(*svp++); /* mark lexical as active */
     }
     RETURN;
 }

diff --git a/scope.c b/scope.c
index 3240800..2594fca 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -892,14 +892,25 @@ Perl_leave_scope(pTHX_ I32 base)
            ptr = SSPOPPTR;
            Safefree(ptr);
            break;
+
+        {
+          SV **svp;
+        case SAVEt_CLEARPADRANGE:
+            i = (I32)((uv >> SAVE_TIGHT_SHIFT) & OPpPADRANGE_COUNTMASK);
+           svp = &PL_curpad[uv >>
+                    (OPpPADRANGE_COUNTSHIFT + SAVE_TIGHT_SHIFT)] + i - 1;
+            goto clearsv;
        case SAVEt_CLEARSV:
-           ptr = (void*)&PL_curpad[uv >> SAVE_TIGHT_SHIFT];
-           sv = *(SV**)ptr;
+           svp = &PL_curpad[uv >> SAVE_TIGHT_SHIFT];
+            i = 1;
+          clearsv:
+            for (; i; i--, svp--) {
+           sv = *svp;
 
            DEBUG_Xv(PerlIO_printf(Perl_debug_log,
             "Pad 0x%"UVxf"[0x%"UVxf"] clearsv: %ld sv=0x%"UVxf"<%"IVdf"> %s\n",
                PTR2UV(PL_comppad), PTR2UV(PL_curpad),
-               (long)((SV **)ptr-PL_curpad), PTR2UV(sv), (IV)SvREFCNT(sv),
+               (long)(svp-PL_curpad), PTR2UV(sv), (IV)SvREFCNT(sv),
                (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) ? "clear" : "abandon"
            ));
 
@@ -953,12 +964,10 @@ Perl_leave_scope(pTHX_ I32 base)
                assert(  SvFLAGS(sv) & SVs_PADMY);
                assert(!(SvFLAGS(sv) & SVs_PADTMP));
                switch (SvTYPE(sv)) {   /* Console ourselves with a new value */
-               case SVt_PVAV:  *(SV**)ptr = MUTABLE_SV(newAV());       break;
-               case SVt_PVHV:  *(SV**)ptr = MUTABLE_SV(newHV());       break;
+               case SVt_PVAV:  *svp = MUTABLE_SV(newAV());     break;
+               case SVt_PVHV:  *svp = MUTABLE_SV(newHV());     break;
                case SVt_PVCV:
                {
-                   SV ** const svp = (SV **)ptr;
-
                    /* Create a stub */
                    *svp = newSV_type(SVt_PVCV);
 
@@ -968,14 +977,16 @@ Perl_leave_scope(pTHX_ I32 base)
                        share_hek_hek(CvNAME_HEK((CV *)sv)));
                    break;
                }
-               default:        *(SV**)ptr = newSV(0);          break;
+               default:        *svp = newSV(0);                break;
                }
                SvREFCNT_dec(sv);       /* Cast current value to the winds. */
                /* preserve pad nature, but also mark as not live
                 * for any closure capturing */
-               SvFLAGS(*(SV**)ptr) |= (SVs_PADMY|SVs_PADSTALE);
+               SvFLAGS(*svp) |= (SVs_PADMY|SVs_PADSTALE);
            }
+            }
            break;
+        }
        case SAVEt_DELETE:
            ptr = SSPOPPTR;
            hv = MUTABLE_HV(ptr);

diff --git a/scope.h b/scope.h
index 447d22e..de18fe0 100644 (file)
--- a/scope.h
+++ b/scope.h
@@ -58,6 +58,7 @@
 #define SAVEt_INT_SMALL                48
 #define SAVEt_GVSV             49
 #define SAVEt_FREECOPHH                50
+#define SAVEt_CLEARPADRANGE    51
 
 #define SAVEf_SETMAGIC         1
 #define SAVEf_KEEPOLDELEM      2

diff --git a/sv.c b/sv.c
index ffc098a..726c5cc 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -12493,6 +12493,7 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
        TOPUV(nss,ix) = uv;
        switch (type) {
        case SAVEt_CLEARSV:
+       case SAVEt_CLEARPADRANGE:
            break;
        case SAVEt_HELEM:               /* hash element */
            sv = (const SV *)POPPTR(ss,ix);