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 326e0ee6170e1456ada6f455d4db78428d5d06ec..a4f84c6e9f7fdda75167620990b8925d3e9cefd3 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 29eb74585df7cefc4486d2a48631314dcdccbccc..4daba7a8719ceb1fcc72c2aa53cb45188b12adc7 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 8b8e3d2a56610dbc3e493e27276a4e87c45e37cb..0b84594824baa47b1325ffcea60ecfa877c169e8 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