In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/6aa683079638ed0b1923473b64317a0ef3a99849?hp=82ce0493f7a0b47a207f493f68ab035a48f2284b>

- Log -----------------------------------------------------------------
commit 6aa683079638ed0b1923473b64317a0ef3a99849
Author: Father Chrysostomos <spr...@cpan.org>
Date:   Thu Oct 16 21:52:32 2014 -0700

    Make null list+pushmark happen in more cases
    
    This optimisation, added in 7d3c8a683, nulls the list+pushmark pair if
    it occurs in list context, since the two ops effectively cancel each
    other out.  I recently extended it in 8717a761e to apply to void con-
    text, too.
    
    It works by checking in the peephole optimiser whether the sibling of
    the current op is a list with a pushmark kid:
    
    1   current op
    4   list
    2     pushmark
    3     ...
    5   ...
    
    That means the optimisation doesn’t happen if the elder sibling of the
    list op is something that is not part of the execution chain, such as
    $package_var:
    
    -   ex-rv2sv
    1     gvsv
    4   list
    2     pushmark
    3     ...
    5   ...
    
    because the ex-rv2sv is never the ‘current op’.  So ($_,($_,$_))
    doesn’t get optimised.
    
    We can’t just handle this when ‘pushmark’ or ‘list’ is the 
current
    op, because, in the former case, there is no way to get to the parent
    op to null it; in the latter case, there is no way to get to the op
    pointing to pushmark, to rethread the op_next pointers.
    
    However, handling this when list or void context is applied, before we
    even get to the peephole optimiser, just works, and requires much less
    code.  We can just null the ops there, and leave it to the peephole
    optimiser’s handling of null ops to rethread op_next pointers.
    
    This breaks this convention:
    
        op_prepend_elem(OP_LIST, foo, list(that_list))
    
    by creating two redundant null ops that were not there before, but the
    only pieces of code doing that were calling list() needlessly anyway.
-----------------------------------------------------------------------

Summary of changes:
 embed.fnc       |   1 -
 embed.h         |   1 -
 ext/B/t/f_map.t | 152 +++++++++++++++++++++++++-------------------------------
 op.c            |  92 ++++++++++------------------------
 proto.h         |   5 --
 t/op/opt.t      |  12 ++++-
 6 files changed, 106 insertions(+), 157 deletions(-)

diff --git a/embed.fnc b/embed.fnc
index faef450..006fe45 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1936,7 +1936,6 @@ sR        |OP*    |newDEFSVOP
 sR     |OP*    |search_const   |NN OP *o
 sR     |OP*    |new_logop      |I32 type|I32 flags|NN OP **firstp|NN OP 
**otherp
 s      |void   |simplify_sort  |NN OP *o
-s      |void   |null_listop_in_list_context |NN OP* o
 sRn    |bool   |scalar_mod_type|NULLOK const OP *o|I32 type
 s      |OP *   |my_kid         |NULLOK OP *o|NULLOK OP *attrs|NN OP **imopsp
 s      |OP *   |dup_attrlist   |NN OP *o
diff --git a/embed.h b/embed.h
index 6594a6c..e109c7e 100644
--- a/embed.h
+++ b/embed.h
@@ -1537,7 +1537,6 @@
 #define new_logop(a,b,c,d)     S_new_logop(aTHX_ a,b,c,d)
 #define no_bareword_allowed(a) S_no_bareword_allowed(aTHX_ a)
 #define no_fh_allowed(a)       S_no_fh_allowed(aTHX_ a)
-#define null_listop_in_list_context(a) S_null_listop_in_list_context(aTHX_ a)
 #define op_integerize(a)       S_op_integerize(aTHX_ a)
 #define op_std_init(a)         S_op_std_init(aTHX_ a)
 #define pmtrans(a,b,c)         S_pmtrans(aTHX_ a,b,c)
