Optimise rpp_replace_2_{1,IMM}_NN()

These two static functions are used in a lot of pp functions.
This commit does two main things. First, it makes the size of the inline
function smaller, and second, it uses a single branch (rather than two)
to decide whether either of the two SVs being popped need to be freed.

In detail: apart from the actual stack manipulation itself, the other
main action of these two functions:

    rpp_replace_2_1_NN()
    rpp_replace_2_IMM_NN()

is to do the equivalent of

    SvREFCNT_dec_NN(PL_stack[-1]);
    SvREFCNT_dec_NN(PL_stack[-0]);

Now, SvREFCNT_dec_NN() is an inline function which expands to
something like:

    U32 rc = SvREFCNT(sv);
    if (LIKELY(rc > 1))
        SvREFCNT(sv) = rc - 1;
    else
        Perl_sv_free2(aTHX_ sv, rc);

With this expanded *twice* within the body of rpp_replace_2_1_NN(),
there are two branch tests and two function calls - all of which are
expanded inline into the bodies of all 50+ pp functions which use it.
This commit makes this be changed to something equivalent to

    U32 rc1 = SvREFCNT(sv1);
    U32 rc2 = SvREFCNT(sv2);
    if (LIKELY(rc1 > 1 && rc2 > 1)) {
        SvREFCNT(sv1) = rc1 - 1;
        SvREFCNT(sv2) = rc2 - 1;
    }
    else
        Perl_rpp_free_2_(aTHX_ sv1, sv2, rc1, rc2);

Where Perl_rpp_free_2_() does the hard work of deciding whether either
or both SVs actually need freeing.

This approach assumes that, most of the time, rpp_replace_2_1_NN() won't
actually be freeing either of the two old args on the stack, because
often they are likely to be PADTMPs or lexicals or array elements or
or immortals or whatever, which have a longer lifetime. I.e.  this
commit is betting that

    $a + ($b * $c);   # RHS of '+' is a PADTMP

is more common than

    $a + f();         # RHS of '+' is a temporary SV with RC==1

diff --git a/embed.fnc b/embed.fnc
index 8d2c2ce..0bbee1f 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2766,6 +2766,10 @@ Adipx    |void   |rpp_context    |NN SV **mark                           \
                                |U8 gimme                               \
                                |SSize_t extra
 Adipx  |void   |rpp_extend     |SSize_t n
+Xopx   |void   |rpp_free_2_    |NN SV * const sv1                      \
+                               |NN SV * const sv2                      \
+                               |const U32 rc1                          \
+                               |const U32 rc2
 Adipx  |void   |rpp_invoke_xs  |NN CV *cv
 Adipx  |bool   |rpp_is_lone    |NN SV *sv
 Cpx    |void   |rpp_obliterate_stack_to                                \
@@ -2796,6 +2800,8 @@ Adipx     |void   |rpp_replace_at_norc                                    \
 Adipx  |void   |rpp_replace_at_norc_NN                                 \
                                |NN SV **sp                             \
                                |NN SV *sv
+Cipx   |void   |rpp_replace_2_1_COMMON                                 \
+                               |NN SV *sv
 Adipx  |void   |rpp_replace_1_IMM_NN                                   \
                                |NN SV *sv
 Adipx  |void   |rpp_replace_2_IMM_NN                                   \

diff --git a/embed.h b/embed.h
index 38a65be..9e8a8e4 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -557,6 +557,7 @@
 # define rpp_replace_1_1_NN(a)                  Perl_rpp_replace_1_1_NN(aTHX_ a)
 # define rpp_replace_1_IMM_NN(a)                Perl_rpp_replace_1_IMM_NN(aTHX_ a)
 # define rpp_replace_2_1(a)                     Perl_rpp_replace_2_1(aTHX_ a)
