mg.c pp.c pp_sys.c inline.h add more SV_CONST() SV* HEK* hash optimizations

-faster method lookups, faster new SVPV creation (COWs), some of these
 locations were missed by the original branch/PRs/commits that added
 SV_CONST() macro/api.

-I belive all "" C string literals that match a SV_CONST_UPPERCASE SV* HEK*
 cached constant have been replaced with their SV* POK HEK* COW buffer
 equivalents inside libperl with this commit, excluding some instances of
 "__ANON__" strings. Only PERL_CORE files qualify for the SV_CONST()
 optimization, because of design choices made previously about the
 SV_CONST() API. Changing the PERL_CORE-only design choice is out of
 scope of this patch.

-in pp_dbmopen() add SV_CONST(TIEHASH) macros for faster lookup/U32 hash
 pre-calc, and change newSVpvs_flags("AnyDBM_File", SVs_TEMP) to
 newSVpvs_share("AnyDBM_File"), because this sv is used multiple times
 in this pp_*() function, and it is a package name, and it is guaranteed
 to get passed into hv_common() somewhere eventually in some child
 function call we are making.

-some "__ANON__" locations were not changed from sv_*newSV*pvs("__ANON__");
 to sv_*newSV*hek(SV_CONST(__ANON__)); because right after, there is a
 sv_catpvs(""); that will make the SVPV HEK* COW instantly de-COW which
 saved no CPU or memory resources in the end, and only wasted them. Or it
 didn't look "safe" for a SV* COW buffer to be on that line.

-pp_tie() call_method() is an thin inefficient wrapper that makes a
 mortal SVPV around a C string, since the real backend API is call_sv(),
 so switch the call_method() in pp_tie() to the read backend function
 call_sv() and avoid making that mortal SVPV

Author: bulk88

inline.h

@@ -1176,6 +1176,11 @@ Perl_rpp_invoke_xs(pTHX_ CV *cv)
         CvXSUB(cv)(aTHX_ cv);
 }
 
