Convert the implementation of XS_VERSION_BOOTCHECK to a function from a macro.

The macro expansion generates over 1K of object code. This is in every shared
object, and is only called once. Hence this change increases the perl binary
by about 1K (once), to save 1K for every XS module loaded.

5 files changed, 53 insertions, 37 deletions

diff --git a/XSUB.h b/XSUB.h
index 7a7e88235d..174ce886d6 100644
--- a/XSUB.h
+++ b/XSUB.h
@@ -298,43 +298,7 @@ Rethrows a previously caught exception.  See L<perlguts/"Exception Handling">.
 
 #ifdef XS_VERSION
 #  define XS_VERSION_BOOTCHECK						\
-    STMT_START {							\
-	SV *_sv;							\
-	const char *vn = NULL, *module = SvPV_nolen_const(ST(0));	\
-	if (items >= 2)	 /* version supplied as bootstrap arg */	\
-	    _sv = ST(1);						\
-	else {								\
-	    /* XXX GV_ADDWARN */					\
-	    _sv = get_sv(Perl_form(aTHX_ "%s::%s", module,		\
-				vn = "XS_VERSION"), 0);			\
-	    if (!_sv || !SvOK(_sv))					\
-		_sv = get_sv(Perl_form(aTHX_ "%s::%s", module,		\
-				    vn = "VERSION"), 0);		\
-	}								\
-	if (_sv) {							\
-	    SV *xpt = NULL;						\
-	    SV *xssv = Perl_newSVpvn(aTHX_ STR_WITH_LEN(XS_VERSION));	\
-	    SV *pmsv = sv_derived_from(_sv, "version")			\
-		? SvREFCNT_inc_simple_NN(_sv)				\
-		: new_version(_sv);					\
-	    xssv = upg_version(xssv, 0);				\
-	    if ( vcmp(pmsv,xssv) ) {	 				\
-		xpt = Perl_newSVpvf(aTHX_ "%s object version %"SVf	\
-				    " does not match %s%s%s%s %"SVf,	\
-				    module,				\
-				    SVfARG(Perl_sv_2mortal(aTHX_ vstringify(xssv))), \
-				    vn ? "$" : "", vn ? module : "",	\
-				    vn ? "::" : "",			\
-				    vn ? vn : "bootstrap parameter",	\
-				    SVfARG(Perl_sv_2mortal(aTHX_ vstringify(pmsv)))); \
-		Perl_sv_2mortal(aTHX_ xpt);				\
-	    }								\
-	    SvREFCNT_dec(xssv);						\
-	    SvREFCNT_dec(pmsv);						\
-	    if (xpt)							\
-		Perl_croak_sv(aTHX_ xpt);				\
-	}                                                               \
-    } STMT_END
+    Perl_xs_version_bootcheck(aTHX_ items, ax, STR_WITH_LEN(XS_VERSION))
 #else
 #  define XS_VERSION_BOOTCHECK
 #endif
diff --git a/embed.fnc b/embed.fnc
index c0c5a3f1e3..704a5ddf32 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -2255,6 +2255,9 @@ Apo	|void*	|my_cxt_init	|NN int *index|size_t size
 #endif
 #endif
 
+Apo	|void	|xs_version_bootcheck|U32 items|U32 ax|NN const char *xs_p \
+				|STRLEN xs_len
+
 #ifndef HAS_STRLCAT
 Apno	|Size_t	|my_strlcat	|NULLOK char *dst|NULLOK const char *src|Size_t size
 #endif
diff --git a/global.sym b/global.sym
index 152f4b962c..a429d93529 100644
--- a/global.sym
+++ b/global.sym
@@ -742,6 +742,7 @@ Perl_warn
 Perl_warn_sv
 Perl_warner
 Perl_whichsig
+Perl_xs_version_bootcheck
 Perl_yylex
 Perl_utf8n_to_uvchr
 Perl_uvchr_to_utf8
diff --git a/proto.h b/proto.h
index a9ff4ebe35..999762f32a 100644
--- a/proto.h
+++ b/proto.h
@@ -4687,6 +4687,11 @@ PERL_CALLCONV void	Perl_write_to_stderr(pTHX_ SV* msv)
 #define PERL_ARGS_ASSERT_WRITE_TO_STDERR	\
 	assert(msv)
 
+PERL_CALLCONV void	Perl_xs_version_bootcheck(pTHX_ U32 items, U32 ax, const char *xs_p, STRLEN xs_len)
+			__attribute__nonnull__(pTHX_3);
+#define PERL_ARGS_ASSERT_XS_VERSION_BOOTCHECK	\
+	assert(xs_p)
+
 PERL_CALLCONV int	Perl_yyerror(pTHX_ const char *const s)
 			__attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_YYERROR	\
diff --git a/util.c b/util.c
index 75dbc1bf65..b1b2af5d3b 100644
--- a/util.c
+++ b/util.c
@@ -6471,6 +6471,49 @@ Perl_my_cxt_init(pTHX_ const char *my_cxt_key, size_t size)
 #endif /* #ifndef PERL_GLOBAL_STRUCT_PRIVATE */
 #endif /* PERL_IMPLICIT_CONTEXT */
 
+void
+Perl_xs_version_bootcheck(pTHX_ U32 items, U32 ax, const char *xs_p,
+			  STRLEN xs_len)
+{
+    SV *sv;
+    const char *vn = NULL;
+    const char *module = SvPV_nolen_const(PL_stack_base[ax]);
+
+    PERL_ARGS_ASSERT_XS_VERSION_BOOTCHECK;
+
+    if (items >= 2)	 /* version supplied as bootstrap arg */
+	sv = PL_stack_base[ax + 1];
+    else {
+	/* XXX GV_ADDWARN */
+	sv = get_sv(Perl_form(aTHX_ "%s::%s", module, vn = "XS_VERSION"), 0);
+	if (!sv || !SvOK(sv))
+	    sv = get_sv(Perl_form(aTHX_ "%s::%s", module, vn = "VERSION"), 0);
+    }
+    if (sv) {
+	SV *xpt = NULL;
+	SV *xssv = Perl_newSVpvn(aTHX_ xs_p, xs_len);
+	SV *pmsv = sv_derived_from(sv, "version")
+	    ? SvREFCNT_inc_simple_NN(sv)
+	    : new_version(sv);
+	xssv = upg_version(xssv, 0);
+	if ( vcmp(pmsv,xssv) ) {
+	    xpt = Perl_newSVpvf(aTHX_ "%s object version %"SVf
+				" does not match %s%s%s%s %"SVf,
+				module,
+				SVfARG(Perl_sv_2mortal(aTHX_ vstringify(xssv))),
+				vn ? "$" : "", vn ? module : "",
+				vn ? "::" : "",
+				vn ? vn : "bootstrap parameter",
+				SVfARG(Perl_sv_2mortal(aTHX_ vstringify(pmsv))));
+	    Perl_sv_2mortal(aTHX_ xpt);
+	}
+	SvREFCNT_dec(xssv);
+	SvREFCNT_dec(pmsv);
+	if (xpt)
+	    Perl_croak_sv(aTHX_ xpt);
+    }
+}
+
 #ifndef HAS_STRLCAT
 Size_t
 Perl_my_strlcat(char *dst, const char *src, Size_t size)