XS subs that can inline as ops

So, I wondered just how hard it is to make a way for XS subs to provide an
inlineable OP version.

Not much. The meat, and this might already be too flexible, is:

diff --git a/op.c b/op.c
index 8aa1cae..0e946a8 100644
--- a/op.c
+++ b/op.c
@@ -8436,6 +8436,25 @@ Perl_ck_subr(pTHX_ OP *o)
 		proto = SvPV(MUTABLE_SV(cv), len);
 		proto_end = proto + len;
 	    }
+	    if (!PL_madskills && cv && (CvFLAGS(cv) & CVf_INLINEABLE)) {
+		OP *alternate;
+
+		assert(CvXSUBANY(cv).any_xopcvu32ptr);
+
+		alternate = CvXSUBANY(cv).any_xopcvu32ptr(aTHX_ cv, o, 0);
+
+		if (alternate) {
+		    /* The routine has completely replaced this part of the
+		       optree.  Return immediately.  */
+		    return alternate;
+		}
+
+		if (o->op_type != OP_ENTERSUB) {
+		    /* A change was made.  In which case, no longer need to
+		       push the CV onto the stack before calling the op.  */
+		    op_null((OP *)tmpop);
+		}
+	    }
 	}
     }
     else if (cvop->op_type == OP_METHOD || cvop->op_type == OP_METHOD_NAMED) {



Obviously the real work is in preparing the XSUB correctly. I've not worked
out how much of that could be automated, let alone written the tools to do it.
My test is all "hand written". 

Missing also are

1: Figuring out why B::Concise doesn't show const(PV "Uryyb Jbeyq")
   (This might be because we don't have per-custom op flags)
2: registering the ops properly as custom ops
3: proper warnings about redefining such subroutines. (I think that they need
   to be treated with the same level of care as subs with CVf_CONST)
4: more tests
5: sv_dump tweaks
6: probably some other stuff

But it works:

$ ./perl -Ilib -MXS::APItest -lwe '$a = XS::APItest::rot13("Uryyb Jbeyq"); print $a' 
Hello World
$ ./perl -Ilib -MXS::APItest -lwe '$a = \&XS::APItest::rot13; print $a->("Uryyb Jbeyq")'
Hello World

First gets inlined as a custom op:

$ ./perl -Ilib -MO=Concise -MXS::APItest -lwe '$a = XS::APItest::rot13("Uryyb Jbeyq"); print $a'
c  <@> leave[1 ref] vKP/REFC ->(end)
1     <0> enter ->2
2     <;> nextstate(main 356 -e:1) v:{ ->3
7     <2> sassign vKS/2 ->8
5        <0> custom s ->6
-        <1> ex-rv2sv sKRM*/1 ->7
6           <$> gvsv(*a) s ->7
8     <;> nextstate(main 356 -e:1) v:{ ->9
b     <@> print vK ->c
9        <0> pushmark s ->a
-        <1> ex-rv2sv sK/1 ->b
a           <$> gvsv(*a) s ->b
-e syntax OK

Second is called as a regular XSUB. There's a lot more going on here, and
unfortunately B::Concise isn't actually showing the arguments to the custom
op above, you can't see the differences around the "call" above.
(The "entersub" becomes "custom", and the "gvsv" gets scrubbed out)

$ ./perl -Ilib -MO=Concise -MXS::APItest -lwe '$a = \&XS::APItest::rot13; print $a->("Uryyb Jbeyq")'
g  <@> leave[1 ref] vKP/REFC ->(end)
1     <0> enter ->2
2     <;> nextstate(main 356 -e:1) v:{ ->3
8     <2> sassign vKS/2 ->9
6        <1> refgen sK/1 ->7
-           <1> ex-list lKRM ->6
3              <0> pushmark sRM ->4
5              <1> rv2cv[t1] lKRM/AMPER,32 ->6
-                 <1> ex-list lK ->5
-                    <0> ex-pushmark s ->4
-                    <1> ex-rv2cv sK/8 ->-
4                       <$> gv(*XS::APItest::rot13) s ->5
-        <1> ex-rv2sv sKRM*/1 ->8
7           <$> gvsv(*a) s ->8
9     <;> nextstate(main 356 -e:1) v:{ ->a
f     <@> print vK ->g
a        <0> pushmark s ->b
e        <1> entersub[t2] lKS/TARG,1 ->f
-           <1> ex-list lK ->e
b              <0> pushmark s ->c
c              <$> const(PV "Uryyb Jbeyq") sM ->d
-              <1> ex-rv2cv lK ->-
-                 <1> ex-rv2sv sK/1 ->-
d                    <$> gvsv(*a) s ->e
-e syntax OK


Is this useful to pursue?

Nicholas Clark

diff --git a/cv.h b/cv.h
index 7979a05..57a3cc7 100644
--- a/cv.h
+++ b/cv.h
@@ -77,6 +77,7 @@ Returns the stash of the CV.
 #define CVf_NODEBUG	0x0200	/* no DB::sub indirection for this CV
 				   (esp. useful for special XSUBs) */
 #define CVf_CVGV_RC	0x0400	/* CvGV is reference counted */
+#define CVf_INLINEABLE	0x0800	/* CvXSUBANY() is an inlining routine.  */
 
 /* This symbol for optimised communication between toke.c and op.c: */
 #define CVf_BUILTIN_ATTRS	(CVf_METHOD|CVf_LVALUE)
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 5ce9bfa..f947902 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -327,6 +327,66 @@ blockhook_test_eval(pTHX_ OP *const o)
 
 STATIC BHK bhk_csc, bhk_test;
 
+static void
+rot13(SV *targ)
+{
+    dXSARGS;
+    STRLEN len;
+    char *p;
+    const char *end;
+    SV *raw;
+
+    if (items != 1)
+       croak("Usage: XS::APItest(raw)");
+
+    raw = TOPs;
+
+    sv_copypv(targ, raw);
+    p = SvPV(targ, len);
+    end = p + len;
+    while (p < end) {
+	if ((*p >= 'A' && *p <= 'M') || (*p >= 'a' && *p <= 'm')) {
+	    *p += 'Z' - 'M';
+	} else if ((*p >= 'N' && *p <= 'Z') || (*p >= 'n' && *p <= 'z')) {
+	    *p -= 'Z' - 'M';
+	}
+	++p;
+    }
+    ST(0) = targ;
+}
+
+XS(XS_rot13)
+{
+    dXSTARG;
+    PERL_UNUSED_ARG(cv);
+    rot13(TARG);
+}
+
+PP(pp_rot13)
+{
+    rot13(sv_newmortal());
+    return NORMAL;
+}
+
+static OP *
+rot13_inliner(pTHX_ CV *xsub, OP *calltree, U32 flags)
+{
+    if (flags) {
+	/* Return NULL immediately, with the op unchanged, if we don't
+	   understand how we're being called.  */
+	return NULL;
+    }
+
+    calltree->op_type = OP_CUSTOM;
+    calltree->op_ppaddr = &Perl_pp_rot13;
+    calltree->op_flags = 0;
+    calltree->op_private = 0;
+
+    /* Returning NULL, but with op_type changed, signal that we have not
+       completely replaced this optree, but we have replaced the entersub.  */
+    return NULL;
+}
+
 #include "const-c.inc"
 
 MODULE = XS::APItest:Hash		PACKAGE = XS::APItest::Hash
@@ -1158,3 +1218,8 @@ BOOT:
 	cv = GvCV(*meth);
 	CvLVALUE_on(cv);
 	}
+	{
+	    CV *cv = newXS("XS::APItest::rot13", XS_rot13, file);
+	    CvXSUBANY(cv).any_xopcvu32ptr = rot13_inliner;
+	    CvFLAGS(cv) |= CVf_INLINEABLE;
+	}
diff --git a/op.c b/op.c
index 8aa1cae..0e946a8 100644
--- a/op.c
+++ b/op.c
@@ -8436,6 +8436,25 @@ Perl_ck_subr(pTHX_ OP *o)
 		proto = SvPV(MUTABLE_SV(cv), len);
 		proto_end = proto + len;
 	    }
+	    if (!PL_madskills && cv && (CvFLAGS(cv) & CVf_INLINEABLE)) {
+		OP *alternate;
+
+		assert(CvXSUBANY(cv).any_xopcvu32ptr);
+
+		alternate = CvXSUBANY(cv).any_xopcvu32ptr(aTHX_ cv, o, 0);
+
+		if (alternate) {
+		    /* The routine has completely replaced this part of the
+		       optree.  Return immediately.  */
+		    return alternate;
+		}
+
+		if (o->op_type != OP_ENTERSUB) {
+		    /* A change was made.  In which case, no longer need to
+		       push the CV onto the stack before calling the op.  */
+		    op_null((OP *)tmpop);
+		}
+	    }
 	}
     }
     else if (cvop->op_type == OP_METHOD || cvop->op_type == OP_METHOD_NAMED) {
diff --git a/perl.h b/perl.h
index ccf89ad..cb65809 100644
--- a/perl.h
+++ b/perl.h
@@ -3358,6 +3358,7 @@ union any {
     bool	any_bool;
     void	(*any_dptr) (void*);
     void	(*any_dxptr) (pTHX_ void*);
+    OP *	(*any_xopcvu32ptr) (pTHX_ CV *, OP *, U32);
 };
 #endif
 

• XS subs that can inline as ops by Nicholas Clark
• Re: XS subs that can inline as ops by Zefram
• Re: XS subs that can inline as ops by Zefram
• Re: XS subs that can inline as ops by Nicholas Clark
• Re: XS subs that can inline as ops by Zefram