This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Use a HEK to store the GV's name, rather than a malloc()ed string.
authorNicholas Clark <nick@ccl4.org>
Sun, 5 Mar 2006 17:47:23 +0000 (17:47 +0000)
committerNicholas Clark <nick@ccl4.org>
Sun, 5 Mar 2006 17:47:23 +0000 (17:47 +0000)
Saves 1 word in each GV (no more strlen), and will also save the memory
used by the string itself, as the HEK will exist already due to the
key used by the symbol table for this GV.

p4raw-id: //depot/perl@27379

gv.c
gv.h
sv.c
sv.h

diff --git a/gv.c b/gv.c
index f6c2087..8b3b099 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -2107,11 +2107,15 @@ void
 Perl_gv_name_set(pTHX_ GV *gv, const char *name, U32 len, U32 flags)
 {
     dVAR;
+    U32 hash;
 
     PERL_UNUSED_ARG(flags);
 
-    GvXPVGV(gv)->xgv_name = name ? savepvn(name, len) : NULL;
-    GvXPVGV(gv)->xgv_namelen = len;
+    if (len > I32_MAX)
+       Perl_croak(aTHX_ "panic: gv name too long (%"UVuf")", (UV) len);
+
+    PERL_HASH(hash, name, len);
+    GvXPVGV(gv)->xgv_namehek = name ? share_hek(name, len, hash) : 0;
 }
 
 /*
diff --git a/gv.h b/gv.h
index de8ec52..c4e26c3 100644 (file)
--- a/gv.h
+++ b/gv.h
@@ -43,26 +43,22 @@ struct gp {
            assert(SvTYPE(_gv) == SVt_PVGV || SvTYPE(_gv) >= SVt_PVLV); \
            &(GvXPVGV(_gv)->xnv_u.xgv_stash);                           \
         }))
-#  define GvNAME_get(gv)                                               \
-       ({ GV * const zzzz = (GV *) (gv);                               \
+#  define GvNAME_HEK(gv)                                               \
+       (*({ GV * const zzzz = (GV *) (gv);                             \
           assert(isGV_with_GP(zzzz));                                  \
           assert(SvTYPE(zzzz) == SVt_PVGV || SvTYPE(zzzz) >= SVt_PVLV); \
-          0 + (GvXPVGV(zzzz)->xgv_name);                               \
-        })
-#  define GvNAMELEN_get(gv)                                            \
-       ({ GV * const glank = (GV *) (gv);                              \
-          assert(isGV_with_GP(glank));                         \
-          assert(SvTYPE(glank) == SVt_PVGV || SvTYPE(glank) >= SVt_PVLV); \
-          0 + (GvXPVGV(glank)->xgv_namelen);                           \
-        })
+          &(GvXPVGV(zzzz)->xgv_namehek);                               \
+        }))
 #else
 #  define GvGP(gv)     ((gv)->sv_u.svu_gp)
 #  define GvFLAGS(gv)  (GvXPVGV(gv)->xpv_cur)
 #  define GvSTASH(gv)  (GvXPVGV(gv)->xnv_u.xgv_stash)
-#  define GvNAME_get(gv)       (0 + GvXPVGV(gv)->xgv_name)
-#  define GvNAMELEN_get(gv)    (0 + GvXPVGV(gv)->xgv_namelen)
+#  define GvNAME_HEK(gv)       (GvXPVGV(gv)->xgv_namehek)
 #endif
 
+#define GvNAME_get(gv)         (GvNAME_HEK(gv) ? HEK_KEY(GvNAME_HEK(gv)) : 0)
+#define GvNAMELEN_get(gv)      (GvNAME_HEK(gv) ? HEK_LEN(GvNAME_HEK(gv)) : 0)
+
 #define GvNAME(gv)     GvNAME_get(gv)
 #define GvNAMELEN(gv)  GvNAMELEN_get(gv)
 
diff --git a/sv.c b/sv.c
index 74e6a8b..17d8cc2 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3216,7 +3216,7 @@ S_glob_assign_glob(pTHX_ SV *dstr, SV *sstr, const int dtype)
        GvSTASH(dstr) = GvSTASH(sstr);
        if (GvSTASH(dstr))
            Perl_sv_add_backref(aTHX_ (SV*)GvSTASH(dstr), dstr);
-       gv_name_set(dstr, name, len, 0);
+       gv_name_set((GV *)dstr, name, len, 0);
        SvFAKE_on(dstr);        /* can coerce to non-glob */
     }
 
@@ -5111,7 +5111,9 @@ Perl_sv_clear(pTHX_ register SV *sv)
        goto freescalar;
     case SVt_PVGV:
        gp_free((GV*)sv);
-       Safefree(GvNAME(sv));
+       if (GvNAME_HEK(sv)) {
+           unshare_hek(GvNAME_HEK(sv));
+       }
        /* If we're in a stash, we don't own a reference to it. However it does
           have a back reference to us, which needs to be cleared.  */
        if (GvSTASH(sv))
@@ -7715,7 +7717,9 @@ S_sv_unglob(pTHX_ SV *sv)
        GvSTASH(sv) = NULL;
     }
     GvMULTI_off(sv);
-    Safefree(GvNAME(sv));
+    if (GvNAME_HEK(sv)) {
+       unshare_hek(GvNAME_HEK(sv));
+    }
     SvSCREAM_off(sv);
 
     /* need to keep SvANY(sv) in the right arena */
@@ -9836,7 +9840,8 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
                    LvTARG(dstr) = sv_dup_inc(LvTARG(dstr), param);
                break;
            case SVt_PVGV:
-               GvXPVGV(dstr)->xgv_name = SAVEPVN(GvNAME(dstr), GvNAMELEN(dstr));
+               if (GvNAME_HEK(dstr))
+                   GvNAME_HEK(dstr) = hek_dup(GvNAME_HEK(dstr), param);
 
                /* Don't call sv_add_backref here as it's going to be created
                   as part of the magic cloning of the symbol table.  */
diff --git a/sv.h b/sv.h
index 50f11e0..7a63afc 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -487,8 +487,7 @@ struct xpvlv {
     HV*                xmg_stash;      /* class package */
 
     /* a full glob fits into this */
-    char*      xgv_name;
-    STRLEN     xgv_namelen;
+    HEK *      xgv_namehek;
 
     STRLEN     xlv_targoff;
     STRLEN     xlv_targlen;
@@ -516,8 +515,7 @@ struct xpvgv {
     } xmg_u;
     HV*                xmg_stash;      /* class package */
 
-    char*      xgv_name;
-    STRLEN     xgv_namelen;
+    HEK *      xgv_namehek;
 };
 
 struct xpvbm {