This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Move hv_name, hv_eiter and hv_riter into a new aux structure.
authorNicholas Clark <nick@ccl4.org>
Sat, 21 May 2005 12:31:52 +0000 (12:31 +0000)
committerNicholas Clark <nick@ccl4.org>
Sat, 21 May 2005 12:31:52 +0000 (12:31 +0000)
Provide (more efficient) _get and _set macros.
Adjust the core to use them.

p4raw-id: //depot/perl@24526

24 files changed:
dump.c
embed.fnc
ext/Data/Dumper/Dumper.xs
ext/Devel/DProf/DProf.xs
ext/Opcode/Opcode.xs
ext/PerlIO/via/via.xs
ext/Storable/Storable.xs
ext/threads/shared/shared.xs
global.sym
gv.c
hv.c
hv.h
mg.c
op.c
op.h
perl.c
pp.c
pp_hot.c
pp_sys.c
proto.h
sv.c
toke.c
universal.c
xsutils.c

diff --git a/dump.c b/dump.c
index f3d6657..547af9f 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -1060,9 +1060,10 @@ Perl_magic_dump(pTHX_ const MAGIC *mg)
 void
 Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, const char *name, HV *sv)
 {
+    const char *hvname;
     Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
-    if (sv && HvNAME(sv))
-       PerlIO_printf(file, "\t\"%s\"\n", HvNAME(sv));
+    if (sv && (hvname = HvNAME_get(sv)))
+       PerlIO_printf(file, "\t\"%s\"\n", hvname);
     else
        PerlIO_putc(file, '\n');
 }
