This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Mac OS X/Darwin seems to have problems with tzname().
[perl5.git] / hv.c
diff --git a/hv.c b/hv.c
index 78d0280..1de2e01 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1,7 +1,7 @@
 /*    hv.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
 /*    hv.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
 
 /* 
 =head1 Hash Manipulation Functions
 
 /* 
 =head1 Hash Manipulation Functions
+
+A HV structure represents a Perl hash. It consists mainly of an array
+of pointers, each of which points to a linked list of HE structures. The
+array is indexed by the hash function of the key, so each linked list
+represents all the hash entries with the same hash value. Each HE contains
+a pointer to the actual value, plus a pointer to a HEK structure which
+holds the key and hash value.
+
+=cut
+
 */
 
 #include "EXTERN.h"
 */
 
 #include "EXTERN.h"
 
 #define HV_MAX_LENGTH_BEFORE_SPLIT 14
 
 
 #define HV_MAX_LENGTH_BEFORE_SPLIT 14
 
-STATIC HE*
-S_new_he(pTHX)
-{
-    HE* he;
-    LOCK_SV_MUTEX;
-    if (!PL_he_root)
-       more_he();
-    he = PL_he_root;
-    PL_he_root = HeNEXT(he);
-    UNLOCK_SV_MUTEX;
-    return he;
-}
-
-STATIC void
-S_del_he(pTHX_ HE *p)
-{
-    LOCK_SV_MUTEX;
-    HeNEXT(p) = (HE*)PL_he_root;
-    PL_he_root = p;
-    UNLOCK_SV_MUTEX;
-}
+static const char S_strtab_error[]
+    = "Cannot modify shared string table in hv_%s";
 
 STATIC void
 S_more_he(pTHX)
 {
 
 STATIC void
 S_more_he(pTHX)
 {
-    register HE* he;
-    register HE* heend;
-    XPV *ptr;
-    New(54, ptr, 1008/sizeof(XPV), XPV);
-    ptr->xpv_pv = (char*)PL_he_arenaroot;
-    PL_he_arenaroot = ptr;
-
-    he = (HE*)ptr;
-    heend = &he[1008 / sizeof(HE) - 1];
-    PL_he_root = ++he;
+    HE* he;
+    HE* heend;
+    Newx(he, PERL_ARENA_SIZE/sizeof(HE), HE);
+    HeNEXT(he) = (HE*) PL_body_arenaroots[HE_SVSLOT];
+    PL_body_arenaroots[HE_SVSLOT] = he;
+
+    heend = &he[PERL_ARENA_SIZE / sizeof(HE) - 1];
+    PL_body_roots[HE_SVSLOT] = ++he;
     while (he < heend) {
        HeNEXT(he) = (HE*)(he + 1);
        he++;
     while (he < heend) {
        HeNEXT(he) = (HE*)(he + 1);
        he++;
@@ -72,38 +61,64 @@ S_more_he(pTHX)
 
 #else
 
 
 #else
 
+STATIC HE*
+S_new_he(pTHX)
+{
+    HE* he;
+    void **root = &PL_body_roots[HE_SVSLOT];
+
+    LOCK_SV_MUTEX;
+    if (!*root)
+       S_more_he(aTHX);
+    he = *root;
+    *root = HeNEXT(he);
+    UNLOCK_SV_MUTEX;
+    return he;
+}
+
 #define new_HE() new_he()
 #define new_HE() new_he()
-#define del_HE(p) del_he(p)
+#define del_HE(p) \
+    STMT_START { \
+       LOCK_SV_MUTEX; \
+       HeNEXT(p) = (HE*)(PL_body_roots[HE_SVSLOT]);    \
+       PL_body_roots[HE_SVSLOT] = p; \
+       UNLOCK_SV_MUTEX; \
+    } STMT_END
+
+
 
 #endif
 
 STATIC HEK *
 S_save_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags)
 {
 
 #endif
 
 STATIC HEK *
 S_save_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags)
 {
+    const int flags_masked = flags & HVhek_MASK;
     char *k;
     register HEK *hek;
 
     char *k;
     register HEK *hek;
 
-    New(54, k, HEK_BASESIZE + len + 2, char);
+    Newx(k, HEK_BASESIZE + len + 2, char);
     hek = (HEK*)k;
     Copy(str, HEK_KEY(hek), len, char);
     HEK_KEY(hek)[len] = 0;
     HEK_LEN(hek) = len;
     HEK_HASH(hek) = hash;
     hek = (HEK*)k;
     Copy(str, HEK_KEY(hek), len, char);
     HEK_KEY(hek)[len] = 0;
     HEK_LEN(hek) = len;
     HEK_HASH(hek) = hash;
-    HEK_FLAGS(hek) = (unsigned char)flags;
+    HEK_FLAGS(hek) = (unsigned char)flags_masked;
+
+    if (flags & HVhek_FREEKEY)
+       Safefree(str);
     return hek;
 }
 
     return hek;
 }
 
-/* free the pool of temporary HE/HEK pairs retunrned by hv_fetch_ent
+/* free the pool of temporary HE/HEK pairs returned by hv_fetch_ent
  * for tied hashes */
 
 void
 Perl_free_tied_hv_pool(pTHX)
 {
  * for tied hashes */
 
 void
 Perl_free_tied_hv_pool(pTHX)
 {
-    HE *ohe;
     HE *he = PL_hv_fetch_ent_mh;
     while (he) {
     HE *he = PL_hv_fetch_ent_mh;
     while (he) {
+       HE * const ohe = he;
        Safefree(HeKEY_hek(he));
        Safefree(HeKEY_hek(he));
-       ohe = he;
        he = HeNEXT(he);
        del_HE(ohe);
     }
        he = HeNEXT(he);
        del_HE(ohe);
     }
@@ -111,8 +126,28 @@ Perl_free_tied_hv_pool(pTHX)
 }
 
 #if defined(USE_ITHREADS)
 }
 
 #if defined(USE_ITHREADS)
+HEK *
+Perl_hek_dup(pTHX_ HEK *source, CLONE_PARAMS* param)
+{
+    HEK *shared = (HEK*)ptr_table_fetch(PL_ptr_table, source);
+
+    PERL_UNUSED_ARG(param);
+
+    if (shared) {
+       /* We already shared this hash key.  */
+       (void)share_hek_hek(shared);
+    }
+    else {
+       shared
+           = share_hek_flags(HEK_KEY(source), HEK_LEN(source),
+                             HEK_HASH(source), HEK_FLAGS(source));
+       ptr_table_store(PL_ptr_table, source, shared);
+    }
+    return shared;
+}
+
 HE *
 HE *
-Perl_he_dup(pTHX_ HE *e, bool shared, CLONE_PARAMS* param)
+Perl_he_dup(pTHX_ const HE *e, bool shared, CLONE_PARAMS* param)
 {
     HE *ret;
 
 {
     HE *ret;
 
@@ -130,13 +165,28 @@ Perl_he_dup(pTHX_ HE *e, bool shared, CLONE_PARAMS* param)
     HeNEXT(ret) = he_dup(HeNEXT(e),shared, param);
     if (HeKLEN(e) == HEf_SVKEY) {
        char *k;
     HeNEXT(ret) = he_dup(HeNEXT(e),shared, param);
     if (HeKLEN(e) == HEf_SVKEY) {
        char *k;
-       New(54, k, HEK_BASESIZE + sizeof(SV*), char);
+       Newx(k, HEK_BASESIZE + sizeof(SV*), char);
        HeKEY_hek(ret) = (HEK*)k;
        HeKEY_sv(ret) = SvREFCNT_inc(sv_dup(HeKEY_sv(e), param));
     }
        HeKEY_hek(ret) = (HEK*)k;
        HeKEY_sv(ret) = SvREFCNT_inc(sv_dup(HeKEY_sv(e), param));
     }
-    else if (shared)
-       HeKEY_hek(ret) = share_hek_flags(HeKEY(e), HeKLEN(e), HeHASH(e),
-                                         HeKFLAGS(e));
+    else if (shared) {
+       /* This is hek_dup inlined, which seems to be important for speed
+          reasons.  */
+       HEK * const source = HeKEY_hek(e);
+       HEK *shared = (HEK*)ptr_table_fetch(PL_ptr_table, source);
+
+       if (shared) {
+           /* We already shared this hash key.  */
+           (void)share_hek_hek(shared);
+       }
+       else {
+           shared
+               = share_hek_flags(HEK_KEY(source), HEK_LEN(source),
+                                 HEK_HASH(source), HEK_FLAGS(source));
+           ptr_table_store(PL_ptr_table, source, shared);
+       }
+       HeKEY_hek(ret) = shared;
+    }
     else
        HeKEY_hek(ret) = save_hek_flags(HeKEY(e), HeKLEN(e), HeHASH(e),
                                         HeKFLAGS(e));
     else
        HeKEY_hek(ret) = save_hek_flags(HeKEY(e), HeKLEN(e), HeHASH(e),
                                         HeKFLAGS(e));
@@ -149,7 +199,7 @@ static void
 S_hv_notallowed(pTHX_ int flags, const char *key, I32 klen,
                const char *msg)
 {
 S_hv_notallowed(pTHX_ int flags, const char *key, I32 klen,
                const char *msg)
 {
-    SV *sv = sv_newmortal(), *esv = sv_newmortal();
+    SV * const sv = sv_newmortal();
     if (!(flags & HVhek_FREEKEY)) {
        sv_setpvn(sv, key, klen);
     }
     if (!(flags & HVhek_FREEKEY)) {
        sv_setpvn(sv, key, klen);
     }
@@ -161,8 +211,7 @@ S_hv_notallowed(pTHX_ int flags, const char *key, I32 klen,
     if (flags & HVhek_UTF8) {
        SvUTF8_on(sv);
     }
     if (flags & HVhek_UTF8) {
        SvUTF8_on(sv);
     }
-    Perl_sv_setpvf(aTHX_ esv, "Attempt to %s a restricted hash", msg);
-    Perl_croak(aTHX_ SvPVX(esv), sv);
+    Perl_croak(aTHX_ msg, sv);
 }
 
 /* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
 }
 
 /* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
@@ -214,7 +263,7 @@ Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen_i32, SV *val, U32 hash)
        flags = 0;
     }
     hek = hv_fetch_common (hv, NULL, key, klen, flags,
        flags = 0;
     }
     hek = hv_fetch_common (hv, NULL, key, klen, flags,
-                          (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, 0);
+                          (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
     return hek ? &HeVAL(hek) : NULL;
 }
 
     return hek ? &HeVAL(hek) : NULL;
 }
 
@@ -222,7 +271,7 @@ SV**
 Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val,
                  register U32 hash, int flags)
 {
 Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val,
                  register U32 hash, int flags)
 {
-    HE *hek = hv_fetch_common (hv, NULL, key, klen, flags,
+    HE * const hek = hv_fetch_common (hv, NULL, key, klen, flags,
                               (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
     return hek ? &HeVAL(hek) : NULL;
 }
                               (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
     return hek ? &HeVAL(hek) : NULL;
 }
@@ -365,12 +414,12 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
                           (lval ? HV_FETCH_LVALUE : 0), Nullsv, hash);
 }
 
                           (lval ? HV_FETCH_LVALUE : 0), Nullsv, hash);
 }
 
-HE *
+STATIC HE *
 S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                  int flags, int action, SV *val, register U32 hash)
 {
 S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                  int flags, int action, SV *val, register U32 hash)
 {
+    dVAR;
     XPVHV* xhv;
     XPVHV* xhv;
-    U32 n_links;
     HE *entry;
     HE **oentry;
     SV *sv;
     HE *entry;
     HE **oentry;
     SV *sv;
@@ -383,7 +432,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     if (keysv) {
        if (flags & HVhek_FREEKEY)
            Safefree(key);
     if (keysv) {
        if (flags & HVhek_FREEKEY)
            Safefree(key);
-       key = SvPV(keysv, klen);
+       key = SvPV_const(keysv, klen);
        flags = 0;
        is_utf8 = (SvUTF8(keysv) != 0);
     } else {
        flags = 0;
        is_utf8 = (SvUTF8(keysv) != 0);
     } else {
@@ -417,7 +466,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                else {
                    char *k;
                    entry = new_HE();
                else {
                    char *k;
                    entry = new_HE();
-                   New(54, k, HEK_BASESIZE + sizeof(SV*), char);
+                   Newx(k, HEK_BASESIZE + sizeof(SV*), char);
                    HeKEY_hek(entry) = (HEK*)k;
                }
                HeNEXT(entry) = Nullhe;
                    HeKEY_hek(entry) = (HEK*)k;
                }
                HeNEXT(entry) = Nullhe;
@@ -441,7 +490,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                    if (isLOWER(key[i])) {
                        /* Would be nice if we had a routine to do the
                           copy and upercase in a single pass through.  */
                    if (isLOWER(key[i])) {
                        /* Would be nice if we had a routine to do the
                           copy and upercase in a single pass through.  */
-                       char *nkey = strupr(savepvn(key,klen));
+                       const char *nkey = strupr(savepvn(key,klen));
                        /* Note that this fetch is for nkey (the uppercased
                           key) whereas the store is for key (the original)  */
                        entry = hv_fetch_common(hv, Nullsv, nkey, klen,
                        /* Note that this fetch is for nkey (the uppercased
                           key) whereas the store is for key (the original)  */
                        entry = hv_fetch_common(hv, Nullsv, nkey, klen,
@@ -467,10 +516,9 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
        } /* ISFETCH */
        else if (SvRMAGICAL(hv) && (action & HV_FETCH_ISEXISTS)) {
            if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
        } /* ISFETCH */
        else if (SvRMAGICAL(hv) && (action & HV_FETCH_ISEXISTS)) {
            if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
-               SV* svret;
                /* I don't understand why hv_exists_ent has svret and sv,
                   whereas hv_exists only had one.  */
                /* I don't understand why hv_exists_ent has svret and sv,
                   whereas hv_exists only had one.  */
-               svret = sv_newmortal();
+               SV * const svret = sv_newmortal();
                sv = sv_newmortal();
 
                if (keysv || is_utf8) {
                sv = sv_newmortal();
 
                if (keysv || is_utf8) {
@@ -495,12 +543,13 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 #ifdef ENV_IS_CASELESS
            else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
                /* XXX This code isn't UTF8 clean.  */
 #ifdef ENV_IS_CASELESS
            else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
                /* XXX This code isn't UTF8 clean.  */
-               const char *keysave = key;
+               char * const keysave = (char * const)key;
                /* Will need to free this, so set FREEKEY flag.  */
                key = savepvn(key,klen);
                key = (const char*)strupr((char*)key);
                is_utf8 = 0;
                hash = 0;
                /* Will need to free this, so set FREEKEY flag.  */
                key = savepvn(key,klen);
                key = (const char*)strupr((char*)key);
                is_utf8 = 0;
                hash = 0;
+               keysv = 0;
 
                if (flags & HVhek_FREEKEY) {
                    Safefree(keysave);
 
                if (flags & HVhek_FREEKEY) {
                    Safefree(keysave);
@@ -514,7 +563,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
            bool needs_store;
            hv_magic_check (hv, &needs_copy, &needs_store);
            if (needs_copy) {
            bool needs_store;
            hv_magic_check (hv, &needs_copy, &needs_store);
            if (needs_copy) {
-               bool save_taint = PL_tainted;   
+               const bool save_taint = PL_tainted;
                if (keysv || is_utf8) {
                    if (!keysv) {
                        keysv = newSVpvn(key, klen);
                if (keysv || is_utf8) {
                    if (!keysv) {
                        keysv = newSVpvn(key, klen);
@@ -529,7 +578,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                }
 
                TAINT_IF(save_taint);
                }
 
                TAINT_IF(save_taint);
-               if (!xhv->xhv_array /* !HvARRAY(hv) */ && !needs_store) {
+               if (!HvARRAY(hv) && !needs_store) {
                    if (flags & HVhek_FREEKEY)
                        Safefree(key);
                    return Nullhe;
                    if (flags & HVhek_FREEKEY)
                        Safefree(key);
                    return Nullhe;
@@ -543,6 +592,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                    key = (const char*)strupr((char*)key);
                    is_utf8 = 0;
                    hash = 0;
                    key = (const char*)strupr((char*)key);
                    is_utf8 = 0;
                    hash = 0;
+                   keysv = 0;
 
                    if (flags & HVhek_FREEKEY) {
                        Safefree(keysave);
 
                    if (flags & HVhek_FREEKEY) {
                        Safefree(keysave);
@@ -554,15 +604,18 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
        } /* ISSTORE */
     } /* SvMAGICAL */
 
        } /* ISSTORE */
     } /* SvMAGICAL */
 
-    if (!xhv->xhv_array /* !HvARRAY(hv) */) {
+    if (!HvARRAY(hv)) {
        if ((action & (HV_FETCH_LVALUE | HV_FETCH_ISSTORE))
 #ifdef DYNAMIC_ENV_FETCH  /* if it's an %ENV lookup, we may get it on the fly */
                 || (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env))
 #endif
        if ((action & (HV_FETCH_LVALUE | HV_FETCH_ISSTORE))
 #ifdef DYNAMIC_ENV_FETCH  /* if it's an %ENV lookup, we may get it on the fly */
                 || (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env))
 #endif
-                                                                 )
-           Newz(503, xhv->xhv_array /* HvARRAY(hv) */,
+                                                                 ) {
+           char *array;
+           Newxz(array,
                 PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
                 char);
                 PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
                 char);
+           HvARRAY(hv) = (HE**)array;
+       }
 #ifdef DYNAMIC_ENV_FETCH
        else if (action & HV_FETCH_ISEXISTS) {
            /* for an %ENV exists, if we do an insert it's by a recursive
 #ifdef DYNAMIC_ENV_FETCH
        else if (action & HV_FETCH_ISEXISTS) {
            /* for an %ENV exists, if we do an insert it's by a recursive
@@ -579,7 +632,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     }
 
     if (is_utf8) {
     }
 
     if (is_utf8) {
-       const char *keysave = key;
+       char * const keysave = (char * const)key;
        key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
         if (is_utf8)
            flags |= HVhek_UTF8;
        key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
         if (is_utf8)
            flags |= HVhek_UTF8;
@@ -602,24 +655,22 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
        flags |= HVhek_REHASH;
     } else if (!hash) {
         if (keysv && (SvIsCOW_shared_hash(keysv))) {
        flags |= HVhek_REHASH;
     } else if (!hash) {
         if (keysv && (SvIsCOW_shared_hash(keysv))) {
-            hash = SvUVX(keysv);
+            hash = SvSHARED_HASH(keysv);
         } else {
             PERL_HASH(hash, key, klen);
         }
     }
 
     masked_flags = (flags & HVhek_MASK);
         } else {
             PERL_HASH(hash, key, klen);
         }
     }
 
     masked_flags = (flags & HVhek_MASK);
-    n_links = 0;
 
 #ifdef DYNAMIC_ENV_FETCH
 
 #ifdef DYNAMIC_ENV_FETCH
-    if (!xhv->xhv_array /* !HvARRAY(hv) */) entry = Null(HE*);
+    if (!HvARRAY(hv)) entry = Null(HE*);
     else
 #endif
     {
     else
 #endif
     {
-       /* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
-       entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
+       entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)];
     }
     }
-    for (; entry; ++n_links, entry = HeNEXT(entry)) {
+    for (; entry; entry = HeNEXT(entry)) {
        if (HeHASH(entry) != hash)              /* strings can't be equal */
            continue;
        if (HeKLEN(entry) != (I32)klen)
        if (HeHASH(entry) != hash)              /* strings can't be equal */
            continue;
        if (HeKLEN(entry) != (I32)klen)
@@ -644,6 +695,14 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                    unshare_hek (HeKEY_hek(entry));
                    HeKEY_hek(entry) = new_hek;
                }
                    unshare_hek (HeKEY_hek(entry));
                    HeKEY_hek(entry) = new_hek;
                }
+               else if (hv == PL_strtab) {
+                   /* PL_strtab is usually the only hash without HvSHAREKEYS,
+                      so putting this test here is cheap  */
+                   if (flags & HVhek_FREEKEY)
+                       Safefree(key);
+                   Perl_croak(aTHX_ S_strtab_error,
+                              action & HV_FETCH_LVALUE ? "fetch" : "store");
+               }
                else
                    HeKFLAGS(entry) = masked_flags;
                if (masked_flags & HVhek_ENABLEHVKFLAGS)
                else
                    HeKFLAGS(entry) = masked_flags;
                if (masked_flags & HVhek_ENABLEHVKFLAGS)
@@ -666,11 +725,11 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                    }
                    /* LVAL fetch which actaully needs a store.  */
                    val = NEWSV(61,0);
                    }
                    /* LVAL fetch which actaully needs a store.  */
                    val = NEWSV(61,0);
-                   xhv->xhv_placeholders--;
+                   HvPLACEHOLDERS(hv)--;
                } else {
                    /* store */
                    if (val != &PL_sv_placeholder)
                } else {
                    /* store */
                    if (val != &PL_sv_placeholder)
-                       xhv->xhv_placeholders--;
+                       HvPLACEHOLDERS(hv)--;
                }
                HeVAL(entry) = val;
            } else if (action & HV_FETCH_ISSTORE) {
                }
                HeVAL(entry) = val;
            } else if (action & HV_FETCH_ISSTORE) {
@@ -690,7 +749,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     if (!(action & HV_FETCH_ISSTORE) 
        && SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
        unsigned long len;
     if (!(action & HV_FETCH_ISSTORE) 
        && SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
        unsigned long len;
-       char *env = PerlEnv_ENVgetenv_len(key,&len);
+       const char * const env = PerlEnv_ENVgetenv_len(key,&len);
        if (env) {
            sv = newSVpvn(env,len);
            SvTAINTED_on(sv);
        if (env) {
            sv = newSVpvn(env,len);
            SvTAINTED_on(sv);
@@ -702,8 +761,8 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 
     if (!entry && SvREADONLY(hv) && !(action & HV_FETCH_ISEXISTS)) {
        S_hv_notallowed(aTHX_ flags, key, klen,
 
     if (!entry && SvREADONLY(hv) && !(action & HV_FETCH_ISEXISTS)) {
        S_hv_notallowed(aTHX_ flags, key, klen,
-                       "access disallowed key '%"SVf"' in"
-                       );
+                       "Attempt to access disallowed key '%"SVf"' in"
+                       " a restricted hash");
     }
     if (!(action & (HV_FETCH_LVALUE|HV_FETCH_ISSTORE))) {
        /* Not doing some form of store, so return failure.  */
     }
     if (!(action & (HV_FETCH_LVALUE|HV_FETCH_ISSTORE))) {
        /* Not doing some form of store, so return failure.  */
@@ -727,22 +786,32 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 
     /* Welcome to hv_store...  */
 
 
     /* Welcome to hv_store...  */
 
-    if (!xhv->xhv_array) {
+    if (!HvARRAY(hv)) {
        /* Not sure if we can get here.  I think the only case of oentry being
           NULL is for %ENV with dynamic env fetch.  But that should disappear
           with magic in the previous code.  */
        /* Not sure if we can get here.  I think the only case of oentry being
           NULL is for %ENV with dynamic env fetch.  But that should disappear
           with magic in the previous code.  */
-       Newz(503, xhv->xhv_array /* HvARRAY(hv) */,
+       char *array;
+       Newxz(array,
             PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
             char);
             PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
             char);
+       HvARRAY(hv) = (HE**)array;
     }
 
     }
 
-    oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
+    oentry = &(HvARRAY(hv))[hash & (I32) xhv->xhv_max];
 
     entry = new_HE();
     /* share_hek_flags will do the free for us.  This might be considered
        bad API design.  */
     if (HvSHAREKEYS(hv))
        HeKEY_hek(entry) = share_hek_flags(key, klen, hash, flags);
 
     entry = new_HE();
     /* share_hek_flags will do the free for us.  This might be considered
        bad API design.  */
     if (HvSHAREKEYS(hv))
        HeKEY_hek(entry) = share_hek_flags(key, klen, hash, flags);
+    else if (hv == PL_strtab) {
+       /* PL_strtab is usually the only hash without HvSHAREKEYS, so putting
+          this test here is cheap  */
+       if (flags & HVhek_FREEKEY)
+           Safefree(key);
+       Perl_croak(aTHX_ S_strtab_error,
+                  action & HV_FETCH_LVALUE ? "fetch" : "store");
+    }
     else                                       /* gotta do the real thing */
        HeKEY_hek(entry) = save_hek_flags(key, klen, hash, flags);
     HeVAL(entry) = val;
     else                                       /* gotta do the real thing */
        HeKEY_hek(entry) = save_hek_flags(key, klen, hash, flags);
     HeVAL(entry) = val;
@@ -750,22 +819,34 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     *oentry = entry;
 
     if (val == &PL_sv_placeholder)
     *oentry = entry;
 
     if (val == &PL_sv_placeholder)
-       xhv->xhv_placeholders++;
+       HvPLACEHOLDERS(hv)++;
     if (masked_flags & HVhek_ENABLEHVKFLAGS)
        HvHASKFLAGS_on(hv);
 
     if (masked_flags & HVhek_ENABLEHVKFLAGS)
        HvHASKFLAGS_on(hv);
 
-    xhv->xhv_keys++; /* HvKEYS(hv)++ */
-    if (!n_links) {                            /* initial entry? */
-       xhv->xhv_fill++; /* HvFILL(hv)++ */
-    } else if ((xhv->xhv_keys > (IV)xhv->xhv_max)
-              || ((n_links > HV_MAX_LENGTH_BEFORE_SPLIT) && !HvREHASH(hv))) {
-       /* Use only the old HvKEYS(hv) > HvMAX(hv) condition to limit bucket
-          splits on a rehashed hash, as we're not going to split it again,
-          and if someone is lucky (evil) enough to get all the keys in one
-          list they could exhaust our memory as we repeatedly double the
-          number of buckets on every entry. Linear search feels a less worse
-          thing to do.  */
-        hsplit(hv);
+    {
+       const HE *counter = HeNEXT(entry);
+
+       xhv->xhv_keys++; /* HvKEYS(hv)++ */
+       if (!counter) {                         /* initial entry? */
+           xhv->xhv_fill++; /* HvFILL(hv)++ */
+       } else if (xhv->xhv_keys > (IV)xhv->xhv_max) {
+           hsplit(hv);
+       } else if(!HvREHASH(hv)) {
+           U32 n_links = 1;
+
+           while ((counter = HeNEXT(counter)))
+               n_links++;
+
+           if (n_links > HV_MAX_LENGTH_BEFORE_SPLIT) {
+               /* Use only the old HvKEYS(hv) > HvMAX(hv) condition to limit
+                  bucket splits on a rehashed hash, as we're not going to
+                  split it again, and if someone is lucky (evil) enough to
+                  get all the keys in one list they could exhaust our memory
+                  as we repeatedly double the number of buckets on every
+                  entry. Linear search feels a less worse thing to do.  */
+               hsplit(hv);
+           }
+       }
     }
 
     return entry;
     }
 
     return entry;
@@ -774,16 +855,15 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 STATIC void
 S_hv_magic_check(pTHX_ HV *hv, bool *needs_copy, bool *needs_store)
 {
 STATIC void
 S_hv_magic_check(pTHX_ HV *hv, bool *needs_copy, bool *needs_store)
 {
-    MAGIC *mg = SvMAGIC(hv);
+    const MAGIC *mg = SvMAGIC(hv);
     *needs_copy = FALSE;
     *needs_store = TRUE;
     while (mg) {
        if (isUPPER(mg->mg_type)) {
            *needs_copy = TRUE;
     *needs_copy = FALSE;
     *needs_store = TRUE;
     while (mg) {
        if (isUPPER(mg->mg_type)) {
            *needs_copy = TRUE;
-           switch (mg->mg_type) {
-           case PERL_MAGIC_tied:
-           case PERL_MAGIC_sig:
+           if (mg->mg_type == PERL_MAGIC_tied) {
                *needs_store = FALSE;
                *needs_store = FALSE;
+               return; /* We've set all there is to set. */
            }
        }
        mg = mg->mg_moremagic;
            }
        }
        mg = mg->mg_moremagic;
@@ -801,13 +881,13 @@ Evaluates the hash in scalar context and returns the result. Handles magic when
 SV *
 Perl_hv_scalar(pTHX_ HV *hv)
 {
 SV *
 Perl_hv_scalar(pTHX_ HV *hv)
 {
-    MAGIC *mg;
     SV *sv;
     SV *sv;
-    
-    if ((SvRMAGICAL(hv) && (mg = mg_find((SV*)hv, PERL_MAGIC_tied)))) {
-        sv = magic_scalarpack(hv, mg);
-        return sv;
-    } 
+
+    if (SvRMAGICAL(hv)) {
+       MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_tied);
+       if (mg)
+           return magic_scalarpack(hv, mg);
+    }
 
     sv = sv_newmortal();
     if (HvFILL((HV*)hv)) 
 
     sv = sv_newmortal();
     if (HvFILL((HV*)hv)) 
@@ -862,14 +942,15 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
     return hv_delete_common(hv, keysv, NULL, 0, 0, flags, hash);
 }
 
     return hv_delete_common(hv, keysv, NULL, 0, 0, flags, hash);
 }
 
-SV *
+STATIC SV *
 S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                   int k_flags, I32 d_flags, U32 hash)
 {
 S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                   int k_flags, I32 d_flags, U32 hash)
 {
+    dVAR;
     register XPVHV* xhv;
     register XPVHV* xhv;
-    register I32 i;
     register HE *entry;
     register HE **oentry;
     register HE *entry;
     register HE **oentry;
+    HE *const *first_entry;
     SV *sv;
     bool is_utf8;
     int masked_flags;
     SV *sv;
     bool is_utf8;
     int masked_flags;
@@ -880,7 +961,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     if (keysv) {
        if (k_flags & HVhek_FREEKEY)
            Safefree(key);
     if (keysv) {
        if (k_flags & HVhek_FREEKEY)
            Safefree(key);
-       key = SvPV(keysv, klen);
+       key = SvPV_const(keysv, klen);
        k_flags = 0;
        is_utf8 = (SvUTF8(keysv) != 0);
     } else {
        k_flags = 0;
        is_utf8 = (SvUTF8(keysv) != 0);
     } else {
@@ -926,12 +1007,12 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
        }
     }
     xhv = (XPVHV*)SvANY(hv);
        }
     }
     xhv = (XPVHV*)SvANY(hv);
-    if (!xhv->xhv_array /* !HvARRAY(hv) */)
+    if (!HvARRAY(hv))
        return Nullsv;
 
     if (is_utf8) {
        return Nullsv;
 
     if (is_utf8) {
-    const char *keysave = key;
-    key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
+       const char *keysave = key;
+       key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
 
         if (is_utf8)
             k_flags |= HVhek_UTF8;
 
         if (is_utf8)
             k_flags |= HVhek_UTF8;
@@ -952,20 +1033,17 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
        PERL_HASH_INTERNAL(hash, key, klen);
     } else if (!hash) {
         if (keysv && (SvIsCOW_shared_hash(keysv))) {
        PERL_HASH_INTERNAL(hash, key, klen);
     } else if (!hash) {
         if (keysv && (SvIsCOW_shared_hash(keysv))) {
-            hash = SvUVX(keysv);
+            hash = SvSHARED_HASH(keysv);
         } else {
             PERL_HASH(hash, key, klen);
         }
         } else {
             PERL_HASH(hash, key, klen);
         }
-       PERL_HASH(hash, key, klen);
     }
 
     masked_flags = (k_flags & HVhek_MASK);
 
     }
 
     masked_flags = (k_flags & HVhek_MASK);
 
-    /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
-    oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
+    first_entry = oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)];
     entry = *oentry;
     entry = *oentry;
-    i = 1;
-    for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
+    for (; entry; oentry = &HeNEXT(entry), entry = *oentry) {
        if (HeHASH(entry) != hash)              /* strings can't be equal */
            continue;
        if (HeKLEN(entry) != (I32)klen)
        if (HeHASH(entry) != hash)              /* strings can't be equal */
            continue;
        if (HeKLEN(entry) != (I32)klen)
@@ -974,34 +1052,27 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
            continue;
        if ((HeKFLAGS(entry) ^ masked_flags) & HVhek_UTF8)
            continue;
            continue;
        if ((HeKFLAGS(entry) ^ masked_flags) & HVhek_UTF8)
            continue;
-        if (k_flags & HVhek_FREEKEY)
-            Safefree(key);
+
+       if (hv == PL_strtab) {
+           if (k_flags & HVhek_FREEKEY)
+               Safefree(key);
+           Perl_croak(aTHX_ S_strtab_error, "delete");
+       }
 
        /* if placeholder is here, it's already been deleted.... */
        if (HeVAL(entry) == &PL_sv_placeholder)
        {
 
        /* if placeholder is here, it's already been deleted.... */
        if (HeVAL(entry) == &PL_sv_placeholder)
        {
-           if (SvREADONLY(hv))
-               return Nullsv; /* if still SvREADONLY, leave it deleted. */
-
-           /* okay, really delete the placeholder. */
-           *oentry = HeNEXT(entry);
-           if (i && !*oentry)
-               xhv->xhv_fill--; /* HvFILL(hv)-- */
-           if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
-               HvLAZYDEL_on(hv);
-           else
-               hv_free_ent(hv, entry);
-           xhv->xhv_keys--; /* HvKEYS(hv)-- */
-          if (xhv->xhv_keys == 0)
-               HvHASKFLAGS_off(hv);
-           xhv->xhv_placeholders--;
-           return Nullsv;
+         if (k_flags & HVhek_FREEKEY)
+            Safefree(key);
+         return Nullsv;
        }
        else if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
            S_hv_notallowed(aTHX_ k_flags, key, klen,
        }
        else if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
            S_hv_notallowed(aTHX_ k_flags, key, klen,
-                           "delete readonly key '%"SVf"' from"
-                           );
+                           "Attempt to delete readonly key '%"SVf"' from"
+                           " a restricted hash");
        }
        }
+        if (k_flags & HVhek_FREEKEY)
+            Safefree(key);
 
        if (d_flags & G_DISCARD)
            sv = Nullsv;
 
        if (d_flags & G_DISCARD)
            sv = Nullsv;
@@ -1017,15 +1088,17 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
         * an error.
         */
        if (SvREADONLY(hv)) {
         * an error.
         */
        if (SvREADONLY(hv)) {
+           SvREFCNT_dec(HeVAL(entry));
            HeVAL(entry) = &PL_sv_placeholder;
            /* We'll be saving this slot, so the number of allocated keys
             * doesn't go down, but the number placeholders goes up */
            HeVAL(entry) = &PL_sv_placeholder;
            /* We'll be saving this slot, so the number of allocated keys
             * doesn't go down, but the number placeholders goes up */
-           xhv->xhv_placeholders++; /* HvPLACEHOLDERS(hv)++ */
+           HvPLACEHOLDERS(hv)++;
        } else {
            *oentry = HeNEXT(entry);
        } else {
            *oentry = HeNEXT(entry);
-           if (i && !*oentry)
+           if(!*first_entry) {
                xhv->xhv_fill--; /* HvFILL(hv)-- */
                xhv->xhv_fill--; /* HvFILL(hv)-- */
-           if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
+           }
+           if (SvOOK(hv) && entry == HvAUX(hv)->xhv_eiter /* HvEITER(hv) */)
                HvLAZYDEL_on(hv);
            else
                hv_free_ent(hv, entry);
                HvLAZYDEL_on(hv);
            else
                hv_free_ent(hv, entry);
@@ -1037,8 +1110,8 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     }
     if (SvREADONLY(hv)) {
         S_hv_notallowed(aTHX_ k_flags, key, klen,
     }
     if (SvREADONLY(hv)) {
         S_hv_notallowed(aTHX_ k_flags, key, klen,
-                       "delete disallowed key '%"SVf"' from"
-                       );
+                       "Attempt to delete disallowed key '%"SVf"' from"
+                       " a restricted hash");
     }
 
     if (k_flags & HVhek_FREEKEY)
     }
 
     if (k_flags & HVhek_FREEKEY)
@@ -1050,48 +1123,68 @@ STATIC void
 S_hsplit(pTHX_ HV *hv)
 {
     register XPVHV* xhv = (XPVHV*)SvANY(hv);
 S_hsplit(pTHX_ HV *hv)
 {
     register XPVHV* xhv = (XPVHV*)SvANY(hv);
-    I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
+    const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
     register I32 newsize = oldsize * 2;
     register I32 i;
     register I32 newsize = oldsize * 2;
     register I32 i;
-    register char *a = xhv->xhv_array; /* HvARRAY(hv) */
+    char *a = (char*) HvARRAY(hv);
     register HE **aep;
     register HE **aep;
-    register HE **bep;
-    register HE *entry;
     register HE **oentry;
     int longest_chain = 0;
     int was_shared;
 
     register HE **oentry;
     int longest_chain = 0;
     int was_shared;
 
+    /*PerlIO_printf(PerlIO_stderr(), "hsplit called for %p which had %d\n",
+      hv, (int) oldsize);*/
+
+    if (HvPLACEHOLDERS_get(hv) && !SvREADONLY(hv)) {
+      /* Can make this clear any placeholders first for non-restricted hashes,
+        even though Storable rebuilds restricted hashes by putting in all the
+        placeholders (first) before turning on the readonly flag, because
+        Storable always pre-splits the hash.  */
+      hv_clear_placeholders(hv);
+    }
+              
     PL_nomemok = TRUE;
 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
     PL_nomemok = TRUE;
 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
-    Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
+    Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
+         + (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0), char);
     if (!a) {
       PL_nomemok = FALSE;
       return;
     }
     if (!a) {
       PL_nomemok = FALSE;
       return;
     }
+    if (SvOOK(hv)) {
+       Copy(&a[oldsize * sizeof(HE*)], &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux);
+    }
 #else
 #else
-    New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
+    Newx(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
+       + (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0), char);
     if (!a) {
       PL_nomemok = FALSE;
       return;
     }
     if (!a) {
       PL_nomemok = FALSE;
       return;
     }
-    Copy(xhv->xhv_array /* HvARRAY(hv) */, a, oldsize * sizeof(HE*), char);
+    Copy(HvARRAY(hv), a, oldsize * sizeof(HE*), char);
+    if (SvOOK(hv)) {
+       Copy(HvAUX(hv), &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux);
+    }
     if (oldsize >= 64) {
     if (oldsize >= 64) {
-       offer_nice_chunk(xhv->xhv_array /* HvARRAY(hv) */,
-                       PERL_HV_ARRAY_ALLOC_BYTES(oldsize));
+       offer_nice_chunk(HvARRAY(hv),
+                        PERL_HV_ARRAY_ALLOC_BYTES(oldsize)
+                        + (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0));
     }
     else
     }
     else
-       Safefree(xhv->xhv_array /* HvARRAY(hv) */);
+       Safefree(HvARRAY(hv));
 #endif
 
     PL_nomemok = FALSE;
     Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char);    /* zero 2nd half*/
     xhv->xhv_max = --newsize;  /* HvMAX(hv) = --newsize */
 #endif
 
     PL_nomemok = FALSE;
     Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char);    /* zero 2nd half*/
     xhv->xhv_max = --newsize;  /* HvMAX(hv) = --newsize */
-    xhv->xhv_array = a;                /* HvARRAY(hv) = a */
+    HvARRAY(hv) = (HE**) a;
     aep = (HE**)a;
 
     for (i=0; i<oldsize; i++,aep++) {
        int left_length = 0;
        int right_length = 0;
     aep = (HE**)a;
 
     for (i=0; i<oldsize; i++,aep++) {
        int left_length = 0;
        int right_length = 0;
+       register HE *entry;
+       register HE **bep;
 
        if (!*aep)                              /* non-existent */
            continue;
 
        if (!*aep)                              /* non-existent */
            continue;
@@ -1140,29 +1233,35 @@ S_hsplit(pTHX_ HV *hv)
       longest_chain, HvTOTALKEYS(hv), HvFILL(hv),  1+HvMAX(hv));*/
 
     ++newsize;
       longest_chain, HvTOTALKEYS(hv), HvFILL(hv),  1+HvMAX(hv));*/
 
     ++newsize;
-    Newz(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
+    Newxz(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
+        + (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0), char);
+    if (SvOOK(hv)) {
+       Copy(HvAUX(hv), &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux);
+    }
+
     was_shared = HvSHAREKEYS(hv);
 
     xhv->xhv_fill = 0;
     HvSHAREKEYS_off(hv);
     HvREHASH_on(hv);
 
     was_shared = HvSHAREKEYS(hv);
 
     xhv->xhv_fill = 0;
     HvSHAREKEYS_off(hv);
     HvREHASH_on(hv);
 
-    aep = (HE **) xhv->xhv_array;
+    aep = HvARRAY(hv);
 
     for (i=0; i<newsize; i++,aep++) {
 
     for (i=0; i<newsize; i++,aep++) {
-       entry = *aep;
+       register HE *entry = *aep;
        while (entry) {
            /* We're going to trash this HE's next pointer when we chain it
               into the new hash below, so store where we go next.  */
        while (entry) {
            /* We're going to trash this HE's next pointer when we chain it
               into the new hash below, so store where we go next.  */
-           HE *next = HeNEXT(entry);
+           HE * const next = HeNEXT(entry);
            UV hash;
            UV hash;
+           HE **bep;
 
            /* Rehash it */
            PERL_HASH_INTERNAL(hash, HeKEY(entry), HeKLEN(entry));
 
            if (was_shared) {
                /* Unshare it.  */
 
            /* Rehash it */
            PERL_HASH_INTERNAL(hash, HeKEY(entry), HeKLEN(entry));
 
            if (was_shared) {
                /* Unshare it.  */
-               HEK *new_hek
+               HEK * const new_hek
                    = save_hek_flags(HeKEY(entry), HeKLEN(entry),
                                     hash, HeKFLAGS(entry));
                unshare_hek (HeKEY_hek(entry));
                    = save_hek_flags(HeKEY(entry), HeKLEN(entry),
                                     hash, HeKFLAGS(entry));
                unshare_hek (HeKEY_hek(entry));
@@ -1185,18 +1284,17 @@ S_hsplit(pTHX_ HV *hv)
            entry = next;
        }
     }
            entry = next;
        }
     }
-    Safefree (xhv->xhv_array);
-    xhv->xhv_array = a;                /* HvARRAY(hv) = a */
+    Safefree (HvARRAY(hv));
+    HvARRAY(hv) = (HE **)a;
 }
 
 void
 Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
 {
     register XPVHV* xhv = (XPVHV*)SvANY(hv);
 }
 
 void
 Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
 {
     register XPVHV* xhv = (XPVHV*)SvANY(hv);
-    I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
+    const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
     register I32 newsize;
     register I32 i;
     register I32 newsize;
     register I32 i;
-    register I32 j;
     register char *a;
     register HE **aep;
     register HE *entry;
     register char *a;
     register HE **aep;
     register HE *entry;
@@ -1213,37 +1311,46 @@ Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
     if (newsize < newmax)
        return;                                 /* overflow detection */
 
     if (newsize < newmax)
        return;                                 /* overflow detection */
 
-    a = xhv->xhv_array; /* HvARRAY(hv) */
+    a = (char *) HvARRAY(hv);
     if (a) {
        PL_nomemok = TRUE;
 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
     if (a) {
        PL_nomemok = TRUE;
 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
-       Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
+       Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
+             + (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0), char);
        if (!a) {
          PL_nomemok = FALSE;
          return;
        }
        if (!a) {
          PL_nomemok = FALSE;
          return;
        }
+       if (SvOOK(hv)) {
+           Copy(&a[oldsize * sizeof(HE*)], &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux);
+       }
 #else
 #else
-       New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
+       Newx(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
+           + (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0), char);
        if (!a) {
          PL_nomemok = FALSE;
          return;
        }
        if (!a) {
          PL_nomemok = FALSE;
          return;
        }
-       Copy(xhv->xhv_array /* HvARRAY(hv) */, a, oldsize * sizeof(HE*), char);
+       Copy(HvARRAY(hv), a, oldsize * sizeof(HE*), char);
+       if (SvOOK(hv)) {
+           Copy(HvAUX(hv), &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux);
+       }
        if (oldsize >= 64) {
        if (oldsize >= 64) {
-           offer_nice_chunk(xhv->xhv_array /* HvARRAY(hv) */,
-                           PERL_HV_ARRAY_ALLOC_BYTES(oldsize));
+           offer_nice_chunk(HvARRAY(hv),
+                            PERL_HV_ARRAY_ALLOC_BYTES(oldsize)
+                            + (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0));
        }
        else
        }
        else
-           Safefree(xhv->xhv_array /* HvARRAY(hv) */);
+           Safefree(HvARRAY(hv));
 #endif
        PL_nomemok = FALSE;
        Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/
     }
     else {
 #endif
        PL_nomemok = FALSE;
        Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/
     }
     else {
-       Newz(0, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
+       Newxz(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
     }
     xhv->xhv_max = --newsize;  /* HvMAX(hv) = --newsize */
     }
     xhv->xhv_max = --newsize;  /* HvMAX(hv) = --newsize */
-    xhv->xhv_array = a;        /* HvARRAY(hv) = a */
+    HvARRAY(hv) = (HE **) a;
     if (!xhv->xhv_fill /* !HvFILL(hv) */)      /* skip rest if no entries */
        return;
 
     if (!xhv->xhv_fill /* !HvFILL(hv) */)      /* skip rest if no entries */
        return;
 
@@ -1252,6 +1359,7 @@ Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
        if (!*aep)                              /* non-existent */
            continue;
        for (oentry = aep, entry = *aep; entry; entry = *oentry) {
        if (!*aep)                              /* non-existent */
            continue;
        for (oentry = aep, entry = *aep; entry; entry = *oentry) {
+           register I32 j;
            if ((j = (HeHASH(entry) & newsize)) != i) {
                j -= i;
                *oentry = HeNEXT(entry);
            if ((j = (HeHASH(entry) & newsize)) != i) {
                j -= i;
                *oentry = HeNEXT(entry);
@@ -1279,10 +1387,9 @@ Creates a new HV.  The reference count is set to 1.
 HV *
 Perl_newHV(pTHX)
 {
 HV *
 Perl_newHV(pTHX)
 {
-    register HV *hv;
     register XPVHV* xhv;
     register XPVHV* xhv;
+    HV * const hv = (HV*)NEWSV(502,0);
 
 
-    hv = (HV*)NEWSV(502,0);
     sv_upgrade((SV *)hv, SVt_PVHV);
     xhv = (XPVHV*)SvANY(hv);
     SvPOK_off(hv);
     sv_upgrade((SV *)hv, SVt_PVHV);
     xhv = (XPVHV*)SvANY(hv);
     SvPOK_off(hv);
@@ -1293,15 +1400,13 @@ Perl_newHV(pTHX)
 
     xhv->xhv_max    = 7;       /* HvMAX(hv) = 7 (start with 8 buckets) */
     xhv->xhv_fill   = 0;       /* HvFILL(hv) = 0 */
 
     xhv->xhv_max    = 7;       /* HvMAX(hv) = 7 (start with 8 buckets) */
     xhv->xhv_fill   = 0;       /* HvFILL(hv) = 0 */
-    xhv->xhv_pmroot = 0;       /* HvPMROOT(hv) = 0 */
-    (void)hv_iterinit(hv);     /* so each() will start off right */
     return hv;
 }
 
 HV *
 Perl_newHVhv(pTHX_ HV *ohv)
 {
     return hv;
 }
 
 HV *
 Perl_newHVhv(pTHX_ HV *ohv)
 {
-    HV *hv = newHV();
+    HV * const hv = newHV();
     STRLEN hv_max, hv_fill;
 
     if (!ohv || (hv_fill = HvFILL(ohv)) == 0)
     STRLEN hv_max, hv_fill;
 
     if (!ohv || (hv_fill = HvFILL(ohv)) == 0)
@@ -1311,15 +1416,16 @@ Perl_newHVhv(pTHX_ HV *ohv)
     if (!SvMAGICAL((SV *)ohv)) {
        /* It's an ordinary hash, so copy it fast. AMS 20010804 */
        STRLEN i;
     if (!SvMAGICAL((SV *)ohv)) {
        /* It's an ordinary hash, so copy it fast. AMS 20010804 */
        STRLEN i;
-       bool shared = !!HvSHAREKEYS(ohv);
-       HE **ents, **oents = (HE **)HvARRAY(ohv);
+       const bool shared = !!HvSHAREKEYS(ohv);
+       HE **ents, ** const oents = (HE **)HvARRAY(ohv);
        char *a;
        char *a;
-       New(0, a, PERL_HV_ARRAY_ALLOC_BYTES(hv_max+1), char);
+       Newx(a, PERL_HV_ARRAY_ALLOC_BYTES(hv_max+1), char);
        ents = (HE**)a;
 
        /* In each bucket... */
        for (i = 0; i <= hv_max; i++) {
        ents = (HE**)a;
 
        /* In each bucket... */
        for (i = 0; i <= hv_max; i++) {
-           HE *prev = NULL, *ent = NULL, *oent = oents[i];
+           HE *prev = NULL, *ent = NULL;
+           HE *oent = oents[i];
 
            if (!oent) {
                ents[i] = NULL;
 
            if (!oent) {
                ents[i] = NULL;
@@ -1327,11 +1433,11 @@ Perl_newHVhv(pTHX_ HV *ohv)
            }
 
            /* Copy the linked list of entries. */
            }
 
            /* Copy the linked list of entries. */
-           for (oent = oents[i]; oent; oent = HeNEXT(oent)) {
-               U32 hash   = HeHASH(oent);
-               char *key  = HeKEY(oent);
-               STRLEN len = HeKLEN(oent);
-                int flags  = HeKFLAGS(oent);
+           for (; oent; oent = HeNEXT(oent)) {
+               const U32 hash   = HeHASH(oent);
+               const char * const key = HeKEY(oent);
+               const STRLEN len = HeKLEN(oent);
+               const int flags  = HeKFLAGS(oent);
 
                ent = new_HE();
                HeVAL(ent)     = newSVsv(HeVAL(oent));
 
                ent = new_HE();
                HeVAL(ent)     = newSVsv(HeVAL(oent));
@@ -1351,12 +1457,12 @@ Perl_newHVhv(pTHX_ HV *ohv)
        HvFILL(hv)  = hv_fill;
        HvTOTALKEYS(hv)  = HvTOTALKEYS(ohv);
        HvARRAY(hv) = ents;
        HvFILL(hv)  = hv_fill;
        HvTOTALKEYS(hv)  = HvTOTALKEYS(ohv);
        HvARRAY(hv) = ents;
-    }
+    } /* not magical */
     else {
        /* Iterate over ohv, copying keys and values one at a time. */
        HE *entry;
     else {
        /* Iterate over ohv, copying keys and values one at a time. */
        HE *entry;
-       I32 riter = HvRITER(ohv);
-       HE *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)
 
        /* Can we use fewer buckets? (hv_max is always 2^n-1) */
        while (hv_max && hv_max + 1 >= hv_fill * 2)
@@ -1369,8 +1475,8 @@ Perl_newHVhv(pTHX_ HV *ohv)
                            newSVsv(HeVAL(entry)), HeHASH(entry),
                            HeKFLAGS(entry));
        }
                            newSVsv(HeVAL(entry)), HeHASH(entry),
                            HeKFLAGS(entry));
        }
-       HvRITER(ohv) = riter;
-       HvEITER(ohv) = eiter;
+       HvRITER_set(ohv, riter);
+       HvEITER_set(ohv, eiter);
     }
 
     return hv;
     }
 
     return hv;
@@ -1384,7 +1490,7 @@ Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
     if (!entry)
        return;
     val = HeVAL(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) {
        PL_sub_generation++;    /* may be deletion of method from stash */
     SvREFCNT_dec(val);
     if (HeKLEN(entry) == HEf_SVKEY) {
@@ -1403,18 +1509,12 @@ Perl_hv_delayfree_ent(pTHX_ HV *hv, register HE *entry)
 {
     if (!entry)
        return;
 {
     if (!entry)
        return;
-    if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
-       PL_sub_generation++;    /* may be deletion of method from stash */
-    sv_2mortal(HeVAL(entry));  /* free between statements */
+    /* SvREFCNT_inc to counter the SvREFCNT_dec in hv_free_ent  */
+    sv_2mortal(SvREFCNT_inc(HeVAL(entry)));    /* free between statements */
     if (HeKLEN(entry) == HEf_SVKEY) {
     if (HeKLEN(entry) == HEf_SVKEY) {
-       sv_2mortal(HeKEY_sv(entry));
-       Safefree(HeKEY_hek(entry));
+       sv_2mortal(SvREFCNT_inc(HeKEY_sv(entry)));
     }
     }
-    else if (HvSHAREKEYS(hv))
-       unshare_hek(HeKEY_hek(entry));
-    else
-       Safefree(HeKEY_hek(entry));
-    del_HE(entry);
+    hv_free_ent(hv, entry);
 }
 
 /*
 }
 
 /*
@@ -1428,6 +1528,7 @@ Clears a hash, making it empty.
 void
 Perl_hv_clear(pTHX_ HV *hv)
 {
 void
 Perl_hv_clear(pTHX_ HV *hv)
 {
+    dVAR;
     register XPVHV* xhv;
     if (!hv)
        return;
     register XPVHV* xhv;
     if (!hv)
        return;
@@ -1436,12 +1537,11 @@ Perl_hv_clear(pTHX_ HV *hv)
 
     xhv = (XPVHV*)SvANY(hv);
 
 
     xhv = (XPVHV*)SvANY(hv);
 
-    if (SvREADONLY(hv) && xhv->xhv_array != NULL) {
+    if (SvREADONLY(hv) && HvARRAY(hv) != NULL) {
        /* restricted hash: convert all keys to placeholders */
        /* restricted hash: convert all keys to placeholders */
-       I32 i;
-       HE* entry;
-       for (i = 0; i <= (I32) xhv->xhv_max; i++) {
-           entry = ((HE**)xhv->xhv_array)[i];
+       STRLEN i;
+       for (i = 0; i <= xhv->xhv_max; i++) {
+           HE *entry = (HvARRAY(hv))[i];
            for (; entry; entry = HeNEXT(entry)) {
                /* not already placeholder */
                if (HeVAL(entry) != &PL_sv_placeholder) {
            for (; entry; entry = HeNEXT(entry)) {
                /* not already placeholder */
                if (HeVAL(entry) != &PL_sv_placeholder) {
@@ -1453,7 +1553,7 @@ Perl_hv_clear(pTHX_ HV *hv)
                    }
                    SvREFCNT_dec(HeVAL(entry));
                    HeVAL(entry) = &PL_sv_placeholder;
                    }
                    SvREFCNT_dec(HeVAL(entry));
                    HeVAL(entry) = &PL_sv_placeholder;
-                   xhv->xhv_placeholders++; /* HvPLACEHOLDERS(hv)++ */
+                   HvPLACEHOLDERS(hv)++;
                }
            }
        }
                }
            }
        }
@@ -1461,9 +1561,9 @@ Perl_hv_clear(pTHX_ HV *hv)
     }
 
     hfreeentries(hv);
     }
 
     hfreeentries(hv);
-    xhv->xhv_placeholders = 0; /* HvPLACEHOLDERS(hv) = 0 */
-    if (xhv->xhv_array /* HvARRAY(hv) */)
-       (void)memzero(xhv->xhv_array /* HvARRAY(hv) */,
+    HvPLACEHOLDERS_set(hv, 0);
+    if (HvARRAY(hv))
+       (void)memzero(HvARRAY(hv),
                      (xhv->xhv_max+1 /* HvMAX(hv)+1 */) * sizeof(HE*));
 
     if (SvRMAGICAL(hv))
                      (xhv->xhv_max+1 /* HvMAX(hv)+1 */) * sizeof(HE*));
 
     if (SvRMAGICAL(hv))
@@ -1472,7 +1572,9 @@ Perl_hv_clear(pTHX_ HV *hv)
     HvHASKFLAGS_off(hv);
     HvREHASH_off(hv);
     reset:
     HvHASKFLAGS_off(hv);
     HvREHASH_off(hv);
     reset:
-    HvEITER(hv) = NULL;
+    if (SvOOK(hv)) {
+       HvEITER_set(hv, NULL);
+    }
 }
 
 /*
 }
 
 /*
@@ -1482,7 +1584,7 @@ Clears any placeholders from a hash.  If a restricted hash has any of its keys
 marked as readonly and the key is subsequently deleted, the key is not actually
 deleted but is marked by assigning it a value of &PL_sv_placeholder.  This tags
 it so it will be ignored by future operations such as iterating over the hash,
 marked as readonly and the key is subsequently deleted, the key is not actually
 deleted but is marked by assigning it a value of &PL_sv_placeholder.  This tags
 it so it will be ignored by future operations such as iterating over the hash,
-but will still allow the hash to have a value reaasigned to the key at some
+but will still allow the hash to have a value reassigned to the key at some
 future point.  This function clears any such placeholder keys from the hash.
 See Hash::Util::lock_keys() for an example of its use.
 
 future point.  This function clears any such placeholder keys from the hash.
 See Hash::Util::lock_keys() for an example of its use.
 
@@ -1492,42 +1594,50 @@ See Hash::Util::lock_keys() for an example of its use.
 void
 Perl_hv_clear_placeholders(pTHX_ HV *hv)
 {
 void
 Perl_hv_clear_placeholders(pTHX_ HV *hv)
 {
-    I32 items;
-    items = (I32)HvPLACEHOLDERS(hv);
-    if (items) {
-        HE *entry;
-        I32 riter = HvRITER(hv);
-        HE *eiter = HvEITER(hv);
-        hv_iterinit(hv);
-        /* This may look suboptimal with the items *after* the iternext, but
-           it's quite deliberate. We only get here with items==0 if we've
-           just deleted the last placeholder in the hash. If we've just done
-           that then it means that the hash is in lazy delete mode, and the
-           HE is now only referenced in our iterator. If we just quit the loop
-           and discarded our iterator then the HE leaks. So we do the && the
-           other way to ensure iternext is called just one more time, which
-           has the side effect of triggering the lazy delete.  */
-        while ((entry = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))
-            && items) {
-            SV *val = hv_iterval(hv, entry);
-
-            if (val == &PL_sv_placeholder) {
-
-                /* It seems that I have to go back in the front of the hash
-                   API to delete a hash, even though I have a HE structure
-                   pointing to the very entry I want to delete, and could hold
-                   onto the previous HE that points to it. And it's easier to
-                   go in with SVs as I can then specify the precomputed hash,
-                   and don't have fun and games with utf8 keys.  */
-                SV *key = hv_iterkeysv(entry);
-
-                hv_delete_ent (hv, key, G_DISCARD, HeHASH(entry));
-                items--;
-            }
-        }
-        HvRITER(hv) = riter;
-        HvEITER(hv) = eiter;
-    }
+    dVAR;
+    I32 items = (I32)HvPLACEHOLDERS_get(hv);
+    I32 i;
+
+    if (items == 0)
+       return;
+
+    i = HvMAX(hv);
+    do {
+       /* Loop down the linked list heads  */
+       bool first = 1;
+       HE **oentry = &(HvARRAY(hv))[i];
+       HE *entry = *oentry;
+
+       if (!entry)
+           continue;
+
+       for (; entry; entry = *oentry) {
+           if (HeVAL(entry) == &PL_sv_placeholder) {
+               *oentry = HeNEXT(entry);
+               if (first && !*oentry)
+                   HvFILL(hv)--; /* This linked list is now empty.  */
+               if (HvEITER_get(hv))
+                   HvLAZYDEL_on(hv);
+               else
+                   hv_free_ent(hv, entry);
+
+               if (--items == 0) {
+                   /* Finished.  */
+                   HvTOTALKEYS(hv) -= (IV)HvPLACEHOLDERS_get(hv);
+                   if (HvKEYS(hv) == 0)
+                       HvHASKFLAGS_off(hv);
+                   HvPLACEHOLDERS_set(hv, 0);
+                   return;
+               }
+           } else {
+               oentry = &HeNEXT(entry);
+               first = 0;
+           }
+       }
+    } while (--i >= 0);
+    /* You can't get here, hence assertion should always fail.  */
+    assert (items == 0);
+    assert (0);
 }
 
 STATIC void
 }
 
 STATIC void
@@ -1535,28 +1645,30 @@ S_hfreeentries(pTHX_ HV *hv)
 {
     register HE **array;
     register HE *entry;
 {
     register HE **array;
     register HE *entry;
-    register HE *oentry = Null(HE*);
     I32 riter;
     I32 max;
     I32 riter;
     I32 max;
+    struct xpvhv_aux *iter;
 
 
-    if (!hv)
-       return;
     if (!HvARRAY(hv))
        return;
 
     if (!HvARRAY(hv))
        return;
 
+    iter =  SvOOK(hv) ? HvAUX(hv) : 0;
+
     riter = 0;
     max = HvMAX(hv);
     array = HvARRAY(hv);
     /* make everyone else think the array is empty, so that the destructors
      * called for freed entries can't recusively mess with us */
     HvARRAY(hv) = Null(HE**); 
     riter = 0;
     max = HvMAX(hv);
     array = HvARRAY(hv);
     /* make everyone else think the array is empty, so that the destructors
      * called for freed entries can't recusively mess with us */
     HvARRAY(hv) = Null(HE**); 
+    SvFLAGS(hv) &= ~SVf_OOK;
+
     HvFILL(hv) = 0;
     ((XPVHV*) SvANY(hv))->xhv_keys = 0;
 
     entry = array[0];
     for (;;) {
        if (entry) {
     HvFILL(hv) = 0;
     ((XPVHV*) SvANY(hv))->xhv_keys = 0;
 
     entry = array[0];
     for (;;) {
        if (entry) {
-           oentry = entry;
+           register HE * const oentry = entry;
            entry = HeNEXT(entry);
            hv_free_ent(hv, oentry);
        }
            entry = HeNEXT(entry);
            hv_free_ent(hv, oentry);
        }
@@ -1566,8 +1678,35 @@ S_hfreeentries(pTHX_ HV *hv)
            entry = array[riter];
        }
     }
            entry = array[riter];
        }
     }
+
+    if (SvOOK(hv)) {
+       /* Someone attempted to iterate or set the hash name while we had
+          the array set to 0.  */
+       assert(HvARRAY(hv));
+
+       if (HvAUX(hv)->xhv_name)
+           unshare_hek_or_pvn(HvAUX(hv)->xhv_name, 0, 0, 0);
+       /* SvOOK_off calls sv_backoff, which isn't correct.  */
+
+       Safefree(HvARRAY(hv));
+       HvARRAY(hv) = 0;
+       SvFLAGS(hv) &= ~SVf_OOK;
+    }
+
+    /* FIXME - things will still go horribly wrong (or at least leak) if
+       people attempt to add elements to the hash while we're undef()ing it  */
+    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*) */
+       SvFLAGS(hv) |= SVf_OOK;
+    }
+
     HvARRAY(hv) = array;
     HvARRAY(hv) = array;
-    (void)hv_iterinit(hv);
 }
 
 /*
 }
 
 /*
@@ -1582,26 +1721,52 @@ void
 Perl_hv_undef(pTHX_ HV *hv)
 {
     register XPVHV* xhv;
 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);
     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))) {
         if(PL_stashcache)
         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, HvNAMELEN_get(hv), G_DISCARD);
+       hv_name_set(hv, Nullch, 0, 0);
     }
     }
+    SvFLAGS(hv) &= ~SVf_OOK;
+    Safefree(HvARRAY(hv));
     xhv->xhv_max   = 7;        /* HvMAX(hv) = 7 (it's a normal hash) */
     xhv->xhv_max   = 7;        /* HvMAX(hv) = 7 (it's a normal hash) */
-    xhv->xhv_array = 0;        /* HvARRAY(hv) = 0 */
-    xhv->xhv_placeholders = 0; /* HvPLACEHOLDERS(hv) = 0 */
+    HvARRAY(hv) = 0;
+    HvPLACEHOLDERS_set(hv, 0);
 
     if (SvRMAGICAL(hv))
        mg_clear((SV*)hv);
 }
 
 
     if (SvRMAGICAL(hv))
        mg_clear((SV*)hv);
 }
 
+static struct xpvhv_aux*
+S_hv_auxinit(pTHX_ HV *hv) {
+    struct xpvhv_aux *iter;
+    char *array;
+
+    if (!HvARRAY(hv)) {
+       Newxz(array, PERL_HV_ARRAY_ALLOC_BYTES(HvMAX(hv) + 1)
+           + sizeof(struct xpvhv_aux), char);
+    } else {
+       array = (char *) HvARRAY(hv);
+       Renew(array, PERL_HV_ARRAY_ALLOC_BYTES(HvMAX(hv) + 1)
+             + sizeof(struct xpvhv_aux), char);
+    }
+    HvARRAY(hv) = (HE**) array;
+    /* SvOOK_on(hv) attacks the IV flags.  */
+    SvFLAGS(hv) |= SVf_OOK;
+    iter = HvAUX(hv);
+
+    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
 
 /*
 =for apidoc hv_iterinit
 
@@ -1620,23 +1785,114 @@ value, you can get it through the macro C<HvFILL(tb)>.
 I32
 Perl_hv_iterinit(pTHX_ HV *hv)
 {
 I32
 Perl_hv_iterinit(pTHX_ HV *hv)
 {
-    register XPVHV* xhv;
     HE *entry;
 
     if (!hv)
        Perl_croak(aTHX_ "Bad hash");
     HE *entry;
 
     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);
+
+    if (SvOOK(hv)) {
+       struct xpvhv_aux *iter = HvAUX(hv);
+       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 {
+       S_hv_auxinit(aTHX_ hv);
     }
     }
-    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 */
     /* used to be xhv->xhv_fill before 5.004_65 */
-    return XHvTOTALKEYS(xhv);
+    return HvTOTALKEYS(hv);
+}
+
+I32 *
+Perl_hv_riter_p(pTHX_ HV *hv) {
+    struct xpvhv_aux *iter;
+
+    if (!hv)
+       Perl_croak(aTHX_ "Bad hash");
+
+    iter = SvOOK(hv) ? HvAUX(hv) : S_hv_auxinit(aTHX_ hv);
+    return &(iter->xhv_riter);
+}
+
+HE **
+Perl_hv_eiter_p(pTHX_ HV *hv) {
+    struct xpvhv_aux *iter;
+
+    if (!hv)
+       Perl_croak(aTHX_ "Bad hash");
+
+    iter = SvOOK(hv) ? HvAUX(hv) : S_hv_auxinit(aTHX_ hv);
+    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");
+
+    if (SvOOK(hv)) {
+       iter = HvAUX(hv);
+    } else {
+       if (riter == -1)
+           return;
+
+       iter = S_hv_auxinit(aTHX_ hv);
+    }
+    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");
+
+    if (SvOOK(hv)) {
+       iter = HvAUX(hv);
+    } else {
+       /* 0 is the default so don't go malloc()ing a new structure just to
+          hold 0.  */
+       if (!eiter)
+           return;
+
+       iter = S_hv_auxinit(aTHX_ hv);
+    }
+    iter->xhv_eiter = eiter;
 }
 }
+
+void
+Perl_hv_name_set(pTHX_ HV *hv, const char *name, I32 len, int flags)
+{
+    struct xpvhv_aux *iter;
+    U32 hash;
+
+    PERL_UNUSED_ARG(flags);
+
+    if (SvOOK(hv)) {
+       iter = HvAUX(hv);
+       if (iter->xhv_name) {
+           unshare_hek_or_pvn(iter->xhv_name, 0, 0, 0);
+       }
+    } else {
+       if (name == 0)
+           return;
+
+       iter = S_hv_auxinit(aTHX_ hv);
+    }
+    PERL_HASH(hash, name, len);
+    iter->xhv_name = name ? share_hek(name, len, hash) : 0;
+}
+
 /*
 /*
+hv_iternext is implemented as a macro in hv.h
+
 =for apidoc hv_iternext
 
 Returns entries from a hash iterator.  See C<hv_iterinit>.
 =for apidoc hv_iternext
 
 Returns entries from a hash iterator.  See C<hv_iterinit>.
@@ -1649,16 +1905,6 @@ to free the entry on the next call to C<hv_iternext>, so you must not discard
 your iterator immediately else the entry will leak - call C<hv_iternext> to
 trigger the resource deallocation.
 
 your iterator immediately else the entry will leak - call C<hv_iternext> to
 trigger the resource deallocation.
 
-=cut
-*/
-
-HE *
-Perl_hv_iternext(pTHX_ HV *hv)
-{
-    return hv_iternext_flags(hv, 0);
-}
-
-/*
 =for apidoc hv_iternext_flags
 
 Returns entries from a hash iterator.  See C<hv_iterinit> and C<hv_iternext>.
 =for apidoc hv_iternext_flags
 
 Returns entries from a hash iterator.  See C<hv_iterinit> and C<hv_iternext>.
@@ -1676,18 +1922,29 @@ insufficiently abstracted for any change to be tidy.
 HE *
 Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
 {
 HE *
 Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
 {
+    dVAR;
     register XPVHV* xhv;
     register HE *entry;
     HE *oldentry;
     MAGIC* mg;
     register XPVHV* xhv;
     register HE *entry;
     HE *oldentry;
     MAGIC* mg;
+    struct xpvhv_aux *iter;
 
     if (!hv)
        Perl_croak(aTHX_ "Bad hash");
     xhv = (XPVHV*)SvANY(hv);
 
     if (!hv)
        Perl_croak(aTHX_ "Bad hash");
     xhv = (XPVHV*)SvANY(hv);
-    oldentry = entry = xhv->xhv_eiter; /* HvEITER(hv) */
+
+    if (!SvOOK(hv)) {
+       /* 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 = HvAUX(hv);
+
+    oldentry = entry = iter->xhv_eiter; /* HvEITER(hv) */
 
     if ((mg = SvTIED_mg((SV*)hv, PERL_MAGIC_tied))) {
 
     if ((mg = SvTIED_mg((SV*)hv, PERL_MAGIC_tied))) {
-       SV *key = sv_newmortal();
+       SV * const key = sv_newmortal();
        if (entry) {
            sv_setsv(key, HeSVKEY_force(entry));
            SvREFCNT_dec(HeSVKEY(entry));       /* get rid of previous key */
        if (entry) {
            sv_setsv(key, HeSVKEY_force(entry));
            SvREFCNT_dec(HeSVKEY(entry));       /* get rid of previous key */
@@ -1697,9 +1954,9 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
            HEK *hek;
 
            /* one HE per MAGICAL hash */
            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);
            Zero(entry, 1, HE);
-           Newz(54, k, HEK_BASESIZE + sizeof(SV*), char);
+           Newxz(k, HEK_BASESIZE + sizeof(SV*), char);
            hek = (HEK*)k;
            HeKEY_hek(entry) = hek;
            HeKLEN(entry) = HEf_SVKEY;
            hek = (HEK*)k;
            HeKEY_hek(entry) = hek;
            HeKLEN(entry) = HEf_SVKEY;
@@ -1714,18 +1971,26 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
            SvREFCNT_dec(HeVAL(entry));
        Safefree(HeKEY_hek(entry));
        del_HE(entry);
            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 */
        return Null(HE*);
     }
 #ifdef DYNAMIC_ENV_FETCH  /* set up %ENV for iteration */
-    if (!entry && SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env))
+    if (!entry && SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
        prime_env_iter();
        prime_env_iter();
+#ifdef VMS
+       /* The prime_env_iter() on VMS just loaded up new hash values
+        * so the iteration count needs to be reset back to the beginning
+        */
+       hv_iterinit(hv);
+       iter = HvAUX(hv);
+       oldentry = entry = iter->xhv_eiter; /* HvEITER(hv) */
+#endif
+    }
 #endif
 
 #endif
 
-    if (!xhv->xhv_array /* !HvARRAY(hv) */)
-       Newz(506, xhv->xhv_array /* HvARRAY(hv) */,
-            PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
-            char);
+    /* hv_iterint now ensures this.  */
+    assert (HvARRAY(hv));
+
     /* At start of hash, entry is NULL.  */
     if (entry)
     {
     /* At start of hash, entry is NULL.  */
     if (entry)
     {
@@ -1743,14 +2008,13 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
     while (!entry) {
        /* OK. Come to the end of the current list.  Grab the next one.  */
 
     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.  */
            /* There is no next one.  End of the hash.  */
-           xhv->xhv_riter = -1; /* HvRITER(hv) = -1 */
+           iter->xhv_riter = -1; /* HvRITER(hv) = -1 */
            break;
        }
            break;
        }
-       /* entry = (HvARRAY(hv))[HvRITER(hv)]; */
-       entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
+       entry = (HvARRAY(hv))[iter->xhv_riter];
 
         if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) {
             /* If we have an entry, but it's a placeholder, don't count it.
 
         if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) {
             /* If we have an entry, but it's a placeholder, don't count it.
@@ -1771,7 +2035,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);*/
 
     /*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;
 }
 
     return entry;
 }
 
@@ -1813,39 +2077,7 @@ see C<hv_iterinit>.
 SV *
 Perl_hv_iterkeysv(pTHX_ register HE *entry)
 {
 SV *
 Perl_hv_iterkeysv(pTHX_ register HE *entry)
 {
-    if (HeKLEN(entry) != HEf_SVKEY) {
-        HEK *hek = HeKEY_hek(entry);
-        int flags = HEK_FLAGS(hek);
-        SV *sv;
-
-        if (flags & HVhek_WASUTF8) {
-            /* Trouble :-)
-               Andreas would like keys he put in as utf8 to come back as utf8
-            */
-            STRLEN utf8_len = HEK_LEN(hek);
-            U8 *as_utf8 = bytes_to_utf8 ((U8*)HEK_KEY(hek), &utf8_len);
-
-            sv = newSVpvn ((char*)as_utf8, utf8_len);
-            SvUTF8_on (sv);
-           Safefree (as_utf8); /* bytes_to_utf8() allocates a new string */
-       } else if (flags & HVhek_REHASH) {
-           /* We don't have a pointer to the hv, so we have to replicate the
-              flag into every HEK. This hv is using custom a hasing
-              algorithm. Hence we can't return a shared string scalar, as
-              that would contain the (wrong) hash value, and might get passed
-              into an hv routine with a regular hash  */
-
-            sv = newSVpvn (HEK_KEY(hek), HEK_LEN(hek));
-           if (HEK_UTF8(hek))
-               SvUTF8_on (sv);
-       } else {
-            sv = newSVpvn_share(HEK_KEY(hek),
-                                (HEK_UTF8(hek) ? -HEK_LEN(hek) : HEK_LEN(hek)),
-                                HEK_HASH(hek));
-        }
-        return sv_2mortal(sv);
-    }
-    return sv_mortalcopy(HeKEY_sv(entry));
+    return sv_2mortal(newSVhek(HeKEY_hek(entry)));
 }
 
 /*
 }
 
 /*
@@ -1862,10 +2094,11 @@ Perl_hv_iterval(pTHX_ HV *hv, register HE *entry)
 {
     if (SvRMAGICAL(hv)) {
        if (mg_find((SV*)hv, PERL_MAGIC_tied)) {
 {
     if (SvRMAGICAL(hv)) {
        if (mg_find((SV*)hv, PERL_MAGIC_tied)) {
-           SV* sv = sv_newmortal();
+           SV* const sv = sv_newmortal();
            if (HeKLEN(entry) == HEf_SVKEY)
                mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
            if (HeKLEN(entry) == HEf_SVKEY)
                mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
-           else mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry));
+           else
+               mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry));
            return sv;
        }
     }
            return sv;
        }
     }
@@ -1892,6 +2125,9 @@ Perl_hv_iternextsv(pTHX_ HV *hv, char **key, I32 *retlen)
 }
 
 /*
 }
 
 /*
+
+Now a macro in hv.h
+
 =for apidoc hv_magic
 
 Adds magic to a hash.  See C<sv_magic>.
 =for apidoc hv_magic
 
 Adds magic to a hash.  See C<sv_magic>.
@@ -1899,22 +2135,6 @@ Adds magic to a hash.  See C<sv_magic>.
 =cut
 */
 
 =cut
 */
 
-void
-Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how)
-{
-    sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
-}
-
-#if 0 /* use the macro from hv.h instead */
-
-char*  
-Perl_sharepvn(pTHX_ const char *sv, I32 len, U32 hash)
-{
-    return HEK_KEY(share_hek(sv, len, hash));
-}
-
-#endif
-
 /* possibly free a shared string if no one has access to it
  * len and hash must both be valid for str.
  */
 /* possibly free a shared string if no one has access to it
  * len and hash must both be valid for str.
  */
@@ -1936,18 +2156,36 @@ Perl_unshare_hek(pTHX_ HEK *hek)
    are used.  If so, len and hash must both be valid for str.
  */
 STATIC void
    are used.  If so, len and hash must both be valid for str.
  */
 STATIC void
-S_unshare_hek_or_pvn(pTHX_ HEK *hek, const char *str, I32 len, U32 hash)
+S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
 {
     register XPVHV* xhv;
 {
     register XPVHV* xhv;
-    register HE *entry;
+    HE *entry;
     register HE **oentry;
     register HE **oentry;
-    register I32 i = 1;
-    I32 found = 0;
+    HE **first;
+    bool found = 0;
     bool is_utf8 = FALSE;
     int k_flags = 0;
     bool is_utf8 = FALSE;
     int k_flags = 0;
-    const char *save = str;
+    const char * const save = str;
+    struct shared_he *he = 0;
 
     if (hek) {
 
     if (hek) {
+       /* Find the shared he which is just before us in memory.  */
+       he = (struct shared_he *)(((char *)hek)
+                                 - STRUCT_OFFSET(struct shared_he,
+                                                 shared_he_hek));
+
+       /* Assert that the caller passed us a genuine (or at least consistent)
+          shared hek  */
+       assert (he->shared_he_he.hent_hek == hek);
+
+       LOCK_STRTAB_MUTEX;
+       if (he->shared_he_he.hent_val - 1) {
+           --he->shared_he_he.hent_val;
+           UNLOCK_STRTAB_MUTEX;
+           return;
+       }
+       UNLOCK_STRTAB_MUTEX;
+
         hash = HEK_HASH(hek);
     } else if (len < 0) {
         STRLEN tmplen = -len;
         hash = HEK_HASH(hek);
     } else if (len < 0) {
         STRLEN tmplen = -len;
@@ -1969,18 +2207,18 @@ S_unshare_hek_or_pvn(pTHX_ HEK *hek, const char *str, I32 len, U32 hash)
     xhv = (XPVHV*)SvANY(PL_strtab);
     /* assert(xhv_array != 0) */
     LOCK_STRTAB_MUTEX;
     xhv = (XPVHV*)SvANY(PL_strtab);
     /* assert(xhv_array != 0) */
     LOCK_STRTAB_MUTEX;
-    /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
-    oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
-    if (hek) {
-        for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
-            if (HeKEY_hek(entry) != hek)
+    first = oentry = &(HvARRAY(PL_strtab))[hash & (I32) HvMAX(PL_strtab)];
+    if (he) {
+       const HE *const he_he = &(he->shared_he_he);
+        for (entry = *oentry; entry; oentry = &HeNEXT(entry), entry = *oentry) {
+            if (entry != he_he)
                 continue;
             found = 1;
             break;
         }
     } else {
                 continue;
             found = 1;
             break;
         }
     } else {
-        int flags_masked = k_flags & HVhek_MASK;
-        for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
+        const int flags_masked = k_flags & HVhek_MASK;
+        for (entry = *oentry; entry; oentry = &HeNEXT(entry), entry = *oentry) {
             if (HeHASH(entry) != hash)         /* strings can't be equal */
                 continue;
             if (HeKLEN(entry) != len)
             if (HeHASH(entry) != hash)         /* strings can't be equal */
                 continue;
             if (HeKLEN(entry) != len)
@@ -1997,10 +2235,11 @@ S_unshare_hek_or_pvn(pTHX_ HEK *hek, const char *str, I32 len, U32 hash)
     if (found) {
         if (--HeVAL(entry) == Nullsv) {
             *oentry = HeNEXT(entry);
     if (found) {
         if (--HeVAL(entry) == Nullsv) {
             *oentry = HeNEXT(entry);
-            if (i && !*oentry)
+            if (!*first) {
+               /* There are now no entries in our slot.  */
                 xhv->xhv_fill--; /* HvFILL(hv)-- */
                 xhv->xhv_fill--; /* HvFILL(hv)-- */
-            Safefree(HeKEY_hek(entry));
-            del_HE(entry);
+           }
+            Safefree(entry);
             xhv->xhv_keys--; /* HvKEYS(hv)-- */
         }
     }
             xhv->xhv_keys--; /* HvKEYS(hv)-- */
         }
     }
@@ -2008,9 +2247,10 @@ S_unshare_hek_or_pvn(pTHX_ HEK *hek, const char *str, I32 len, U32 hash)
     UNLOCK_STRTAB_MUTEX;
     if (!found && ckWARN_d(WARN_INTERNAL))
        Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
     UNLOCK_STRTAB_MUTEX;
     if (!found && ckWARN_d(WARN_INTERNAL))
        Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
-                    "Attempt to free non-existent shared string '%s'%s",
+                    "Attempt to free non-existent shared string '%s'%s"
+                    pTHX__FORMAT,
                     hek ? HEK_KEY(hek) : str,
                     hek ? HEK_KEY(hek) : str,
-                    (k_flags & HVhek_UTF8) ? " (utf8)" : "");
+                    ((k_flags & HVhek_UTF8) ? " (utf8)" : "") pTHX__VALUE);
     if (k_flags & HVhek_FREEKEY)
        Safefree(str);
 }
     if (k_flags & HVhek_FREEKEY)
        Safefree(str);
 }
@@ -2024,7 +2264,7 @@ Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash)
 {
     bool is_utf8 = FALSE;
     int flags = 0;
 {
     bool is_utf8 = FALSE;
     int flags = 0;
-    const char *save = str;
+    const char * const save = str;
 
     if (len < 0) {
       STRLEN tmplen = -len;
 
     if (len < 0) {
       STRLEN tmplen = -len;
@@ -2049,12 +2289,10 @@ Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash)
 STATIC HEK *
 S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
 {
 STATIC HEK *
 S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
 {
-    register XPVHV* xhv;
     register HE *entry;
     register HE **oentry;
     register HE *entry;
     register HE **oentry;
-    register I32 i = 1;
     I32 found = 0;
     I32 found = 0;
-    int flags_masked = flags & HVhek_MASK;
+    const int flags_masked = flags & HVhek_MASK;
 
     /* what follows is the moral equivalent of:
 
 
     /* what follows is the moral equivalent of:
 
@@ -2064,12 +2302,11 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
        Can't rehash the shared string table, so not sure if it's worth
        counting the number of entries in the linked list
     */
        Can't rehash the shared string table, so not sure if it's worth
        counting the number of entries in the linked list
     */
-    xhv = (XPVHV*)SvANY(PL_strtab);
+    register XPVHV * const xhv = (XPVHV*)SvANY(PL_strtab);
     /* assert(xhv_array != 0) */
     LOCK_STRTAB_MUTEX;
     /* assert(xhv_array != 0) */
     LOCK_STRTAB_MUTEX;
-    /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
-    oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
-    for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
+    oentry = &(HvARRAY(PL_strtab))[hash & (I32) HvMAX(PL_strtab)];
+    for (entry = *oentry; entry; entry = HeNEXT(entry)) {
        if (HeHASH(entry) != hash)              /* strings can't be equal */
            continue;
        if (HeKLEN(entry) != len)
        if (HeHASH(entry) != hash)              /* strings can't be equal */
            continue;
        if (HeKLEN(entry) != len)
@@ -2082,13 +2319,41 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
        break;
     }
     if (!found) {
        break;
     }
     if (!found) {
-       entry = new_HE();
-       HeKEY_hek(entry) = save_hek_flags(str, len, hash, flags);
+       /* What used to be head of the list.
+          If this is NULL, then we're the first entry for this slot, which
+          means we need to increate fill.  */
+       const HE *old_first = *oentry;
+       struct shared_he *new_entry;
+       HEK *hek;
+       char *k;
+
+       /* We don't actually store a HE from the arena and a regular HEK.
+          Instead we allocate one chunk of memory big enough for both,
+          and put the HEK straight after the HE. This way we can find the
+          HEK directly from the HE.
+       */
+
+       Newx(k, STRUCT_OFFSET(struct shared_he,
+                               shared_he_hek.hek_key[0]) + len + 2, char);
+       new_entry = (struct shared_he *)k;
+       entry = &(new_entry->shared_he_he);
+       hek = &(new_entry->shared_he_hek);
+
+       Copy(str, HEK_KEY(hek), len, char);
+       HEK_KEY(hek)[len] = 0;
+       HEK_LEN(hek) = len;
+       HEK_HASH(hek) = hash;
+       HEK_FLAGS(hek) = (unsigned char)flags_masked;
+
+       /* Still "point" to the HEK, so that other code need not know what
+          we're up to.  */
+       HeKEY_hek(entry) = hek;
        HeVAL(entry) = Nullsv;
        HeNEXT(entry) = *oentry;
        *oentry = entry;
        HeVAL(entry) = Nullsv;
        HeNEXT(entry) = *oentry;
        *oentry = entry;
+
        xhv->xhv_keys++; /* HvKEYS(hv)++ */
        xhv->xhv_keys++; /* HvKEYS(hv)++ */
-       if (i) {                                /* initial entry? */
+       if (!old_first) {                       /* initial entry? */
            xhv->xhv_fill++; /* HvFILL(hv)++ */
        } else if (xhv->xhv_keys > (IV)xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */) {
                hsplit(PL_strtab);
            xhv->xhv_fill++; /* HvFILL(hv)++ */
        } else if (xhv->xhv_keys > (IV)xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */) {
                hsplit(PL_strtab);
@@ -2104,6 +2369,46 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
     return HeKEY_hek(entry);
 }
 
     return HeKEY_hek(entry);
 }
 
+I32 *
+Perl_hv_placeholders_p(pTHX_ HV *hv)
+{
+    dVAR;
+    MAGIC *mg = mg_find((SV*)hv, PERL_MAGIC_rhash);
+
+    if (!mg) {
+       mg = sv_magicext((SV*)hv, 0, PERL_MAGIC_rhash, 0, 0, 0);
+
+       if (!mg) {
+           Perl_die(aTHX_ "panic: hv_placeholders_p");
+       }
+    }
+    return &(mg->mg_len);
+}
+
+
+I32
+Perl_hv_placeholders_get(pTHX_ HV *hv)
+{
+    dVAR;
+    MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_rhash);
+
+    return mg ? mg->mg_len : 0;
+}
+
+void
+Perl_hv_placeholders_set(pTHX_ HV *hv, I32 ph)
+{
+    dVAR;
+    MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_rhash);
+
+    if (mg) {
+       mg->mg_len = ph;
+    } else if (ph) {
+       if (!sv_magicext((SV*)hv, 0, PERL_MAGIC_rhash, 0, 0, ph))
+           Perl_die(aTHX_ "panic: hv_placeholders_set");
+    }
+    /* else we don't need to add magic to record 0 placeholders.  */
+}
 
 /*
 =for apidoc hv_assert
 
 /*
 =for apidoc hv_assert
@@ -2116,13 +2421,14 @@ Check that a hash is in an internally consistent state.
 void
 Perl_hv_assert(pTHX_ HV *hv)
 {
 void
 Perl_hv_assert(pTHX_ HV *hv)
 {
+  dVAR;
   HE* entry;
   int withflags = 0;
   int placeholders = 0;
   int real = 0;
   int bad = 0;
   HE* entry;
   int withflags = 0;
   int placeholders = 0;
   int real = 0;
   int bad = 0;
-  I32 riter = HvRITER(hv);
-  HE *eiter = HvEITER(hv);
+  const I32 riter = HvRITER_get(hv);
+  HE *eiter = HvEITER_get(hv);
 
   (void)hv_iterinit(hv);
 
 
   (void)hv_iterinit(hv);
 
@@ -2154,10 +2460,10 @@ Perl_hv_assert(pTHX_ HV *hv)
                    (int) real, (int) HvUSEDKEYS(hv));
       bad = 1;
     }
                    (int) real, (int) HvUSEDKEYS(hv));
       bad = 1;
     }
-    if (HvPLACEHOLDERS(hv) != placeholders) {
+    if (HvPLACEHOLDERS_get(hv) != placeholders) {
       PerlIO_printf(Perl_debug_log,
                    "Count %d placeholder(s), but hash reports %d\n",
       PerlIO_printf(Perl_debug_log,
                    "Count %d placeholder(s), but hash reports %d\n",
-                   (int) placeholders, (int) HvPLACEHOLDERS(hv));
+                   (int) placeholders, (int) HvPLACEHOLDERS_get(hv));
       bad = 1;
     }
   }
       bad = 1;
     }
   }
@@ -2170,6 +2476,16 @@ Perl_hv_assert(pTHX_ HV *hv)
   if (bad) {
     sv_dump((SV *)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);
 }
 }
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */