From 4e09461c68f4fd1b02cb93ceb753e6d3b4f6b786 Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Wed, 17 Oct 2012 19:45:38 +0100
Subject: [PATCH] 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.
---
 op.c     |  6 ++++++
 op.h     |  3 ++-
 pp_hot.c | 12 +++++++++++-
 scope.c  | 29 ++++++++++++++++++++---------
 scope.h  |  1 +
 sv.c     |  1 +
 6 files changed, 41 insertions(+), 11 deletions(-)

diff --git a/op.c b/op.c
index bf1a4c6..af6a6b0 100644
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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);
-- 
2.7.4