@@ -1082,9 +1083,10 @@ Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv)
 {
     Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
     if (sv && GvNAME(sv)) {
+       const char *hvname;
        PerlIO_printf(file, "\t\"");
-       if (GvSTASH(sv) && HvNAME(GvSTASH(sv)))
-           PerlIO_printf(file, "%s\" :: \"", HvNAME(GvSTASH(sv)));
+       if (GvSTASH(sv) && (hvname = HvNAME_get(GvSTASH(sv))))
+           PerlIO_printf(file, "%s\" :: \"", hvname);
        PerlIO_printf(file, "%s\"\n", GvNAME(sv));
     }
     else
@@ -1420,17 +1422,20 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        Perl_dump_indent(aTHX_ level, file, "  KEYS = %"IVdf"\n", (IV)HvKEYS(sv));
        Perl_dump_indent(aTHX_ level, file, "  FILL = %"IVdf"\n", (IV)HvFILL(sv));
        Perl_dump_indent(aTHX_ level, file, "  MAX = %"IVdf"\n", (IV)HvMAX(sv));
-       Perl_dump_indent(aTHX_ level, file, "  RITER = %"IVdf"\n", (IV)HvRITER(sv));
-       Perl_dump_indent(aTHX_ level, file, "  EITER = 0x%"UVxf"\n", PTR2UV(HvEITER(sv)));
+       Perl_dump_indent(aTHX_ level, file, "  RITER = %"IVdf"\n", (IV)HvRITER_get(sv));
+       Perl_dump_indent(aTHX_ level, file, "  EITER = 0x%"UVxf"\n", PTR2UV(HvEITER_get(sv)));
        {
            MAGIC *mg = mg_find(sv, PERL_MAGIC_symtab);
            if (mg && mg->mg_obj) {
                Perl_dump_indent(aTHX_ level, file, "  PMROOT = 0x%"UVxf"\n", PTR2UV(mg->mg_obj));
            }
        }
-       if (HvNAME(sv))
-           Perl_dump_indent(aTHX_ level, file, "  NAME = \"%s\"\n", HvNAME(sv));
-       if (nest < maxnest && !HvEITER(sv)) { /* Try to preserve iterator */
+       {
+           const char *hvname = HvNAME_get(sv);
+           if (hvname)
+               Perl_dump_indent(aTHX_ level, file, "  NAME = \"%s\"\n", hvname);
+       }
+       if (nest < maxnest && !HvEITER_get(sv)) { /* Try to preserve iterator */
            HE *he;
            HV *hv = (HV*)sv;
            int count = maxnest - nest;
index 11c362e..02b75ec 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1397,7 +1397,12 @@ sM       |HE*    |hv_fetch_common|HV* tb|SV* key_sv|const char* key|STRLEN klen|int flags
 Apd    |void   |hv_clear_placeholders|HV* hb
 
 Apd    |SV*    |hv_scalar      |HV* hv|
-
+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    |I32*   |hv_placeholders_p      |HV* hv
 Apo    |I32    |hv_placeholders_get    |HV* hv
 Apo    |void   |hv_placeholders_set    |HV* hv|I32 ph
index ee1bc14..3f06b7b 100644 (file)
@@ -14,6 +14,10 @@ static I32 DD_dump (pTHX_ SV *val, char *name, STRLEN namelen, SV *retval,
                    I32 purity, I32 deepcopy, I32 quotekeys, SV *bless,
                    I32 maxdepth, SV *sortkeys);
 
+#ifndef HvNAME_get
+#define HvNAME_get HvNAME
+#endif
+
 #if PERL_VERSION <= 6 /* Perl 5.6 and earlier */
 
 # ifdef EBCDIC
@@ -281,7 +285,7 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
         (void) sprintf(id, "0x%"UVxf, PTR2UV(ival));
        idlen = strlen(id);
        if (SvOBJECT(ival))
-           realpack = HvNAME(SvSTASH(ival));
+           realpack = HvNAME_get(SvSTASH(ival));
        else
            realpack = Nullch;
 
index 10d4172..c840b24 100644 (file)
@@ -42,8 +42,8 @@ dprof_dbg_sub_notify(pTHX_ SV *Sub) {
     GV   *gv = cv ? CvGV(cv) : NULL;
     if (cv && gv) {
        warn("XS DBsub(%s::%s)\n",
-            ((GvSTASH(gv) && HvNAME(GvSTASH(gv))) ?
-             HvNAME(GvSTASH(gv)) : "(null)"),
+            ((GvSTASH(gv) && HvNAME_get(GvSTASH(gv))) ?
+             HvNAME_get(GvSTASH(gv)) : "(null)"),
             GvNAME(gv));
     } else {
        warn("XS DBsub(unknown) at %x", Sub);
@@ -371,9 +371,8 @@ prof_mark(pTHX_ opcode ptype)
 
        cv = db_get_cv(aTHX_ Sub);
        gv = CvGV(cv);
-       pname = ((GvSTASH(gv) && HvNAME(GvSTASH(gv))) 
-                ? HvNAME(GvSTASH(gv)) 
-                : (char *) "(null)");
+       pname = GvSTASH(gv) ? HvNAME_get(GvSTASH(gv)) : 0;
+       pname = pname ? pname : (char *) "(null)";
        gname = GvNAME(gv);
 
        set_cv_key(aTHX_ cv, pname, gname);
index 067ffdb..78c7605 100644 (file)
@@ -268,9 +268,9 @@ PPCODE:
    
     hv = gv_stashpv(Package, GV_ADDWARN); /* should exist already      */
 
-    if (strNE(HvNAME(hv),"main")) {
-        Safefree(HvNAME(hv));         
-        HvNAME(hv) = savepv("main"); /* make it think it's in main:: */
+    if (strNE(HvNAME_get(hv),"main")) {
+        /* make it think it's in main:: */
+       Perl_hv_name_set(aTHX_ hv, "main", 4, 0);
         hv_store(hv,"_",1,(SV *)PL_defgv,0);  /* connect _ to global */
         SvREFCNT_inc((SV *)PL_defgv);  /* want to keep _ around! */
     }
index 36394dd..028a298 100644 (file)
@@ -45,7 +45,7 @@ PerlIOVia_fetchmethod(pTHX_ PerlIOVia * s, char *method, CV ** save)
 {
     GV *gv = gv_fetchmeth(s->stash, method, strlen(method), 0);
 #if 0
-    Perl_warn(aTHX_ "Lookup %s::%s => %p", HvNAME(s->stash), method, gv);
+    Perl_warn(aTHX_ "Lookup %s::%s => %p", HvNAME_get(s->stash), method, gv);
 #endif
     if (gv) {
        return *save = GvCV(gv);
@@ -87,7 +87,7 @@ PerlIOVia_method(pTHX_ PerlIO * f, char *method, CV ** save, int flags,
        }
        if (*PerlIONext(f)) {
            if (!s->fh) {
-               GV *gv = newGVgen(HvNAME(s->stash));
+               GV *gv = newGVgen(HvNAME_get(s->stash));
                GvIOp(gv) = newIO();
                s->fh = newRV_noinc((SV *) gv);
                s->io = GvIOp(gv);
index 68d8e26..53f9543 100644 (file)
@@ -107,6 +107,24 @@ typedef double NV;                 /* Older perls lack the NV type */
 #define dVAR dNOOP
 #endif
 
+#ifndef HvRITER_set
+#  define HvRITER_set(hv,r)    (*HvRITER(hv) = r)
+#endif
+#ifndef HvEITER_set
+#  define HvEITER_set(hv,r)    (*HvEITER(hv) = r)
+#endif
+
+#ifndef HvRITER_get
+#  define HvRITER_get HvRITER
+#endif
+#ifndef HvEITER_get
+#  define HvEITER_get HvEITER
+#endif
+
+#ifndef HvNAME_get
+#define HvNAME_get HvNAME
+#endif
+
 #ifndef HvPLACEHOLDERS_get
 #  define HvPLACEHOLDERS_get HvPLACEHOLDERS
 #endif
@@ -1637,6 +1655,8 @@ static SV *pkg_fetchmeth(
 {
        GV *gv;
        SV *sv;
+       const char *hvname = HvNAME_get(pkg);
+
 
        /*
         * The following code is the same as the one performed by UNIVERSAL::can
@@ -1646,10 +1666,10 @@ static SV *pkg_fetchmeth(
        gv = gv_fetchmethod_autoload(pkg, method, FALSE);
        if (gv && isGV(gv)) {
                sv = newRV((SV*) GvCV(gv));
-               TRACEME(("%s->%s: 0x%"UVxf, HvNAME(pkg), method, PTR2UV(sv)));
+               TRACEME(("%s->%s: 0x%"UVxf, hvname, method, PTR2UV(sv)));
        } else {
                sv = newSVsv(&PL_sv_undef);
-               TRACEME(("%s->%s: not found", HvNAME(pkg), method));
+               TRACEME(("%s->%s: not found", hvname, method));
        }
 
        /*
@@ -1657,7 +1677,7 @@ static SV *pkg_fetchmeth(
         * it just won't be cached.
         */
 
-       (void) hv_store(cache, HvNAME(pkg), strlen(HvNAME(pkg)), sv, 0);
+       (void) hv_store(cache, hvname, strlen(hvname), sv, 0);
 
        return SvOK(sv) ? sv : (SV *) 0;
 }
@@ -1673,8 +1693,9 @@ static void pkg_hide(
        HV *pkg,
        char *method)
 {
+       const char *hvname = HvNAME_get(pkg);
        (void) hv_store(cache,
-               HvNAME(pkg), strlen(HvNAME(pkg)), newSVsv(&PL_sv_undef), 0);
+               hvname, strlen(hvname), newSVsv(&PL_sv_undef), 0);
 }
 
 /*
@@ -1688,7 +1709,8 @@ static void pkg_uncache(
        HV *pkg,
        char *method)
 {
-       (void) hv_delete(cache, HvNAME(pkg), strlen(HvNAME(pkg)), G_DISCARD);
+       const char *hvname = HvNAME_get(pkg);
+       (void) hv_delete(cache, hvname, strlen(hvname), G_DISCARD);
 }
 
 /*
@@ -1707,8 +1729,9 @@ static SV *pkg_can(
 {
        SV **svh;
        SV *sv;
+       const char *hvname = HvNAME_get(pkg);
 
-       TRACEME(("pkg_can for %s->%s", HvNAME(pkg), method));
+       TRACEME(("pkg_can for %s->%s", hvname, method));
 
        /*
         * Look into the cache to see whether we already have determined
@@ -1718,15 +1741,15 @@ static SV *pkg_can(
         * that only one hook (i.e. always the same) is cached in a given cache.
         */
 
-       svh = hv_fetch(cache, HvNAME(pkg), strlen(HvNAME(pkg)), FALSE);
+       svh = hv_fetch(cache, hvname, strlen(hvname), FALSE);
        if (svh) {
                sv = *svh;
                if (!SvOK(sv)) {
-                       TRACEME(("cached %s->%s: not found", HvNAME(pkg), method));
+                       TRACEME(("cached %s->%s: not found", hvname, method));
                        return (SV *) 0;
                } else {
                        TRACEME(("cached %s->%s: 0x%"UVxf,
-                               HvNAME(pkg), method, PTR2UV(sv)));
+                               hvname, method, PTR2UV(sv)));
                        return sv;
                }
        }
@@ -2260,8 +2283,8 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
         * Save possible iteration state via each() on that table.
         */
 
-       riter = HvRITER(hv);
-       eiter = HvEITER(hv);
+       riter = HvRITER_get(hv);
+       eiter = HvEITER_get(hv);
        hv_iterinit(hv);
 
        /*
@@ -2529,8 +2552,8 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
        TRACEME(("ok (hash 0x%"UVxf")", PTR2UV(hv)));
 
 out:
-       HvRITER(hv) = riter;            /* Restore hash iterator state */
-       HvEITER(hv) = eiter;
+       HvRITER_set(hv, riter);         /* Restore hash iterator state */
+       HvEITER_set(hv, eiter);
 
        return ret;
 }
@@ -2835,7 +2858,7 @@ static int store_hook(
        char mtype = '\0';                              /* for blessed ref to tied structures */
        unsigned char eflags = '\0';    /* used when object type is SHT_EXTRA */
 
-       TRACEME(("store_hook, classname \"%s\", tagged #%d", HvNAME(pkg), cxt->tagnum));
+       TRACEME(("store_hook, classname \"%s\", tagged #%d", HvNAME_get(pkg), cxt->tagnum));
 
        /*
         * Determine object type on 2 bits.
@@ -2886,7 +2909,7 @@ static int store_hook(
        }
        flags = SHF_NEED_RECURSE | obj_type;
 
-       classname = HvNAME(pkg);
+       classname = HvNAME_get(pkg);
        len = strlen(classname);
 
        /*
@@ -3254,7 +3277,7 @@ static int store_blessed(
        char *classname;
        I32 classnum;
 
-       TRACEME(("store_blessed, type %d, class \"%s\"", type, HvNAME(pkg)));
+       TRACEME(("store_blessed, type %d, class \"%s\"", type, HvNAME_get(pkg)));
 
        /*
         * Look for a hook for this blessed SV and redirect to store_hook()
@@ -3269,7 +3292,7 @@ static int store_blessed(
         * This is a blessed SV without any serialization hook.
         */
 
-       classname = HvNAME(pkg);
+       classname = HvNAME_get(pkg);
        len = strlen(classname);
 
        TRACEME(("blessed 0x%"UVxf" in %s, no hook: tagged #%d",
@@ -4511,7 +4534,7 @@ static SV *retrieve_overloaded(pTHX_ stcxt_t *cxt, char *cname)
        }
        if (!Gv_AMG(stash)) {
                SV *psv = newSVpvn("require ", 8);
-               const char *package = HvNAME(stash);
+               const char *package = HvNAME_get(stash);
                sv_catpv(psv, package);
 
                TRACEME(("No overloading defined for package %s", package));
index dcaa7e7..aa1dcf2 100644 (file)
@@ -529,7 +529,7 @@ sharedsv_scalar_store(pTHX_ SV *sv, shared_sv *shared)
            sv_setsv_nomg(SHAREDSvPTR(shared), tmp);
            SvREFCNT_dec(tmp);
            if(SvOBJECT(SvRV(sv))) {
-             SV* fake_stash = newSVpv(HvNAME(SvSTASH(SvRV(sv))),0);
+             SV* fake_stash = newSVpv(HvNAME_get(SvSTASH(SvRV(sv))),0);
              SvOBJECT_on(SHAREDSvPTR(target));
              SvSTASH_set(SHAREDSvPTR(target), (HV*)fake_stash);
            }
@@ -544,7 +544,7 @@ sharedsv_scalar_store(pTHX_ SV *sv, shared_sv *shared)
        SHARED_CONTEXT;
        sv_setsv_nomg(SHAREDSvPTR(shared), sv);
        if(SvOBJECT(sv)) {
-         SV* fake_stash = newSVpv(HvNAME(SvSTASH(sv)),0);
+         SV* fake_stash = newSVpv(HvNAME_get(SvSTASH(sv)),0);
          SvOBJECT_on(SHAREDSvPTR(shared));
          SvSTASH_set(SHAREDSvPTR(shared), (HV*)fake_stash);
        }
@@ -1294,7 +1294,7 @@ bless(SV* ref, ...);
            ENTER_LOCK;
            SHARED_CONTEXT;
            {
-             SV* fake_stash = newSVpv(HvNAME(stash),0);
+             SV* fake_stash = newSVpv(HvNAME_get(stash),0);
              (void)sv_bless(SHAREDSvPTR(shared),(HV*)fake_stash);
            }
            CALLER_CONTEXT;
index c982795..cc938bc 100644 (file)
@@ -675,6 +675,12 @@ Perl_save_set_svflags
 Perl_hv_assert
 Perl_hv_clear_placeholders
 Perl_hv_scalar
+Perl_hv_riter_p
+Perl_hv_eiter_p
+Perl_hv_riter_set
+Perl_hv_eiter_set
+Perl_hv_name_p
+Perl_hv_name_set
 Perl_hv_placeholders_p
 Perl_hv_placeholders_get
 Perl_hv_placeholders_set
diff --git a/gv.c b/gv.c
index 5d533f0..40a0e8d 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -201,6 +201,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
     GV* gv;
     GV** gvp;
     CV* cv;
+    const char *hvname;
 
     /* UNIVERSAL methods should be callable without a stash */
     if (!stash) {
@@ -209,15 +210,16 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
            return 0;
     }
 
-    if (!HvNAME(stash))
+    hvname = HvNAME_get(stash);
+    if (!hvname)
       Perl_croak(aTHX_
                 "Can't use anonymous symbol table for method lookup");
 
     if ((level > 100) || (level < -100))
        Perl_croak(aTHX_ "Recursive inheritance detected while looking for method '%s' in package '%s'",
-             name, HvNAME(stash));
+             name, hvname);
 
-    DEBUG_o( Perl_deb(aTHX_ "Looking for method %s in package %s\n",name,HvNAME(stash)) );
+    DEBUG_o( Perl_deb(aTHX_ "Looking for method %s in package %s\n",name,hvname) );
 
     gvp = (GV**)hv_fetch(stash, name, len, (level >= 0));
     if (!gvp)
@@ -244,19 +246,19 @@ 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)) {
-       const char* packname = HvNAME(stash);
-       STRLEN packlen = strlen(packname);
+       /* FIXME - get this from the symtab magic.  */
+       STRLEN packlen = strlen(hvname);
 
-       if (packlen >= 7 && strEQ(packname + packlen - 7, "::SUPER")) {
+       if (packlen >= 7 && strEQ(hvname + packlen - 7, "::SUPER")) {
            HV* basestash;
 
            packlen -= 7;
-           basestash = gv_stashpvn(packname, packlen, TRUE);
+           basestash = gv_stashpvn(hvname, packlen, TRUE);
            gvp = (GV**)hv_fetch(basestash, "ISA", 3, FALSE);
            if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) {
                gvp = (GV**)hv_fetch(stash, "ISA", 3, TRUE);
                if (!gvp || !(gv = *gvp))
-                   Perl_croak(aTHX_ "Cannot create %s::ISA", HvNAME(stash));
+                   Perl_croak(aTHX_ "Cannot create %s::ISA", hvname);
                if (SvTYPE(gv) != SVt_PVGV)
                    gv_init(gv, stash, "ISA", 3, TRUE);
                SvREFCNT_dec(GvAV(gv));
@@ -275,7 +277,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
            if (!basestash) {
                if (ckWARN(WARN_MISC))
                    Perl_warner(aTHX_ packWARN(WARN_MISC), "Can't locate package %"SVf" for @%s::ISA",
-                       sv, HvNAME(stash));
+                       sv, hvname);
                continue;
            }
            gv = gv_fetchmeth(basestash, name, len,
@@ -435,7 +437,7 @@ Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
            /* __PACKAGE__::SUPER stash should be autovivified */
            stash = gv_stashpvn(SvPVX_const(tmpstr), SvCUR(tmpstr), TRUE);
            DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n",
-                        origname, HvNAME(stash), name) );
+                        origname, HvNAME_get(stash), name) );
        }
        else {
             /* don't autovifify if ->NoSuchStash::method */
@@ -500,7 +502,7 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
            stash = Nullhv;
        }
        else {
-           packname = HvNAME(stash);
+           packname = HvNAME_get(stash);
        }
     }
     if (!(gv = gv_fetchmeth(stash, S_autoload, S_autolen, FALSE)))
@@ -629,8 +631,8 @@ Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 create)
     if (!GvHV(tmpgv))
        GvHV(tmpgv) = newHV();
     stash = GvHV(tmpgv);
-    if (!HvNAME(stash))
-       HvNAME(stash) = savepv(name);
+    if (!HvNAME_get(stash))
+       Perl_hv_name_set(aTHX_ stash, name, namelen, 0);
     return stash;
 }
 
@@ -718,8 +720,8 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
                if (!(stash = GvHV(gv)))
                    stash = GvHV(gv) = newHV();
 
-               if (!HvNAME(stash))
-                   HvNAME(stash) = savepvn(nambeg, namend - nambeg);
+               if (!HvNAME_get(stash))
+                   Perl_hv_name_set(aTHX, stash, nambeg, namend - nambeg, 0);
            }
 
            if (*namend == ':')
@@ -1131,7 +1133,7 @@ Perl_gv_fullname4(pTHX_ SV *sv, const GV *gv, const char *prefix, bool keepmain)
     }
     sv_setpv(sv, prefix ? prefix : "");
     
