Store the package name as a shared HEK.

Abolish HvNAME() - as the stored pointer is not a char* you can't set
it directly now.
Storing a pointer to a HEK tracks the length too, and seems to be
faster.

p4raw-id: //depot/perl@24584

diff --git a/embed.fnc b/embed.fnc
index 8a7a248..2c03d96 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1434,8 +1434,7 @@ Apo       |I32*   |hv_riter_p     |HV* hv
 Apo    |HE**   |hv_eiter_p     |HV* hv
 Apo    |void   |hv_riter_set   |HV* hv|I32 riter
 Apo    |void   |hv_eiter_set   |HV* hv|HE* eiter
-Apo    |char** |hv_name_p      |HV* hv
-Apo    |void   |hv_name_set    |HV* hv|const char *|STRLEN len|int flags
+Apo    |void   |hv_name_set    |HV* hv|const char *|I32 len|int flags
 Apo    |I32*   |hv_placeholders_p      |HV* hv
 Apo    |I32    |hv_placeholders_get    |HV* hv
 Apo    |void   |hv_placeholders_set    |HV* hv|I32 ph

diff --git a/gv.c b/gv.c
index 5110617..98baea8 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -246,8 +246,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
 
     /* create and re-create @.*::SUPER::ISA on demand */
     if (!av || !SvMAGIC(av)) {
-       /* FIXME - get this from the symtab magic.  */
-       STRLEN packlen = strlen(hvname);
+       STRLEN packlen = HvNAMELEN_get(stash);
 
        if (packlen >= 7 && strEQ(hvname + packlen - 7, "::SUPER")) {
            HV* basestash;
@@ -493,16 +492,18 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
     GV* vargv;
     SV* varsv;
     const char *packname = "";
+    STRLEN packname_len;
 
     if (len == S_autolen && strnEQ(name, S_autoload, S_autolen))
        return Nullgv;
     if (stash) {
        if (SvTYPE(stash) < SVt_PVHV) {
-           packname = SvPV_nolen((SV*)stash);
+           packname = SvPV((SV*)stash, packname_len);
            stash = Nullhv;
        }
        else {
            packname = HvNAME_get(stash);
+           packname_len = HvNAMELEN_get(stash);
        }
     }
     if (!(gv = gv_fetchmeth(stash, S_autoload, S_autolen, FALSE)))
@@ -547,7 +548,7 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
        gv_init(vargv, varstash, S_autoload, S_autolen, FALSE);
     LEAVE;
     varsv = GvSV(vargv);
-    sv_setpv(varsv, packname);
+    sv_setpvn(varsv, packname, packname_len);
     sv_catpvn(varsv, "::", 2);
     sv_catpvn(varsv, name, len);
     SvTAINTED_off(varsv);
@@ -1126,6 +1127,7 @@ void
 Perl_gv_fullname4(pTHX_ SV *sv, const GV *gv, const char *prefix, bool keepmain)
 {
     const char *name;
+    STRLEN namelen;
     const HV * const hv = GvSTASH(gv);
     if (!hv) {
        SvOK_off(sv);
@@ -1134,11 +1136,15 @@ Perl_gv_fullname4(pTHX_ SV *sv, const GV *gv, const char *prefix, bool keepmain)
     sv_setpv(sv, prefix ? prefix : "");
     
     name = HvNAME_get(hv);
-    if (!name)
+    if (name) {
+       namelen = HvNAMELEN_get(hv);
+    } else {
        name = "__ANON__";
+       namelen = 8;
+    }
        
     if (keepmain || strNE(name, "main")) {
-       sv_catpv(sv,name);
+       sv_catpvn(sv,name,namelen);
        sv_catpvn(sv,"::", 2);
     }
     sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv));
@@ -1309,10 +1315,10 @@ Perl_gp_free(pTHX_ GV *gv)
     /* FIXME - another reference loop GV -> symtab -> GV ?
        Somehow gp->gp_hv can end up pointing at freed garbage.  */
     if (gp->gp_hv && SvTYPE(gp->gp_hv) == SVt_PVHV) {
-       /* FIXME strlen HvNAME  */
        const char *hvname = HvNAME_get(gp->gp_hv);
        if (PL_stashcache && hvname)
-           hv_delete(PL_stashcache, hvname, strlen(hvname), G_DISCARD);
+           hv_delete(PL_stashcache, hvname, HvNAMELEN_get(gp->gp_hv),
+                     G_DISCARD);
        SvREFCNT_dec(gp->gp_hv);
     }
     if (gp->gp_io)   SvREFCNT_dec(gp->gp_io);

diff --git a/hv.c b/hv.c
index 5086b83..fe7e388 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1627,7 +1627,8 @@ S_hfreeentries(pTHX_ HV *hv)
            HvLAZYDEL_off(hv);
            hv_free_ent(hv, entry);
        }
-       Safefree(iter->xhv_name);
+       if (iter->xhv_name)
+           unshare_hek_or_pvn(iter->xhv_name, 0, 0, 0);
        Safefree(iter);
        ((XPVHV*) SvANY(hv))->xhv_aux = 0;
     }
