In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/e9b067d91703bf151aa6769b5c49fb95a91f6fa5?hp=7b20c7cd49d506897c54f5ed022a5e5b5f8c594a>
- Log ----------------------------------------------------------------- commit e9b067d91703bf151aa6769b5c49fb95a91f6fa5 Author: Nicholas Clark <[email protected]> Date: Thu Oct 7 16:30:32 2010 +0100 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. ----------------------------------------------------------------------- Summary of changes: XSUB.h | 38 +------------------------------------- embed.fnc | 3 +++ global.sym | 1 + proto.h | 5 +++++ util.c | 43 +++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 53 insertions(+), 37 deletions(-) diff --git a/XSUB.h b/XSUB.h index 7a7e882..174ce88 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 c0c5a3f..704a5dd 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 152f4b9..a429d93 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 a9ff4eb..999762f 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 75dbc1b..b1b2af5 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) -- Perl5 Master Repository
