add padrange op

This single op can, in some circumstances, replace the sequence of a
pushmark followed by one or more padsv/padav/padhv ops, and possibly
a trailing 'list' op, but only where the targs of the pad ops form
a continuous range.

This is generally more efficient, but is particularly so in the case
of void-context my declarations, such as:

    my ($a,@b);

Formerly this would be executed as the following set of ops:

    pushmark  pushes a new mark
    padsv[$a] pushes $a, does a SAVEt_CLEARSV
    padav[@b] pushes all the flattened elements (i.e. none) of @a,
              does a SAVEt_CLEARSV
    list      pops the mark, and pops all stack elements except the last
    nextstate pops the remaining stack element

It's now:

    padrange[$a..@b] does two SAVEt_CLEARSV's
    nextstate        nothing needing doing to the stack

Note that in the case above, this commit changes user-visible behaviour in
pathological cases; in particular, it has always been possible to modify a
lexical var *before* the my is executed, using goto or closure tricks.
So in principle someone could tie an array, then could notice that FETCH
is no longer being called, e.g.

    f();
    my ($s, @a); # this no longer triggers two FETCHES
    sub f {
	tie @a, ...;
	push @a, 1,2;
    }

But I think we can live with that.

Note also that having a padrange operator will allow us shortly to have
a corresponding SAVEt_CLEARPADRANGE save type, that will replace multiple
individual SAVEt_CLEARSV's.

4 files changed, 84 insertions, 80 deletions

diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index 796841a7e5..8bebdfc0cb 100644
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -596,7 +596,7 @@ our %priv; # used to display each opcode's BASEOP.op_private values
 $priv{$_}{128} = "LVINTRO"
   for ("pos", "substr", "vec", "threadsv", "gvsv", "rv2sv", "rv2hv", "rv2gv",
        "rv2av", "rv2arylen", "aelem", "helem", "aslice", "hslice", "padsv",
-       "padav", "padhv", "enteriter", "entersub");
+       "padav", "padhv", "enteriter", "entersub", "padrange", "pushmark");
 $priv{$_}{64} = "REFC" for ("leave", "leavesub", "leavesublv", "leavewrite");
 $priv{"aassign"}{64} = "COMMON";
 $priv{"aassign"}{32} = "STATE";