diff --git a/ext/B/t/f_map.t b/ext/B/t/f_map.t
index 639f89c..675cd43 100644
--- a/ext/B/t/f_map.t
+++ b/ext/B/t/f_map.t
@@ -237,18 +237,16 @@ checkOptree(note   => q{},
 # 5  <1> rv2av[t7] lKM/1
 # 6  <@> mapstart lK
 # 7  <|> mapwhile(other->8)[t9] lK
-# 8      <0> pushmark s
-# 9      <#> gvsv[*_] s
-# a      <1> lc[t4] sK/1
-# b      <@> stringify[t5] sK/1
-# c      <$> const[IV 1] s
-# d      <@> list lK
+# 8      <#> gvsv[*_] s
+# 9      <1> lc[t4] sK/1
+# a      <@> stringify[t5] sK/1
+# b      <$> const[IV 1] s
 #            goto 7
-# e  <0> pushmark s
-# f  <#> gv[*hash] s
-# g  <1> rv2hv lKRM*/1
-# h  <2> aassign[t10] KS/COMMON
-# i  <1> leavesub[1 ref] K/REFC,1
+# c  <0> pushmark s
+# d  <#> gv[*hash] s
+# e  <1> rv2hv lKRM*/1
+# f  <2> aassign[t10] KS/COMMON
+# g  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 560 (eval 15):1) v
 # 2  <0> pushmark s
@@ -257,18 +255,16 @@ EOT_EOT
 # 5  <1> rv2av[t4] lKM/1
 # 6  <@> mapstart lK
 # 7  <|> mapwhile(other->8)[t5] lK
-# 8      <0> pushmark s
-# 9      <$> gvsv(*_) s
-# a      <1> lc[t2] sK/1
-# b      <@> stringify[t3] sK/1
-# c      <$> const(IV 1) s
-# d      <@> list lK
+# 8      <$> gvsv(*_) s
+# 9      <1> lc[t2] sK/1
+# a      <@> stringify[t3] sK/1
+# b      <$> const(IV 1) s
 #            goto 7
-# e  <0> pushmark s
-# f  <$> gv(*hash) s
-# g  <1> rv2hv lKRM*/1
-# h  <2> aassign[t6] KS/COMMON
-# i  <1> leavesub[1 ref] K/REFC,1
+# c  <0> pushmark s
+# d  <$> gv(*hash) s
+# e  <1> rv2hv lKRM*/1
+# f  <2> aassign[t6] KS/COMMON
+# g  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
 
 
@@ -289,18 +285,16 @@ checkOptree(note   => q{},
 # 5  <1> rv2av[t7] lKM/1
 # 6  <@> mapstart lK
 # 7  <|> mapwhile(other->8)[t9] lK
-# 8      <0> pushmark s
-# 9      <#> gvsv[*_] s
-# a      <1> lc[t4] sK/1
-# b      <@> stringify[t5] sK/1
-# c      <$> const[IV 1] s
-# d      <@> list lKP
+# 8      <#> gvsv[*_] s
+# 9      <1> lc[t4] sK/1
+# a      <@> stringify[t5] sK/1
+# b      <$> const[IV 1] s
 #            goto 7
-# e  <0> pushmark s
-# f  <#> gv[*hash] s
-# g  <1> rv2hv lKRM*/1
-# h  <2> aassign[t10] KS/COMMON
-# i  <1> leavesub[1 ref] K/REFC,1
+# c  <0> pushmark s
+# d  <#> gv[*hash] s
+# e  <1> rv2hv lKRM*/1
+# f  <2> aassign[t10] KS/COMMON
+# g  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 560 (eval 15):1) v
 # 2  <0> pushmark s
@@ -309,18 +303,16 @@ EOT_EOT
 # 5  <1> rv2av[t4] lKM/1
 # 6  <@> mapstart lK
 # 7  <|> mapwhile(other->8)[t5] lK
-# 8      <0> pushmark s
-# 9      <$> gvsv(*_) s
-# a      <1> lc[t2] sK/1
-# b      <@> stringify[t3] sK/1
-# c      <$> const(IV 1) s
-# d      <@> list lKP
+# 8      <$> gvsv(*_) s
+# 9      <1> lc[t2] sK/1
+# a      <@> stringify[t3] sK/1
+# b      <$> const(IV 1) s
 #            goto 7
-# e  <0> pushmark s
-# f  <$> gv(*hash) s
-# g  <1> rv2hv lKRM*/1
-# h  <2> aassign[t6] KS/COMMON
-# i  <1> leavesub[1 ref] K/REFC,1
+# c  <0> pushmark s
+# d  <$> gv(*hash) s
+# e  <1> rv2hv lKRM*/1
+# f  <2> aassign[t6] KS/COMMON
+# g  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
 
 
@@ -341,17 +333,15 @@ checkOptree(note   => q{},
 # 5  <1> rv2av[t6] lKM/1
 # 6  <@> mapstart lK
 # 7  <|> mapwhile(other->8)[t8] lK
-# 8      <0> pushmark s
-# 9      <#> gvsv[*_] s
-# a      <1> lc[t4] sK/1
-# b      <$> const[IV 1] s
-# c      <@> list lK
+# 8      <#> gvsv[*_] s
+# 9      <1> lc[t4] sK/1
+# a      <$> const[IV 1] s
 #            goto 7
-# d  <0> pushmark s
-# e  <#> gv[*hash] s
-# f  <1> rv2hv lKRM*/1
-# g  <2> aassign[t9] KS/COMMON
-# h  <1> leavesub[1 ref] K/REFC,1
+# b  <0> pushmark s
+# c  <#> gv[*hash] s
+# d  <1> rv2hv lKRM*/1
+# e  <2> aassign[t9] KS/COMMON
+# f  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 589 (eval 26):1) v
 # 2  <0> pushmark s
@@ -360,17 +350,15 @@ EOT_EOT
 # 5  <1> rv2av[t3] lKM/1
 # 6  <@> mapstart lK
 # 7  <|> mapwhile(other->8)[t4] lK
-# 8      <0> pushmark s
-# 9      <$> gvsv(*_) s
-# a      <1> lc[t2] sK/1
-# b      <$> const(IV 1) s
-# c      <@> list lK
+# 8      <$> gvsv(*_) s
+# 9      <1> lc[t2] sK/1
+# a      <$> const(IV 1) s
 #            goto 7
-# d  <0> pushmark s
-# e  <$> gv(*hash) s
-# f  <1> rv2hv lKRM*/1
-# g  <2> aassign[t5] KS/COMMON
-# h  <1> leavesub[1 ref] K/REFC,1
+# b  <0> pushmark s
+# c  <$> gv(*hash) s
+# d  <1> rv2hv lKRM*/1
+# e  <2> aassign[t5] KS/COMMON
+# f  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
 
 
@@ -391,17 +379,15 @@ checkOptree(note   => q{},
 # 5  <1> rv2av[t6] lKM/1
 # 6  <@> mapstart lK
 # 7  <|> mapwhile(other->8)[t7] lK
-# 8      <0> pushmark s
-# 9      <#> gvsv[*_] s
-# a      <1> lc[t4] sK/1
-# b      <$> const[IV 1] s
-# c      <@> list lKP
+# 8      <#> gvsv[*_] s
+# 9      <1> lc[t4] sK/1
+# a      <$> const[IV 1] s
 #            goto 7
-# d  <0> pushmark s
-# e  <#> gv[*hash] s
-# f  <1> rv2hv lKRM*/1
-# g  <2> aassign[t8] KS/COMMON
-# h  <1> leavesub[1 ref] K/REFC,1
+# b  <0> pushmark s
+# c  <#> gv[*hash] s
+# d  <1> rv2hv lKRM*/1
+# e  <2> aassign[t8] KS/COMMON
+# f  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 593 (eval 28):1) v
 # 2  <0> pushmark s
@@ -410,17 +396,15 @@ EOT_EOT
 # 5  <1> rv2av[t3] lKM/1
 # 6  <@> mapstart lK
 # 7  <|> mapwhile(other->8)[t4] lK
-# 8      <0> pushmark s
-# 9      <$> gvsv(*_) s
-# a      <1> lc[t2] sK/1
-# b      <$> const(IV 1) s
-# c      <@> list lKP
+# 8      <$> gvsv(*_) s
+# 9      <1> lc[t2] sK/1
+# a      <$> const(IV 1) s
 #            goto 7
-# d  <0> pushmark s
-# e  <$> gv(*hash) s
-# f  <1> rv2hv lKRM*/1
-# g  <2> aassign[t5] KS/COMMON
-# h  <1> leavesub[1 ref] K/REFC,1
+# b  <0> pushmark s
+# c  <$> gv(*hash) s
+# d  <1> rv2hv lKRM*/1
+# e  <2> aassign[t5] KS/COMMON
+# f  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
 
 
diff --git a/op.c b/op.c
index 47d02ef..c1672ed 100644
--- a/op.c
+++ b/op.c
@@ -1878,12 +1878,27 @@ Perl_scalarvoid(pTHX_ OP *o)
     case OP_LEAVETRY:
     case OP_LEAVELOOP:
     case OP_LINESEQ:
-    case OP_LIST:
     case OP_LEAVEGIVEN:
     case OP_LEAVEWHEN:
+      kids:
        for (kid = cLISTOPo->op_first; kid; kid = OP_SIBLING(kid))
            scalarvoid(kid);
        break;
+    case OP_LIST:
+       /* If the first kid after pushmark is something that the padrange
+          optimisation would reject, then null the list and the pushmark.
+        */
+       if ((kid = cLISTOPo->op_first)->op_type == OP_PUSHMARK
+        && (  !(kid = OP_SIBLING(kid))
+           || (  kid->op_type != OP_PADSV
+              && kid->op_type != OP_PADAV
+              && kid->op_type != OP_PADHV)
+           || kid->op_private & ~OPpLVAL_INTRO)
+       ) {
+           op_null(cUNOPo->op_first); /* NULL the pushmark */
+           op_null(o); /* NULL the list */
+       }
+       goto kids;
     case OP_ENTEREVAL:
        scalarkids(o);
        break;
@@ -1959,8 +1974,14 @@ Perl_list(pTHX_ OP *o)
            list(cBINOPo->op_first);
            return gen_constant_list(o);
        }
+       listkids(o);
+       break;
     case OP_LIST:
        listkids(o);
+       if (cLISTOPo->op_first->op_type == OP_PUSHMARK) {
+           op_null(cUNOPo->op_first); /* NULL the pushmark */
+           op_null(o); /* NULL the list */
+       }
        break;
     case OP_LEAVE:
     case OP_LEAVETRY:
@@ -3093,7 +3114,7 @@ S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, 
OP **imopsp)
     meth = newSVpvs_share("import");
     imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL|OPf_WANT_VOID,
                   op_append_elem(OP_LIST,
-                              op_prepend_elem(OP_LIST, pack, list(arg)),
+                              op_prepend_elem(OP_LIST, pack, arg),
                               newMETHOP_named(OP_METHOD_NAMED, 0, meth)));
 
     /* Combine the ops. */
@@ -5585,7 +5606,7 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP 
*idop, OP *arg)
            meth = newSVpvs_share("VERSION");
            veop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
                            op_append_elem(OP_LIST,
-                                       op_prepend_elem(OP_LIST, pack, 
list(version)),
+                                       op_prepend_elem(OP_LIST, pack, version),
                                        newMETHOP_named(OP_METHOD_NAMED, 0, 
meth)));
        }
     }