-    name = HvNAME(hv);
+    name = HvNAME_get(hv);
     if (!name)
        name = "__ANON__";
        
@@ -1242,7 +1244,7 @@ Perl_gv_check(pTHX_ HV *stash)
 #endif
                Perl_warner(aTHX_ packWARN(WARN_ONCE),
                        "Name \"%s::%s\" used only once: possible typo",
-                       HvNAME(stash), GvNAME(gv));
+                       HvNAME_get(stash), GvNAME(gv));
            }
        }
     }
@@ -1304,12 +1306,14 @@ Perl_gp_free(pTHX_ GV *gv)
 
     if (gp->gp_sv) SvREFCNT_dec(gp->gp_sv);
     if (gp->gp_av) SvREFCNT_dec(gp->gp_av);
-    if (gp->gp_hv) {
-        if (PL_stashcache && HvNAME(gp->gp_hv))
-             hv_delete(PL_stashcache,
-                       HvNAME(gp->gp_hv), strlen(HvNAME(gp->gp_hv)),
-                       G_DISCARD);
-        SvREFCNT_dec(gp->gp_hv);
+    /* 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);
+       SvREFCNT_dec(gp->gp_hv);
     }
     if (gp->gp_io)   SvREFCNT_dec(gp->gp_io);
     if (gp->gp_cv)   SvREFCNT_dec(gp->gp_cv);
@@ -1354,7 +1358,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
       return (bool)AMT_OVERLOADED(amtp);
   sv_unmagic((SV*)stash, PERL_MAGIC_overload_table);
 
-  DEBUG_o( Perl_deb(aTHX_ "Recalcing overload magic in package %s\n",HvNAME(stash)) );
+  DEBUG_o( Perl_deb(aTHX_ "Recalcing overload magic in package %s\n",HvNAME_get(stash)) );
 
   Zero(&amt,1,AMT);
   amt.was_ok_am = PL_amagic_generation;
@@ -1390,7 +1394,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
        const STRLEN l = strlen(cooky);
 
        DEBUG_o( Perl_deb(aTHX_ "Checking overloading of `%s' in package `%.256s'\n",
-                    cp, HvNAME(stash)) );
+                    cp, HvNAME_get(stash)) );
        /* don't fill the cache while looking up!
           Creation of inheritance stubs in intermediate packages may
           conflict with the logic of runtime method substitution.
@@ -1404,8 +1408,9 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
            gv = Perl_gv_fetchmeth(aTHX_ stash, cooky, l, -1);
         cv = 0;
         if (gv && (cv = GvCV(gv))) {
+           const char *hvname;
            if (GvNAMELEN(CvGV(cv)) == 3 && strEQ(GvNAME(CvGV(cv)), "nil")
-               && strEQ(HvNAME(GvSTASH(CvGV(cv))), "overload")) {
+               && strEQ(hvname = HvNAME_get(GvSTASH(CvGV(cv))), "overload")) {
                /* This is a hack to support autoloading..., while
                   knowing *which* methods were declared as overloaded. */
                /* GvSV contains the name of the method. */
@@ -1413,7 +1418,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
                
                DEBUG_o( Perl_deb(aTHX_ "Resolving method `%"SVf256\
                        "' for overloaded `%s' in package `%.256s'\n",
-                            GvSV(gv), cp, HvNAME(stash)) );
+                            GvSV(gv), cp, hvname) );
                if (!SvPOK(GvSV(gv))
                    || !(ngv = gv_fetchmethod_autoload(stash, SvPVX_const(GvSV(gv)),
                                                       FALSE)))
