From 437e3a7dac994ebace1195549170c81f474d9c20 Mon Sep 17 00:00:00 2001 From: Matthew Horsfall Date: Wed, 11 Dec 2013 18:28:21 -0500 Subject: [PATCH] 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) --- ext/B/t/optree_samples.t | 18 +++++++++++++++++- op.c | 31 +++++++++++++++++++++++++++++++ op.h | 6 ++++++ 3 files changed, 54 insertions(+), 1 deletion(-) diff --git a/ext/B/t/optree_samples.t b/ext/B/t/optree_samples.t index 326e0ee617..a4f84c6e9f 100644 --- 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 29eb74585d..4daba7a871 100644 --- 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 8b8e3d2a56..0b84594824 100644 --- 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 -- 2.34.1