add Perl_gimme_V() static inline fn for GIMME_V

This function makes use of PL_curstackinfo->si_cxsubix to avoid the
overhead of a call to block_gimme() when the context of the op is
unknown.

diff --git a/embed.fnc b/embed.fnc
index a3e5fb2..8c346c5 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -3517,6 +3517,7 @@ Apx       |void   |leave_adjust_stacks|NN SV **from_sp|NN SV **to_sp \
                 |U8 gimme|int filter
 
 #ifndef PERL_NO_INLINE_FUNCTIONS
+Aixp   |U8     |gimme_V         |
 Aixp   |PERL_CONTEXT * |cx_pushblock|U8 type|U8 gimme|NN SV** sp|I32 saveix
 Aixp   |void   |cx_popblock|NN PERL_CONTEXT *cx
 Aixp   |void   |cx_topblock|NN PERL_CONTEXT *cx

diff --git a/embed.h b/embed.h
index f1c3f57..53dd870 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -979,6 +979,7 @@
 #define cx_pushsub(a,b,c,d)    Perl_cx_pushsub(aTHX_ a,b,c,d)
 #define cx_pushwhen(a)         Perl_cx_pushwhen(aTHX_ a)
 #define cx_topblock(a)         Perl_cx_topblock(aTHX_ a)
+#define gimme_V()              Perl_gimme_V(aTHX)
 #endif
 #if defined(DEBUGGING)
 #define pad_setsv(a,b)         Perl_pad_setsv(aTHX_ a,b)

diff --git a/inline.h b/inline.h
index 84b0bfc..1755893 100644 (file)
--- a/inline.h
+++ b/inline.h
@@ -2056,6 +2056,26 @@ Perl_sv_only_taint_gmagic(SV *sv)
 
 /* ------------------ cop.h ------------------------------------------- */
 
+/* implement GIMME_V() macro */
+
+PERL_STATIC_INLINE U8
+Perl_gimme_V(pTHX)
+{
+    I32 cxix;
+    U8  gimme = (PL_op->op_flags & OPf_WANT);
+
+    if (gimme)
+        return gimme;
+    cxix = PL_curstackinfo->si_cxsubix;
+    if (cxix < 0)
+        return G_VOID;
+    gimme = (cxstack[cxix].blk_gimme & G_WANT);
+    if (gimme)
+        return gimme;
+    /* use the full sub to report the error */
+    return block_gimme();
+}
+
 
 /* Enter a block. Push a new base context and return its address. */
 

diff --git a/op.h b/op.h
index c494386..89440a2 100644 (file)
--- a/op.h
+++ b/op.h
@@ -85,7 +85,7 @@ Deprecated.  Use C<GIMME_V> instead.
 =cut
 */
 
-#define GIMME_V                OP_GIMME(PL_op, block_gimme())
+#define GIMME_V                Perl_gimme_V(aTHX)
 
 /* Public flags */
 

diff --git a/pp_ctl.c b/pp_ctl.c
index ef1ff8d..af95a9e 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1389,6 +1389,8 @@ Perl_dowantarray(pTHX)
     return (gimme == G_VOID) ? G_SCALAR : gimme;
 }
 
+/* note that this function has mostly been superseded by Perl_gimme_V */
+
 U8
 Perl_block_gimme(pTHX)
 {

diff --git a/proto.h b/proto.h
index fe9b9a0..f351644 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -4868,6 +4868,10 @@ PERL_STATIC_INLINE void  Perl_cx_topblock(pTHX_ PERL_CONTEXT *cx);
 #define PERL_ARGS_ASSERT_CX_TOPBLOCK   \
        assert(cx)
 #endif
+#ifndef PERL_NO_INLINE_FUNCTIONS
+PERL_STATIC_INLINE U8  Perl_gimme_V(pTHX);
+#define PERL_ARGS_ASSERT_GIMME_V
+#endif
 #endif
 #if !defined(PERL_NO_UTF16_FILTER)
 #  if defined(PERL_IN_TOKE_C)

diff --git a/t/perf/benchmarks b/t/perf/benchmarks
index 7795079..63eb62c 100644 (file)
--- a/t/perf/benchmarks
+++ b/t/perf/benchmarks
@@ -158,6 +158,12 @@
         code    => '$x = f(1)',
     },
 
+    'call::sub::scalar' => {
+        desc    => 'sub called in scalar context',
+        setup   => 'my $x; my @a = 1..4; sub f { @a }',
+        code    => '$x = f()',
+    },
+
     'call::goto::empty' => {
         desc    => 'goto &funtion with no args or body',
         setup   => 'sub f { goto &g } sub g {}',