+# define rpp_replace_2_1_COMMON(a)              Perl_rpp_replace_2_1_COMMON(aTHX_ a)
 # define rpp_replace_2_1_NN(a)                  Perl_rpp_replace_2_1_NN(aTHX_ a)
 # define rpp_replace_2_IMM_NN(a)                Perl_rpp_replace_2_IMM_NN(aTHX_ a)
 # define rpp_replace_at(a,b)                    Perl_rpp_replace_at(aTHX_ a,b)

diff --git a/inline.h b/inline.h
index a6e54ed..ccccddd 100644 (file)
--- a/inline.h
+++ b/inline.h
@@ -842,25 +842,42 @@ Perl_rpp_replace_2_1(pTHX_ SV *sv)
 }
 
 
+/* Private helper function for _NN and _IMM_NN variants.
+ * Assumes sv has already had its ref count incremented,
+ * ready for being put on the stack.
+ * Intended to be small and fast, since it's inlined into many hot parts of
+ * code.
+ */
+
 PERL_STATIC_INLINE void
-Perl_rpp_replace_2_1_NN(pTHX_ SV *sv)
+Perl_rpp_replace_2_1_COMMON(pTHX_ SV *sv)
 {
-    PERL_ARGS_ASSERT_RPP_REPLACE_2_1_NN;
 
     assert(sv);
-    assert(PL_stack_sp[0]);
-    assert(PL_stack_sp[-1]);
 #ifdef PERL_RC_STACK
+    SV *sv2 = *PL_stack_sp--;
+    assert(sv2);
+    SV *sv1 = *PL_stack_sp;
+    assert(sv1);
+
+    *PL_stack_sp = sv;
     assert(rpp_stack_is_rc());
-    /* replace PL_stack_sp[-1] first; leave PL_stack_sp[0] in place while
-     * we free [-1], so if an exception occurs, [0] will still be freed.
-     */
-    SV *oldsv = PL_stack_sp[-1];
-    PL_stack_sp[-1] = sv;
-    SvREFCNT_inc_simple_void_NN(sv);
-    SvREFCNT_dec_NN(oldsv);
-    oldsv = *PL_stack_sp--;
-    SvREFCNT_dec_NN(oldsv);
+    U32 rc1 = SvREFCNT(sv1);
+    U32 rc2 = SvREFCNT(sv2);
+    /* This expression is intended to be true if either of rc1 or rc2 has
+     * the value 0 or 1, but using only a single branch test, rather
+     * than the two branches that a compiler would plant for a boolean
+     * expression. We are working on the assumption that, most of the
+     * time, neither of the args to a binary function will need to be
+     * freed - they're likely to lex vars, or PADTMPs or whatever.
+     * So give the CPU a single branch that is rarely taken. */
+    if (UNLIKELY( !(rc1>>1) + !(rc2>>1) ))
+        /* at least one of the old SVs needs freeing. Do it the long way */
+        Perl_rpp_free_2_(aTHX_ sv1, sv2, rc1, rc2);
+    else {
+        SvREFCNT(sv1) = rc1 - 1;
+        SvREFCNT(sv2) = rc2 - 1;
+    }
 #else
     *--PL_stack_sp = sv;
 #endif
@@ -868,27 +885,26 @@ Perl_rpp_replace_2_1_NN(pTHX_ SV *sv)
 
 
 PERL_STATIC_INLINE void
+Perl_rpp_replace_2_1_NN(pTHX_ SV *sv)
+{
+    PERL_ARGS_ASSERT_RPP_REPLACE_2_1_NN;
+
+    assert(sv);
+#ifdef PERL_RC_STACK
+    SvREFCNT_inc_simple_void_NN(sv);
+#endif
+    rpp_replace_2_1_COMMON(sv);
+}
+
+
+PERL_STATIC_INLINE void
 Perl_rpp_replace_2_IMM_NN(pTHX_ SV *sv)
 {
     PERL_ARGS_ASSERT_RPP_REPLACE_2_IMM_NN;
 
     assert(sv);
     assert(SvIMMORTAL(sv));
-    assert(PL_stack_sp[0]);
-    assert(PL_stack_sp[-1]);
-#ifdef PERL_RC_STACK
-    assert(rpp_stack_is_rc());
-    /* replace PL_stack_sp[-1] first; leave PL_stack_sp[0] in place while
-     * we free [-1], so if an exception occurs, [0] will still be freed.
-     */
-    SV *oldsv = PL_stack_sp[-1];
-    PL_stack_sp[-1] = sv;
-    SvREFCNT_dec_NN(oldsv);
-    oldsv = *PL_stack_sp--;
-    SvREFCNT_dec_NN(oldsv);
-#else
-    *--PL_stack_sp = sv;
-#endif
+    rpp_replace_2_1_COMMON(sv);
 }
 
 

diff --git a/pp_hot.c b/pp_hot.c
index 5600e4b..84563af 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -176,6 +176,47 @@ Perl_xs_wrap(pTHX_ XSUBADDR_t xsub, CV *cv)
 #endif
 
 
+
+/* Private helper function for Perl_rpp_replace_2_1_COMMON().
+ * Free the two passed SVs, whose original ref counts are rc1 and rc2.
+ * Assumes the stack initially looked like
+ *    .... sv1 sv2
+ * and is now:
+ *    .... X
+ * but where sv2 is still on the slot above the current PL_stack_sp.
+ */
+
+void
+Perl_rpp_free_2_(pTHX_ SV *const sv1,  SV *const sv2,
+                       const U32 rc1,  const U32 rc2)
+{
+
+    PERL_ARGS_ASSERT_RPP_FREE_2_;
+
+#ifdef PERL_RC_STACK
+    if (rc1 > 1)
+        SvREFCNT(sv1) = rc1 - 1;
+    else {
+        /* temporarily reclaim sv2 on stack in case we die while freeing sv1 */
+        assert(PL_stack_sp[1] == sv2);
+        PL_stack_sp++;
+        Perl_sv_free2(aTHX_ sv1, rc1);
+        PL_stack_sp--;
+    }
+    if (rc2 > 1)
+        SvREFCNT(sv2) = rc2 - 1;
+    else
+        Perl_sv_free2(aTHX_ sv2, rc2);
+#else
+    PERL_UNUSED_VAR(sv1);
+    PERL_UNUSED_VAR(sv2);
+    PERL_UNUSED_VAR(rc1);
+    PERL_UNUSED_VAR(rc2);
+#endif
+}
+
+
+
 /* ----------------------------------------------------------- */
 
 

diff --git a/proto.h b/proto.h
index 84c68d3..e06c0b2 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -3839,6 +3839,11 @@ Perl_rpeep(pTHX_ OP *o)
 #define PERL_ARGS_ASSERT_RPEEP
 
 PERL_CALLCONV void
+Perl_rpp_free_2_(pTHX_ SV * const sv1, SV * const sv2, const U32 rc1, const U32 rc2);
+#define PERL_ARGS_ASSERT_RPP_FREE_2_            \
+        assert(sv1); assert(sv2)
+
+PERL_CALLCONV void
 Perl_rpp_obliterate_stack_to(pTHX_ I32 ix);
 #define PERL_ARGS_ASSERT_RPP_OBLITERATE_STACK_TO
 
@@ -9903,6 +9908,11 @@ Perl_rpp_replace_2_1(pTHX_ SV *sv);
         assert(sv)
 
 PERL_STATIC_INLINE void
+Perl_rpp_replace_2_1_COMMON(pTHX_ SV *sv);
+# define PERL_ARGS_ASSERT_RPP_REPLACE_2_1_COMMON \
+        assert(sv)
+
+PERL_STATIC_INLINE void
 Perl_rpp_replace_2_1_NN(pTHX_ SV *sv);
 # define PERL_ARGS_ASSERT_RPP_REPLACE_2_1_NN    \
         assert(sv)