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.

Author: syber

embed.fnc

@@ -550,6 +550,7 @@ 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

embed.h

@@ -1440,6 +1440,7 @@
 #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)

gv.c

@@ -1313,6 +1313,9 @@ 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
 */
 
@@ -1362,44 +1365,82 @@ S_gv_stashpvn_internal(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;
 
+    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));
         (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);
 }
 
 

proto.h

@@ -5912,6 +5912,7 @@ PERL_STATIC_INLINE HV*	S_gv_stashpvn_internal(pTHX_ const char* name, U32 namele
 #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);