@@ -787,30 +787,39 @@ sub concise_op {
 	    $h{targarglife} = $h{targarg} = "$h{targ} $refs";
 	}
     } elsif ($h{targ}) {
-	my $padname = (($curcv->PADLIST->ARRAY)[0]->ARRAY)[$h{targ}];
-	if (defined $padname and class($padname) ne "SPECIAL") {
-	    $h{targarg}  = $padname->PVX;
-	    if ($padname->FLAGS & SVf_FAKE) {
-		# These changes relate to the jumbo closure fix.
-		# See changes 19939 and 20005
-		my $fake = '';
-		$fake .= 'a'
-		    if $padname->PARENT_FAKELEX_FLAGS & PAD_FAKELEX_ANON;
-		$fake .= 'm'
-		    if $padname->PARENT_FAKELEX_FLAGS & PAD_FAKELEX_MULTI;
-		$fake .= ':' . $padname->PARENT_PAD_INDEX
-		    if $curcv->CvFLAGS & CVf_ANON;
-		$h{targarglife} = "$h{targarg}:FAKE:$fake";
-	    }
-	    else {
-		my $intro = $padname->COP_SEQ_RANGE_LOW - $cop_seq_base;
-		my $finish = int($padname->COP_SEQ_RANGE_HIGH) - $cop_seq_base;
-		$finish = "end" if $finish == 999999999 - $cop_seq_base;
-		$h{targarglife} = "$h{targarg}:$intro,$finish";
+	my $count = $h{name} eq 'padrange' ? ($op->private & 127) : 1;
+	my (@targarg, @targarglife);
+	for my $i (0..$count-1) {
+	    my ($targarg, $targarglife);
+	    my $padname = (($curcv->PADLIST->ARRAY)[0]->ARRAY)[$h{targ}+$i];
+	    if (defined $padname and class($padname) ne "SPECIAL") {
+		$targarg  = $padname->PVX;
+		if ($padname->FLAGS & SVf_FAKE) {
+		    # These changes relate to the jumbo closure fix.
+		    # See changes 19939 and 20005
+		    my $fake = '';
+		    $fake .= 'a'
+			if $padname->PARENT_FAKELEX_FLAGS & PAD_FAKELEX_ANON;
+		    $fake .= 'm'
+			if $padname->PARENT_FAKELEX_FLAGS & PAD_FAKELEX_MULTI;
+		    $fake .= ':' . $padname->PARENT_PAD_INDEX
+			if $curcv->CvFLAGS & CVf_ANON;
+		    $targarglife = "$targarg:FAKE:$fake";
+		}
+		else {
+		    my $intro = $padname->COP_SEQ_RANGE_LOW - $cop_seq_base;
+		    my $finish = int($padname->COP_SEQ_RANGE_HIGH) - $cop_seq_base;
+		    $finish = "end" if $finish == 999999999 - $cop_seq_base;
+		    $targarglife = "$targarg:$intro,$finish";
+		}
+	    } else {
+		$targarglife = $targarg = "t" . ($h{targ}+$i);
 	    }
-	} else {
-	    $h{targarglife} = $h{targarg} = "t" . $h{targ};
+	    push @targarg,     $targarg;
+	    push @targarglife, $targarglife;
 	}
+	$h{targarg}     = join '; ', @targarg;
+	$h{targarglife} = join '; ', @targarglife;
     }
     $h{arg} = "";
     $h{svclass} = $h{svaddr} = $h{svval} = "";
diff --git a/ext/B/B/Xref.pm b/ext/B/B/Xref.pm
index 3a44454857..8beb243f71 100644
--- a/ext/B/B/Xref.pm
+++ b/ext/B/B/Xref.pm
@@ -1,6 +1,6 @@
 package B::Xref;
 
-our $VERSION = '1.04';
+our $VERSION = '1.05';
 
 =head1 NAME
 
@@ -275,6 +275,15 @@ sub pp_nextstate {
     $top = UNKNOWN;
 }
 
+sub pp_padrange {
+    my $op = shift;
+    my $count = $op->private & 127;
+    for my $i (0..$count-1) {
+	$top = $pad[$op->targ + $i];
+	process($top, $op->private & OPpLVAL_INTRO ? "intro" : "used");
+    }
+}
+
 sub pp_padsv {
     my $op = shift;
     $top = $pad[$op->targ];
diff --git a/ext/B/t/optree_sort.t b/ext/B/t/optree_sort.t
index b602e436a5..a78b31ee94 100644
--- a/ext/B/t/optree_sort.t
+++ b/ext/B/t/optree_sort.t
@@ -196,10 +196,9 @@ checkOptree ( name	=> 'sub {my @a; @a = sort @a}',
 5  <0> pushmark s
 6  <0> padav[@a:-437,-436] l
 7  <@> sort lK
-8  <0> pushmark s
-9  <0> padav[@a:-437,-436] lRM*
-a  <2> aassign[t2] KS/COMMON
-b  <1> leavesub[1 ref] K/REFC,1
+8  <0> padrange[@a:-437,-436] l/1
+9  <2> aassign[t2] KS/COMMON
+a  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 427 optree_sort.t:172) v:>,<,%
 # 2  <0> padav[@a:427,428] vM/LVINTRO
@@ -208,10 +207,9 @@ EOT_EOT
 # 5  <0> pushmark s
 # 6  <0> padav[@a:427,428] l
 # 7  <@> sort lK
-# 8  <0> pushmark s
-# 9  <0> padav[@a:427,428] lRM*
-# a  <2> aassign[t2] KS/COMMON
-# b  <1> leavesub[1 ref] K/REFC,1
+# 8  <0> padrange[@a:427,428] l/1
+# 9  <2> aassign[t2] KS/COMMON
+# a  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
 
 checkOptree ( name	=> 'my @a; @a = sort @a',
@@ -224,20 +222,18 @@ checkOptree ( name	=> 'my @a; @a = sort @a',
 3  <0> padav[@a:1,2] vM/LVINTRO
 4  <;> nextstate(main 2 -e:1) v:>,<,%,{
 5  <0> pushmark s
-6  <0> pushmark s
-7  <0> padav[@a:1,2] lRM*
-8  <@> sort lK/INPLACE
-9  <@> leave[1 ref] vKP/REFC
+6  <0> padrange[@a:1,2] l/1
+7  <@> sort lK/INPLACE
+8  <@> leave[1 ref] vKP/REFC
 EOT_EOT
 # 1  <0> enter 
 # 2  <;> nextstate(main 1 -e:1) v:>,<,%,{
 # 3  <0> padav[@a:1,2] vM/LVINTRO
 # 4  <;> nextstate(main 2 -e:1) v:>,<,%,{
 # 5  <0> pushmark s
-# 6  <0> pushmark s
-# 7  <0> padav[@a:1,2] lRM*
-# 8  <@> sort lK/INPLACE
-# 9  <@> leave[1 ref] vKP/REFC
+# 6  <0> padrange[@a:1,2] l/1
+# 7  <@> sort lK/INPLACE
+# 8  <@> leave[1 ref] vKP/REFC
 EONT_EONT
 
 checkOptree ( name	=> 'sub {my @a; @a = sort @a; push @a, 1}',
@@ -250,29 +246,25 @@ checkOptree ( name	=> 'sub {my @a; @a = sort @a; push @a, 1}',
 2  <0> padav[@a:-437,-436] vM/LVINTRO
 3  <;> nextstate(main -436 optree.t:325) v:>,<,%
 4  <0> pushmark s
-5  <0> pushmark s
-6  <0> padav[@a:-437,-436] lRM*
-7  <@> sort lK/INPLACE
-8  <;> nextstate(main -436 optree.t:325) v:>,<,%,{
-9  <0> pushmark s
-a  <0> padav[@a:-437,-436] lRM
-b  <$> const[IV 1] s
-c  <@> push[t3] sK/2
-d  <1> leavesub[1 ref] K/REFC,1
+5  <0> padrange[@a:-437,-436] l/1
+6  <@> sort lK/INPLACE
+7  <;> nextstate(main -436 optree.t:325) v:>,<,%,{
+8  <0> padrange[@a:-437,-436] l/1
+9  <$> const[IV 1] s
+a  <@> push[t3] sK/2
+b  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 429 optree_sort.t:219) v:>,<,%
 # 2  <0> padav[@a:429,430] vM/LVINTRO
 # 3  <;> nextstate(main 430 optree_sort.t:220) v:>,<,%
 # 4  <0> pushmark s
-# 5  <0> pushmark s
-# 6  <0> padav[@a:429,430] lRM*
-# 7  <@> sort lK/INPLACE
-# 8  <;> nextstate(main 430 optree_sort.t:220) v:>,<,%,{
-# 9  <0> pushmark s
-# a  <0> padav[@a:429,430] lRM
-# b  <$> const(IV 1) s
-# c  <@> push[t3] sK/2
-# d  <1> leavesub[1 ref] K/REFC,1
+# 5  <0> padrange[@a:429,430] l/1
+# 6  <@> sort lK/INPLACE
+# 7  <;> nextstate(main 430 optree_sort.t:220) v:>,<,%,{
+# 8  <0> padrange[@a:429,430] l/1
+# 9  <$> const(IV 1) s
+# a  <@> push[t3] sK/2
+# b  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
 
 checkOptree ( name	=> 'sub {my @a; @a = sort @a; 1}',
@@ -285,21 +277,19 @@ checkOptree ( name	=> 'sub {my @a; @a = sort @a; 1}',
 2  <0> padav[@a:-437,-436] vM/LVINTRO
 3  <;> nextstate(main -436 optree.t:325) v:>,<,%
 4  <0> pushmark s
-5  <0> pushmark s
-6  <0> padav[@a:-437,-436] lRM*
-7  <@> sort lK/INPLACE
-8  <;> nextstate(main -436 optree.t:346) v:>,<,%,{
-9  <$> const[IV 1] s
-a  <1> leavesub[1 ref] K/REFC,1
+5  <0> padrange[@a:-437,-436] l/1
+6  <@> sort lK/INPLACE
+7  <;> nextstate(main -436 optree.t:346) v:>,<,%,{
+8  <$> const[IV 1] s
+9  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 431 optree_sort.t:250) v:>,<,%
 # 2  <0> padav[@a:431,432] vM/LVINTRO
 # 3  <;> nextstate(main 432 optree_sort.t:251) v:>,<,%
 # 4  <0> pushmark s
-# 5  <0> pushmark s
-# 6  <0> padav[@a:431,432] lRM*
-# 7  <@> sort lK/INPLACE
-# 8  <;> nextstate(main 432 optree_sort.t:251) v:>,<,%,{
-# 9  <$> const(IV 1) s
-# a  <1> leavesub[1 ref] K/REFC,1
+# 5  <0> padrange[@a:431,432] l/1
+# 6  <@> sort lK/INPLACE
+# 7  <;> nextstate(main 432 optree_sort.t:251) v:>,<,%,{
+# 8  <$> const(IV 1) s
+# 9  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
diff --git a/ext/B/t/optree_varinit.t b/ext/B/t/optree_varinit.t
index e0a95b7652..4c4632508d 100644
--- a/ext/B/t/optree_varinit.t
+++ b/ext/B/t/optree_varinit.t
@@ -390,18 +390,14 @@ checkOptree ( name	=> 'my ($a,$b)=()',
 # 1  <0> enter 
 # 2  <;> nextstate(main 1 -e:1) v:>,<,%,{
 # 3  <0> pushmark s
-# 4  <0> pushmark sRM*/128
-# 5  <0> padsv[$a:1,2] lRM*/LVINTRO
-# 6  <0> padsv[$b:1,2] lRM*/LVINTRO
-# 7  <2> aassign[t3] vKS
-# 8  <@> leave[1 ref] vKP/REFC
+# 4  <0> padrange[$a:1,2; $b:1,2] lRM*/LVINTRO,2
+# 5  <2> aassign[t3] vKS
+# 6  <@> leave[1 ref] vKP/REFC
 EOT_EOT
 # 1  <0> enter 
 # 2  <;> nextstate(main 1 -e:1) v:>,<,%,{
 # 3  <0> pushmark s
-# 4  <0> pushmark sRM*/128
-# 5  <0> padsv[$a:1,2] lRM*/LVINTRO
-# 6  <0> padsv[$b:1,2] lRM*/LVINTRO
-# 7  <2> aassign[t3] vKS
-# 8  <@> leave[1 ref] vKP/REFC
+# 4  <0> padrange[$a:1,2; $b:1,2] lRM*/LVINTRO,2
+# 5  <2> aassign[t3] vKS
+# 6  <@> leave[1 ref] vKP/REFC
 EONT_EONT