support RC XS subs: add CVf_XS_RCSTACK flag

Allow an XS sub to be flagged with CVf_XS_RCSTACK, which indicates that
it expects a reference-counted stack - and so pp_entersub() etc should
invoke it directly rather than via xs_wrap() on PERL_RC_STACK builds.

Note that there is not yet any syntax in an XS file which supports
marking an XS sub as 'RC-aware', so this facility is very much
in the early stages and "at your own risk", requiring the CV to
manually have its CVf_XS_RCSTACK flag set.

Author: iabyn

MANIFEST

@@ -4897,6 +4897,7 @@ ext/XS-APItest/t/ptr_table.t			Test ptr_table_* APIs
 ext/XS-APItest/t/push.t				XS::APItest extension
 ext/XS-APItest/t/refs.t				Test typemap ref handling
 ext/XS-APItest/t/rmagical.t			XS::APItest extension
+ext/XS-APItest/t/rpp_invoke_xs.t		XS::APItest: test rpp_invoke_xs()
 ext/XS-APItest/t/rv2cv_op_cv.t			test rv2cv_op_cv() API
 ext/XS-APItest/t/savehints.t			test SAVEHINTS() API
 ext/XS-APItest/t/savestack.t			test savestack behavior, currently only in the regex engine

cv.h

@@ -138,6 +138,8 @@ See L<perlguts/Autoloading with XSUBs>.
 #define CVf_IsMETHOD    0x100000 /* CV is a (real) method of a real class. Not
                                    to be confused with what used to be called
                                    CVf_METHOD; now CVf_NOWARN_AMBIGUOUS */
+#define CVf_XS_RCSTACK  0x200000 /* the XS function understands a
+                                    reference-counted stack */
 
 /* This symbol for optimised communication between toke.c and op.c: */
 #define CVf_BUILTIN_ATTRS	(CVf_NOWARN_AMBIGUOUS|CVf_LVALUE|CVf_ANONCONST)
@@ -264,6 +266,10 @@ Helper macro to turn off the C<CvREFCOUNTED_ANYSV> flag.
 #define CvIsMETHOD_on(cv)	(CvFLAGS(cv) |= CVf_IsMETHOD)
 #define CvIsMETHOD_off(cv)	(CvFLAGS(cv) &= ~CVf_IsMETHOD)
 
+#define CvXS_RCSTACK(cv)        (CvFLAGS(cv) & CVf_XS_RCSTACK)
+#define CvXS_RCSTACK_on(cv)     (CvFLAGS(cv) |= CVf_XS_RCSTACK)
+#define CvXS_RCSTACK_off(cv)    (CvFLAGS(cv) &= ~CVf_XS_RCSTACK)
+
 /* Back-compat */
 #ifndef PERL_CORE
 #  define CVf_METHOD            CVf_NOWARN_AMBIGUOUS

ext/XS-APItest/APItest.xs

@@ -4821,6 +4821,35 @@ set_custom_pp_func(sv)
         PERL_UNUSED_ARG(sv);
         XSRETURN(1);
 
+void
+set_xs_rc_stack(cv, sv)
+    CV *cv;
+    SV *sv;
+    PPCODE:
+        /* set or undet the CVf_XS_RCSTACK flag on the CV */
+        assert(SvTYPE(cv) == SVt_PVCV);
+        if (SvTRUE(sv))
+            CvXS_RCSTACK_on(cv);
+        else
+            CvXS_RCSTACK_off(cv);
+        XSRETURN(0);
+
+void
+rc_add(sv1, sv2)
+    SV *sv1;
+    SV *sv2;
+    PPCODE:
+        /* Do the XS equivalent of pp_add(), while expecting a
+         * reference-counted stack */
+
+        /* manipulate the stack directly */
+        PERL_UNUSED_ARG(sv1);
+        PERL_UNUSED_ARG(sv2);
+        SV *r = newSViv(SvIV(PL_stack_sp[-1]) + SvIV(PL_stack_sp[0]));
+        rpp_replace_2_1(r);
+        return;
+
+
 
 MODULE = XS::APItest PACKAGE = XS::APItest::AUTOLOADtest
 

ext/XS-APItest/t/rpp_invoke_xs.t

@@ -0,0 +1,52 @@
+#!perl
+#
+# Test the rpp_invoke_xs() function.
+# In particular, ensure that an XS CV flagged as CvXS_RCSTACK()
+# is called without being wrapped by xs_wrap() but works ok, with no
+# leaks or premature frees etc.
+
+use warnings;
+use strict;
+use Test::More;
+use XS::APItest qw(set_xs_rc_stack rc_add);
+
+
+# Test that $_[0] has the expected refcount
+
+sub rc_is {
+    my (undef, $exp_rc, $desc) = @_;
+    $exp_rc++ if (Internals::stack_refcounted() & 1);
+    is(Internals::SvREFCNT($_[0]), $exp_rc, $desc);
+}
+
+
+# Mark the XS function as 'reference-counted-stack aware'.
+# There's no way do do this yet using XS syntax.
+
+set_xs_rc_stack(\&rc_add, 1);
+
+
+# Basic sanity check
+
+is (rc_add(7,15), 22, "7+15");
+
+
+# Args with RC==1 should be the same afterwards
+
+{
+    my ($x, $y) = (3, 16);
+    rc_is($x, 1, '3+16 rc($x) before');
+    rc_is($y, 1, '3+16 rc($y) before');
+    is (rc_add($x, $y), 19, "3+16");
+    rc_is($x, 1, '3+16 rc($x) after');
+    rc_is($y, 1, '3+16 rc($y) after');
+}
+
+
+# Return value is a newSV kept alive just by the stack
+
+rc_is(rc_add(34, 17), 1, "rc(34+17)");
+
+
+
+done_testing();

inline.h

@@ -782,10 +782,11 @@ Perl_rpp_invoke_xs(pTHX_ CV *cv)
     PERL_ARGS_ASSERT_RPP_INVOKE_XS;
 
 #ifdef PERL_RC_STACK
-    Perl_xs_wrap(aTHX_ CvXSUB(cv), cv);
-#else
-    CvXSUB(cv)(aTHX_ cv);
+    if (!CvXS_RCSTACK(cv))
+        Perl_xs_wrap(aTHX_ CvXSUB(cv), cv);
+    else
 #endif
+        CvXSUB(cv)(aTHX_ cv);
 }