@@ -1425,12 +1430,12 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
                                "in package `%.256s'",
                               (GvCVGEN(gv) ? "Stub found while resolving"
                                : "Can't resolve"),
-                              name, cp, HvNAME(stash));
+                              name, cp, hvname);
                }
                cv = GvCV(gv = ngv);
            }
            DEBUG_o( Perl_deb(aTHX_ "Overloading `%s' in package `%.256s' via `%.256s::%.256s' \n",
-                        cp, HvNAME(stash), HvNAME(GvSTASH(CvGV(cv))),
+                        cp, HvNAME_get(stash), HvNAME_get(GvSTASH(CvGV(cv))),
                         GvNAME(CvGV(cv))) );
            filled = 1;
            if (i < DESTROY_amg)
@@ -1465,7 +1470,7 @@ Perl_gv_handler(pTHX_ HV *stash, I32 id)
     MAGIC *mg;
     AMT *amtp;
 
-    if (!stash || !HvNAME(stash))
+    if (!stash || !HvNAME_get(stash))
         return Nullcv;
     mg = mg_find((SV*)stash, PERL_MAGIC_overload_table);
     if (!mg) {
@@ -1696,7 +1701,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
                        "in overloaded package ":
                        "has no overloaded magic",
                      SvAMAGIC(left)?
-                       HvNAME(SvSTASH(SvRV(left))):
+                       HvNAME_get(SvSTASH(SvRV(left))):
                        "",
                      SvAMAGIC(right)?
                        ",\n\tright argument in overloaded package ":
@@ -1704,7 +1709,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
                         ? ""
                         : ",\n\tright argument has no overloaded magic"),
                      SvAMAGIC(right)?
-                       HvNAME(SvSTASH(SvRV(right))):
+                       HvNAME_get(SvSTASH(SvRV(right))):
                        ""));
        if (amtp && amtp->fallback >= AMGfallYES) {
          DEBUG_o( Perl_deb(aTHX_ "%s", SvPVX_const(msg)) );
@@ -1729,7 +1734,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
                     flags & AMGf_unary? "" :
                     lr==1 ? " for right argument": " for left argument",
                     flags & AMGf_unary? " for argument" : "",
-                    stash ? HvNAME(stash) : "null",
+                    stash ? HvNAME_get(stash) : "null",
                     fl? ",\n\tassignment variant used": "") );
   }
 #endif
diff --git a/hv.c b/hv.c
index c12d20e..4daaf33 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1027,7 +1027,8 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
            *oentry = HeNEXT(entry);
            if (i && !*oentry)
                xhv->xhv_fill--; /* HvFILL(hv)-- */
-           if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
+           if (xhv->xhv_aux && entry
+               == ((struct xpvhv_aux *)xhv->xhv_aux)->xhv_eiter /* HvEITER(hv) */)
                HvLAZYDEL_on(hv);
            else
                hv_free_ent(hv, entry);
@@ -1307,7 +1308,7 @@ Perl_newHV(pTHX)
 
     xhv->xhv_max    = 7;       /* HvMAX(hv) = 7 (start with 8 buckets) */
     xhv->xhv_fill   = 0;       /* HvFILL(hv) = 0 */
-    (void)hv_iterinit(hv);     /* so each() will start off right */
+    xhv->xhv_aux = 0;
     return hv;
 }
 
@@ -1368,8 +1369,8 @@ Perl_newHVhv(pTHX_ HV *ohv)
     else {
        /* Iterate over ohv, copying keys and values one at a time. */
        HE *entry;
-       const I32 riter = HvRITER(ohv);
-       HE * const eiter = HvEITER(ohv);
+       const I32 riter = HvRITER_get(ohv);
+       HE * const eiter = HvEITER_get(ohv);
 
        /* Can we use fewer buckets? (hv_max is always 2^n-1) */
        while (hv_max && hv_max + 1 >= hv_fill * 2)
@@ -1382,8 +1383,8 @@ Perl_newHVhv(pTHX_ HV *ohv)
                            newSVsv(HeVAL(entry)), HeHASH(entry),
                            HeKFLAGS(entry));
        }
-       HvRITER(ohv) = riter;
-       HvEITER(ohv) = eiter;
+       HvRITER_set(ohv, riter);
+       HvEITER_set(ohv, eiter);
     }
 
     return hv;
@@ -1397,7 +1398,7 @@ Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
     if (!entry)
        return;
     val = HeVAL(entry);
-    if (val && isGV(val) && GvCVu(val) && HvNAME(hv))
+    if (val && isGV(val) && GvCVu(val) && HvNAME_get(hv))
        PL_sub_generation++;    /* may be deletion of method from stash */
     SvREFCNT_dec(val);
     if (HeKLEN(entry) == HEf_SVKEY) {
@@ -1416,7 +1417,7 @@ Perl_hv_delayfree_ent(pTHX_ HV *hv, register HE *entry)
 {
     if (!entry)
        return;
-    if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
+    if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME_get(hv))
        PL_sub_generation++;    /* may be deletion of method from stash */
     sv_2mortal(HeVAL(entry));  /* free between statements */
     if (HeKLEN(entry) == HEf_SVKEY) {
@@ -1485,7 +1486,9 @@ Perl_hv_clear(pTHX_ HV *hv)
     HvHASKFLAGS_off(hv);
     HvREHASH_off(hv);
     reset:
-    HvEITER(hv) = NULL;
+    if (xhv->xhv_aux) {
+       HvEITER_set(hv, NULL);
+    }
 }
 
 /*
@@ -1526,7 +1529,7 @@ Perl_hv_clear_placeholders(pTHX_ HV *hv)
                *oentry = HeNEXT(entry);
                if (first && !*oentry)
                    HvFILL(hv)--; /* This linked list is now empty.  */
-               if (HvEITER(hv))
+               if (HvEITER_get(hv))
                    HvLAZYDEL_on(hv);
                else
                    hv_free_ent(hv, entry);
@@ -1557,6 +1560,7 @@ S_hfreeentries(pTHX_ HV *hv)
     register HE *entry;
     I32 riter;
     I32 max;
+    struct xpvhv_aux *iter;
 
     if (!hv)
        return;
@@ -1586,7 +1590,17 @@ S_hfreeentries(pTHX_ HV *hv)
        }
     }
     HvARRAY(hv) = array;
-    (void)hv_iterinit(hv);
+
+    iter = ((XPVHV*) SvANY(hv))->xhv_aux;
+    if (iter) {
+       entry = iter->xhv_eiter; /* HvEITER(hv) */
+       if (entry && HvLAZYDEL(hv)) {   /* was deleted earlier? */
+           HvLAZYDEL_off(hv);
+           hv_free_ent(hv, entry);
+       }
+       Safefree(iter);
+       ((XPVHV*) SvANY(hv))->xhv_aux = 0;
+    }
 }
 
 /*
@@ -1601,17 +1615,18 @@ void
 Perl_hv_undef(pTHX_ HV *hv)
 {
     register XPVHV* xhv;
+    const char *name;
     if (!hv)
        return;
     DEBUG_A(Perl_hv_assert(aTHX_ hv));
     xhv = (XPVHV*)SvANY(hv);
     hfreeentries(hv);
     Safefree(xhv->xhv_array /* HvARRAY(hv) */);
-    if (HvNAME(hv)) {
+    if ((name = HvNAME_get(hv))) {
+       /* FIXME - strlen HvNAME  */
         if(PL_stashcache)
-           hv_delete(PL_stashcache, HvNAME(hv), strlen(HvNAME(hv)), G_DISCARD);
-       Safefree(HvNAME(hv));
-       HvNAME(hv) = 0;
+           hv_delete(PL_stashcache, name, strlen(name), G_DISCARD);
+       Perl_hv_name_set(aTHX_ hv, 0, 0, 0);
     }
     xhv->xhv_max   = 7;        /* HvMAX(hv) = 7 (it's a normal hash) */
     xhv->xhv_array = 0;        /* HvARRAY(hv) = 0 */
@@ -1621,6 +1636,19 @@ Perl_hv_undef(pTHX_ HV *hv)
        mg_clear((SV*)hv);
 }
 
