In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/808724c8e7a94623556f18e681fba068b52291a5?hp=ea4642524cb9cd6a3625b957b4f2736e08d7e30d>
- Log ----------------------------------------------------------------- commit 808724c8e7a94623556f18e681fba068b52291a5 Author: syber <[email protected]> Date: Mon Sep 1 23:47:54 2014 +0200 introduce gv_stashsvpvn_cached() Wrap gv_stashpvn_internal() with a routine which caches what it does, and rework gv_stashsv() and gv_stashpvn() to use the cached codepath. Also rework the documentation of gv_stashsv() and gv_stashpvn() that the gv_stashsv() is prefered as there is a mechanism to cache the hash value associated with the name which requires an SV to passed in as an argument for caching purposes. Note this is a reworked version of sybers original patch. M embed.fnc M embed.h M gv.c M proto.h commit 0eadbdad7ec0b0c6fc943adc20d761deb02e55b8 Author: Yves Orton <[email protected]> Date: Tue Sep 2 00:09:01 2014 +0200 Rename S_stashpvn to S_gv_stashpvn_internal and add to embed.fnc S_stashpvn was not added to embed.fnc properly, and is named contrary to general expectations of the Perl internals. This fixes that, there should be no other functional differences. M embed.fnc M embed.h M gv.c M proto.h ----------------------------------------------------------------------- Summary of changes: embed.fnc | 4 ++++ embed.h | 2 ++ gv.c | 76 ++++++++++++++++++++++++++++++++++++++++++++++++++++----------- proto.h | 6 +++++ 4 files changed, 75 insertions(+), 13 deletions(-) diff --git a/embed.fnc b/embed.fnc index c17bf39..44f5ebf 100644 --- a/embed.fnc +++ b/embed.fnc @@ -548,6 +548,10 @@ px |GV * |gv_override |NN const char * const name \ XMpd |void |gv_try_downgrade|NN GV* gv Apd |HV* |gv_stashpv |NN const char* name|I32 flags Apd |HV* |gv_stashpvn |NN const char* name|U32 namelen|I32 flags +#if defined(PERL_IN_GV_C) +i |HV* |gv_stashpvn_internal|NN const char* name|U32 namelen|I32 flags +i |HV* |gv_stashsvpvn_cached|NULLOK SV *namesv|NULLOK const char* name|U32 namelen|I32 flags +#endif Apd |HV* |gv_stashsv |NN SV* sv|I32 flags Apd |void |hv_clear |NULLOK HV *hv : used in SAVEHINTS() and op.c diff --git a/embed.h b/embed.h index 50d07bb..938a5c9 100644 --- a/embed.h +++ b/embed.h @@ -1439,6 +1439,8 @@ #define gv_is_in_main(a,b,c) S_gv_is_in_main(aTHX_ a,b,c) #define gv_magicalize(a,b,c,d,e,f) S_gv_magicalize(aTHX_ a,b,c,d,e,f) #define gv_magicalize_isa(a) S_gv_magicalize_isa(aTHX_ a) +#define gv_stashpvn_internal(a,b,c) S_gv_stashpvn_internal(aTHX_ a,b,c) +#define gv_stashsvpvn_cached(a,b,c,d) S_gv_stashsvpvn_cached(aTHX_ a,b,c,d) #define maybe_multimagic_gv(a,b,c) S_maybe_multimagic_gv(aTHX_ a,b,c) #define parse_gv_stash_name(a,b,c,d,e,f,g,h) S_parse_gv_stash_name(aTHX_ a,b,c,d,e,f,g,h) #define require_tie_mod(a,b,c,d,e) S_require_tie_mod(aTHX_ a,b,c,d,e) diff --git a/gv.c b/gv.c index 7cc2c1e..5cbcf62 100644 --- a/gv.c +++ b/gv.c @@ -1313,11 +1313,22 @@ Flags may be one of: The most important of which are probably GV_ADD and SVf_UTF8. +Note, use of C<gv_stashsv> instead of C<gv_stashpvn> where possible is strongly +recommended for performance reasons. + =cut */ +/* +gv_stashpvn_internal + +Perform the internal bits of gv_stashsvpvn_cached. You could think of this +as being one half of the logic. Not to be called except from gv_stashsvpvn_cached(). + +*/ + PERL_STATIC_INLINE HV* -S_stashpvn(pTHX_ const char *name, U32 namelen, I32 flags) +S_gv_stashpvn_internal(pTHX_ const char *name, U32 namelen, I32 flags) { char smallbuf[128]; char *tmpbuf; @@ -1325,7 +1336,7 @@ S_stashpvn(pTHX_ const char *name, U32 namelen, I32 flags) GV *tmpgv; U32 tmplen = namelen + 2; - PERL_ARGS_ASSERT_GV_STASHPVN; + PERL_ARGS_ASSERT_GV_STASHPVN_INTERNAL; if (tmplen <= sizeof smallbuf) tmpbuf = smallbuf; @@ -1354,43 +1365,82 @@ S_stashpvn(pTHX_ const char *name, U32 namelen, I32 flags) return stash; } -HV* -Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 flags) +/* +gv_stashsvpvn_cached + +Returns a pointer to the stash for a specified package, possibly +cached. Implements both C<gv_stashpvn> and C<gc_stashsv>. + +Requires one of either namesv or namepv to be non-null. + +See C<gv_stashpvn> for details on "flags". + +Note the sv interface is strongly preferred for performance reasons. + +*/ + +#define PERL_ARGS_ASSERT_GV_STASHSVPVN_CACHED \ + assert(namesv || name) + +PERL_STATIC_INLINE HV* +S_gv_stashsvpvn_cached(pTHX_ SV *namesv, const char *name, U32 namelen, I32 flags) { HV* stash; - const HE* const he = (const HE *)hv_common( - PL_stashcache, NULL, name, namelen, + HE* he; + + PERL_ARGS_ASSERT_GV_STASHSVPVN_CACHED; + + he = (HE *)hv_common( + PL_stashcache, namesv, name, namelen, (flags & SVf_UTF8) ? HVhek_UTF8 : 0, 0, NULL, 0 ); + if (he) return INT2PTR(HV*,SvIVX(HeVAL(he))); else if (flags & GV_CACHE_ONLY) return NULL; - stash = S_stashpvn(aTHX_ name, namelen, flags); + if (namesv) { + if (SvOK(namesv)) { /* prevent double uninit warning */ + STRLEN len; + name = SvPV_const(namesv, len); + namelen = len; + flags |= SvUTF8(namesv); + } else { + name = ""; namelen = 0; + } + } + stash = gv_stashpvn_internal(name, namelen, flags); + if (stash && namelen) { SV* const ref = newSViv(PTR2IV(stash)); - hv_store(PL_stashcache, name, + (void)hv_store(PL_stashcache, name, (flags & SVf_UTF8) ? -(I32)namelen : (I32)namelen, ref, 0); } + return stash; } +HV* +Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 flags) +{ + PERL_ARGS_ASSERT_GV_STASHPVN; + return gv_stashsvpvn_cached(NULL, name, namelen, flags); +} + /* =for apidoc gv_stashsv Returns a pointer to the stash for a specified package. See C<gv_stashpvn>. +Note this interface is strongly preferred over C<gv_stashpvn> for performance reasons. + =cut */ HV* Perl_gv_stashsv(pTHX_ SV *sv, I32 flags) { - STRLEN len; - const char * const ptr = SvPV_const(sv,len); - PERL_ARGS_ASSERT_GV_STASHSV; - - return gv_stashpvn(ptr, len, flags | SvUTF8(sv)); + return gv_stashsvpvn_cached(sv, NULL, 0, flags); } diff --git a/proto.h b/proto.h index 30d70a5..a6453dc 100644 --- a/proto.h +++ b/proto.h @@ -5907,6 +5907,12 @@ STATIC void S_gv_magicalize_isa(pTHX_ GV *gv) #define PERL_ARGS_ASSERT_GV_MAGICALIZE_ISA \ assert(gv) +PERL_STATIC_INLINE HV* S_gv_stashpvn_internal(pTHX_ const char* name, U32 namelen, I32 flags) + __attribute__nonnull__(pTHX_1); +#define PERL_ARGS_ASSERT_GV_STASHPVN_INTERNAL \ + assert(name) + +PERL_STATIC_INLINE HV* S_gv_stashsvpvn_cached(pTHX_ SV *namesv, const char* name, U32 namelen, I32 flags); STATIC void S_maybe_multimagic_gv(pTHX_ GV *gv, const char *name, const svtype sv_type) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2); -- Perl5 Master Repository