@@ -5612,8 +5633,9 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP 
*idop, OP *arg)
            ? newSVpvs_share("import") : newSVpvs_share("unimport");
        imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
                       op_append_elem(OP_LIST,
-                                  op_prepend_elem(OP_LIST, pack, list(arg)),
-                                  newMETHOP_named(OP_METHOD_NAMED, 0, meth)));
+                                  op_prepend_elem(OP_LIST, pack, arg),
+                                  newMETHOP_named(OP_METHOD_NAMED, 0, meth)
+                      ));
     }
 
     /* Fake up the BEGIN {}, which does its thing immediately. */
@@ -11655,18 +11677,6 @@ S_inplace_aassign(pTHX_ OP *o) {
 #define IS_OR_OP(o)    (o->op_type == OP_OR)
 
 
-STATIC void
-S_null_listop_in_list_context(pTHX_ OP *o)
-{
-    PERL_ARGS_ASSERT_NULL_LISTOP_IN_LIST_CONTEXT;
-
-    /* This is an OP_LIST in list (or void) context. That means we
-     * can ditch the OP_LIST and the OP_PUSHMARK within. */
-
-    op_null(cUNOPo->op_first); /* NULL the pushmark */
-    op_null(o); /* NULL the list */
-}
-
 /* A peephole optimizer.  We visit the ops in the order they're to execute.
  * See the comments at the top of this file for more details about when
  * peep() is called */
@@ -11708,54 +11718,6 @@ Perl_rpeep(pTHX_ OP *o)
        PL_op = o;
 
 
-        /* The following will have the OP_LIST and OP_PUSHMARK
-         * patched out later IF the OP_LIST is in list context, or
-         * if it is in void context and padrange is not possible.
-         * So in that case, we can set the this OP's op_next
-         * to skip to after the OP_PUSHMARK:
-         *   a THIS -> b
-         *   d list -> e
-         *   b   pushmark -> c
-         *   c   whatever -> d
-         *   e whatever
-         * will eventually become:
-         *   a THIS -> c
-         *   - ex-list -> -
-         *   -   ex-pushmark -> -
-         *   c   whatever -> e
-         *   e whatever
-         */
-        {
-            OP *sibling;
-            OP *other_pushmark;
-            OP *pushsib;
-            if (OP_TYPE_IS(o->op_next, OP_PUSHMARK)
-                && (sibling = OP_SIBLING(o))
-                && sibling->op_type == OP_LIST
-                /* This KIDS check is likely superfluous since OP_LIST
-                 * would otherwise be an OP_STUB. */
-                && sibling->op_flags & OPf_KIDS
-                && (other_pushmark = cLISTOPx(sibling)->op_first)
-                /* Pointer equality also effectively checks that it's a
-                 * pushmark. */
-                && other_pushmark == o->op_next
-                /* List context */
-                && (  (sibling->op_flags & OPf_WANT) == OPf_WANT_LIST
-                   /* ... or void context... */
-                   || (  (sibling->op_flags & OPf_WANT) == OPf_WANT_VOID
-                      /* ...and something padrange would reject */
-                      && (  !(pushsib = OP_SIBLING(other_pushmark))
-                         || (  pushsib->op_type != OP_PADSV
-                            && pushsib->op_type != OP_PADAV
-                            && pushsib->op_type != OP_PADHV)
-                         || pushsib->op_private & ~OPpLVAL_INTRO))
-                   ))
-            {
-                o->op_next = other_pushmark->op_next;
-                null_listop_in_list_context(sibling);
-            }
-        }
-
        switch (o->op_type) {
        case OP_DBSTATE:
            PL_curcop = ((COP*)o);              /* for warnings */
diff --git a/proto.h b/proto.h
index b9e3048..c0829e3 100644
--- a/proto.h
+++ b/proto.h
@@ -6306,11 +6306,6 @@ STATIC OP*       S_no_fh_allowed(pTHX_ OP *o)
 #define PERL_ARGS_ASSERT_NO_FH_ALLOWED \
        assert(o)
 
-STATIC void    S_null_listop_in_list_context(pTHX_ OP* o)
-                       __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_NULL_LISTOP_IN_LIST_CONTEXT   \
-       assert(o)
-
 PERL_STATIC_INLINE OP* S_op_integerize(pTHX_ OP *o)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_OP_INTEGERIZE \
diff --git a/t/op/opt.t b/t/op/opt.t
index 690565e..ef8649f 100644
--- a/t/op/opt.t
+++ b/t/op/opt.t
@@ -9,7 +9,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-plan 22;
+plan 23;
 
 use v5.10; # state
 use B qw 'svref_2object OPpASSIGN_COMMON';
@@ -57,6 +57,16 @@ for (['CONSTANT', sub {          join "foo", "bar"    }, 0, 
"bar"    ],
 }
 
 
+# list+pushmark in list context elided out of the execution chain
+is svref_2object(sub { () = ($_, ($_, $_)) })
+    ->START # nextstate
+    ->next  # pushmark
+    ->next  # gvsv
+    ->next  # should be gvsv, not pushmark
+  ->name, 'gvsv',
+  "list+pushmark in list context where list's elder sibling is a null";
+
+
 # nextstate multiple times becoming one nextstate
 
 is svref_2object(sub { 0;0;0;0;0;0;time })->START->next->name, 'time',

--
Perl5 Master Repository

Reply via email to