+struct xpvhv_aux*
+S_hv_auxinit(aTHX) {
+    struct xpvhv_aux *iter;
+
+    New(0, iter, 1, struct xpvhv_aux);
+
+    iter->xhv_riter = -1;      /* HvRITER(hv) = -1 */
+    iter->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
+    iter->xhv_name = 0;
+
+    return iter;
+}
+
 /*
 =for apidoc hv_iterinit
 
@@ -1641,20 +1669,120 @@ Perl_hv_iterinit(pTHX_ HV *hv)
 {
     register XPVHV* xhv;
     HE *entry;
+    struct xpvhv_aux *iter;
 
     if (!hv)
        Perl_croak(aTHX_ "Bad hash");
     xhv = (XPVHV*)SvANY(hv);
-    entry = xhv->xhv_eiter; /* HvEITER(hv) */
-    if (entry && HvLAZYDEL(hv)) {      /* was deleted earlier? */
-       HvLAZYDEL_off(hv);
-       hv_free_ent(hv, entry);
+
+    iter = xhv->xhv_aux;
+    if (iter) {
+       entry = iter->xhv_eiter; /* HvEITER(hv) */
+       if (entry && HvLAZYDEL(hv)) {   /* was deleted earlier? */
+           HvLAZYDEL_off(hv);
+           hv_free_ent(hv, entry);
+       }
+       iter->xhv_riter = -1;   /* HvRITER(hv) = -1 */
+       iter->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
+    } else {
+       xhv->xhv_aux = S_hv_auxinit(aTHX);
     }
-    xhv->xhv_riter = -1;       /* HvRITER(hv) = -1 */
-    xhv->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
+
     /* used to be xhv->xhv_fill before 5.004_65 */
     return XHvTOTALKEYS(xhv);
 }
+
+I32 *
+Perl_hv_riter_p(pTHX_ HV *hv) {
+    struct xpvhv_aux *iter;
+
+    if (!hv)
+       Perl_croak(aTHX_ "Bad hash");
+
+    iter = ((XPVHV *)SvANY(hv))->xhv_aux;
+    if (!iter) {
+       ((XPVHV *)SvANY(hv))->xhv_aux = iter = S_hv_auxinit(aTHX);
+    }
+    return &(iter->xhv_riter);
+}
+
+HE **
+Perl_hv_eiter_p(pTHX_ HV *hv) {
+    struct xpvhv_aux *iter;
+
+    if (!hv)
+       Perl_croak(aTHX_ "Bad hash");
+
+    iter = ((XPVHV *)SvANY(hv))->xhv_aux;
+    if (!iter) {
+       ((XPVHV *)SvANY(hv))->xhv_aux = iter = S_hv_auxinit(aTHX);
+    }
+    return &(iter->xhv_eiter);
+}
+
+void
+Perl_hv_riter_set(pTHX_ HV *hv, I32 riter) {
+    struct xpvhv_aux *iter;
+
+    if (!hv)
+       Perl_croak(aTHX_ "Bad hash");
+
+
+    iter = ((XPVHV *)SvANY(hv))->xhv_aux;
+    if (!iter) {
+       if (riter == -1)
+           return;
+
+       ((XPVHV *)SvANY(hv))->xhv_aux = iter = S_hv_auxinit(aTHX);
+    }
+    iter->xhv_riter = riter;
+}
+
+void
+Perl_hv_eiter_set(pTHX_ HV *hv, HE *eiter) {
+    struct xpvhv_aux *iter;
+
+    if (!hv)
+       Perl_croak(aTHX_ "Bad hash");
+
+    iter = ((XPVHV *)SvANY(hv))->xhv_aux;
+    if (!iter) {
+       /* 0 is the default so don't go malloc()ing a new structure just to
+          hold 0.  */
+       if (!eiter)
+           return;
+
+       ((XPVHV *)SvANY(hv))->xhv_aux = iter = S_hv_auxinit(aTHX);
+    }
+    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)
+{
+    struct xpvhv_aux *iter = ((XPVHV *)SvANY(hv))->xhv_aux;
+
+    if (!iter) {
+       if (name == 0)
+           return;
+
+       ((XPVHV *)SvANY(hv))->xhv_aux = iter = S_hv_auxinit(aTHX);
+    }
+    iter->xhv_name = savepvn(name, len);
+}
+
 /*
 =for apidoc hv_iternext
 
@@ -1700,11 +1828,22 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
     register HE *entry;
     HE *oldentry;
     MAGIC* mg;
+    struct xpvhv_aux *iter;
 
     if (!hv)
        Perl_croak(aTHX_ "Bad hash");
     xhv = (XPVHV*)SvANY(hv);
-    oldentry = entry = xhv->xhv_eiter; /* HvEITER(hv) */
+    iter = xhv->xhv_aux;
+
+    if (!iter) {
+       /* Too many things (well, pp_each at least) merrily assume that you can
+          call iv_iternext without calling hv_iterinit, so we'll have to deal
+          with it.  */
+       hv_iterinit(hv);
+       iter = ((XPVHV *)SvANY(hv))->xhv_aux;
+    }
+
+    oldentry = entry = iter->xhv_eiter; /* HvEITER(hv) */
 
     if ((mg = SvTIED_mg((SV*)hv, PERL_MAGIC_tied))) {
        SV *key = sv_newmortal();
@@ -1717,7 +1856,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
            HEK *hek;
 
            /* one HE per MAGICAL hash */
-           xhv->xhv_eiter = entry = new_HE(); /* HvEITER(hv) = new_HE() */
+           iter->xhv_eiter = entry = new_HE(); /* HvEITER(hv) = new_HE() */
            Zero(entry, 1, HE);
            Newz(54, k, HEK_BASESIZE + sizeof(SV*), char);
            hek = (HEK*)k;
@@ -1734,7 +1873,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
            SvREFCNT_dec(HeVAL(entry));
        Safefree(HeKEY_hek(entry));
        del_HE(entry);
-       xhv->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
+       iter->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
        return Null(HE*);
     }
 #ifdef DYNAMIC_ENV_FETCH  /* set up %ENV for iteration */
@@ -1763,14 +1902,14 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
     while (!entry) {
        /* OK. Come to the end of the current list.  Grab the next one.  */
 
-       xhv->xhv_riter++; /* HvRITER(hv)++ */
-       if (xhv->xhv_riter > (I32)xhv->xhv_max /* HvRITER(hv) > HvMAX(hv) */) {
+       iter->xhv_riter++; /* HvRITER(hv)++ */
+       if (iter->xhv_riter > (I32)xhv->xhv_max /* HvRITER(hv) > HvMAX(hv) */) {
            /* There is no next one.  End of the hash.  */
-           xhv->xhv_riter = -1; /* HvRITER(hv) = -1 */
+           iter->xhv_riter = -1; /* HvRITER(hv) = -1 */
            break;
        }
        /* entry = (HvARRAY(hv))[HvRITER(hv)]; */
-       entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
+       entry = ((HE**)xhv->xhv_array)[iter->xhv_riter];
 
         if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) {
             /* If we have an entry, but it's a placeholder, don't count it.
@@ -1791,7 +1930,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
     /*if (HvREHASH(hv) && entry && !HeKREHASH(entry))
       PerlIO_printf(PerlIO_stderr(), "Awooga %p %p\n", hv, entry);*/
 
-    xhv->xhv_eiter = entry; /* HvEITER(hv) = entry */
+    iter->xhv_eiter = entry; /* HvEITER(hv) = entry */
     return entry;
 }
 
@@ -2184,8 +2323,8 @@ Perl_hv_assert(pTHX_ HV *hv)
   int placeholders = 0;
   int real = 0;
   int bad = 0;
-  const I32 riter = HvRITER(hv);
-  HE *eiter = HvEITER(hv);
+  const I32 riter = HvRITER_get(hv);
+  HE *eiter = HvEITER_get(hv);
 
   (void)hv_iterinit(hv);
 
@@ -2233,8 +2372,8 @@ Perl_hv_assert(pTHX_ HV *hv)
   if (bad) {
     sv_dump((SV *)hv);
   }
-  HvRITER(hv) = riter;         /* Restore hash iterator state */
-  HvEITER(hv) = eiter;
+  HvRITER_set(hv, riter);              /* Restore hash iterator state */
+  HvEITER_set(hv, eiter);
 }
 
 /*
diff --git a/hv.h b/hv.h
index da3e0e6..2388113 100644 (file)
--- a/hv.h
+++ b/hv.h
@@ -29,6 +29,16 @@ struct hek {
        is UTF-8 */
 };
 
