Change the generation of {} and [] from 3 ops to 1, and avoid 1 mortal

on the tempstack, by augmenting pp_anonlist and pp_anonhash to accept
OPf_SPECIAL to mean "return a reference to the aggregate" on the stack
rather than the aggregate itself.

p4raw-id: //depot/perl@28771

diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm
index 8764113..7b1e538 100644 (file)
--- a/ext/B/B/Deparse.pm
+++ b/ext/B/B/Deparse.pm
@@ -20,7 +20,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
          CVf_METHOD CVf_LOCKED CVf_LVALUE CVf_ASSERTION
         PMf_KEEP PMf_GLOBAL PMf_CONTINUE PMf_EVAL PMf_ONCE PMf_SKIPWHITE
         PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED);
-$VERSION = 0.76;
+$VERSION = 0.77;
 use strict;
 use vars qw/$AUTOLOAD/;
 use warnings ();
@@ -1751,6 +1751,32 @@ sub padval {
     return $self->{'curcv'}->PADLIST->ARRAYelt(1)->ARRAYelt($targ);
 }
 
+sub anon_hash_or_list {
+    my $self = shift;
+    my $op = shift;
+
+    my($pre, $post) = @{{"anonlist" => ["[","]"],
+                        "anonhash" => ["{","}"]}->{$op->name}};
+    my($expr, @exprs);
+    $op = $op->first->sibling; # skip pushmark
+    for (; !null($op); $op = $op->sibling) {
+       $expr = $self->deparse($op, 6);
+       push @exprs, $expr;
+    }
+    return $pre . join(", ", @exprs) . $post;
+}
+
+sub pp_anonlist {
+    my ($self, $op) = @_;
+    if ($op->flags & OPf_SPECIAL) {
+       return $self->anon_hash_or_list($op);
+    }
+    warn "Unexpected op pp_" . $op->name() . " without OPf_SPECIAL";
+    return 'XXX';
+}
+
+*pp_anonhash = \&pp_anonlist;
+
 sub pp_refgen {
     my $self = shift;  
     my($op, $cx) = @_;
@@ -1758,15 +1784,7 @@ sub pp_refgen {
     if ($kid->name eq "null") {
        $kid = $kid->first;
        if ($kid->name eq "anonlist" || $kid->name eq "anonhash") {
-           my($pre, $post) = @{{"anonlist" => ["[","]"],
-                                "anonhash" => ["{","}"]}->{$kid->name}};
-           my($expr, @exprs);
-           $kid = $kid->first->sibling; # skip pushmark
-           for (; !null($kid); $kid = $kid->sibling) {
-               $expr = $self->deparse($kid, 6);
-               push @exprs, $expr;
-           }
-           return $pre . join(", ", @exprs) . $post;
+           return $self->anon_hash_or_list($op);
        } elsif (!null($kid->sibling) and
                 $kid->sibling->name eq "anoncode") {
            return "sub " .

diff --git a/ext/B/t/concise-xs.t b/ext/B/t/concise-xs.t
index 7caf292..f0c7a70 100644 (file)
--- a/ext/B/t/concise-xs.t
+++ b/ext/B/t/concise-xs.t
@@ -117,7 +117,7 @@ use Getopt::Std;
 use Carp;
 use Test::More tests => ( # per-pkg tests (function ct + require_ok)
                          40 + 16       # Data::Dumper, Digest::MD5
-                         + 512 + 235   # B::Deparse, B
+                         + 515 + 235   # B::Deparse, B
                          + 595 + 190   # POSIX, IO::Socket
                          + 3 * ($] > 5.009)
                          + 16 * ($] >= 5.009003)

diff --git a/ext/B/t/f_map.t b/ext/B/t/f_map.t
index 9c2dd1d..420e649 100644 (file)
--- a/ext/B/t/f_map.t
+++ b/ext/B/t/f_map.t
@@ -512,14 +512,13 @@ checkOptree(note   => q{},
 # 9      <#> gvsv[*_] s
 # a      <1> lc[t4] sK/1
 # b      <$> const[IV 1] s
-# c      <@> anonhash sKRM/1
-# d      <1> srefgen sK/1
+# c      <@> anonhash sK*/1
 #            goto 7
-# e  <0> pushmark s
-# f  <#> gv[*hashes] s
-# g  <1> rv2av[t2] lKRM*/1
-# h  <2> aassign[t8] KS/COMMON
-# i  <1> leavesub[1 ref] K/REFC,1
+# d  <0> pushmark s
+# e  <#> gv[*hashes] s
+# f  <1> rv2av[t2] lKRM*/1
+# g  <2> aassign[t8] KS/COMMON
+# h  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 601 (eval 32):1) v
 # 2  <0> pushmark s
@@ -532,12 +531,11 @@ EOT_EOT
 # 9      <$> gvsv(*_) s
 # a      <1> lc[t2] sK/1
 # b      <$> const(IV 1) s
-# c      <@> anonhash sKRM/1
-# d      <1> srefgen sK/1
+# c      <@> anonhash sK*/1
 #            goto 7
-# e  <0> pushmark s
-# f  <$> gv(*hashes) s
-# g  <1> rv2av[t1] lKRM*/1
-# h  <2> aassign[t5] KS/COMMON
-# i  <1> leavesub[1 ref] K/REFC,1
+# d  <0> pushmark s
+# e  <$> gv(*hashes) s
+# f  <1> rv2av[t1] lKRM*/1
+# g  <2> aassign[t5] KS/COMMON
+# h  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT

diff --git a/ext/B/t/f_sort.t b/ext/B/t/f_sort.t
index 20bf865..b81d4c3 100644 (file)
--- a/ext/B/t/f_sort.t
+++ b/ext/B/t/f_sort.t
@@ -516,25 +516,24 @@ checkOptree(name   => q{Compound sort/map Expression },
 # e      </> match(/"=(\\d+)"/) l/RTIME
 # f      <#> gvsv[*_] s
 # g      <1> uc[t17] sK/1
-# h      <@> anonlist sKRM/1
-# i      <1> srefgen sK/1
-# j      <@> leave lKP
+# h      <@> anonlist sK*/1
+# i      <@> leave lKP
 #            goto 9
-# k  <@> sort lKMS*
-# l  <@> mapstart lK*
-# m  <|> mapwhile(other->n)[t26] lK
-# n      <#> gv[*_] s
-# o      <1> rv2sv sKM/DREFAV,1
-# p      <1> rv2av[t4] sKR/1
-# q      <$> const[IV 0] s
-# r      <2> aelem sK/2
+# j  <@> sort lKMS*
+# k  <@> mapstart lK*
+# l  <|> mapwhile(other->m)[t26] lK
+# m      <#> gv[*_] s
+# n      <1> rv2sv sKM/DREFAV,1
+# o      <1> rv2av[t4] sKR/1
+# p      <$> const[IV 0] s
+# q      <2> aelem sK/2
 # -      <@> scope lK
-#            goto m
-# s  <0> pushmark s
-# t  <#> gv[*new] s
-# u  <1> rv2av[t2] lKRM*/1
-# v  <2> aassign[t27] KS/COMMON
-# w  <1> leavesub[1 ref] K/REFC,1
+#            goto l
+# r  <0> pushmark s
+# s  <#> gv[*new] s
+# t  <1> rv2av[t2] lKRM*/1
+# u  <2> aassign[t27] KS/COMMON
+# v  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 609 (eval 34):3) v:{
 # 2  <0> pushmark s
@@ -552,25 +551,24 @@ EOT_EOT
 # e      </> match(/"=(\\d+)"/) l/RTIME
 # f      <$> gvsv(*_) s
 # g      <1> uc[t9] sK/1
-# h      <@> anonlist sKRM/1
-# i      <1> srefgen sK/1
-# j      <@> leave lKP
+# h      <@> anonlist sK*/1
+# i      <@> leave lKP
 #            goto 9
-# k  <@> sort lKMS*
-# l  <@> mapstart lK*
-# m  <|> mapwhile(other->n)[t12] lK
-# n      <$> gv(*_) s
-# o      <1> rv2sv sKM/DREFAV,1
-# p      <1> rv2av[t2] sKR/1
-# q      <$> const(IV 0) s
-# r      <2> aelem sK/2
+# j  <@> sort lKMS*
+# k  <@> mapstart lK*
+# l  <|> mapwhile(other->m)[t12] lK
+# m      <$> gv(*_) s
+# n      <1> rv2sv sKM/DREFAV,1
+# o      <1> rv2av[t2] sKR/1
+# p      <$> const(IV 0) s
+# q      <2> aelem sK/2
 # -      <@> scope lK
-#            goto m
-# s  <0> pushmark s
-# t  <$> gv(*new) s
-# u  <1> rv2av[t1] lKRM*/1
-# v  <2> aassign[t13] KS/COMMON
-# w  <1> leavesub[1 ref] K/REFC,1
+#            goto l
+# r  <0> pushmark s
+# s  <$> gv(*new) s
+# t  <1> rv2av[t1] lKRM*/1
+# u  <2> aassign[t13] KS/COMMON
+# v  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
     
 

diff --git a/ext/Devel/Peek/t/Peek.t b/ext/Devel/Peek/t/Peek.t
index 099e165..cf20f8b 100644 (file)
--- a/ext/Devel/Peek/t/Peek.t
+++ b/ext/Devel/Peek/t/Peek.t
@@ -180,7 +180,7 @@ do_test(11,
   FLAGS = \\(ROK\\)
   RV = $ADDR
   SV = PVAV\\($ADDR\\) at $ADDR
-    REFCNT = 2
+    REFCNT = 1
     FLAGS = \\(\\)
     ARRAY = $ADDR
     FILL = 1
@@ -201,7 +201,7 @@ do_test(12,
   FLAGS = \\(ROK\\)
   RV = $ADDR
   SV = PVHV\\($ADDR\\) at $ADDR
-    REFCNT = 2
+    REFCNT = 1
     FLAGS = \\(SHAREKEYS\\)
     ARRAY = $ADDR  \\(0:7, 1:1\\)
     hash quality = 100.0%
@@ -291,7 +291,7 @@ do_test(16,
   FLAGS = \\(ROK\\)
   RV = $ADDR
   SV = PVHV\\($ADDR\\) at $ADDR
-    REFCNT = 2
+    REFCNT = 1
     FLAGS = \\(OBJECT,SHAREKEYS\\)
     STASH = $ADDR\\t"Tac"
     ARRAY = 0x0
@@ -351,7 +351,7 @@ do_test(19,
   FLAGS = \\(ROK\\)
   RV = $ADDR
   SV = PVHV\\($ADDR\\) at $ADDR
-    REFCNT = 2
+    REFCNT = 1
     FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
     ARRAY = $ADDR  \\(0:7, 1:1\\)
     hash quality = 100.0%
@@ -375,7 +375,7 @@ do_test(19,
   FLAGS = \\(ROK\\)
   RV = $ADDR
   SV = PVHV\\($ADDR\\) at $ADDR
-    REFCNT = 2
+    REFCNT = 1
     FLAGS = \\(SHAREKEYS,HASKFLAGS\\)
     ARRAY = $ADDR  \\(0:7, 1:1\\)
     hash quality = 100.0%

diff --git a/op.c b/op.c
index c9f6171..1e16606 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2258,6 +2258,8 @@ Perl_gen_constant_list(pTHX_ register OP *o)
     pp_pushmark();
     CALLRUNOPS(aTHX);
     PL_op = curop;
+    assert (!(curop->op_flags & OPf_SPECIAL));
+    assert(curop->op_type == OP_RANGE);
     pp_anonlist();
     PL_tmps_floor = oldtmps_floor;
 
@@ -5681,15 +5683,13 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
 OP *
 Perl_newANONLIST(pTHX_ OP *o)
 {
-    return newUNOP(OP_REFGEN, 0,
-       mod(list(convert(OP_ANONLIST, 0, o)), OP_REFGEN));
+    return convert(OP_ANONLIST, OPf_SPECIAL, o);
 }
 
 OP *
 Perl_newANONHASH(pTHX_ OP *o)
 {
-    return newUNOP(OP_REFGEN, 0,
-       mod(list(convert(OP_ANONHASH, 0, o)), OP_REFGEN));
+    return convert(OP_ANONHASH, OPf_SPECIAL, o);
 }
 
 OP *

diff --git a/op.h b/op.h
index c299c5d..0713711 100644 (file)
--- a/op.h
+++ b/op.h
@@ -121,6 +121,8 @@ Deprecated.  Use C<GIMME_V> instead.
                                /*  On OP_ENTERWHEN, there's no condition */
                                /*  On OP_BREAK, an implicit break */
                                /*  On OP_SMARTMATCH, an implicit smartmatch */
+                               /*  On OP_ANONHASH and OP_ANONLIST, create a
+                                   reference to the new anon hash or array */
 
 /* old names; don't use in new code, but don't break them, either */
 #define OPf_LIST       OPf_WANT_LIST

diff --git a/pp.c b/pp.c
index d90545e..78f7adf 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -4123,16 +4123,17 @@ PP(pp_anonlist)
 {
     dVAR; dSP; dMARK; dORIGMARK;
     const I32 items = SP - MARK;
-    SV * const av = sv_2mortal((SV*)av_make(items, MARK+1));
+    SV * const av = (SV *) av_make(items, MARK+1);
     SP = ORIGMARK;             /* av_make() might realloc stack_sp */
-    XPUSHs(av);
+    XPUSHs(sv_2mortal((PL_op->op_flags & OPf_SPECIAL)
+                     ? newRV_noinc(av) : av));
     RETURN;
 }
 
 PP(pp_anonhash)
 {
     dVAR; dSP; dMARK; dORIGMARK;
-    HV* const hv = (HV*)sv_2mortal((SV*)newHV());
+    HV* const hv = newHV();
 
     while (MARK < SP) {
        SV * const key = *++MARK;
@@ -4144,7 +4145,8 @@ PP(pp_anonhash)
        (void)hv_store_ent(hv,key,val,0);
     }
     SP = ORIGMARK;
-    XPUSHs((SV*)hv);
+    XPUSHs(sv_2mortal((PL_op->op_flags & OPf_SPECIAL)
+                     ? newRV_noinc((SV*) hv) : (SV*)hv));
     RETURN;
 }