@@ -1653,9 +1654,8 @@ Perl_hv_undef(pTHX_ HV *hv)
     hfreeentries(hv);
     Safefree(HvARRAY(hv));
     if ((name = HvNAME_get(hv))) {
-       /* FIXME - strlen HvNAME  */
         if(PL_stashcache)
-           hv_delete(PL_stashcache, name, strlen(name), G_DISCARD);
+           hv_delete(PL_stashcache, name, HvNAMELEN_get(hv), G_DISCARD);
        Perl_hv_name_set(aTHX_ hv, 0, 0, 0);
     }
     xhv->xhv_max   = 7;        /* HvMAX(hv) = 7 (it's a normal hash) */
@@ -1787,32 +1787,24 @@ Perl_hv_eiter_set(pTHX_ HV *hv, HE *eiter) {
     iter->xhv_eiter = eiter;
 }
 
-
-char **
-Perl_hv_name_p(pTHX_ HV *hv)
-{
-    struct xpvhv_aux *iter = ((XPVHV *)SvANY(hv))->xhv_aux;
-
-    if (!iter) {
-       ((XPVHV *)SvANY(hv))->xhv_aux = iter = S_hv_auxinit(aTHX);
-    }
-    return &(iter->xhv_name);
-}
-
 void
-Perl_hv_name_set(pTHX_ HV *hv, const char *name, STRLEN len, int flags)
+Perl_hv_name_set(pTHX_ HV *hv, const char *name, I32 len, int flags)
 {
     struct xpvhv_aux *iter = ((XPVHV *)SvANY(hv))->xhv_aux;
+    U32 hash;
 
     if (iter) {
-       Safefree(iter->xhv_name);
+       if (iter->xhv_name) {
+           unshare_hek_or_pvn(iter->xhv_name, 0, 0, 0);
+       }
     } else {
        if (name == 0)
            return;
 
        ((XPVHV *)SvANY(hv))->xhv_aux = iter = S_hv_auxinit(aTHX);
     }
-    iter->xhv_name = savepvn(name, len);
+    PERL_HASH(hash, name, len);
+    iter->xhv_name = name ? share_hek(name, len, hash) : 0;
 }
 
 /*

diff --git a/hv.h b/hv.h
index d53bfaf..db6ad94 100644 (file)
--- a/hv.h
+++ b/hv.h
@@ -34,7 +34,7 @@ struct hek {
    Don't access this directly.
 */
 struct xpvhv_aux {
-    char       *xhv_name;      /* name, if a symbol table */
+    HEK                *xhv_name;      /* name, if a symbol table */
     HE         *xhv_eiter;     /* current entry of iterator */
     I32                xhv_riter;      /* current root of iterator */
 };
@@ -224,11 +224,13 @@ C<SV*>.
                         ((struct xpvhv_aux*)((XPVHV *)SvANY(hv))->xhv_aux)->xhv_riter : -1)
 #define HvEITER_get(hv)        (((XPVHV *)SvANY(hv))->xhv_aux ? \
                         ((struct xpvhv_aux *)((XPVHV *)SvANY(hv))->xhv_aux)->xhv_eiter : 0)
-#define HvNAME(hv)     (*Perl_hv_name_p(aTHX_ (HV*)hv))
+#define HvNAME(hv)     HvNAME_get(hv)
 /* FIXME - all of these should use a UTF8 aware API, which should also involve
    getting the length. */
 #define HvNAME_get(hv) (((XPVHV *)SvANY(hv))->xhv_aux ? \