+
+/* Subject to change.
+   Don't access this directly.
+*/
+struct xpvhv_aux {
+    char       *xhv_name;      /* name, if a symbol table */
+    HE         *xhv_eiter;     /* current entry of iterator */
+    I32                xhv_riter;      /* current root of iterator */
+};
+
 /* hash structure: */
 /* This structure must match the beginning of struct xpvmg in sv.h. */
 struct xpvhv {
@@ -40,10 +50,8 @@ struct xpvhv {
     MAGIC*     xmg_magic;      /* magic for scalar array */
     HV*                xmg_stash;      /* class package */
 
-    I32                xhv_riter;      /* current root of iterator */
-    HE         *xhv_eiter;     /* current entry of iterator */
+    struct xpvhv_aux* xhv_aux;
     /* list of pm's for this package is now stored in symtab magic.  */
-    char       *xhv_name;      /* name, if a symbol table */
 };
 
 /* hash a key */
@@ -178,9 +186,19 @@ C<SV*>.
 #define HvARRAY(hv)    (*(HE***)&((XPVHV*)  SvANY(hv))->xhv_array)
 #define HvFILL(hv)     ((XPVHV*)  SvANY(hv))->xhv_fill
 #define HvMAX(hv)      ((XPVHV*)  SvANY(hv))->xhv_max
-#define HvRITER(hv)    ((XPVHV*)  SvANY(hv))->xhv_riter
-#define HvEITER(hv)    ((XPVHV*)  SvANY(hv))->xhv_eiter
-#define HvNAME(hv)     ((XPVHV*)  SvANY(hv))->xhv_name
+#define HvRITER(hv)    (*Perl_hv_riter_p(aTHX_ (HV*)(hv)))
+#define HvEITER(hv)    (*Perl_hv_eiter_p(aTHX_ (HV*)(hv)))
+#define HvRITER_set(hv,r)      Perl_hv_riter_set(aTHX_ (HV*)(hv), r)
+#define HvEITER_set(hv,e)      Perl_hv_eiter_set(aTHX_ (HV*)(hv), e)
+#define HvRITER_get(hv)        (((XPVHV *)SvANY(hv))->xhv_aux ? \
+                        ((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))
+/* 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)
 
 /* the number of keys (including any placeholers) */
 #define XHvTOTALKEYS(xhv)      ((xhv)->xhv_keys)
@@ -318,3 +336,13 @@ C<SV*>.
 /* available as a function in hv.c */
 #define Perl_sharepvn(sv, len, hash) HEK_KEY(share_hek(sv, len, hash))
 #define sharepvn(sv, len, hash)             Perl_sharepvn(sv, len, hash)
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */
diff --git a/mg.c b/mg.c
index 1611d1f..f15dc26 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1605,13 +1605,13 @@ Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
    
     if (!gv_fetchmethod_autoload(pkg, "SCALAR", FALSE)) {
         SV *key;
-        if (HvEITER(hv))
+        if (HvEITER_get(hv))
             /* we are in an iteration so the hash cannot be empty */
             return &PL_sv_yes;
         /* no xhv_eiter so now use FIRSTKEY */
         key = sv_newmortal();
         magic_nextpack((SV*)hv, mg, key);
-        HvEITER(hv) = NULL;     /* need to reset iterator */
+        HvEITER_set(hv, NULL);     /* need to reset iterator */
         return SvOK(key) ? &PL_sv_yes : &PL_sv_no;
     }
    
diff --git a/op.c b/op.c
index 17522bf..0e1e6b8 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(stash), 0);
+       stashsv = newSVpv(HvNAME_get(stash), 0);
     else
        stashsv = &PL_sv_no;
 
@@ -1589,7 +1589,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(stash), 0);
+       stashsv = newSVpv(HvNAME_get(stash), 0);
     else
        stashsv = &PL_sv_no;
     arg = newOP(OP_PADSV, 0);
@@ -4654,7 +4654,7 @@ Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename)
        else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
            /* already defined (or promised) */
            if (ckWARN(WARN_REDEFINE) && !(CvGV(cv) && GvSTASH(CvGV(cv))
-                           && strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) {
+                           && strEQ(HvNAME_get(GvSTASH(CvGV(cv))), "autouse"))) {
                const line_t oldline = CopLINE(PL_curcop);
                if (PL_copline != NOLINE)
                    CopLINE_set(PL_curcop, PL_copline);
@@ -6805,7 +6805,7 @@ Perl_peep(pTHX_ register OP *o)
            {
                Perl_croak(aTHX_ "No such class field \"%s\" " 
                           "in variable %s of type %s", 
-                     key, SvPV_nolen(lexname), HvNAME(SvSTASH(lexname)));
+                     key, SvPV_nolen(lexname), HvNAME_get(SvSTASH(lexname)));
            }
 
             break;
@@ -6862,7 +6862,7 @@ Perl_peep(pTHX_ register OP *o)
                {
                    Perl_croak(aTHX_ "No such class field \"%s\" "
                               "in variable %s of type %s",
-                         key, SvPV_nolen(lexname), HvNAME(SvSTASH(lexname)));
+                         key, SvPV_nolen(lexname), HvNAME_get(SvSTASH(lexname)));
                }
            }
            break;
@@ -7134,7 +7134,7 @@ const_sv_xsub(pTHX_ CV* cv)
     if (items != 0) {
 #if 0
         Perl_croak(aTHX_ "usage: %s::%s()",
-                   HvNAME(GvSTASH(CvGV(cv))), GvNAME(CvGV(cv)));
+                   HvNAME_get(GvSTASH(CvGV(cv))), GvNAME(CvGV(cv)));
 #endif
     }
     EXTEND(sp, 1);
diff --git a/op.h b/op.h
index 95cc1e6..f949179 100644 (file)
--- a/op.h
+++ b/op.h
@@ -330,13 +330,13 @@ struct pmop {
 #  define PmopSTASHPV_set(o,pv)        (PmopSTASHPV(o) = savesharedpv(pv))
 #  define PmopSTASH(o)         (PmopSTASHPV(o) \
                                 ? gv_stashpv(PmopSTASHPV(o),GV_ADD) : Nullhv)
-#  define PmopSTASH_set(o,hv)  PmopSTASHPV_set(o, ((hv) ? HvNAME(hv) : Nullch))
+#  define PmopSTASH_set(o,hv)  PmopSTASHPV_set(o, ((hv) ? HvNAME_get(hv) : Nullch))
 #  define PmopSTASH_free(o)    PerlMemShared_free(PmopSTASHPV(o))
 
 #else
 #  define PmopSTASH(o)         ((o)->op_pmstash)
 #  define PmopSTASH_set(o,hv)  ((o)->op_pmstash = (hv))
-#  define PmopSTASHPV(o)       (PmopSTASH(o) ? HvNAME(PmopSTASH(o)) : Nullch)
+#  define PmopSTASHPV(o)       (PmopSTASH(o) ? HvNAME_get(PmopSTASH(o)) : Nullch)
    /* op_pmstash is not refcounted */
 #  define PmopSTASHPV_set(o,pv)        PmopSTASH_set((o), gv_stashpv(pv,GV_ADD))
 #  define PmopSTASH_free(o)    
diff --git a/perl.c b/perl.c
index c6e5ee3..4ebcefa 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -3061,7 +3061,7 @@ S_init_main_stash(pTHX)
     SvREFCNT_dec(GvHV(gv));
     GvHV(gv) = (HV*)SvREFCNT_inc(PL_defstash);
     SvREADONLY_on(gv);
-    HvNAME(PL_defstash) = savepvn("main", 4);
+    Perl_hv_name_set(aTHX_ PL_defstash, "main", 4, 0);
     PL_incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV)));
     GvMULTI_on(PL_incgv);
     PL_hintgv = gv_fetchpv("\010",TRUE, SVt_PV); /* ^H */
diff --git a/pp.c b/pp.c
index 19e740b..f4d1163 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -600,7 +600,7 @@ PP(pp_gelem)
            break;
        case 'P':
            if (strEQ(elem2, "ACKAGE")) {
-               const char *name = HvNAME(GvSTASH(gv));
+               const char *name = HvNAME_get(GvSTASH(gv));
                sv = newSVpv(name ? name : "__ANON__", 0);
            }
            break;
