In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/a3353dbeb3804ed7053b9be5196a69c0811e7f94?hp=23270f966ec4ff1b9f41f332ac6a33cf250742f9>

- Log -----------------------------------------------------------------
commit a3353dbeb3804ed7053b9be5196a69c0811e7f94
Author: Father Chrysostomos <spr...@cpan.org>
Date:   Fri Oct 17 13:07:31 2014 -0700

    Skip padrange optimisation for one padop
    
    cachegrind shows that padrange is marginally slower than pushmark+padsv
    (<20141017140518.gf5...@iabyn.com>).

M       ext/B/t/optree_sort.t
M       op.c

commit c51d52ee469b65f967308e6daad9be1395d927e9
Author: Father Chrysostomos <spr...@cpan.org>
Date:   Thu Oct 16 17:53:54 2014 -0700

    B::Concise: Dump private vars for null ops
    
    This can be very helpful for debugging.  For null ops that were not
    always null, output the private flags as we would for unnulled ops.

M       ext/B/B/Concise.pm
M       ext/B/t/optree_varinit.t
-----------------------------------------------------------------------

Summary of changes:
 ext/B/B/Concise.pm       | 11 ++++---
 ext/B/t/optree_sort.t    | 82 +++++++++++++++++++++++++++---------------------
 ext/B/t/optree_varinit.t | 20 ++++++------
 op.c                     |  2 +-
 4 files changed, 64 insertions(+), 51 deletions(-)

diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index 51ef7a7..96869c7 100644
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -773,15 +773,18 @@ sub concise_op {
     $h{extarg} = $h{targ} = $op->targ;
     $h{extarg} = "" unless $h{extarg};
     $h{privval} = $op->private;
-    $h{private} = private_flags($h{name}, $op->private);
+    # for null ops, targ holds the old type
+    my $origname = $h{name} eq "null" && $h{targ}
+      ? substr(ppname($h{targ}), 3)
+      : $h{name};
+    $h{private} = private_flags($origname, $op->private);
     if ($op->folded) {
       $h{private} &&= "$h{private},";
       $h{private} .= "FOLD";
     }
 
-    if ($h{name} eq "null" and $h{targ}) {
-       # targ holds the old type
-       $h{exname} = "ex-" . substr(ppname($h{targ}), 3);
+    if ($h{name} ne $origname) { # a null op
+       $h{exname} = "ex-$origname";
        $h{extarg} = "";
     } elsif ($h{private} =~ /\bREFC\b/) {
        # targ holds a reference count
diff --git a/ext/B/t/optree_sort.t b/ext/B/t/optree_sort.t
index a78b31e..660d9b2 100644
--- a/ext/B/t/optree_sort.t
+++ b/ext/B/t/optree_sort.t
@@ -196,9 +196,10 @@ checkOptree ( name => 'sub {my @a; @a = sort @a}',
 5  <0> pushmark s
 6  <0> padav[@a:-437,-436] l
 7  <@> sort lK
-8  <0> padrange[@a:-437,-436] l/1
-9  <2> aassign[t2] KS/COMMON
-a  <1> leavesub[1 ref] K/REFC,1
+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
 EOT_EOT
 # 1  <;> nextstate(main 427 optree_sort.t:172) v:>,<,%
 # 2  <0> padav[@a:427,428] vM/LVINTRO
@@ -207,9 +208,10 @@ EOT_EOT
 # 5  <0> pushmark s
 # 6  <0> padav[@a:427,428] l
 # 7  <@> sort lK
-# 8  <0> padrange[@a:427,428] l/1
-# 9  <2> aassign[t2] KS/COMMON
-# a  <1> leavesub[1 ref] K/REFC,1
+# 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
 EONT_EONT
 
 checkOptree ( name     => 'my @a; @a = sort @a',
@@ -222,18 +224,20 @@ 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> padrange[@a:1,2] l/1
-7  <@> sort lK/INPLACE
-8  <@> leave[1 ref] vKP/REFC
+6  <0> pushmark s
+7  <0> padav[@a:1,2] lRM*
+8  <@> sort lK/INPLACE
+9  <@> 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> padrange[@a:1,2] l/1
-# 7  <@> sort lK/INPLACE
-# 8  <@> leave[1 ref] vKP/REFC
+# 6  <0> pushmark s
+# 7  <0> padav[@a:1,2] lRM*
+# 8  <@> sort lK/INPLACE
+# 9  <@> leave[1 ref] vKP/REFC
 EONT_EONT
 
 checkOptree ( name     => 'sub {my @a; @a = sort @a; push @a, 1}',
@@ -246,25 +250,29 @@ 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> 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
+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
 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> 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
+# 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
 EONT_EONT
 
 checkOptree ( name     => 'sub {my @a; @a = sort @a; 1}',
@@ -277,19 +285,21 @@ 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> 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
+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
 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> 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
+# 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
 EONT_EONT
diff --git a/ext/B/t/optree_varinit.t b/ext/B/t/optree_varinit.t
index 676d517..2ca5243 100644
--- a/ext/B/t/optree_varinit.t
+++ b/ext/B/t/optree_varinit.t
@@ -117,13 +117,13 @@ checkOptree ( name        => 'local $c',
 4  <@> leave[1 ref] vKP/REFC ->(end)
 1     <0> enter ->2
 2     <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3
--     <1> ex-rv2sv vKM/129 ->4
+-     <1> ex-rv2sv vKM/LVINTRO,1 ->4
 3        <#> gvsv[*c] s/LVINTRO ->4
 EOT_EOT
 # 4  <@> leave[1 ref] vKP/REFC ->(end)
 # 1     <0> enter ->2
 # 2     <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3
-# -     <1> ex-rv2sv vKM/129 ->4
+# -     <1> ex-rv2sv vKM/LVINTRO,1 ->4
 # 3        <$> gvsv(*c) s/LVINTRO ->4
 EONT_EONT
 
@@ -160,7 +160,7 @@ checkOptree ( name  => 'sub {our $a=undef}',
 1        <;> nextstate(main 26 optree.t:109) v:>,<,%,{ ->2
 4        <2> sassign sKS/2 ->5
 2           <0> undef s ->3
--           <1> ex-rv2sv sKRM*/17 ->4
+-           <1> ex-rv2sv sKRM*/OURINTR,1 ->4
 3              <#> gvsv[*a] s/OURINTR ->4
 EOT_EOT
 # 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
@@ -168,7 +168,7 @@ EOT_EOT
 # 1        <;> nextstate(main 446 optree_varinit.t:137) v:>,<,%,{ ->2
 # 4        <2> sassign sKS/2 ->5
 # 2           <0> undef s ->3
-# -           <1> ex-rv2sv sKRM*/17 ->4
+# -           <1> ex-rv2sv sKRM*/OURINTR,1 ->4
 # 3              <$> gvsv(*a) s/OURINTR ->4
 EONT_EONT
 
@@ -183,7 +183,7 @@ checkOptree ( name  => 'sub {local $a=undef}',
 1        <;> nextstate(main 28 optree.t:122) v:>,<,%,{ ->2
 4        <2> sassign sKS/2 ->5
 2           <0> undef s ->3
--           <1> ex-rv2sv sKRM*/129 ->4
+-           <1> ex-rv2sv sKRM*/LVINTRO,1 ->4
 3              <#> gvsv[*a] s/LVINTRO ->4
 EOT_EOT
 # 5  <1> leavesub[1 ref] K/REFC,1 ->(end)
@@ -191,7 +191,7 @@ EOT_EOT
 # 1        <;> nextstate(main 58 optree.t:141) v:>,<,%,{ ->2
 # 4        <2> sassign sKS/2 ->5
 # 2           <0> undef s ->3
-# -           <1> ex-rv2sv sKRM*/129 ->4
+# -           <1> ex-rv2sv sKRM*/LVINTRO,1 ->4
 # 3              <$> gvsv(*a) s/LVINTRO ->4
 EONT_EONT
 
@@ -226,7 +226,7 @@ checkOptree ( name  => 'our $a=undef',
 2     <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3
 5     <2> sassign vKS/2 ->6
 3        <0> undef s ->4
--        <1> ex-rv2sv sKRM*/17 ->5
+-        <1> ex-rv2sv sKRM*/OURINTR,1 ->5
 4           <#> gvsv[*a] s/OURINTR ->5
 EOT_EOT
 # 6  <@> leave[1 ref] vKP/REFC ->(end)
@@ -234,7 +234,7 @@ EOT_EOT
 # 2     <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3
 # 5     <2> sassign vKS/2 ->6
 # 3        <0> undef s ->4
-# -        <1> ex-rv2sv sKRM*/17 ->5
+# -        <1> ex-rv2sv sKRM*/OURINTR,1 ->5
 # 4           <$> gvsv(*a) s/OURINTR ->5
 EONT_EONT
 
@@ -250,7 +250,7 @@ checkOptree ( name  => 'local $c=undef',
 2     <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3
 5     <2> sassign vKS/2 ->6
 3        <0> undef s ->4
--        <1> ex-rv2sv sKRM*/129 ->5
+-        <1> ex-rv2sv sKRM*/LVINTRO,1 ->5
 4           <#> gvsv[*c] s/LVINTRO ->5
 EOT_EOT
 # 6  <@> leave[1 ref] vKP/REFC ->(end)
@@ -258,7 +258,7 @@ EOT_EOT
 # 2     <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3
 # 5     <2> sassign vKS/2 ->6
 # 3        <0> undef s ->4
-# -        <1> ex-rv2sv sKRM*/129 ->5
+# -        <1> ex-rv2sv sKRM*/LVINTRO,1 ->5
 # 4           <$> gvsv(*c) s/LVINTRO ->5
 EONT_EONT
 
diff --git a/op.c b/op.c
index f14c5af..44d52f9 100644
--- a/op.c
+++ b/op.c
@@ -12073,7 +12073,7 @@ Perl_rpeep(pTHX_ OP *o)
                 followop = p->op_next;
             }
 
-            if (count < 1)
+            if (count < 1 || (count == 1 && !defav))
                 break;
 
             /* pp_padrange in specifically compile-time void context

--
Perl5 Master Repository

Reply via email to