-                        ((struct xpvhv_aux *)((XPVHV *)SvANY(hv))->xhv_aux)->xhv_name : 0)
+                        (((struct xpvhv_aux *)((XPVHV *)SvANY(hv))->xhv_aux)->xhv_name) ? HEK_KEY(((struct xpvhv_aux *)((XPVHV *)SvANY(hv))->xhv_aux)->xhv_name) : 0 : 0)
+#define HvNAMELEN_get(hv)      (((XPVHV *)SvANY(hv))->xhv_aux ? \
+                        (((struct xpvhv_aux *)((XPVHV *)SvANY(hv))->xhv_aux)->xhv_name) ? HEK_LEN(((struct xpvhv_aux *)((XPVHV *)SvANY(hv))->xhv_aux)->xhv_name) : 0 : 0)
 
 /* the number of keys (including any placeholers) */
 #define XHvTOTALKEYS(xhv)      ((xhv)->xhv_keys)

diff --git a/op.c b/op.c
index c49537c..9d0ca5d 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1535,7 +1535,7 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my)
     ENTER;             /* need to protect against side-effects of 'use' */
     SAVEINT(PL_expect);
     if (stash)
-       stashsv = newSVpv(HvNAME_get(stash), 0);
+       stashsv = newSVpvn(HvNAME_get(stash), HvNAMELEN_get(stash));
     else
        stashsv = &PL_sv_no;
 
@@ -1588,7 +1588,7 @@ S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp)
 
     /* Build up the real arg-list. */
     if (stash)
-       stashsv = newSVpv(HvNAME_get(stash), 0);
+       stashsv = newSVpvn(HvNAME_get(stash), HvNAMELEN_get(stash));
     else
        stashsv = &PL_sv_no;
     arg = newOP(OP_PADSV, 0);

diff --git a/pp.c b/pp.c
index 2a543b3..f63b372 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -601,7 +601,8 @@ PP(pp_gelem)
        case 'P':
            if (strEQ(elem2, "ACKAGE")) {
                const char *name = HvNAME_get(GvSTASH(gv));
-               sv = newSVpv(name ? name : "__ANON__", 0);
+               sv = newSVpvn(name ? name : "__ANON__",
+                             name ? HvNAMELEN_get(GvSTASH(gv)) : 8);
            }
            break;
        case 'S':

diff --git a/proto.h b/proto.h
index 839cdbf..4a26ca4 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -2530,7 +2530,7 @@ PERL_CALLCONV HE**        Perl_hv_eiter_p(pTHX_ HV* hv);
 PERL_CALLCONV void     Perl_hv_riter_set(pTHX_ HV* hv, I32 riter);
 PERL_CALLCONV void     Perl_hv_eiter_set(pTHX_ HV* hv, HE* eiter);
 PERL_CALLCONV char**   Perl_hv_name_p(pTHX_ HV* hv);
-PERL_CALLCONV void     Perl_hv_name_set(pTHX_ HV* hv, const char *, STRLEN len, int flags);
+PERL_CALLCONV void     Perl_hv_name_set(pTHX_ HV* hv, const char *, I32 len, int flags);
 PERL_CALLCONV I32*     Perl_hv_placeholders_p(pTHX_ HV* hv);
 PERL_CALLCONV I32      Perl_hv_placeholders_get(pTHX_ HV* hv);
 PERL_CALLCONV void     Perl_hv_placeholders_set(pTHX_ HV* hv, I32 ph);

