Optimise out PUSHMARK/RETURN if return is the last statement in a sub.

This makes:

  sub baz { return $cat; }

Behave like:

  sub baz { $cat; }

Which is notably faster.

Unpatched:

  ./perl -Ilib/ ~/stuff/bench.pl
  Benchmark: timing 40000000 iterations of normal, ret...
    normal:  3 wallclock secs ( 1.60 usr +  0.01 sys =  1.61 CPU) @ 24844720.50/s (n=40000000)
       ret:  3 wallclock secs ( 2.08 usr +  0.00 sys =  2.08 CPU) @ 19230769.23/s (n=40000000)

Patched:

  ./perl -Ilib ~/stuff/bench.pl
  Benchmark: timing 40000000 iterations of aret, normal...
    normal:  2 wallclock secs ( 1.72 usr +  0.00 sys =  1.72 CPU) @ 23255813.95/s (n=40000000)
       ret:  2 wallclock secs ( 1.72 usr +  0.00 sys =  1.72 CPU) @ 23255813.95/s (n=40000000)

The difference in OP trees can be seen here:

Unpatched:

  $ perl  -MO=Concise,baz -e 'sub baz { return $cat }'
  main::baz:
  5  <1> leavesub[1 ref] K/REFC,1 ->(end)
  -     <@> lineseq KP ->5
  1        <;> nextstate(main 1 -e:1) v ->2
  4        <@> return K ->5
  2           <0> pushmark s ->3
  -           <1> ex-rv2sv sK/1 ->4
  3              <#> gvsv[*cat] s ->4
  -e syntax OK

Patched:

  $ ./perl -Ilib  -MO=Concise,baz -e 'sub baz { return $cat }'
  main::baz:
  3  <1> leavesub[1 ref] K/REFC,1 ->(end)
  -     <@> lineseq KP ->3
  1        <;> nextstate(main 1 -e:1) v ->2
  -        <@> return K ->-
  -           <0> pushmark s ->2
  -           <1> ex-rv2sv sK/1 ->-
  2              <$> gvsv(*cat) s ->3
  -e syntax OK

(Includes some modifications from Steffen)

diff --git a/ext/B/t/optree_samples.t b/ext/B/t/optree_samples.t
index 326e0ee..a4f84c6 100644 (file)
--- a/ext/B/t/optree_samples.t
+++ b/ext/B/t/optree_samples.t
@@ -14,7 +14,7 @@ BEGIN {
 }
 use OptreeCheck;
 use Config;
-plan tests     => 34;
+plan tests     => 37;
 
 pass("GENERAL OPTREE EXAMPLES");
 
@@ -637,6 +637,22 @@ EOT_EOT
 # 6  <@> leave[1 ref] vKP/REFC
 EONT_EONT
 
+pass("rpeep - return \$x at end of sub");
+
+checkOptree ( name     => '-exec sub { return 1 }',
+             code      => sub { return 1 },
+             bcopts    => '-exec',
+             strip_open_hints => 1,
+             expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
+# 1  <;> nextstate(main 1 -e:1) v
+# 2  <$> const[IV 1] s
+# 3  <1> leavesub[1 ref] K/REFC,1
+EOT_EOT
+# 1  <;> nextstate(main 1 -e:1) v
+# 2  <$> const(IV 1) s
+# 3  <1> leavesub[1 ref] K/REFC,1
+EONT_EONT
+
 __END__
 
 #######################################################################

diff --git a/op.c b/op.c
index 29eb745..4daba7a 100644 (file)
--- a/op.c
+++ b/op.c
@@ -11109,6 +11109,37 @@ Perl_rpeep(pTHX_ OP *o)
        case OP_NEXTSTATE:
            PL_curcop = ((COP*)o);              /* for warnings */
 
+           /* Optimise a "return ..." at the end of a sub to just be "...".
+            * This saves 2 ops. Before:
+            * 1  <;> nextstate(main 1 -e:1) v ->2
+            * 4  <@> return K ->5
+            * 2    <0> pushmark s ->3
+            * -    <1> ex-rv2sv sK/1 ->4
+            * 3      <#> gvsv[*cat] s ->4
+            *
+            * After:
+            * -  <@> return K ->-
+            * -    <0> pushmark s ->2
+            * -    <1> ex-rv2sv sK/1 ->-
+            * 2      <$> gvsv(*cat) s ->3
+            */
+           {
+               OP *next = o->op_next;
+               OP *sibling = o->op_sibling;
+               if (   OP_TYPE_IS(next, OP_PUSHMARK)
+                   && OP_TYPE_IS(sibling, OP_RETURN)
+                   && OP_TYPE_IS(sibling->op_next, OP_LINESEQ)
+                   && OP_TYPE_IS(sibling->op_next->op_next, OP_LEAVESUB)
+                   && cUNOPx(sibling)->op_first == next
+                   && next->op_sibling && next->op_sibling->op_next
+                    && next->op_sibling->op_next == sibling
+                   && next->op_next && sibling->op_next)
+               {
+                   next->op_sibling->op_next = sibling->op_next;
+                   o->op_next = next->op_next;
+               }
+           }
+
            /* Two NEXTSTATEs in a row serve no purpose. Except if they happen
               to carry two labels. For now, take the easier option, and skip
               this optimisation if the first NEXTSTATE has a label.  */

diff --git a/op.h b/op.h
index 8b8e3d2..0b84594 100644 (file)
--- a/op.h
+++ b/op.h
@@ -1003,6 +1003,9 @@ For custom ops the type is returned from the registration, and it is up
 to the registree to ensure it is accurate. The value returned will be
 one of the OA_* constants from op.h.
 
+=for apidoc Am|bool|OP_TYPE_IS|OP *o, Optype type
+Returns true if the given OP is not NULL and if it is of the given
+type.
 =cut
 */
 
@@ -1016,6 +1019,9 @@ one of the OA_* constants from op.h.
                     ? XopENTRYCUSTOM(o, xop_class) \
                     : (PL_opargs[(o)->op_type] & OA_CLASS_MASK))
 
+#define OP_TYPE_IS(o, type) ((o) && (o)->op_type == (type))
+
+
 #define newSUB(f, o, p, b)     Perl_newATTRSUB(aTHX_ (f), (o), (p), NULL, (b))
 
 #ifdef PERL_MAD