+/* SV_CONST() is limited to #ifdef PERL_CORE, so make a temporary macro. */
+#define x_SV_CONST(name) PL_sv_consts[SV_CONST_##name] \
+    ? PL_sv_consts[SV_CONST_##name] \
+    : (PL_sv_consts[SV_CONST_##name] = newSVpv_share(#name, 0))
+
 
 /* for SvCANEXISTDELETE() macro in pp.h */
 PERL_STATIC_INLINE bool
@@ -1188,10 +1193,11 @@ Perl_sv_can_existdelete(pTHX_ SV *sv)
 
     HV *stash = SvSTASH(SvRV(SvTIED_obj(sv, mg)));
     return stash &&
-        gv_fetchmethod_autoload(stash, "EXISTS", TRUE) &&
-        gv_fetchmethod_autoload(stash, "DELETE", TRUE);
+        gv_fetchmethod_sv_flags(stash, x_SV_CONST(EXISTS), GV_AUTOLOAD) &&
+        gv_fetchmethod_sv_flags(stash, x_SV_CONST(DELETE), GV_AUTOLOAD);
 }
 
+#undef x_SV_CONST
 
 /* ----------------------------- regexp.h ----------------------------- */
 

mg.c

@@ -2306,8 +2306,7 @@ Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
     HV * const pkg = SvSTASH((const SV *)SvRV(tied));
 
     PERL_ARGS_ASSERT_MAGIC_SCALARPACK;
-
-    if (!gv_fetchmethod_autoload(pkg, "SCALAR", FALSE)) {
+    if (!gv_fetchmethod_sv_flags(pkg, SV_CONST(SCALAR), 0)) {
         SV *key;
         if (HvEITER_get(hv))
             /* we are in an iteration so the hash cannot be empty */

op.c

@@ -11080,7 +11080,7 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
         gv = gv_fetchsv(sv, gv_fetch_flags, SVt_PVCV);
         has_name = TRUE;
     } else if (PL_curstash) {
-        gv = gv_fetchpvs("__ANON__", gv_fetch_flags, SVt_PVCV);
+        gv = gv_fetchsv(SV_CONST(__ANON__), gv_fetch_flags, SVt_PVCV);
         has_name = FALSE;
     } else {
         gv = gv_fetchpvs("__ANON__::__ANON__", gv_fetch_flags, SVt_PVCV);

pp.c

@@ -681,8 +681,12 @@ PP(pp_gelem)
         case 'P':
             if (memEQs(elem, len, "PACKAGE")) {
                 const HV * const stash = GvSTASH(gv);
-                const HEK * const hek = stash ? HvNAME_HEK(stash) : NULL;
-                sv = hek ? newSVhek(hek) : newSVpvs("__ANON__");
+                const HEK * hek = stash ? HvNAME_HEK(stash) : NULL;
+                if (!hek) {
+                    SV * sv_hek = SV_CONST(__ANON__);
+                    hek = SvSHARED_HEK_FROM_PV(SvPVX_const(sv_hek));
+                }
+                sv = newSVhek(hek);
             }
             break;
         case 'S':

pp_sys.c

@@ -1078,7 +1078,7 @@ PP_wrapped(pp_tie, 0, 1)
     GV *gv = NULL;
     SV *sv;
     const SSize_t markoff = MARK - PL_stack_base;
-    const char *methname;
+    SV* methname;
     int how = PERL_MAGIC_tied;
     SSize_t items;
     SV *varsv = *++MARK;
@@ -1087,7 +1087,7 @@ PP_wrapped(pp_tie, 0, 1)
         case SVt_PVHV:
         {
             HE *entry;
-            methname = "TIEHASH";
+            methname = SV_CONST(TIEHASH);
             if (HvLAZYDEL(varsv) && (entry = HvEITER_get((HV *)varsv))) {
                 HvLAZYDEL_off(varsv);
                 hv_free_ent(NULL, entry);
@@ -1097,7 +1097,7 @@ PP_wrapped(pp_tie, 0, 1)
             break;
         }
         case SVt_PVAV:
-            methname = "TIEARRAY";
+            methname = SV_CONST(TIEARRAY);
             if (!AvREAL(varsv)) {
                 if (!AvREIFY(varsv))
                     croak("Cannot tie unreifiable array");
@@ -1109,7 +1109,7 @@ PP_wrapped(pp_tie, 0, 1)
         case SVt_PVGV:
         case SVt_PVLV:
             if (isGV_with_GP(varsv) && !SvFAKE(varsv)) {
-                methname = "TIEHANDLE";
+                methname = SV_CONST(TIEHANDLE);
                 how = PERL_MAGIC_tiedscalar;
                 /* For tied filehandles, we apply tiedscalar magic to the IO
                    slot of the GP rather than the GV itself. AMS 20010812 */
@@ -1124,7 +1124,7 @@ PP_wrapped(pp_tie, 0, 1)
             }
             /* FALLTHROUGH */
         default:
-            methname = "TIESCALAR";
+            methname = SV_CONST(TIESCALAR);
             how = PERL_MAGIC_tiedscalar;
             break;
     }
@@ -1137,7 +1137,7 @@ PP_wrapped(pp_tie, 0, 1)
         while (items--)
             PUSHs(*MARK++);
         PUTBACK;
-        call_method(methname, G_SCALAR);
+        call_sv(methname, G_SCALAR | G_METHOD);
     }
     else {
         /* Can't use call_method here, else this: fileno FOO; tie @a, "FOO"
@@ -1148,37 +1148,37 @@ PP_wrapped(pp_tie, 0, 1)
        stash = gv_stashsv(*MARK, 0);
        if (!stash) {
            if (SvROK(*MARK))
-               DIE(aTHX_ "Can't locate object method %" PVf_QUOTEDPREFIX
+               DIE(aTHX_ "Can't locate object method %" SVf_QUOTEDPREFIX
                          " via package %" SVf_QUOTEDPREFIX,
-                   methname, SVfARG(*MARK));
+                   SVfARG(methname), SVfARG(*MARK));
            else if (isGV(*MARK)) {
                /* If the glob doesn't name an existing package, using
                 * SVfARG(*MARK) would yield "*Foo::Bar" or *main::Foo. So
                 * generate the name for the error message explicitly. */
                SV *stashname = sv_newmortal();
                gv_fullname4(stashname, (GV *) *MARK, NULL, FALSE);
-               DIE(aTHX_ "Can't locate object method %" PVf_QUOTEDPREFIX
+               DIE(aTHX_ "Can't locate object method %" SVf_QUOTEDPREFIX
                          " via package %" SVf_QUOTEDPREFIX,
-                   methname, SVfARG(stashname));
+                   SVfARG(methname), SVfARG(stashname));
            }
            else {
                SV *stashname = !SvPOK(*MARK) ? &PL_sv_no
                              : SvCUR(*MARK)  ? *MARK
                              :                 newSVpvs_flags("main", SVs_TEMP);
-               DIE(aTHX_ "Can't locate object method %" PVf_QUOTEDPREFIX
+               DIE(aTHX_ "Can't locate object method %" SVf_QUOTEDPREFIX
                          " via package %" SVf_QUOTEDPREFIX
                    " (perhaps you forgot to load %" SVf_QUOTEDPREFIX "?)",
-                   methname, SVfARG(stashname), SVfARG(stashname));
+                   SVfARG(methname), SVfARG(stashname), SVfARG(stashname));
            }
        }
-       else if (!(gv = gv_fetchmethod(stash, methname))) {
+       else if (!(gv = gv_fetchmethod_sv_flags(stash, methname, GV_AUTOLOAD))) {
            /* The effective name can only be NULL for stashes that have
             * been deleted from the symbol table, which this one can't
             * be, since we just looked it up by name.
             */
-           DIE(aTHX_ "Can't locate object method %" PVf_QUOTEDPREFIX
+           DIE(aTHX_ "Can't locate object method %" SVf_QUOTEDPREFIX
                      " via package %" HEKf_QUOTEDPREFIX ,
-               methname, HvENAME_HEK_NN(stash));
+               SVfARG(methname), HvENAME_HEK_NN(stash));
        }
         ENTER_with_name("call_TIE");
         PUSHSTACKi(PERLSI_MAGIC);
@@ -1229,7 +1229,7 @@ PP_wrapped(pp_untie, 1, 0)
     if ((mg = SvTIED_mg(sv, how))) {
         SV * const obj = SvRV(SvTIED_obj(sv, mg));
         if (obj && SvSTASH(obj)) {
-            GV * const gv = gv_fetchmethod_autoload(SvSTASH(obj), "UNTIE", FALSE);
+            GV * const gv = gv_fetchmethod_sv_flags(SvSTASH(obj), SV_CONST(UNTIE), 0);
             CV *cv;
             if (gv && isGV(gv) && (cv = GvCV(gv))) {
                PUSHMARK(SP);
@@ -1295,13 +1295,13 @@ PP_wrapped(pp_dbmopen, 3, 0)
     GV *gv = NULL;
 
     HV * const hv = MUTABLE_HV(POPs);
-    SV * const sv = newSVpvs_flags("AnyDBM_File", SVs_TEMP);
+    SV * const sv = sv_2mortal(newSVpvs_share("AnyDBM_File"));
     stash = gv_stashsv(sv, 0);
-    if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH"))) {
+    if (!stash || !(gv = gv_fetchmethod_sv_flags(stash, SV_CONST(TIEHASH), GV_AUTOLOAD))) {
         PUTBACK;
         require_pv("AnyDBM_File.pm");
         SPAGAIN;
-        if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH")))
+        if (!stash || !(gv = gv_fetchmethod_sv_flags(stash, SV_CONST(TIEHASH), GV_AUTOLOAD)))
             DIE(aTHX_ "No dbm on this machine");
     }
 

sv.h

@@ -2664,8 +2664,12 @@ Create a new IO, setting the reference count to 1.
 #  define SV_CONST_FETCHSIZE 5
 #  define SV_CONST_STORE 6
 #  define SV_CONST_STORESIZE 7
-#  define SV_CONST_EXISTS 8
+#endif
+
+/* required by Perl_sv_can_existdelete() */
+#define SV_CONST_EXISTS 8
 
+#if defined(PERL_CORE) || defined(PERL_EXT)
 #  define SV_CONST_PUSH 9
 #  define SV_CONST_POP 10
 #  define SV_CONST_SHIFT 11
@@ -2690,8 +2694,12 @@ Create a new IO, setting the reference count to 1.
 #  define SV_CONST_BINMODE 28
 #  define SV_CONST_FILENO 29
 #  define SV_CONST_CLOSE 30
+#endif
 
+/* required by Perl_sv_can_existdelete() */
 #  define SV_CONST_DELETE 31
+
+#if defined(PERL_CORE) || defined(PERL_EXT)
 #  define SV_CONST_CLEAR 32
 #  define SV_CONST_UNTIE 33
 #  define SV_CONST_DESTROY 34