diff --git a/sv.c b/sv.c
index 297ddbe..67ef7e6 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -10913,16 +10913,29 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
        SvMAGIC_set(dstr, mg_dup(SvMAGIC(sstr), param));
        SvSTASH_set(dstr, hv_dup_inc(SvSTASH(sstr), param));
        {
-           const char *hvname = HvNAME_get((HV*)sstr);
            struct xpvhv_aux *aux = ((XPVHV *)SvANY(sstr))->xhv_aux;
+           HEK *hvname = 0;
 
-           ((XPVHV *)SvANY(dstr))->xhv_aux = 0;
            if (aux) {
-               HvRITER_set((HV*)dstr, HvRITER_get((HV*)sstr));
-               /* FIXME strlen HvNAME  */
-               Perl_hv_name_set(aTHX_ (HV*) dstr, hvname,
-                                hvname ? strlen(hvname) : 0,
-                                0);
+               I32 riter = aux->xhv_riter;
+
+               hvname = aux->xhv_name;
+               if (hvname || riter != -1) {
+                   struct xpvhv_aux *d_aux;
+
+                   New(0, d_aux, 1, struct xpvhv_aux);
+
+                   d_aux->xhv_riter = riter;
+                   d_aux->xhv_eiter = 0;
+                   d_aux->xhv_name = hvname ? hek_dup(hvname, param) : hvname;
+
+                   ((XPVHV *)SvANY(dstr))->xhv_aux = d_aux;
+               } else {
+                   ((XPVHV *)SvANY(dstr))->xhv_aux = 0;
+               }
+           }
+           else {
+               ((XPVHV *)SvANY(dstr))->xhv_aux = 0;
            }
            if (HvARRAY((HV*)sstr)) {
                STRLEN i = 0;
@@ -11456,6 +11469,7 @@ do_mark_cloneable_stash(pTHX_ SV *sv)
     const char *hvname = HvNAME_get((HV*)sv);
     if (hvname) {
        GV* cloner = gv_fetchmethod_autoload((HV*)sv, "CLONE_SKIP", 0);
+       STRLEN len = HvNAMELEN_get((HV*)sv);
        SvFLAGS(sv) |= SVphv_CLONEABLE; /* clone objects by default */
        if (cloner && GvCV(cloner)) {
            dSP;
@@ -11464,7 +11478,7 @@ do_mark_cloneable_stash(pTHX_ SV *sv)
            ENTER;
            SAVETMPS;
            PUSHMARK(SP);
-           XPUSHs(sv_2mortal(newSVpv(hvname, 0)));
+           XPUSHs(sv_2mortal(newSVpvn(hvname, len)));
            PUTBACK;
            call_sv((SV*)GvCV(cloner), G_SCALAR);
            SPAGAIN;
@@ -12314,7 +12328,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
            ENTER;
            SAVETMPS;
            PUSHMARK(SP);
-           XPUSHs(sv_2mortal(newSVpv(HvNAME_get(stash), 0)));
+           XPUSHs(sv_2mortal(newSVpvn(HvNAME_get(stash), HvNAMELEN_get(stash))));
            PUTBACK;
            call_sv((SV*)GvCV(cloner), G_DISCARD);
            FREETMPS;

diff --git a/toke.c b/toke.c
index c24c8e4..432d6cc 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -4346,7 +4346,8 @@ Perl_yylex(pTHX)
        case KEY___PACKAGE__:
            yylval.opval = (OP*)newSVOP(OP_CONST, 0,
                                        (PL_curstash
-                                        ? newSVpv(HvNAME_get(PL_curstash), 0)
+                                        ? newSVpvn(HvNAME_get(PL_curstash),
+                                                   HvNAMELEN_get(PL_curstash))
                                         : &PL_sv_undef));
            TERM(THING);
 
@@ -5537,7 +5538,8 @@ S_pending_ident(pTHX)
             /* might be an "our" variable" */
             if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) {
                 /* build ops for a bareword */
-                SV *sym = newSVpv(HvNAME_get(PAD_COMPNAME_OURSTASH(tmp)), 0);
+                SV *sym = newSVpvn(HvNAME_get(PAD_COMPNAME_OURSTASH(tmp)),
+                                  HvNAMELEN_get(PAD_COMPNAME_OURSTASH(tmp)));
                 sv_catpvn(sym, "::", 2);
                 sv_catpv(sym, PL_tokenbuf+1);
                 yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym);
@@ -9738,7 +9740,8 @@ S_scan_inputsymbol(pTHX_ char *start)
            if ((tmp = pad_findmy(d)) != NOT_IN_PAD) {
                if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) {
                    SV *sym = sv_2mortal(
-                           newSVpv(HvNAME_get(PAD_COMPNAME_OURSTASH(tmp)),0));
+                           newSVpvn(HvNAME_get(PAD_COMPNAME_OURSTASH(tmp)),
+                                    HvNAMELEN_get(PAD_COMPNAME_OURSTASH(tmp))));
                    sv_catpvn(sym, "::", 2);
                    sv_catpv(sym, d+1);
                    d = SvPVX(sym);

diff --git a/xsutils.c b/xsutils.c
index 7cdf41a..7b968cf 100644 (file)
--- a/xsutils.c
+++ b/xsutils.c
@@ -258,7 +258,7 @@ usage:
     sv = SvRV(rv);
 
     if (SvOBJECT(sv))
-       sv_setpv(TARG, HvNAME_get(SvSTASH(sv)));
+       sv_setpvn(TARG, HvNAME_get(SvSTASH(sv)), HvNAMELEN_get(SvSTASH(sv)));
 #if 0  /* this was probably a bad idea */
     else if (SvPADMY(sv))
        sv_setsv(TARG, &PL_sv_no);      /* unblessed lexical */
@@ -284,7 +284,7 @@ usage:
            break;
        }
        if (stash)
-           sv_setpv(TARG, HvNAME_get(stash));
+           sv_setpvn(TARG, HvNAME_get(stash), HvNAMELEN_get(stash));
     }
 
     SvSETMAGIC(TARG);