index 93184cf..1f9abc3 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1717,7 +1717,7 @@ PP(pp_helem)
            RETURN;
        }
        if (PL_op->op_private & OPpLVAL_INTRO) {
-           if (HvNAME(hv) && isGV(*svp))
+           if (HvNAME_get(hv) && isGV(*svp))
                save_gp((GV*)*svp, !(PL_op->op_flags & OPf_SPECIAL));
            else {
                if (!preeminent) {
@@ -3089,7 +3089,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
        if (!sep || ((sep - name) == 5 && strnEQ(name, "SUPER", 5))) {
            /* the method name is unqualified or starts with SUPER:: */ 
            packname = sep ? CopSTASHPV(PL_curcop) :
-               stash ? HvNAME(stash) : packname;
+               stash ? HvNAME_get(stash) : packname;
            if (!packname)
                Perl_croak(aTHX_
                           "Can't use anonymous symbol table for method lookup");
index a75b87c..ab55aff 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -798,7 +798,7 @@ PP(pp_tie)
     switch(SvTYPE(varsv)) {
        case SVt_PVHV:
            methname = "TIEHASH";
-           HvEITER((HV *)varsv) = Null(HE *);
+           HvEITER_set((HV *)varsv, 0);
            break;
        case SVt_PVAV:
            methname = "TIEARRAY";
diff --git a/proto.h b/proto.h
index 8f8ab0a..3b07c32 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -2311,7 +2311,12 @@ STATIC HE*       S_hv_fetch_common(pTHX_ HV* tb, SV* key_sv, const char* key, STRLEN k
 PERL_CALLCONV void     Perl_hv_clear_placeholders(pTHX_ HV* hb);
 
 PERL_CALLCONV SV*      Perl_hv_scalar(pTHX_ HV* hv);
-
+PERL_CALLCONV I32*     Perl_hv_riter_p(pTHX_ HV* hv);
+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 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 49e02f2..51a3896 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -754,7 +754,7 @@ S_varname(pTHX_ GV *gv, const char *gvtype, PADOFFSET targ,
        sv_setpv(name, gvtype);
        if (!hv)
            p = "???";
-       else if (!(p=HvNAME(hv)))
+       else if (!(p=HvNAME_get(hv)))
            p = "__ANON__";
        if (strNE(p, "main")) {
            sv_catpv(name,p);
@@ -1970,9 +1970,7 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
        break;
     case SVt_PVHV:
        SvANY(sv) = new_XPVHV();
-       HvRITER(sv)     = 0;
-       HvEITER(sv)     = 0;
-       HvNAME(sv)      = 0;
+       ((XPVHV*) SvANY(sv))->xhv_aux = 0;
        HvFILL(sv)      = 0;
        HvMAX(sv)       = 0;
        HvTOTALKEYS(sv) = 0;
@@ -3659,7 +3657,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
                }
                tsv = NEWSV(0,0);
                if (SvOBJECT(sv)) {
-                   const char *name = HvNAME(SvSTASH(sv));
+                   const char *name = HvNAME_get(SvSTASH(sv));
                    Perl_sv_setpvf(aTHX_ tsv, "%s=%s(0x%"UVxf")",
                                   name ? name : "__ANON__" , typestr, PTR2UV(sv));
                }
@@ -4451,7 +4449,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
                                        CvCONST(cv)
                                        ? "Constant subroutine %s::%s redefined"
                                        : "Subroutine %s::%s redefined",
-                                       HvNAME(GvSTASH((GV*)dstr)),
+                                       HvNAME_get(GvSTASH((GV*)dstr)),
                                        GvENAME((GV*)dstr));
                                }
                            }
@@ -5561,6 +5559,7 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam
     case PERL_MAGIC_vec:
        vtable = &PL_vtbl_vec;
        break;
+    case PERL_MAGIC_rhash:
     case PERL_MAGIC_symtab:
     case PERL_MAGIC_vstring:
        vtable = 0;
@@ -5961,7 +5960,7 @@ Perl_sv_clear(pTHX_ register SV *sv)
            if (SvREFCNT(sv)) {
                if (PL_in_clean_objs)
                    Perl_croak(aTHX_ "DESTROY created new reference to dead object '%s'",
-                         HvNAME(stash));
+                         HvNAME_get(stash));
                /* DESTROY gave object new lease on life */
                return;
            }
@@ -7983,7 +7982,7 @@ Perl_sv_reset(pTHX_ register const char *s, HV *stash)
                if (GvAV(gv)) {
                    av_clear(GvAV(gv));
                }
-               if (GvHV(gv) && !HvNAME(GvHV(gv))) {
+               if (GvHV(gv) && !HvNAME_get(GvHV(gv))) {
                    hv_clear(GvHV(gv));
 #ifndef PERL_MICRO
 #ifdef USE_ENVIRON_ARRAY
@@ -8454,7 +8453,7 @@ Perl_sv_reftype(pTHX_ const SV *sv, int ob)
     /* The fact that I don't need to downcast to char * everywhere, only in ?:
        inside return suggests a const propagation bug in g++.  */
     if (ob && SvOBJECT(sv)) {
-       char *name = HvNAME(SvSTASH(sv));
+       char *name = HvNAME_get(SvSTASH(sv));
        return name ? name : (char *) "__ANON__";
     }
     else {
@@ -8529,6 +8528,7 @@ an inheritance relationship.
 int
 Perl_sv_isa(pTHX_ SV *sv, const char *name)
 {
+    const char *hvname;
     if (!sv)
        return 0;
     if (SvGMAGICAL(sv))
@@ -8538,10 +8538,11 @@ Perl_sv_isa(pTHX_ SV *sv, const char *name)
     sv = (SV*)SvRV(sv);
     if (!SvOBJECT(sv))
        return 0;
-    if (!HvNAME(SvSTASH(sv)))
+    hvname = HvNAME_get(SvSTASH(sv));
+    if (!hvname)
        return 0;
 
-    return strEQ(HvNAME(SvSTASH(sv)), name);
+    return strEQ(hvname, name);
 }
 
 /*
@@ -10676,7 +10677,7 @@ S_gv_share(pTHX_ SV *sstr, CLONE_PARAMS *param)
     if (!GvUNIQUE(gv)) {
 #if 0
         PerlIO_printf(Perl_debug_log, "gv_share: unable to share %s::%s\n",
-                      HvNAME(GvSTASH(gv)), GvNAME(gv));
+                      HvNAME_get(GvSTASH(gv)), GvNAME(gv));
 #endif
         return Nullsv;
     }
@@ -10782,11 +10783,12 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
     if(param->flags & CLONEf_JOIN_IN) {
         /** We are joining here so we don't want do clone
            something that is bad **/
+       const char *hvname;
 
         if(SvTYPE(sstr) == SVt_PVHV &&
-          HvNAME(sstr)) {
+          (hvname = HvNAME_get(sstr))) {
            /** don't clone stashes if they already exist **/
-           HV* old_stash = gv_stashpv(HvNAME(sstr),0);
+           HV* old_stash = gv_stashpv(hvname,0);
            return (SV*) old_stash;
         }
     }
@@ -10914,7 +10916,7 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
                 ptr_table_store(PL_ptr_table, sstr, dstr);
 #if 0
                 PerlIO_printf(Perl_debug_log, "sv_dup: sharing %s::%s\n",
-                              HvNAME(GvSTASH(share)), GvNAME(share));
+                              HvNAME_get(GvSTASH(share)), GvNAME(share));
 #endif
                 break;
             }
@@ -11020,30 +11022,43 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
        SvNV_set(dstr, SvNVX(sstr));
        SvMAGIC_set(dstr, mg_dup(SvMAGIC(sstr), param));
        SvSTASH_set(dstr, hv_dup_inc(SvSTASH(sstr), param));
-       HvRITER((HV*)dstr)      = HvRITER((HV*)sstr);
-       if (HvARRAY((HV*)sstr)) {
-           STRLEN i = 0;
-           XPVHV *dxhv = (XPVHV*)SvANY(dstr);
-           XPVHV *sxhv = (XPVHV*)SvANY(sstr);
-           Newz(0, dxhv->xhv_array,
-                PERL_HV_ARRAY_ALLOC_BYTES(dxhv->xhv_max+1), char);
-           while (i <= sxhv->xhv_max) {
-               ((HE**)dxhv->xhv_array)[i] = he_dup(((HE**)sxhv->xhv_array)[i],
-                                                   (bool)!!HvSHAREKEYS(sstr),
-                                                   param);
-               ++i;
+       {
+           const char *hvname = HvNAME_get((HV*)sstr);
+           struct xpvhv_aux *aux = ((XPVHV *)SvANY(sstr))->xhv_aux;
+
+           if (aux) {
+               New(0, ((XPVHV *)SvANY(dstr))->xhv_aux, 1, struct xpvhv_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);
+           } else {
+               ((XPVHV *)SvANY(dstr))->xhv_aux = 0;
            }
-           dxhv->xhv_eiter = he_dup(sxhv->xhv_eiter,
-                                    (bool)!!HvSHAREKEYS(sstr), param);
-       }
-       else {
-           SvPV_set(dstr, Nullch);
-           HvEITER((HV*)dstr)  = (HE*)NULL;
+           if (HvARRAY((HV*)sstr)) {
+               STRLEN i = 0;
+               XPVHV *dxhv = (XPVHV*)SvANY(dstr);
+               XPVHV *sxhv = (XPVHV*)SvANY(sstr);
+               Newz(0, dxhv->xhv_array,
+                    PERL_HV_ARRAY_ALLOC_BYTES(dxhv->xhv_max+1), char);
+               while (i <= sxhv->xhv_max) {
+                   ((HE**)dxhv->xhv_array)[i]
+                       = he_dup(((HE**)sxhv->xhv_array)[i],
+                                (bool)!!HvSHAREKEYS(sstr), param);
+                   ++i;
+               }
+               HvEITER_set(dstr, he_dup(HvEITER_get(sstr),
+                                        (bool)!!HvSHAREKEYS(sstr), param));
+           }
+           else {
+               SvPV_set(dstr, Nullch);
+               HvEITER_set((HV*)dstr, (HE*)NULL);
+           }
+           /* Record stashes for possible cloning in Perl_clone(). */
+           if(hvname)
+               av_push(param->stashes, dstr);
        }
-       HvNAME((HV*)dstr)       = SAVEPV(HvNAME((HV*)sstr));
-    /* Record stashes for possible cloning in Perl_clone(). */
-       if(HvNAME((HV*)dstr))
-           av_push(param->stashes, dstr);
        break;
     case SVt_PVFM:
        SvANY(dstr)     = new_XPVFM();
@@ -11547,7 +11562,8 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
 static void
 do_mark_cloneable_stash(pTHX_ SV *sv)
 {
-    if (HvNAME((HV*)sv)) {
+    const char *hvname = HvNAME_get((HV*)sv);
+    if (hvname) {
        GV* cloner = gv_fetchmethod_autoload((HV*)sv, "CLONE_SKIP", 0);
        SvFLAGS(sv) |= SVphv_CLONEABLE; /* clone objects by default */
        if (cloner && GvCV(cloner)) {
@@ -11557,7 +11573,7 @@ do_mark_cloneable_stash(pTHX_ SV *sv)
            ENTER;
            SAVETMPS;
            PUSHMARK(SP);
-           XPUSHs(sv_2mortal(newSVpv(HvNAME((HV*)sv), 0)));
+           XPUSHs(sv_2mortal(newSVpv(hvname, 0)));
            PUTBACK;
            call_sv((SV*)GvCV(cloner), G_SCALAR);
            SPAGAIN;
@@ -12406,7 +12422,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
            ENTER;
            SAVETMPS;
            PUSHMARK(SP);
-           XPUSHs(sv_2mortal(newSVpv(HvNAME(stash), 0)));
+           XPUSHs(sv_2mortal(newSVpv(HvNAME_get(stash), 0)));
            PUTBACK;
            call_sv((SV*)GvCV(cloner), G_DISCARD);
            FREETMPS;
diff --git a/toke.c b/toke.c
index b570040..d496f48 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -4346,7 +4346,7 @@ Perl_yylex(pTHX)
        case KEY___PACKAGE__:
            yylval.opval = (OP*)newSVOP(OP_CONST, 0,
                                        (PL_curstash
-                                        ? newSVpv(HvNAME(PL_curstash), 0)
+                                        ? newSVpv(HvNAME_get(PL_curstash), 0)
                                         : &PL_sv_undef));
            TERM(THING);
 
@@ -4358,7 +4358,7 @@ Perl_yylex(pTHX)
            if (PL_rsfp && (!PL_in_eval || PL_tokenbuf[2] == 'D')) {
                const char *pname = "main";
                if (PL_tokenbuf[2] == 'D')
-                   pname = HvNAME(PL_curstash ? PL_curstash : PL_defstash);
+                   pname = HvNAME_get(PL_curstash ? PL_curstash : PL_defstash);
                gv = gv_fetchpv(Perl_form(aTHX_ "%s::DATA", pname), TRUE, SVt_PVIO);
                GvMULTI_on(gv);
                if (!GvIO(gv))
@@ -5536,7 +5536,7 @@ 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(PAD_COMPNAME_OURSTASH(tmp)), 0);
+                SV *sym = newSVpv(HvNAME_get(PAD_COMPNAME_OURSTASH(tmp)), 0);
                 sv_catpvn(sym, "::", 2);
                 sv_catpv(sym, PL_tokenbuf+1);
                 yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym);
@@ -9737,7 +9737,7 @@ 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(PAD_COMPNAME_OURSTASH(tmp)),0));
+                           newSVpv(HvNAME_get(PAD_COMPNAME_OURSTASH(tmp)),0));
                    sv_catpvn(sym, "::", 2);
                    sv_catpv(sym, d+1);
                    d = SvPVX(sym);
index b62e368..e02bf00 100644 (file)
@@ -40,13 +40,16 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash,
     GV** gvp;
     HV* hv = Nullhv;
     SV* subgen = Nullsv;
+    const char *hvname;
 
     /* A stash/class can go by many names (ie. User == main::User), so 
        we compare the stash itself just in case */
     if (name_stash && (stash == name_stash))
         return &PL_sv_yes;
 
-    if (strEQ(HvNAME(stash), name))
+    hvname = HvNAME_get(stash);
+
+    if (strEQ(hvname, name))
        return &PL_sv_yes;
 
     if (strEQ(name, "UNIVERSAL"))
@@ -54,7 +57,7 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash,
 
     if (level > 100)
        Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'",
-                  HvNAME(stash));
+                  hvname);
 
     gvp = (GV**)hv_fetch(stash, "::ISA::CACHE::", 14, FALSE);
 
@@ -66,13 +69,13 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash,
            SV** svp = (SV**)hv_fetch(hv, name, len, FALSE);
            if (svp && (sv = *svp) != (SV*)&PL_sv_undef) {
                DEBUG_o( Perl_deb(aTHX_ "Using cached ISA %s for package %s\n",
-                                 name, HvNAME(stash)) );
+                                 name, hvname) );
                return sv;
            }
        }
        else {
            DEBUG_o( Perl_deb(aTHX_ "ISA Cache in package %s is stale\n",
-                             HvNAME(stash)) );
+                             hvname) );
            hv_clear(hv);
            sv_setiv(subgen, PL_sub_generation);
        }
