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.

diff --git a/XSUB.h b/XSUB.h
index 7a7e882..174ce88 100644 (file)
--- 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 c0c5a3f..704a5dd 100644 (file)
--- 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 152f4b9..a429d93 100644 (file)
--- 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 a9ff4eb..999762f 100644 (file)
--- 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 75dbc1b..b1b2af5 100644 (file)
--- 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)