Optimization: Remove needless list/pushmark pairs from the OP execution

This is an optimization for OP trees that involve list OPs in list
context. In list context, the list OP's first child, a pushmark, will do
what its name claims and push a mark to the mark stack, indicating the
start of a list of parameters to another OP. Then the list's other
child OPs will do their stack pushing. Finally, the list OP will be
executed and do nothing but undo what the pushmark has done. This is
because the main effect of the list OP only really kicks in if it's
not in array context (actually, it should probably only kick in if
it's in scalar context, but I don't know of any valid examples of
list OPs in void contexts).

This optimization is quite a measurable speed-up for array or hash
slicing and some other situations. Another (contrived) example is
that (1,2,(3,4)) now actually is the same, performance-wise as
(1,2,3,4), albeit that's rarely relevant.

The price to pay for this is a slightly convoluted (by standards other
than the perl core) bit of optimization logic that has to do minor
look-ahead on certain OPs in the peephole optimizer.

A number of tests failed after the first attack on this problem. The
failures were in two categories:

a) Tests that are sensitive to details of the OP tree structure and did
verbatim text comparisons of B::Concise output (ouch). These are just
patched according to the new red in this commit.

b) Test that validly failed because certain conditions in op.c were
expecting OP_LISTs where there are now OP_NULLs (with op_targ=OP_LIST).
For these, the respective conditions in op.c were adjusted.

The change includes modifying B::Deparse to handle the new OP tree
structure in the face of nulled OP_LISTs.

1 files changed, 71 insertions, 5 deletions

diff --git a/op.c b/op.c
index f17216c953..508dce6d40 100644
--- a/op.c
+++ b/op.c
@@ -1228,6 +1228,11 @@ S_scalar_slice_warning(pTHX_ const OP *o)
     case OP_RVALUES:
 	return;
     }
+
+    /* Don't warn if we have a nulled list either. */
+    if (kid->op_type == OP_NULL && kid->op_targ == OP_LIST)
+        return;
+
     assert(kid->op_sibling);
     name = S_op_varname(aTHX_ kid->op_sibling);
     if (!name) /* XS module fiddling with the op tree */
@@ -1953,10 +1958,13 @@ S_finalize_op(pTHX_ OP* o)
 	S_scalar_slice_warning(aTHX_ o);
 
     case OP_KVHSLICE:
+        kid = cLISTOPo->op_first->op_sibling;
 	if (/* I bet there's always a pushmark... */
-	        (kid = cLISTOPo->op_first->op_sibling)->op_type != OP_LIST
-	      && kid->op_type != OP_CONST)
+	    OP_TYPE_ISNT_AND_WASNT_NN(kid, OP_LIST)
+	    && OP_TYPE_ISNT_NN(kid, OP_CONST))
+        {
 	    break;
+        }
 
 	key_op = (SVOP*)(kid->op_type == OP_CONST
 				? kid
@@ -5803,7 +5811,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 			   (state $a, my $b, our $c, $d, undef) = ... */
 		    }
 		} else if (lop->op_type == OP_UNDEF ||
-			   lop->op_type == OP_PUSHMARK) {
+                           OP_TYPE_IS_OR_WAS(lop, OP_PUSHMARK)) {
 		    /* undef may be interesting in
 		       (state $a, undef, state $c) */
 		} else {
@@ -9661,7 +9669,7 @@ Perl_ck_sassign(pTHX_ OP *o)
 	/* For state variable assignment, kkid is a list op whose op_last
 	   is a padsv. */
 	if ((kkid->op_type == OP_PADSV ||
-	     (kkid->op_type == OP_LIST &&
+	     (OP_TYPE_IS_OR_WAS(kkid, OP_LIST) &&
 	      (kkid = cLISTOPx(kkid)->op_last)->op_type == OP_PADSV
 	     )
 	    )
@@ -11144,6 +11152,26 @@ S_inplace_aassign(pTHX_ OP *o) {
 #define IS_AND_OP(o)   (o->op_type == OP_AND)
 #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 context. That means we
+     * can ditch the OP_LIST and the OP_PUSHMARK within. */
+
+    OP *kid = cLISTOPo->op_first;
+    /* Find the end of the chain of OPs executed within the OP_LIST. */
+    while (kid->op_next != o) {
+        assert(kid);
+        kid = kid->op_next;
+    }
+
+    kid->op_next = o->op_next; /* patch list out of exec chain */
+    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 */
@@ -11176,6 +11204,44 @@ Perl_rpeep(pTHX_ OP *o)
 	   clear this again.  */
 	o->op_opt = 1;
 	PL_op = o;
+
+
+        /* The following will have the OP_LIST and OP_PUSHMARK
+         * patched out later IF the OP_LIST is in list context.
+         * 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;
+            if (OP_TYPE_IS(o->op_next, OP_PUSHMARK)
+                && (sibling = o->op_sibling)
+                && 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
+                && (sibling->op_flags & OPf_WANT) == OPf_WANT_LIST
+                && (other_pushmark = cLISTOPx(sibling)->op_first)
+                /* Pointer equality also effectively checks that it's a
+                 * pushmark. */
+                && other_pushmark == o->op_next)
+            {
+                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 */
@@ -11538,7 +11604,7 @@ Perl_rpeep(pTHX_ OP *o)
              */
             assert(followop);
             if (gimme == OPf_WANT_VOID) {
-                if (followop->op_type == OP_LIST
+                if (OP_TYPE_IS_OR_WAS(followop, OP_LIST)
                         && gimme == (followop->op_flags & OPf_WANT)
                         && (   followop->op_next->op_type == OP_NEXTSTATE
                             || followop->op_next->op_type == OP_DBSTATE))