padrange: handle @_ directly

In a construct like
    my ($x,$y) = @_
the pushmark/padsv/padsv is already optimised into a single padrange
op. This commit makes the OPf_SPECIAL flag on the padrange op indicate
that in addition, @_ should be pushed onto the stack, skipping an
additional pushmark/gv[*_]/rv2sv combination.

So in total (including the earlier padrange work), the above construct
goes from being

    3  <0> pushmark s
    4  <$> gv(*_) s
    5  <1> rv2av[t3] lK/1
    6  <0> pushmark sRM*/128
    7  <0> padsv[$x:1,2] lRM*/LVINTRO
    8  <0> padsv[$y:1,2] lRM*/LVINTRO
    9  <2> aassign[t4] vKS

to

    3  <0> padrange[$x:1,2; $y:1,2] l*/LVINTRO,2 ->4
    4  <2> aassign[t4] vKS

diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm
index 85b3cb4..1771f01 100644 (file)
--- a/dist/B-Deparse/Deparse.pm
+++ b/dist/B-Deparse/Deparse.pm
@@ -329,18 +329,24 @@ sub _pessimise_walk {
 
        if ($ppname eq "padrange") {
            # remove PADRANGE:
-           # the original optimisation changed this:
+           # the original optimisation either (1) changed this:
            #    pushmark -> (various pad and list and null ops) -> the_rest
+           # or (2), for the = @_ case, changed this:
+           #    pushmark -> gv[_] -> rv2av -> (pad stuff)       -> the_rest
            # into this:
            #    padrange ----------------------------------------> the_rest
            # so we just need to convert the padrange back into a
-           # pushmark, and set its op_next to op_sibling, which is the
-           # head of the original chain of optimised-away pad ops.
+           # pushmark, and in case (1), set its op_next to op_sibling,
+           # which is the head of the original chain of optimised-away
+           # pad ops, or for (2), set it to sibling->first, which is
+           # the original gv[_].
 
            $B::overlay->{$$op} = {
                    name => 'pushmark',
                    private => ($op->private & OPpLVAL_INTRO),
-                   next    => $op->sibling,
+                   next    => ($op->flags & OPf_SPECIAL)
+                                   ? $op->sibling->first
+                                   : $op->sibling,
            };
        }
 

diff --git a/dist/B-Deparse/t/deparse.t b/dist/B-Deparse/t/deparse.t
index 0b04467..0a31c66 100644 (file)
--- a/dist/B-Deparse/t/deparse.t
+++ b/dist/B-Deparse/t/deparse.t
@@ -1365,3 +1365,6 @@ $a x= $b;
 @e = ($a, $b) x $d;
 @e = ($a, $b, $c) x $d;
 @e = ($a, 1) x $d;
+####
+# @_ with padrange
+my($a, $b, $c) = @_;

diff --git a/ext/B/t/optree_misc.t b/ext/B/t/optree_misc.t
index 6bc081b..277d315 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 => 8;
+plan tests => 12;
 
 SKIP: {
 skip "no perlio in this build", 4 unless $Config::Config{useperlio};
@@ -192,4 +192,142 @@ EOT_EOT
 # 9                 <$> gv(*b) s ->a
 EONT_EONT
 
+checkOptree ( name      => 'padrange',
+             code      => sub { my ($x,$y); @a = ($x,$y); ($x,$y) = @a },
+             strip_open_hints => 1,
+             skip      => ($] < 5.017006),
+             expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
+# f  <1> leavesub[1 ref] K/REFC,1 ->(end)
+# -     <@> lineseq KP ->f
+# 1        <;> nextstate(main 1 -e:1) v ->2
+# -        <@> list vKP ->3
+# 2           <0> padrange[$x:1,2; $y:1,2] vM/LVINTRO,2 ->3
+# -           <0> padsv[$x:1,2] vM/LVINTRO ->-
+# -           <0> padsv[$y:1,2] vM/LVINTRO ->-
+# 3        <;> nextstate(main 2 -e:1) v ->4
+# 8        <2> aassign[t4] vKS ->9
+# -           <1> ex-list lKP ->5
+# 4              <0> padrange[$x:1,2; $y:1,2] l/2 ->5
+# -              <0> padsv[$x:1,2] l ->-
+# -              <0> padsv[$y:1,2] l ->-
+# -           <1> ex-list lK ->8
+# 5              <0> pushmark s ->6
+# 7              <1> rv2av[t3] lKRM*/1 ->8
+# 6                 <#> gv[*a] s ->7
+# 9        <;> nextstate(main 2 -e:1) v:{ ->a
+# e        <2> aassign[t6] KS ->f
+# -           <1> ex-list lK ->d
+# a              <0> pushmark s ->b
+# c              <1> rv2av[t5] lK/1 ->d
+# b                 <#> gv[*a] s ->c
+# -           <1> ex-list lKPRM* ->e
+# d              <0> padrange[$x:1,2; $y:1,2] lRM/2 ->e
+# -              <0> padsv[$x:1,2] lRM* ->-
+# -              <0> padsv[$y:1,2] lRM* ->-
+EOT_EOT
+# f  <1> leavesub[1 ref] K/REFC,1 ->(end)
+# -     <@> lineseq KP ->f
+# 1        <;> nextstate(main 1 -e:1) v ->2
+# -        <@> list vKP ->3
+# 2           <0> padrange[$x:1,2; $y:1,2] vM/LVINTRO,2 ->3
+# -           <0> padsv[$x:1,2] vM/LVINTRO ->-
+# -           <0> padsv[$y:1,2] vM/LVINTRO ->-
+# 3        <;> nextstate(main 2 -e:1) v ->4
+# 8        <2> aassign[t4] vKS ->9
+# -           <1> ex-list lKP ->5
+# 4              <0> padrange[$x:1,2; $y:1,2] l/2 ->5
+# -              <0> padsv[$x:1,2] l ->-
+# -              <0> padsv[$y:1,2] l ->-
+# -           <1> ex-list lK ->8
+# 5              <0> pushmark s ->6
+# 7              <1> rv2av[t3] lKRM*/1 ->8
+# 6                 <$> gv(*a) s ->7
+# 9        <;> nextstate(main 2 -e:1) v:{ ->a
+# e        <2> aassign[t6] KS ->f
+# -           <1> ex-list lK ->d
+# a              <0> pushmark s ->b
+# c              <1> rv2av[t5] lK/1 ->d
+# b                 <$> gv(*a) s ->c
+# -           <1> ex-list lKPRM* ->e
+# d              <0> padrange[$x:1,2; $y:1,2] lRM/2 ->e
+# -              <0> padsv[$x:1,2] lRM* ->-
+# -              <0> padsv[$y:1,2] lRM* ->-
+EONT_EONT
+
+checkOptree ( name      => 'padrange and @_',
+             code      => sub { my ($a,$b) = @_;
+                                my ($c,$d) = @X::_;
+                                package Y;
+                                my ($e,$f) = @_;
+                            },
+             strip_open_hints => 1,
+             skip      => ($] < 5.017006),
+             expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
+# d  <1> leavesub[1 ref] K/REFC,1 ->(end)
+# -     <@> lineseq KP ->d
+# 1        <;> nextstate(main 1 p3:1) v ->2
+# 3        <2> aassign[t5] vKS ->4
+# -           <1> ex-list lK ->-
+# 2              <0> padrange[$a:1,4; $b:1,4] l*/LVINTRO,2 ->3
+# -              <1> rv2av[t4] lK/1 ->-
+# -                 <#> gv[*_] s ->-
+# -           <1> ex-list lKPRM* ->3
+# -              <0> pushmark sRM*/LVINTRO ->-
+# -              <0> padsv[$a:1,4] lRM*/LVINTRO ->-
+# -              <0> padsv[$b:1,4] lRM*/LVINTRO ->-
+# 4        <;> nextstate(main 2 p3:2) v ->5
+# 9        <2> aassign[t10] vKS ->a
+# -           <1> ex-list lK ->8
+# 5              <0> pushmark s ->6
+# 7              <1> rv2av[t9] lK/1 ->8
+# 6                 <#> gv[*X::_] s ->7
+# -           <1> ex-list lKPRM* ->9
+# 8              <0> padrange[$c:2,4; $d:2,4] lRM/LVINTRO,2 ->9
+# -              <0> padsv[$c:2,4] lRM*/LVINTRO ->-
+# -              <0> padsv[$d:2,4] lRM*/LVINTRO ->-
+# a        <;> nextstate(Y 3 p3:4) v:{ ->b
+# c        <2> aassign[t15] KS ->d
+# -           <1> ex-list lK ->-
+# b              <0> padrange[$e:3,4; $f:3,4] l*/LVINTRO,2 ->c
+# -              <1> rv2av[t14] lK/1 ->-
+# -                 <#> gv[*_] s ->-
+# -           <1> ex-list lKPRM* ->c
+# -              <0> pushmark sRM*/LVINTRO ->-
+# -              <0> padsv[$e:3,4] lRM*/LVINTRO ->-
+# -              <0> padsv[$f:3,4] lRM*/LVINTRO ->-
+EOT_EOT
+# d  <1> leavesub[1 ref] K/REFC,1 ->(end)
+# -     <@> lineseq KP ->d
+# 1        <;> nextstate(main 1 p3:1) v ->2
+# 3        <2> aassign[t5] vKS ->4
+# -           <1> ex-list lK ->-
+# 2              <0> padrange[$a:1,4; $b:1,4] l*/LVINTRO,2 ->3
+# -              <1> rv2av[t4] lK/1 ->-
+# -                 <$> gv(*_) s ->-
+# -           <1> ex-list lKPRM* ->3
+# -              <0> pushmark sRM*/LVINTRO ->-
+# -              <0> padsv[$a:1,4] lRM*/LVINTRO ->-
+# -              <0> padsv[$b:1,4] lRM*/LVINTRO ->-
+# 4        <;> nextstate(main 2 p3:2) v ->5
+# 9        <2> aassign[t10] vKS ->a
+# -           <1> ex-list lK ->8
+# 5              <0> pushmark s ->6
+# 7              <1> rv2av[t9] lK/1 ->8
+# 6                 <$> gv(*X::_) s ->7
+# -           <1> ex-list lKPRM* ->9
+# 8              <0> padrange[$c:2,4; $d:2,4] lRM/LVINTRO,2 ->9
+# -              <0> padsv[$c:2,4] lRM*/LVINTRO ->-
+# -              <0> padsv[$d:2,4] lRM*/LVINTRO ->-
+# a        <;> nextstate(Y 3 p3:4) v:{ ->b
+# c        <2> aassign[t15] KS ->d
+# -           <1> ex-list lK ->-
+# b              <0> padrange[$e:3,4; $f:3,4] l*/LVINTRO,2 ->c
+# -              <1> rv2av[t14] lK/1 ->-
+# -                 <$> gv(*_) s ->-
+# -           <1> ex-list lKPRM* ->c
+# -              <0> pushmark sRM*/LVINTRO ->-
+# -              <0> padsv[$e:3,4] lRM*/LVINTRO ->-
+# -              <0> padsv[$f:3,4] lRM*/LVINTRO ->-
+EONT_EONT
+
 unlink $tmpfile;

diff --git a/ext/B/t/optree_varinit.t b/ext/B/t/optree_varinit.t
index 4c46325..3287179 100644 (file)
--- a/ext/B/t/optree_varinit.t
+++ b/ext/B/t/optree_varinit.t
@@ -390,14 +390,14 @@ checkOptree ( name        => 'my ($a,$b)=()',
 # 1  <0> enter 
 # 2  <;> nextstate(main 1 -e:1) v:>,<,%,{
 # 3  <0> pushmark s
-# 4  <0> padrange[$a:1,2; $b:1,2] lRM*/LVINTRO,2
+# 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> padrange[$a:1,2; $b:1,2] lRM*/LVINTRO,2
+# 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

diff --git a/op.c b/op.c
index af6a6b0..cd07039 100644 (file)
--- a/op.c
+++ b/op.c
@@ -10943,16 +10943,48 @@ Perl_rpeep(pTHX_ register OP *o)
             U8 intro = 0;
             PADOFFSET base = 0; /* init only to stop compiler whining */
             U8 gimme       = 0; /* init only to stop compiler whining */
-
-            /* To allow Deparse to pessimise this, it needs to be able
-             * to restore the pushmark's original op_next, which it
-             * will assume to be the same as op_sibling. */
-            if (o->op_next != o->op_sibling)
-                break;
+            bool defav = 0;  /* seen (...) = @_ */
+
+            /* look for a pushmark -> gv[_] -> rv2av */
+
+            {
+                GV *gv;
+                OP *rv2av, *q;
+                p = o->op_next;
+                if (   p->op_type == OP_GV
+                    && (gv = cGVOPx_gv(p))
+                    && GvNAMELEN_get(gv) == 1
+                    && *GvNAME_get(gv) == '_'
+                    && GvSTASH(gv) == PL_defstash
+                    && (rv2av = p->op_next)
+                    && rv2av->op_type == OP_RV2AV
+                    && !(rv2av->op_flags & OPf_REF)
+                    && !(rv2av->op_private & (OPpLVAL_INTRO|OPpMAYBE_LVSUB))
+                    && ((rv2av->op_flags & OPf_WANT) == OPf_WANT_LIST)
+                    && o->op_sibling == rv2av /* these two for Deparse */
+                    && cUNOPx(rv2av)->op_first == p
+                ) {
+                    q = rv2av->op_next;
+                    if (q->op_type == OP_NULL)
+                        q = q->op_next;
+                    if (q->op_type == OP_PUSHMARK) {
+                        defav = 1;
+                        p = q;
+                    }
+                }
+            }
+            if (!defav) {
+                /* To allow Deparse to pessimise this, it needs to be able
+                 * to restore the pushmark's original op_next, which it
+                 * will assume to be the same as op_sibling. */
+                if (o->op_next != o->op_sibling)
+                    break;
+                p = o;
+            }
 
             /* scan for PAD ops */
 
-            for (p = o->op_next; p; p = p->op_next) {
+            for (p = p->op_next; p; p = p->op_next) {
                 if (p->op_type == OP_NULL)
                     continue;
 
@@ -11052,7 +11084,8 @@ Perl_rpeep(pTHX_ register OP *o)
             o->op_targ = base;
             /* bit 7: INTRO; bit 6..0: count */
             o->op_private = (intro | count);
-            o->op_flags = ((o->op_flags & ~OPf_WANT) | gimme);
+            o->op_flags = ((o->op_flags & ~(OPf_WANT|OPf_SPECIAL))
+                                | gimme | (defav ? OPf_SPECIAL : 0));
 
             break;
         }

diff --git a/op.h b/op.h
index 07ad34c..210521e 100644 (file)
--- a/op.h
+++ b/op.h
@@ -140,6 +140,7 @@ Deprecated.  Use C<GIMME_V> instead.
                                    - Before ck_glob, called as CORE::glob
                                    - After ck_glob, use Perl glob function
                                 */
+                                /*  On OP_PADRANGE, push @_ */
 
 /* 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 a402672..5b0010f 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -84,6 +84,7 @@ PP(pp_padav)
     }
     gimme = GIMME_V;
     if (gimme == G_ARRAY) {
+        /* XXX see also S_pushav in pp_hot.c */
        const I32 maxarg = AvFILL(MUTABLE_AV(TARG)) + 1;
        EXTEND(SP, maxarg);
        if (SvMAGICAL(TARG)) {

diff --git a/pp_hot.c b/pp_hot.c
index 0ef64f3..b5551bf 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -306,6 +306,35 @@ PP(pp_concat)
   }
 }
 
+/* push the elements of av onto the stack.
+ * XXX Note that padav has similar code but without the mg_get().
+ * I suspect that the mg_get is no longer needed, but while padav
+ * differs, it can't share this function */
+
+void
+S_pushav(pTHX_ AV* const av)
+{
+    dSP;
+    const I32 maxarg = AvFILL(av) + 1;
+    EXTEND(SP, maxarg);
+    if (SvRMAGICAL(av)) {
+        U32 i;
+        for (i=0; i < (U32)maxarg; i++) {
+            SV ** const svp = av_fetch(av, i, FALSE);
+            /* See note in pp_helem, and bug id #27839 */
+            SP[i+1] = svp
+                ? SvGMAGICAL(*svp) ? (mg_get(*svp), *svp) : *svp
+                : &PL_sv_undef;
+        }
+    }
+    else {
+        Copy(AvARRAY(av), SP+1, maxarg, SV*);
+    }
+    SP += maxarg;
+    PUTBACK;
+}
+
+
 /* ($lex1,@lex2,...)   or my ($lex1,@lex2,...)  */
 
 PP(pp_padrange)
@@ -314,6 +343,13 @@ PP(pp_padrange)
     PADOFFSET base = PL_op->op_targ;
     int count = (int)(PL_op->op_private) & OPpPADRANGE_COUNTMASK;
     int i;
+    if (PL_op->op_flags & OPf_SPECIAL) {
+        /* fake the RHS of my ($x,$y,..) = @_ */
+        PUSHMARK(SP);
+        S_pushav(aTHX_ GvAVn(PL_defgv));
+        SPAGAIN;
+    }
+
     /* note, this is only skipped for compile-time-known void cxt */
     if ((PL_op->op_flags & OPf_WANT) != OPf_WANT_VOID) {
         EXTEND(SP, count);
@@ -850,23 +886,10 @@ PP(pp_rv2av)
           (until such time as we get tools that can do blame annotation across
           whitespace changes.  */
        if (gimme == G_ARRAY) {
-           const I32 maxarg = AvFILL(av) + 1;
-           (void)POPs;                 /* XXXX May be optimized away? */
-           EXTEND(SP, maxarg);
-           if (SvRMAGICAL(av)) {
-               U32 i;
-               for (i=0; i < (U32)maxarg; i++) {
-                   SV ** const svp = av_fetch(av, i, FALSE);
-                   /* See note in pp_helem, and bug id #27839 */
-                   SP[i+1] = svp
-                       ? SvGMAGICAL(*svp) ? (mg_get(*svp), *svp) : *svp
-                       : &PL_sv_undef;
-               }
-           }
-           else {
-               Copy(AvARRAY(av), SP+1, maxarg, SV*);
-           }
-           SP += maxarg;
+            SP--;
+            PUTBACK;
+            S_pushav(aTHX_ av);
+            SPAGAIN;
        }
        else if (gimme == G_SCALAR) {
            dTARGET;