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.

1 files changed, 50 insertions, 9 deletions

diff --git a/gv.c b/gv.c
index 3eec538e05..5cbcf62176 100644
--- a/gv.c
+++ b/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,17 +1365,49 @@ 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) {
@@ -1380,26 +1415,32 @@ Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 flags)
         (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);
 }