@@ -106,8 +109,8 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash,
                if (!basestash) {
                    if (ckWARN(WARN_MISC))
                        Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-                            "Can't locate package %"SVf" for @%s::ISA",
-                           sv, HvNAME(stash));
+                                   "Can't locate package %"SVf" for @%s::ISA",
+                                   sv, hvname);
                    continue;
                }
                if (&PL_sv_yes == isa_lookup(basestash, name, name_stash, 
@@ -348,11 +351,12 @@ XS(XS_UNIVERSAL_VERSION)
        SV *req = ST(1);
 
        if (undef) {
-           if (pkg)
+           if (pkg) {
+               const char *name = HvNAME_get(pkg);
                Perl_croak(aTHX_
-                            "%s does not define $%s::VERSION--version check failed",
-                            HvNAME(pkg), HvNAME(pkg));
-           else {
+                          "%s does not define $%s::VERSION--version check failed",
+                          name, name);
+           else {
                STRLEN n_a;
                Perl_croak(aTHX_
                             "%s defines neither package nor VERSION--version check failed",
@@ -370,7 +374,7 @@ XS(XS_UNIVERSAL_VERSION)
 
        if ( vcmp( req, sv ) > 0 )
            Perl_croak(aTHX_ "%s version %"SVf" (%"SVf") required--"
-                   "this is only version %"SVf" (%"SVf")", HvNAME(pkg),
+                   "this is only version %"SVf" (%"SVf")", HvNAME_get(pkg),
                    vnumify(req),vnormal(req),vnumify(sv),vnormal(sv));
     }
 
index 5956ff2..7cdf41a 100644 (file)
--- a/xsutils.c
+++ b/xsutils.c
@@ -258,7 +258,7 @@ usage:
     sv = SvRV(rv);
 
     if (SvOBJECT(sv))
-       sv_setpv(TARG, HvNAME(SvSTASH(sv)));
+       sv_setpv(TARG, HvNAME_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(stash));
+           sv_setpv(TARG, HvNAME_get(stash));
     }
 
     SvSETMAGIC(TARG);