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;

diff --git a/ext/B/t/optree_misc.t b/ext/B/t/optree_misc.t
index 277d315..648539b 100644 (file)
--- 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 (file)
--- 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;