From 4774ee0a8f9bc16a2ee4d1603401c927d02c41bc Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Fri, 2 Nov 2012 14:37:29 +0000
Subject: [PATCH] Consolidate adjacent padrange ops

In something like

    my ($a,$b);
    my ($c,$d);

when converting $c,$d into a padrange op, check first whether we're
immediately preceded by a similar padrange (and nextstate) op,
and if so re-use the existing padrange op (by increasing the count).
Also, skip the first nextstate and only use the second nextstate.

So

    pushmark;
    padsv[$a]; padsv[$b]; list;
    nextstate 1;
    pushmark;
    padsv[$c]; padsv[$c]; list;
    nextstate 2;

becomes

    padrange[$a,$b]
    nextstate 1;
    pushmark;
    padsv[$c]; padsv[$c]; list;
    nextstate 2;

which then becomes

    padrange[$a,$b,$c,$d];
    nextstate 2;
---
 ext/B/t/optree_misc.t | 39 ++++++++++++++++++++++++++++++++++++++-
 op.c                  | 29 ++++++++++++++++++++++++++++-
 2 files changed, 66 insertions(+), 2 deletions(-)

diff --git a/ext/B/t/optree_misc.t b/ext/B/t/optree_misc.t
index 277d315..648539b 100644
--- a/ext/B/t/optree_misc.t
+++ b/ext/B/t/optree_misc.t
@@ -10,7 +10,7 @@ BEGIN {
 }
 use OptreeCheck;
 use Config;
-plan tests => 12;
+plan tests => 14;
 
 SKIP: {
 skip "no perlio in this build", 4 unless $Config::Config{useperlio};
@@ -330,4 +330,41 @@ EOT_EOT
 # -              <0> padsv[$f:3,4] lRM*/LVINTRO ->-
 EONT_EONT
 
+checkOptree ( name      => 'consolidate padranges',
+	      code	=> sub { my ($a,$b); my ($c,$d); 1 },
+	      strip_open_hints => 1,
+	      skip	=> ($] < 5.017006),
+	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
+# 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
+# -     <@> lineseq KP ->5
+# 1        <;> nextstate(main 900 optree_misc.t:334) v ->2
+# -        <@> list vKP ->-
+# 2           <0> padrange[$a:900,902; $b:900,902; $c:901,902; $d:901,902] vM/LVINTRO,4 ->3
+# -           <0> padsv[$a:900,902] vM/LVINTRO ->-
+# -           <0> padsv[$b:900,902] vM/LVINTRO ->-
+# -        <;> nextstate(main 901 optree_misc.t:334) v ->-
+# -        <@> list vKP ->3
+# -           <0> pushmark vM/LVINTRO ->-
+# -           <0> padsv[$c:901,902] vM/LVINTRO ->-
+# -           <0> padsv[$d:901,902] vM/LVINTRO ->-
+# 3        <;> nextstate(main 902 optree_misc.t:334) v:{ ->4
+# 4        <$> const[IV 1] s ->5
+EOT_EOT
+# 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
+# -     <@> lineseq KP ->5
+# 1        <;> nextstate(main 900 optree_misc.t:334) v ->2
+# -        <@> list vKP ->-
+# 2           <0> padrange[$a:900,902; $b:900,902; $c:901,902; $d:901,902] vM/LVINTRO,4 ->3
+# -           <0> padsv[$a:900,902] vM/LVINTRO ->-
+# -           <0> padsv[$b:900,902] vM/LVINTRO ->-
+# -        <;> nextstate(main 901 optree_misc.t:334) v ->-
+# -        <@> list vKP ->3
+# -           <0> pushmark vM/LVINTRO ->-
+# -           <0> padsv[$c:901,902] vM/LVINTRO ->-
+# -           <0> padsv[$d:901,902] vM/LVINTRO ->-
+# 3        <;> nextstate(main 902 optree_misc.t:334) v:{ ->4
+# 4        <$> const(IV 1) s ->5
+EONT_EONT
+
+
 unlink $tmpfile;
diff --git a/op.c b/op.c
index cd07039..fdb5094 100644
--- a/op.c
+++ b/op.c
@@ -10790,6 +10790,7 @@ Perl_rpeep(pTHX_ register OP *o)
 {
     dVAR;
     OP* oldop = NULL;
+    OP* oldoldop = NULL;
     OP* defer_queue[MAX_DEFERRED]; /* small queue of deferred branches */
     int defer_base = 0;
     int defer_ix = -1;
@@ -11053,7 +11054,7 @@ Perl_rpeep(pTHX_ register OP *o)
             if (count < 1)
                 break;
 
-            /* op_padrange in specifically compile-time void context
+            /* pp_padrange in specifically compile-time void context
              * skips pushing a mark and lexicals; in all other contexts
              * (including unknown till runtime) it pushes a mark and the
              * lexicals. We must be very careful then, that the ops we
@@ -11072,7 +11073,32 @@ Perl_rpeep(pTHX_ register OP *o)
                         && gimme == (followop->op_flags & OPf_WANT)
                         && (   followop->op_next->op_type == OP_NEXTSTATE
                             || followop->op_next->op_type == OP_DBSTATE))
+                {
                     followop = followop->op_next; /* skip OP_LIST */
+
+                    /* consolidate two successive my(...);'s */
+                    if (   oldoldop
+                        && oldoldop->op_type == OP_PADRANGE
+                        && (oldoldop->op_flags & OPf_WANT) == OPf_WANT_VOID
+                        && (oldoldop->op_private & OPpLVAL_INTRO) == intro
+                    ) {
+                        U8 old_count;
+                        assert(oldoldop->op_next == oldop);
+                        assert(   oldop->op_type == OP_NEXTSTATE
+                               || oldop->op_type == OP_DBSTATE);
+                        assert(oldop->op_next == o);
+
+                        old_count
+                            = (oldoldop->op_private & OPpPADRANGE_COUNTMASK);
+                        assert(oldoldop->op_targ + old_count == base);
+
+                        if (old_count < OPpPADRANGE_COUNTMASK - count) {
+                            oldoldop->op_private = (intro | (old_count+count));
+                            oldoldop->op_next = followop;
+                            break;
+                        }
+                    }
+                }
                 else
                     break;
             }
@@ -11446,6 +11472,7 @@ Perl_rpeep(pTHX_ register OP *o)
 	}
 	    
 	}
+	oldoldop = oldop;
 	oldop = o;
     }
     LEAVE;
-- 
2.7.4