This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
promote hv_clear_placeholders to perl API
[perl5.git] / hv.c
diff --git a/hv.c b/hv.c
index 76180f2..41f65a7 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1,6 +1,7 @@
 /*    hv.c
  *
 /*    hv.c
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ *    2000, 2001, 2002, 2003, 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.
@@ -11,17 +12,24 @@
  * "I sit beside the fire and think of all that I have seen."  --Bilbo
  */
 
  * "I sit beside the fire and think of all that I have seen."  --Bilbo
  */
 
+/* 
+=head1 Hash Manipulation Functions
+*/
+
 #include "EXTERN.h"
 #define PERL_IN_HV_C
 #include "EXTERN.h"
 #define PERL_IN_HV_C
+#define PERL_HASH_INTERNAL_ACCESS
 #include "perl.h"
 
 #include "perl.h"
 
+#define HV_MAX_LENGTH_BEFORE_SPLIT 14
+
 STATIC HE*
 S_new_he(pTHX)
 {
     HE* he;
     LOCK_SV_MUTEX;
     if (!PL_he_root)
 STATIC HE*
 S_new_he(pTHX)
 {
     HE* he;
     LOCK_SV_MUTEX;
     if (!PL_he_root)
-        more_he();
+       more_he();
     he = PL_he_root;
     PL_he_root = HeNEXT(he);
     UNLOCK_SV_MUTEX;
     he = PL_he_root;
     PL_he_root = HeNEXT(he);
     UNLOCK_SV_MUTEX;
@@ -51,8 +59,8 @@ S_more_he(pTHX)
     heend = &he[1008 / sizeof(HE) - 1];
     PL_he_root = ++he;
     while (he < heend) {
     heend = &he[1008 / sizeof(HE) - 1];
     PL_he_root = ++he;
     while (he < heend) {
-        HeNEXT(he) = (HE*)(he + 1);
-        he++;
+       HeNEXT(he) = (HE*)(he + 1);
+       he++;
     }
     HeNEXT(he) = 0;
 }
     }
     HeNEXT(he) = 0;
 }
@@ -70,36 +78,41 @@ S_more_he(pTHX)
 #endif
 
 STATIC HEK *
 #endif
 
 STATIC HEK *
-S_save_hek(pTHX_ const char *str, I32 len, U32 hash)
+S_save_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags)
 {
     char *k;
     register HEK *hek;
 {
     char *k;
     register HEK *hek;
-    bool is_utf8 = FALSE;
 
 
-    if (len < 0) {
-      len = -len;
-      is_utf8 = TRUE;
-    }
-
-    New(54, k, HEK_BASESIZE + len + 1, char);
+    New(54, k, HEK_BASESIZE + len + 2, char);
     hek = (HEK*)k;
     Copy(str, HEK_KEY(hek), len, 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_LEN(hek) = len;
     HEK_HASH(hek) = hash;
-    HEK_UTF8(hek) = (char)is_utf8;
+    HEK_FLAGS(hek) = (unsigned char)flags;
     return hek;
 }
 
     return hek;
 }
 
+/* free the pool of temporary HE/HEK pairs retunrned by hv_fetch_ent
+ * for tied hashes */
+
 void
 void
-Perl_unshare_hek(pTHX_ HEK *hek)
+Perl_free_tied_hv_pool(pTHX)
 {
 {
-    unsharepvn(HEK_KEY(hek),HEK_UTF8(hek)?-HEK_LEN(hek):HEK_LEN(hek),
-               HEK_HASH(hek));
+    HE *ohe;
+    HE *he = PL_hv_fetch_ent_mh;
+    while (he) {
+       Safefree(HeKEY_hek(he));
+       ohe = he;
+       he = HeNEXT(he);
+       del_HE(ohe);
+    }
+    PL_hv_fetch_ent_mh = Nullhe;
 }
 
 #if defined(USE_ITHREADS)
 HE *
 }
 
 #if defined(USE_ITHREADS)
 HE *
-Perl_he_dup(pTHX_ HE *e, bool shared, clone_params* param)
+Perl_he_dup(pTHX_ HE *e, bool shared, CLONE_PARAMS* param)
 {
     HE *ret;
 
 {
     HE *ret;
 
@@ -115,17 +128,43 @@ Perl_he_dup(pTHX_ HE *e, bool shared, clone_params* param)
     ptr_table_store(PL_ptr_table, e, ret);
 
     HeNEXT(ret) = he_dup(HeNEXT(e),shared, param);
     ptr_table_store(PL_ptr_table, e, ret);
 
     HeNEXT(ret) = he_dup(HeNEXT(e),shared, param);
-    if (HeKLEN(e) == HEf_SVKEY)
+    if (HeKLEN(e) == HEf_SVKEY) {
+       char *k;
+       New(54, k, HEK_BASESIZE + sizeof(SV*), char);
+       HeKEY_hek(ret) = (HEK*)k;
        HeKEY_sv(ret) = SvREFCNT_inc(sv_dup(HeKEY_sv(e), param));
        HeKEY_sv(ret) = SvREFCNT_inc(sv_dup(HeKEY_sv(e), param));
+    }
     else if (shared)
     else if (shared)
-       HeKEY_hek(ret) = share_hek(HeKEY(e), HeKLEN_UTF8(e), HeHASH(e));
+       HeKEY_hek(ret) = share_hek_flags(HeKEY(e), HeKLEN(e), HeHASH(e),
+                                         HeKFLAGS(e));
     else
     else
-       HeKEY_hek(ret) = save_hek(HeKEY(e), HeKLEN_UTF8(e), HeHASH(e));
+       HeKEY_hek(ret) = save_hek_flags(HeKEY(e), HeKLEN(e), HeHASH(e),
+                                        HeKFLAGS(e));
     HeVAL(ret) = SvREFCNT_inc(sv_dup(HeVAL(e), param));
     return ret;
 }
 #endif /* USE_ITHREADS */
 
     HeVAL(ret) = SvREFCNT_inc(sv_dup(HeVAL(e), param));
     return ret;
 }
 #endif /* USE_ITHREADS */
 
+static void
+S_hv_notallowed(pTHX_ int flags, const char *key, I32 klen,
+               const char *msg)
+{
+    SV *sv = sv_newmortal(), *esv = sv_newmortal();
+    if (!(flags & HVhek_FREEKEY)) {
+       sv_setpvn(sv, key, klen);
+    }
+    else {
+       /* Need to free saved eventually assign to mortal SV */
+       /* XXX is this line an error ???:  SV *sv = sv_newmortal(); */
+       sv_usepvn(sv, (char *) key, klen);
+    }
+    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);
+}
+
 /* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
  * contains an SV* */
 
 /* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
  * contains an SV* */
 
@@ -135,7 +174,7 @@ Perl_he_dup(pTHX_ HE *e, bool shared, clone_params* param)
 Returns the SV which corresponds to the specified key in the hash.  The
 C<klen> is the length of the key.  If C<lval> is set then the fetch will be
 part of a store.  Check that the return value is non-null before
 Returns the SV which corresponds to the specified key in the hash.  The
 C<klen> is the length of the key.  If C<lval> is set then the fetch will be
 part of a store.  Check that the return value is non-null before
-dereferencing it to a C<SV*>.
+dereferencing it to an C<SV*>.
 
 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
 information on how to use this function on tied hashes.
 
 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
 information on how to use this function on tied hashes.
@@ -143,116 +182,19 @@ information on how to use this function on tied hashes.
 =cut
 */
 
 =cut
 */
 
+#define HV_FETCH_LVALUE  0x01
+#define HV_FETCH_JUST_SV 0x02
+
 SV**
 Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen, I32 lval)
 {
 SV**
 Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen, I32 lval)
 {
-    register XPVHV* xhv;
-    register U32 hash;
-    register HE *entry;
-    SV *sv;
-    bool is_utf8 = FALSE;
-    const char *keysave = key;
-
-    if (!hv)
-       return 0;
-
-    if (klen < 0) {
-      klen = -klen;
-      is_utf8 = TRUE;
-    }
-
-    if (SvRMAGICAL(hv)) {
-       if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
-           sv = sv_newmortal();
-           mg_copy((SV*)hv, sv, key, klen);
-           PL_hv_fetch_sv = sv;
-           return &PL_hv_fetch_sv;
-       }
-#ifdef ENV_IS_CASELESS
-       else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
-           U32 i;
-           for (i = 0; i < klen; ++i)
-               if (isLOWER(key[i])) {
-                   char *nkey = strupr(SvPVX(sv_2mortal(newSVpvn(key,klen))));
-                   SV **ret = hv_fetch(hv, nkey, klen, 0);
-                   if (!ret && lval)
-                       ret = hv_store(hv, key, klen, NEWSV(61,0), 0);
-                   return ret;
-               }
-       }
-#endif
-    }
-
-    /* We use xhv->xhv_foo fields directly instead of HvFOO(hv) to
-       avoid unnecessary pointer dereferencing. */
-    xhv = (XPVHV*)SvANY(hv);
-    if (!xhv->xhv_array /* !HvARRAY(hv) */) {
-       if (lval
-#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) */,
-                PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
-                char);
-       else
-           return 0;
-    }
-
-    if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT)) {
-       STRLEN tmplen = klen;
-       /* Just casting the &klen to (STRLEN) won't work well
-        * if STRLEN and I32 are of different widths. --jhi */
-       key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
-       klen = tmplen;
-    }
-
-    PERL_HASH(hash, key, klen);
-
-    /* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
-    entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
-    for (; entry; entry = HeNEXT(entry)) {
-       if (HeHASH(entry) != hash)              /* strings can't be equal */
-           continue;
-       if (HeKLEN(entry) != klen)
-           continue;
-       if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
-           continue;
-       if (HeKUTF8(entry) != (char)is_utf8)
-           continue;
-       if (key != keysave)
-           Safefree(key);
-       return &HeVAL(entry);
-    }
-#ifdef DYNAMIC_ENV_FETCH  /* %ENV lookup?  If so, try to fetch the value now */
-    if (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
-       unsigned long len;
-       char *env = PerlEnv_ENVgetenv_len(key,&len);
-       if (env) {
-           sv = newSVpvn(env,len);
-           SvTAINTED_on(sv);
-           if (key != keysave)
-               Safefree(key);
-           return hv_store(hv,key,klen,sv,hash);
-       }
-    }
-#endif
-    if (lval) {                /* gonna assign to this, so it better be there */
-       sv = NEWSV(61,0);
-       if (key != keysave) { /* must be is_utf8 == 0 */
-           SV **ret = hv_store(hv,key,klen,sv,hash);
-           Safefree(key);
-           return ret;
-       }
-       else
-           return hv_store(hv,key,is_utf8?-klen:klen,sv,hash);
-    }
-    if (key != keysave)
-       Safefree(key);
-    return 0;
+    HE *hek = hv_fetch_common (hv, NULL, key, klen, 0,
+                              HV_FETCH_JUST_SV | (lval ? HV_FETCH_LVALUE : 0),
+                              0);
+    return hek ? &HeVAL(hek) : NULL;
 }
 
 }
 
-/* returns a HE * structure with the all fields set */
+/* returns an HE * structure with the all fields set */
 /* note that hent_val will be a mortal sv for MAGICAL hashes */
 /*
 =for apidoc hv_fetch_ent
 /* note that hent_val will be a mortal sv for MAGICAL hashes */
 /*
 =for apidoc hv_fetch_ent
@@ -274,42 +216,95 @@ information on how to use this function on tied hashes.
 HE *
 Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
 {
 HE *
 Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
 {
+    return hv_fetch_common(hv, keysv, NULL, 0, 0, lval ? HV_FETCH_LVALUE : 0,
+                          hash);
+}
+
+HE *
+S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, I32 klen_i32,
+                 int flags, int action, register U32 hash)
+{
     register XPVHV* xhv;
     register XPVHV* xhv;
-    register char *key;
     STRLEN klen;
     register HE *entry;
     SV *sv;
     bool is_utf8;
     STRLEN klen;
     register HE *entry;
     SV *sv;
     bool is_utf8;
-    char *keysave;
+    const char *keysave;
+    int masked_flags;
 
     if (!hv)
        return 0;
 
 
     if (!hv)
        return 0;
 
+    if (keysv) {
+       key = SvPV(keysv, klen);
+       is_utf8 = (SvUTF8(keysv) != 0);
+    } else {
+       if (klen_i32 < 0) {
+           klen = -klen_i32;
+           is_utf8 = TRUE;
+       } else {
+           klen = klen_i32;
+           is_utf8 = FALSE;
+       }
+    }
+    keysave = key;
+
     if (SvRMAGICAL(hv)) {
        if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
            sv = sv_newmortal();
     if (SvRMAGICAL(hv)) {
        if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
            sv = sv_newmortal();
-           keysv = sv_2mortal(newSVsv(keysv));
-           mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
-           if (!HeKEY_hek(&PL_hv_fetch_ent_mh)) {
+
+           /* XXX should be able to skimp on the HE/HEK here when
+              HV_FETCH_JUST_SV is true.  */
+
+           if (!keysv) {
+               keysv = newSVpvn(key, klen);
+               if (is_utf8) {
+                   SvUTF8_on(keysv);
+               }
+           } else {
+               keysv = newSVsv(keysv);
+           }
+           mg_copy((SV*)hv, sv, (char *)keysv, HEf_SVKEY);
+
+
+           /* grab a fake HE/HEK pair from the pool or make a new one */
+           entry = PL_hv_fetch_ent_mh;
+           if (entry)
+               PL_hv_fetch_ent_mh = HeNEXT(entry);
+           else {
                char *k;
                char *k;
+               entry = new_HE();
                New(54, k, HEK_BASESIZE + sizeof(SV*), char);
                New(54, k, HEK_BASESIZE + sizeof(SV*), char);
-               HeKEY_hek(&PL_hv_fetch_ent_mh) = (HEK*)k;
+               HeKEY_hek(entry) = (HEK*)k;
            }
            }
-           HeSVKEY_set(&PL_hv_fetch_ent_mh, keysv);
-           HeVAL(&PL_hv_fetch_ent_mh) = sv;
-           return &PL_hv_fetch_ent_mh;
-       }
+           HeNEXT(entry) = Nullhe;
+           HeSVKEY_set(entry, keysv);
+           HeVAL(entry) = sv;
+           sv_upgrade(sv, SVt_PVLV);
+           LvTYPE(sv) = 'T';
+           LvTARG(sv) = (SV*)entry; /* so we can free entry when freeing sv */
+
+           /* XXX remove at some point? */
+            if (flags & HVhek_FREEKEY)
+                Safefree(key);
+
+           return entry;
+       }
 #ifdef ENV_IS_CASELESS
        else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
            U32 i;
 #ifdef ENV_IS_CASELESS
        else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
            U32 i;
-           key = SvPV(keysv, klen);
            for (i = 0; i < klen; ++i)
                if (isLOWER(key[i])) {
                    SV *nkeysv = sv_2mortal(newSVpvn(key,klen));
                    (void)strupr(SvPVX(nkeysv));
            for (i = 0; i < klen; ++i)
                if (isLOWER(key[i])) {
                    SV *nkeysv = sv_2mortal(newSVpvn(key,klen));
                    (void)strupr(SvPVX(nkeysv));
-                   entry = hv_fetch_ent(hv, nkeysv, 0, 0);
-                   if (!entry && lval)
+                   entry = hv_fetch_common(hv, nkeysv, NULL, 0, 0, 0);
+                   if (!entry && (action & HV_FETCH_LVALUE))
                        entry = hv_store_ent(hv, keysv, NEWSV(61,0), hash);
                        entry = hv_store_ent(hv, keysv, NEWSV(61,0), hash);
+
+                   /* XXX remove at some point? */
+                   if (flags & HVhek_FREEKEY)
+                       Safefree(key);
+
                    return entry;
                }
        }
                    return entry;
                }
        }
@@ -318,39 +313,84 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
 
     xhv = (XPVHV*)SvANY(hv);
     if (!xhv->xhv_array /* !HvARRAY(hv) */) {
 
     xhv = (XPVHV*)SvANY(hv);
     if (!xhv->xhv_array /* !HvARRAY(hv) */) {
-       if (lval
+       if ((action & HV_FETCH_LVALUE)
 #ifdef DYNAMIC_ENV_FETCH  /* if it's an %ENV lookup, we may get it on the fly */
 #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))
+                || (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env))
 #endif
 #endif
-                                                                 )
+                                                                 )
            Newz(503, xhv->xhv_array /* HvARRAY(hv) */,
                 PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
                 char);
            Newz(503, xhv->xhv_array /* HvARRAY(hv) */,
                 PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
                 char);
-       else
+       else {
+           /* XXX remove at some point? */
+            if (flags & HVhek_FREEKEY)
+                Safefree(key);
+
            return 0;
            return 0;
+       }
     }
 
     }
 
-    keysave = key = SvPV(keysv, klen);
-    is_utf8 = (SvUTF8(keysv)!=0);
-
-    if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT))
+    if (is_utf8) {
+       int oldflags = flags;
        key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
        key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
+        if (is_utf8)
+            flags = HVhek_UTF8;
+        if (key != keysave)
+            flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
+       if (oldflags & HVhek_FREEKEY)
+           Safefree(keysave);
 
 
-    if (!hash)
-       PERL_HASH(hash, key, klen);
+    }
+
+    if (HvREHASH(hv)) {
+       PERL_HASH_INTERNAL(hash, key, klen);
+       /* Yes, you do need this even though you are not "storing" because
+          you can flip the flags below if doing an lval lookup.  (And that
+          was put in to give the semantics Andreas was expecting.)  */
+       flags |= HVhek_REHASH;
+    } else if (!hash) {
+        if (keysv && (SvIsCOW_shared_hash(keysv))) {
+            hash = SvUVX(keysv);
+        } else {
+            PERL_HASH(hash, key, klen);
+        }
+    }
+
+    masked_flags = (flags & HVhek_MASK);
 
     /* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
     for (; entry; entry = HeNEXT(entry)) {
        if (HeHASH(entry) != hash)              /* strings can't be equal */
            continue;
 
     /* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
     for (; entry; entry = HeNEXT(entry)) {
        if (HeHASH(entry) != hash)              /* strings can't be equal */
            continue;
-       if (HeKLEN(entry) != klen)
+       if (HeKLEN(entry) != (I32)klen)
            continue;
        if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
            continue;
            continue;
        if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
            continue;
-       if (HeKUTF8(entry) != (char)is_utf8)
+       if ((HeKFLAGS(entry) ^ masked_flags) & HVhek_UTF8)
            continue;
            continue;
-       if (key != keysave)
+        if ((action & HV_FETCH_LVALUE) && HeKFLAGS(entry) != masked_flags) {
+            /* We match if HVhek_UTF8 bit in our flags and hash key's match.
+               But if entry was set previously with HVhek_WASUTF8 and key now
+               doesn't (or vice versa) then we should change the key's flag,
+               as this is assignment.  */
+            if (HvSHAREKEYS(hv)) {
+                /* Need to swap the key we have for a key with the flags we
+                   need. As keys are shared we can't just write to the flag,
+                   so we share the new one, unshare the old one.  */
+                HEK *new_hek = share_hek_flags(key, klen, hash, masked_flags);
+                unshare_hek (HeKEY_hek(entry));
+                HeKEY_hek(entry) = new_hek;
+            }
+            else
+                HeKFLAGS(entry) = masked_flags;
+            if (masked_flags & HVhek_ENABLEHVKFLAGS)
+                HvHASKFLAGS_on(hv);
+        }
+       /* if we find a placeholder, we pretend we haven't found anything */
+       if (HeVAL(entry) == &PL_sv_placeholder)
+           break;
+       if (flags & HVhek_FREEKEY)
            Safefree(key);
        return entry;
     }
            Safefree(key);
        return entry;
     }
@@ -359,15 +399,35 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
        unsigned long len;
        char *env = PerlEnv_ENVgetenv_len(key,&len);
        if (env) {
        unsigned long len;
        char *env = PerlEnv_ENVgetenv_len(key,&len);
        if (env) {
+           /* XXX remove once common API complete  */
+           if (!keysv) {
+               nkeysv = sv_2mortal(newSVpvn(key,klen));
+           }
+
            sv = newSVpvn(env,len);
            SvTAINTED_on(sv);
            sv = newSVpvn(env,len);
            SvTAINTED_on(sv);
+           if (flags & HVhek_FREEKEY)
+               Safefree(key);
            return hv_store_ent(hv,keysv,sv,hash);
        }
     }
 #endif
            return hv_store_ent(hv,keysv,sv,hash);
        }
     }
 #endif
-    if (key != keysave)
+    if (!entry && SvREADONLY(hv)) {
+       S_hv_notallowed(aTHX_ flags, key, klen,
+                       "access disallowed key '%"SVf"' in"
+                       );
+    }
+    if (action & HV_FETCH_LVALUE) {
+       /* XXX remove once common API complete  */
+       if (!keysv) {
+           keysv = sv_2mortal(newSVpvn(key,klen));
+       }
+    }
+
+    if (flags & HVhek_FREEKEY)
        Safefree(key);
        Safefree(key);
-    if (lval) {                /* gonna assign to this, so it better be there */
+    if (action & HV_FETCH_LVALUE) {
+       /* gonna assign to this, so it better be there */
        sv = NEWSV(61,0);
        return hv_store_ent(hv,keysv,sv,hash);
     }
        sv = NEWSV(61,0);
        return hv_store_ent(hv,keysv,sv,hash);
     }
@@ -403,7 +463,15 @@ NULL if the operation failed or if the value did not need to be actually
 stored within the hash (as in the case of tied hashes).  Otherwise it can
 be dereferenced to get the original C<SV*>.  Note that the caller is
 responsible for suitably incrementing the reference count of C<val> before
 stored within the hash (as in the case of tied hashes).  Otherwise it can
 be dereferenced to get the original C<SV*>.  Note that the caller is
 responsible for suitably incrementing the reference count of C<val> before
-the call, and decrementing it if the function returned NULL.
+the call, and decrementing it if the function returned NULL.  Effectively
+a successful hv_store takes ownership of one reference to C<val>.  This is
+usually what you want; a newly created SV has a reference count of one, so
+if all your code does is create SVs then store them in a hash, hv_store
+will own the only reference to the new SV, and your code doesn't need to do
+anything further to tidy up.  hv_store is not implemented as a call to
+hv_store_ent, and does not create a temporary SV for the key, so if your
+key data is not already in SV form then use hv_store in preference to
+hv_store_ent.
 
 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
 information on how to use this function on tied hashes.
 
 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
 information on how to use this function on tied hashes.
@@ -412,49 +480,88 @@ information on how to use this function on tied hashes.
 */
 
 SV**
 */
 
 SV**
-Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen, SV *val, register U32 hash)
+Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen, SV *val, U32 hash)
 {
 {
-    register XPVHV* xhv;
-    register I32 i;
-    register HE *entry;
-    register HE **oentry;
     bool is_utf8 = FALSE;
     const char *keysave = key;
     bool is_utf8 = FALSE;
     const char *keysave = key;
-
-    if (!hv)
-       return 0;
+    int flags = 0;
 
     if (klen < 0) {
       klen = -klen;
       is_utf8 = TRUE;
     }
 
 
     if (klen < 0) {
       klen = -klen;
       is_utf8 = TRUE;
     }
 
+    if (is_utf8) {
+       STRLEN tmplen = klen;
+       /* Just casting the &klen to (STRLEN) won't work well
+        * if STRLEN and I32 are of different widths. --jhi */
+       key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
+       klen = tmplen;
+        /* If we were able to downgrade here, then than means that we were
+           passed in a key which only had chars 0-255, but was utf8 encoded.  */
+        if (is_utf8)
+            flags = HVhek_UTF8;
+        /* If we found we were able to downgrade the string to bytes, then
+           we should flag that it needs upgrading on keys or each.  */
+        if (key != keysave)
+            flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
+    }
+
+    return hv_store_flags (hv, key, klen, val, hash, flags);
+}
+
+SV**
+Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val,
+                 register U32 hash, int flags)
+{
+    register XPVHV* xhv;
+    register U32 n_links;
+    register HE *entry;
+    register HE **oentry;
+
+    if (!hv)
+       return 0;
+
     xhv = (XPVHV*)SvANY(hv);
     if (SvMAGICAL(hv)) {
        bool needs_copy;
        bool needs_store;
        hv_magic_check (hv, &needs_copy, &needs_store);
        if (needs_copy) {
     xhv = (XPVHV*)SvANY(hv);
     if (SvMAGICAL(hv)) {
        bool needs_copy;
        bool needs_store;
        hv_magic_check (hv, &needs_copy, &needs_store);
        if (needs_copy) {
-           mg_copy((SV*)hv, val, key, klen);
-           if (!xhv->xhv_array /* !HvARRAY */ && !needs_store)
+           if (flags & HVhek_UTF8) {
+               /* This hack based on the code in hv_exists_ent seems to be
+                  the easiest way to pass the utf8 flag through and fix
+                  the bug in hv_exists for tied hashes with utf8 keys.  */
+               SV *keysv = sv_2mortal(newSVpvn(key, klen));
+               SvUTF8_on(keysv);
+               mg_copy((SV*)hv, val, (char *)keysv, HEf_SVKEY);
+           } else {
+               mg_copy((SV*)hv, val, key, klen);
+           }
+           if (!xhv->xhv_array /* !HvARRAY */ && !needs_store) {
+                if (flags & HVhek_FREEKEY)
+                    Safefree(key);
                return 0;
                return 0;
+            }
 #ifdef ENV_IS_CASELESS
            else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
 #ifdef ENV_IS_CASELESS
            else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
-                key = savepvn(key,klen);
+               key = savepvn(key,klen);
                key = (const char*)strupr((char*)key);
                hash = 0;
            }
 #endif
        }
     }
                key = (const char*)strupr((char*)key);
                hash = 0;
            }
 #endif
        }
     }
-    if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT)) {
-       STRLEN tmplen = klen;
-       /* See the note in hv_fetch(). --jhi */
-       key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
-       klen = tmplen;
-    }
 
 
-    if (!hash)
+    if (flags)
+        HvHASKFLAGS_on((SV*)hv);
+
+    if (HvREHASH(hv)) {
+       /* We don't have a pointer to the hv, so we have to replicate the
+          flag into every HEK, so that hv_iterkeysv can see it.  */
+       flags |= HVhek_REHASH;
+       PERL_HASH_INTERNAL(hash, key, klen);
+    } else if (!hash)
        PERL_HASH(hash, key, klen);
 
     if (!xhv->xhv_array /* !HvARRAY(hv) */)
        PERL_HASH(hash, key, klen);
 
     if (!xhv->xhv_array /* !HvARRAY(hv) */)
@@ -464,40 +571,87 @@ Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen, SV *val, register U32 has
 
     /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 
     /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
-    i = 1;
 
 
-    for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
+    n_links = 0;
+
+    for (entry = *oentry; entry; ++n_links, entry = HeNEXT(entry)) {
        if (HeHASH(entry) != hash)              /* strings can't be equal */
            continue;
        if (HeHASH(entry) != hash)              /* strings can't be equal */
            continue;
-       if (HeKLEN(entry) != klen)
+       if (HeKLEN(entry) != (I32)klen)
            continue;
        if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
            continue;
            continue;
        if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
            continue;
-       if (HeKUTF8(entry) != (char)is_utf8)
+       if ((HeKFLAGS(entry) ^ flags) & HVhek_UTF8)
            continue;
            continue;
-       SvREFCNT_dec(HeVAL(entry));
-       HeVAL(entry) = val;
-       if (key != keysave)
-           Safefree(key);
+       if (HeVAL(entry) == &PL_sv_placeholder)
+           xhv->xhv_placeholders--; /* yes, can store into placeholder slot */
+       else
+           SvREFCNT_dec(HeVAL(entry));
+        if (flags & HVhek_PLACEHOLD) {
+            /* We have been requested to insert a placeholder. Currently
+               only Storable is allowed to do this.  */
+            xhv->xhv_placeholders++;
+            HeVAL(entry) = &PL_sv_placeholder;
+        } else
+            HeVAL(entry) = val;
+
+        if (HeKFLAGS(entry) != flags) {
+            /* We match if HVhek_UTF8 bit in our flags and hash key's match.
+               But if entry was set previously with HVhek_WASUTF8 and key now
+               doesn't (or vice versa) then we should change the key's flag,
+               as this is assignment.  */
+            if (HvSHAREKEYS(hv)) {
+                /* Need to swap the key we have for a key with the flags we
+                   need. As keys are shared we can't just write to the flag,
+                   so we share the new one, unshare the old one.  */
+                int flags_nofree = flags & ~HVhek_FREEKEY;
+                HEK *new_hek = share_hek_flags(key, klen, hash, flags_nofree);
+                unshare_hek (HeKEY_hek(entry));
+                HeKEY_hek(entry) = new_hek;
+            }
+            else
+                HeKFLAGS(entry) = flags;
+        }
+        if (flags & HVhek_FREEKEY)
+            Safefree(key);
        return &HeVAL(entry);
     }
 
        return &HeVAL(entry);
     }
 
+    if (SvREADONLY(hv)) {
+       S_hv_notallowed(aTHX_ flags, key, klen,
+                       "access disallowed key '%"SVf"' to"
+                       );
+    }
+
     entry = new_HE();
     entry = new_HE();
+    /* share_hek_flags will do the free for us.  This might be considered
+       bad API design.  */
     if (HvSHAREKEYS(hv))
     if (HvSHAREKEYS(hv))
-       HeKEY_hek(entry) = share_hek(key, is_utf8?-klen:klen, hash);
+       HeKEY_hek(entry) = share_hek_flags(key, klen, hash, flags);
     else                                       /* gotta do the real thing */
     else                                       /* gotta do the real thing */
-       HeKEY_hek(entry) = save_hek(key, is_utf8?-klen:klen, hash);
-    if (key != keysave)
-       Safefree(key);
-    HeVAL(entry) = val;
+       HeKEY_hek(entry) = save_hek_flags(key, klen, hash, flags);
+    if (flags & HVhek_PLACEHOLD) {
+        /* We have been requested to insert a placeholder. Currently
+           only Storable is allowed to do this.  */
+        xhv->xhv_placeholders++;
+        HeVAL(entry) = &PL_sv_placeholder;
+    } else
+        HeVAL(entry) = val;
     HeNEXT(entry) = *oentry;
     *oentry = entry;
 
     xhv->xhv_keys++; /* HvKEYS(hv)++ */
     HeNEXT(entry) = *oentry;
     *oentry = entry;
 
     xhv->xhv_keys++; /* HvKEYS(hv)++ */
-    if (i) {                           /* initial entry? */
+    if (!n_links) {                            /* initial entry? */
        xhv->xhv_fill++; /* HvFILL(hv)++ */
        xhv->xhv_fill++; /* HvFILL(hv)++ */
-       if (xhv->xhv_keys > xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */)
-           hsplit(hv);
+    } else if ((xhv->xhv_keys > (IV)xhv->xhv_max)
+              || ((n_links > HV_MAX_LENGTH_BEFORE_SPLIT) && !HvREHASH(hv))) {
+       /* Use 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 &HeVAL(entry);
     }
 
     return &HeVAL(entry);
@@ -514,7 +668,17 @@ stored within the hash (as in the case of tied hashes).  Otherwise the
 contents of the return value can be accessed using the C<He?> macros
 described here.  Note that the caller is responsible for suitably
 incrementing the reference count of C<val> before the call, and
 contents of the return value can be accessed using the C<He?> macros
 described here.  Note that the caller is responsible for suitably
 incrementing the reference count of C<val> before the call, and
-decrementing it if the function returned NULL.
+decrementing it if the function returned NULL.  Effectively a successful
+hv_store_ent takes ownership of one reference to C<val>.  This is
+usually what you want; a newly created SV has a reference count of one, so
+if all your code does is create SVs then store them in a hash, hv_store
+will own the only reference to the new SV, and your code doesn't need to do
+anything further to tidy up.  Note that hv_store_ent only reads the C<key>;
+unlike C<val> it does not take ownership of it, so maintaining the correct
+reference count on C<key> is entirely the caller's responsibility.  hv_store
+is not implemented as a call to hv_store_ent, and does not create a temporary
+SV for the key, so if your key data is not already in SV form then use
+hv_store in preference to hv_store_ent.
 
 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
 information on how to use this function on tied hashes.
 
 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
 information on how to use this function on tied hashes.
@@ -523,15 +687,16 @@ information on how to use this function on tied hashes.
 */
 
 HE *
 */
 
 HE *
-Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, register U32 hash)
+Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash)
 {
 {
-    register XPVHV* xhv;
-    register char *key;
+    XPVHV* xhv;
+    char *key;
     STRLEN klen;
     STRLEN klen;
-    register I32 i;
-    register HE *entry;
-    register HE **oentry;
+    U32 n_links;
+    HE *entry;
+    HE **oentry;
     bool is_utf8;
     bool is_utf8;
+    int flags = 0;
     char *keysave;
 
     if (!hv)
     char *keysave;
 
     if (!hv)
@@ -539,18 +704,18 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, register U32 hash)
 
     xhv = (XPVHV*)SvANY(hv);
     if (SvMAGICAL(hv)) {
 
     xhv = (XPVHV*)SvANY(hv);
     if (SvMAGICAL(hv)) {
-       bool needs_copy;
-       bool needs_store;
-       hv_magic_check (hv, &needs_copy, &needs_store);
-       if (needs_copy) {
-           bool save_taint = PL_tainted;
-           if (PL_tainting)
-               PL_tainted = SvTAINTED(keysv);
-           keysv = sv_2mortal(newSVsv(keysv));
-           mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
-           TAINT_IF(save_taint);
-           if (!xhv->xhv_array /* !HvARRAY(hv) */ && !needs_store)
-               return Nullhe;
+       bool needs_copy;
+       bool needs_store;
+       hv_magic_check (hv, &needs_copy, &needs_store);
+       if (needs_copy) {
+           bool save_taint = PL_tainted;
+           if (PL_tainting)
+               PL_tainted = SvTAINTED(keysv);
+           keysv = sv_2mortal(newSVsv(keysv));
+           mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
+           TAINT_IF(save_taint);
+           if (!xhv->xhv_array /* !HvARRAY(hv) */ && !needs_store)
+               return Nullhe;
 #ifdef ENV_IS_CASELESS
            else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
                key = SvPV(keysv, klen);
 #ifdef ENV_IS_CASELESS
            else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
                key = SvPV(keysv, klen);
@@ -565,11 +730,27 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, register U32 hash)
     keysave = key = SvPV(keysv, klen);
     is_utf8 = (SvUTF8(keysv) != 0);
 
     keysave = key = SvPV(keysv, klen);
     is_utf8 = (SvUTF8(keysv) != 0);
 
-    if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT))
+    if (is_utf8) {
        key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
        key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
+        if (is_utf8)
+            flags = HVhek_UTF8;
+        if (key != keysave)
+            flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
+        HvHASKFLAGS_on((SV*)hv);
+    }
 
 
-    if (!hash)
-       PERL_HASH(hash, key, klen);
+    if (HvREHASH(hv)) {
+       /* We don't have a pointer to the hv, so we have to replicate the
+          flag into every HEK, so that hv_iterkeysv can see it.  */
+       flags |= HVhek_REHASH;
+       PERL_HASH_INTERNAL(hash, key, klen);
+    } else if (!hash) {
+        if SvIsCOW_shared_hash(keysv) {
+            hash = SvUVX(keysv);
+        } else {
+            PERL_HASH(hash, key, klen);
+        }
+    }
 
     if (!xhv->xhv_array /* !HvARRAY(hv) */)
        Newz(505, xhv->xhv_array /* HvARRAY(hv) */,
 
     if (!xhv->xhv_array /* !HvARRAY(hv) */)
        Newz(505, xhv->xhv_array /* HvARRAY(hv) */,
@@ -578,40 +759,73 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, register U32 hash)
 
     /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 
     /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
-    i = 1;
-
-    for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
+    n_links = 0;
+    entry = *oentry;
+    for (; entry; ++n_links, entry = HeNEXT(entry)) {
        if (HeHASH(entry) != hash)              /* strings can't be equal */
            continue;
        if (HeHASH(entry) != hash)              /* strings can't be equal */
            continue;
-       if (HeKLEN(entry) != klen)
+       if (HeKLEN(entry) != (I32)klen)
            continue;
        if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
            continue;
            continue;
        if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
            continue;
-       if (HeKUTF8(entry) != (char)is_utf8)
+       if ((HeKFLAGS(entry) ^ flags) & HVhek_UTF8)
            continue;
            continue;
-       SvREFCNT_dec(HeVAL(entry));
+       if (HeVAL(entry) == &PL_sv_placeholder)
+           xhv->xhv_placeholders--; /* yes, can store into placeholder slot */
+       else
+           SvREFCNT_dec(HeVAL(entry));
        HeVAL(entry) = val;
        HeVAL(entry) = val;
-       if (key != keysave)
+        if (HeKFLAGS(entry) != flags) {
+            /* We match if HVhek_UTF8 bit in our flags and hash key's match.
+               But if entry was set previously with HVhek_WASUTF8 and key now
+               doesn't (or vice versa) then we should change the key's flag,
+               as this is assignment.  */
+            if (HvSHAREKEYS(hv)) {
+                /* Need to swap the key we have for a key with the flags we
+                   need. As keys are shared we can't just write to the flag,
+                   so we share the new one, unshare the old one.  */
+                int flags_nofree = flags & ~HVhek_FREEKEY;
+                HEK *new_hek = share_hek_flags(key, klen, hash, flags_nofree);
+                unshare_hek (HeKEY_hek(entry));
+                HeKEY_hek(entry) = new_hek;
+            }
+            else
+                HeKFLAGS(entry) = flags;
+        }
+        if (flags & HVhek_FREEKEY)
            Safefree(key);
        return entry;
     }
 
            Safefree(key);
        return entry;
     }
 
+    if (SvREADONLY(hv)) {
+       S_hv_notallowed(aTHX_ flags, key, klen,
+                       "access disallowed key '%"SVf"' to"
+                       );
+    }
+
     entry = new_HE();
     entry = new_HE();
+    /* share_hek_flags will do the free for us.  This might be considered
+       bad API design.  */
     if (HvSHAREKEYS(hv))
     if (HvSHAREKEYS(hv))
-       HeKEY_hek(entry) = share_hek(key, is_utf8?-(I32)klen:klen, hash);
+       HeKEY_hek(entry) = share_hek_flags(key, klen, hash, flags);
     else                                       /* gotta do the real thing */
     else                                       /* gotta do the real thing */
-       HeKEY_hek(entry) = save_hek(key, is_utf8?-(I32)klen:klen, hash);
-    if (key != keysave)
-       Safefree(key);
+       HeKEY_hek(entry) = save_hek_flags(key, klen, hash, flags);
     HeVAL(entry) = val;
     HeNEXT(entry) = *oentry;
     *oentry = entry;
 
     xhv->xhv_keys++; /* HvKEYS(hv)++ */
     HeVAL(entry) = val;
     HeNEXT(entry) = *oentry;
     *oentry = entry;
 
     xhv->xhv_keys++; /* HvKEYS(hv)++ */
-    if (i) {                           /* initial entry? */
+    if (!n_links) {                            /* initial entry? */
        xhv->xhv_fill++; /* HvFILL(hv)++ */
        xhv->xhv_fill++; /* HvFILL(hv)++ */
-       if (xhv->xhv_keys > xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */)
-           hsplit(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);
     }
 
     return entry;
     }
 
     return entry;
@@ -631,93 +845,7 @@ will be returned.
 SV *
 Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags)
 {
 SV *
 Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags)
 {
-    register XPVHV* xhv;
-    register I32 i;
-    register U32 hash;
-    register HE *entry;
-    register HE **oentry;
-    SV **svp;
-    SV *sv;
-    bool is_utf8 = FALSE;
-    const char *keysave = key;
-
-    if (!hv)
-       return Nullsv;
-    if (klen < 0) {
-      klen = -klen;
-      is_utf8 = TRUE;
-    }
-    if (SvRMAGICAL(hv)) {
-       bool needs_copy;
-       bool needs_store;
-       hv_magic_check (hv, &needs_copy, &needs_store);
-
-       if (needs_copy && (svp = hv_fetch(hv, key, klen, TRUE))) {
-           sv = *svp;
-           mg_clear(sv);
-           if (!needs_store) {
-               if (mg_find(sv, PERL_MAGIC_tiedelem)) {
-                   /* No longer an element */
-                   sv_unmagic(sv, PERL_MAGIC_tiedelem);
-                   return sv;
-               }
-               return Nullsv;          /* element cannot be deleted */
-           }
-#ifdef ENV_IS_CASELESS
-           else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
-               sv = sv_2mortal(newSVpvn(key,klen));
-               key = strupr(SvPVX(sv));
-           }
-#endif
-        }
-    }
-    xhv = (XPVHV*)SvANY(hv);
-    if (!xhv->xhv_array /* !HvARRAY(hv) */)
-       return Nullsv;
-
-    if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT)) {
-       STRLEN tmplen = klen;
-       /* See the note in hv_fetch(). --jhi */
-       key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
-       klen = tmplen;
-    }
-
-    PERL_HASH(hash, key, klen);
-
-    /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
-    oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
-    entry = *oentry;
-    i = 1;
-    for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
-       if (HeHASH(entry) != hash)              /* strings can't be equal */
-           continue;
-       if (HeKLEN(entry) != klen)
-           continue;
-       if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
-           continue;
-       if (HeKUTF8(entry) != (char)is_utf8)
-           continue;
-       if (key != keysave)
-           Safefree(key);
-       *oentry = HeNEXT(entry);
-       if (i && !*oentry)
-           xhv->xhv_fill--; /* HvFILL(hv)-- */
-       if (flags & G_DISCARD)
-           sv = Nullsv;
-       else {
-           sv = sv_2mortal(HeVAL(entry));
-           HeVAL(entry) = &PL_sv_undef;
-       }
-       if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
-           HvLAZYDEL_on(hv);
-       else
-           hv_free_ent(hv, entry);
-       xhv->xhv_keys--; /* HvKEYS(hv)-- */
-       return sv;
-    }
-    if (key != keysave)
-       Safefree(key);
-    return Nullsv;
+    return hv_delete_common(hv, NULL, key, klen, flags, 0);
 }
 
 /*
 }
 
 /*
@@ -734,39 +862,76 @@ precomputed hash value, or 0 to ask for it to be computed.
 SV *
 Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
 {
 SV *
 Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
 {
+    return hv_delete_common(hv, keysv, NULL, 0, flags, hash);
+}
+
+SV *
+S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, I32 klen_i32,
+                  I32 flags, U32 hash)
+{
     register XPVHV* xhv;
     register I32 i;
     register XPVHV* xhv;
     register I32 i;
-    register char *key;
     STRLEN klen;
     register HE *entry;
     register HE **oentry;
     SV *sv;
     bool is_utf8;
     STRLEN klen;
     register HE *entry;
     register HE **oentry;
     SV *sv;
     bool is_utf8;
-    char *keysave;
+    int k_flags = 0;
+    const char *keysave;
 
     if (!hv)
        return Nullsv;
 
     if (!hv)
        return Nullsv;
+
+    if (keysv) {
+       key = SvPV(keysv, klen);
+       is_utf8 = (SvUTF8(keysv) != 0);
+    } else {
+       if (klen_i32 < 0) {
+           klen = -klen_i32;
+           is_utf8 = TRUE;
+       } else {
+           klen = klen_i32;
+           is_utf8 = FALSE;
+       }
+    }
+    keysave = key;
+
     if (SvRMAGICAL(hv)) {
        bool needs_copy;
        bool needs_store;
        hv_magic_check (hv, &needs_copy, &needs_store);
 
     if (SvRMAGICAL(hv)) {
        bool needs_copy;
        bool needs_store;
        hv_magic_check (hv, &needs_copy, &needs_store);
 
-       if (needs_copy && (entry = hv_fetch_ent(hv, keysv, TRUE, hash))) {
-           sv = HeVAL(entry);
-           mg_clear(sv);
-           if (!needs_store) {
-               if (mg_find(sv, PERL_MAGIC_tiedelem)) {
-                   /* No longer an element */
-                   sv_unmagic(sv, PERL_MAGIC_tiedelem);
-                   return sv;
-               }               
-               return Nullsv;          /* element cannot be deleted */
+       if (needs_copy) {
+           sv = NULL;
+           if (keysv) {
+               if ((entry = hv_fetch_ent(hv, keysv, TRUE, hash))) {
+                   sv = HeVAL(entry);
+               }
+           } else {
+               SV **svp;
+               if ((svp = hv_fetch(hv, key, is_utf8 ? -klen : klen, TRUE))) {
+                   sv = *svp;
+               }
+           }
+           if (sv) {
+               if (SvMAGICAL(sv)) {
+                   mg_clear(sv);
+               }
+               if (!needs_store) {
+                   if (mg_find(sv, PERL_MAGIC_tiedelem)) {
+                       /* No longer an element */
+                       sv_unmagic(sv, PERL_MAGIC_tiedelem);
+                       return sv;
+                   }           
+                   return Nullsv;              /* element cannot be deleted */
+               }
            }
 #ifdef ENV_IS_CASELESS
            else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
            }
 #ifdef ENV_IS_CASELESS
            else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
-               key = SvPV(keysv, klen);
+               /* XXX This code isn't UTF8 clean.  */
                keysv = sv_2mortal(newSVpvn(key,klen));
                keysv = sv_2mortal(newSVpvn(key,klen));
-               (void)strupr(SvPVX(keysv));
+               keysave = key = strupr(SvPVX(keysv));
+               is_utf8 = 0;
                hash = 0;
            }
 #endif
                hash = 0;
            }
 #endif
@@ -774,16 +939,21 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
     }
     xhv = (XPVHV*)SvANY(hv);
     if (!xhv->xhv_array /* !HvARRAY(hv) */)
     }
     xhv = (XPVHV*)SvANY(hv);
     if (!xhv->xhv_array /* !HvARRAY(hv) */)
-       return Nullsv;
-
-    keysave = key = SvPV(keysv, klen);
-    is_utf8 = (SvUTF8(keysv) != 0);
+       return Nullsv;
 
 
-    if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT))
+    if (is_utf8) {
        key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
        key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
+        if (is_utf8)
+            k_flags = HVhek_UTF8;
+        if (key != keysave)
+            k_flags |= HVhek_FREEKEY;
+    }
 
 
-    if (!hash)
+    if (HvREHASH(hv)) {
+       PERL_HASH_INTERNAL(hash, key, klen);
+    } else if (!hash) {
        PERL_HASH(hash, key, klen);
        PERL_HASH(hash, key, klen);
+    }
 
     /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
 
     /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
@@ -792,31 +962,80 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
     for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
        if (HeHASH(entry) != hash)              /* strings can't be equal */
            continue;
     for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
        if (HeHASH(entry) != hash)              /* strings can't be equal */
            continue;
-       if (HeKLEN(entry) != klen)
+       if (HeKLEN(entry) != (I32)klen)
            continue;
        if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
            continue;
            continue;
        if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
            continue;
-       if (HeKUTF8(entry) != (char)is_utf8)
+       if ((HeKFLAGS(entry) ^ k_flags) & HVhek_UTF8)
            continue;
            continue;
-       if (key != keysave)
-           Safefree(key);
-       *oentry = HeNEXT(entry);
-       if (i && !*oentry)
-           xhv->xhv_fill--; /* HvFILL(hv)-- */
+        if (k_flags & HVhek_FREEKEY)
+            Safefree(key);
+
+       /* 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;
+       }
+       else if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
+           S_hv_notallowed(aTHX_ k_flags, key, klen,
+                           "delete readonly key '%"SVf"' from"
+                           );
+       }
+
        if (flags & G_DISCARD)
            sv = Nullsv;
        else {
            sv = sv_2mortal(HeVAL(entry));
        if (flags & G_DISCARD)
            sv = Nullsv;
        else {
            sv = sv_2mortal(HeVAL(entry));
-           HeVAL(entry) = &PL_sv_undef;
+           HeVAL(entry) = &PL_sv_placeholder;
+       }
+
+       /*
+        * If a restricted hash, rather than really deleting the entry, put
+        * a placeholder there. This marks the key as being "approved", so
+        * we can still access via not-really-existing key without raising
+        * an error.
+        */
+       if (SvREADONLY(hv)) {
+           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)++ */
+       } else {
+           *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);
        }
        }
-       if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
-           HvLAZYDEL_on(hv);
-       else
-           hv_free_ent(hv, entry);
-       xhv->xhv_keys--; /* HvKEYS(hv)-- */
        return sv;
     }
        return sv;
     }
-    if (key != keysave)
+    if (SvREADONLY(hv)) {
+        S_hv_notallowed(aTHX_ k_flags, key, klen,
+                       "delete disallowed key '%"SVf"' from"
+                       );
+    }
+
+    if (k_flags & HVhek_FREEKEY)
        Safefree(key);
     return Nullsv;
 }
        Safefree(key);
     return Nullsv;
 }
@@ -833,88 +1052,9 @@ C<klen> is the length of the key.
 bool
 Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen)
 {
 bool
 Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen)
 {
-    register XPVHV* xhv;
-    register U32 hash;
-    register HE *entry;
-    SV *sv;
-    bool is_utf8 = FALSE;
-    const char *keysave = key;
-
-    if (!hv)
-       return 0;
-
-    if (klen < 0) {
-      klen = -klen;
-      is_utf8 = TRUE;
-    }
-
-    if (SvRMAGICAL(hv)) {
-       if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
-           sv = sv_newmortal();
-           mg_copy((SV*)hv, sv, key, klen);
-           magic_existspack(sv, mg_find(sv, PERL_MAGIC_tiedelem));
-           return SvTRUE(sv);
-       }
-#ifdef ENV_IS_CASELESS
-       else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
-           sv = sv_2mortal(newSVpvn(key,klen));
-           key = strupr(SvPVX(sv));
-       }
-#endif
-    }
-
-    xhv = (XPVHV*)SvANY(hv);
-#ifndef DYNAMIC_ENV_FETCH
-    if (!xhv->xhv_array /* !HvARRAY(hv) */)
-       return 0;
-#endif
-
-    if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT)) {
-       STRLEN tmplen = klen;
-       /* See the note in hv_fetch(). --jhi */
-       key = (char*)bytes_from_utf8((U8*)key, &tmplen, &is_utf8);
-       klen = tmplen;
-    }
-
-    PERL_HASH(hash, key, klen);
-
-#ifdef DYNAMIC_ENV_FETCH
-    if (!xhv->xhv_array /* !HvARRAY(hv) */) entry = Null(HE*);
-    else
-#endif
-    /* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
-    entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
-    for (; entry; entry = HeNEXT(entry)) {
-       if (HeHASH(entry) != hash)              /* strings can't be equal */
-           continue;
-       if (HeKLEN(entry) != klen)
-           continue;
-       if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
-           continue;
-       if (HeKUTF8(entry) != (char)is_utf8)
-           continue;
-       if (key != keysave)
-           Safefree(key);
-       return TRUE;
-    }
-#ifdef DYNAMIC_ENV_FETCH  /* is it out there? */
-    if (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
-       unsigned long len;
-       char *env = PerlEnv_ENVgetenv_len(key,&len);
-       if (env) {
-           sv = newSVpvn(env,len);
-           SvTAINTED_on(sv);
-           (void)hv_store(hv,key,klen,sv,hash);
-           return TRUE;
-       }
-    }
-#endif
-    if (key != keysave)
-       Safefree(key);
-    return FALSE;
+    return hv_exists_common(hv, NULL, key, klen, 0);
 }
 
 }
 
-
 /*
 =for apidoc hv_exists_ent
 
 /*
 =for apidoc hv_exists_ent
 
@@ -928,31 +1068,67 @@ computed.
 bool
 Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
 {
 bool
 Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
 {
+    return hv_exists_common(hv, keysv, NULL, 0, hash);
+}
+
+bool
+S_hv_exists_common(pTHX_ HV *hv, SV *keysv, const char *key, I32 klen_i32,
+                  U32 hash)
+{
     register XPVHV* xhv;
     register XPVHV* xhv;
-    register char *key;
     STRLEN klen;
     register HE *entry;
     SV *sv;
     bool is_utf8;
     STRLEN klen;
     register HE *entry;
     SV *sv;
     bool is_utf8;
-    char *keysave;
+    const char *keysave;
+    int k_flags = 0;
 
     if (!hv)
        return 0;
 
 
     if (!hv)
        return 0;
 
+    if (keysv) {
+       key = SvPV(keysv, klen);
+       is_utf8 = (SvUTF8(keysv) != 0);
+    } else {
+       if (klen_i32 < 0) {
+           klen = -klen_i32;
+           is_utf8 = TRUE;
+       } else {
+           klen = klen_i32;
+           is_utf8 = FALSE;
+       }
+    }
+    keysave = key;
+
     if (SvRMAGICAL(hv)) {
        if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
     if (SvRMAGICAL(hv)) {
        if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
-           SV* svret = sv_newmortal();
+           SV* svret;
+
+           if (keysv || is_utf8) {
+               if (!keysv) {
+                   keysv = newSVpvn(key, klen);
+                   SvUTF8_on(keysv);
+               } else {
+                   keysv = newSVsv(keysv);
+               }
+               key = (char *)sv_2mortal(keysv);
+               klen = HEf_SVKEY;
+           }
+
+           /* I don't understand why hv_exists_ent has svret and sv,
+              whereas hv_exists only had one.  */
+           svret = sv_newmortal();
            sv = sv_newmortal();
            sv = sv_newmortal();
-           keysv = sv_2mortal(newSVsv(keysv));
-           mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
-           magic_existspack(svret, mg_find(sv, PERL_MAGIC_tiedelem));
-           return SvTRUE(svret);
+           mg_copy((SV*)hv, sv, key, klen);
+           magic_existspack(svret, mg_find(sv, PERL_MAGIC_tiedelem));
+           return (bool)SvTRUE(svret);
        }
 #ifdef ENV_IS_CASELESS
        else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
        }
 #ifdef ENV_IS_CASELESS
        else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
-           key = SvPV(keysv, klen);
+           /* XXX This code isn't UTF8 clean.  */
            keysv = sv_2mortal(newSVpvn(key,klen));
            keysv = sv_2mortal(newSVpvn(key,klen));
-           (void)strupr(SvPVX(keysv));
+           keysave = key = strupr(SvPVX(keysv));
+           is_utf8 = 0;
            hash = 0;
        }
 #endif
            hash = 0;
        }
 #endif
@@ -964,11 +1140,16 @@ Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
        return 0;
 #endif
 
        return 0;
 #endif
 
-    keysave = key = SvPV(keysv, klen);
-    is_utf8 = (SvUTF8(keysv) != 0);
-    if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT))
+    if (is_utf8) {
        key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
        key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
-    if (!hash)
+        if (is_utf8)
+            k_flags = HVhek_UTF8;
+        if (key != keysave)
+            k_flags |= HVhek_FREEKEY;
+    }
+    if (HvREHASH(hv)) {
+       PERL_HASH_INTERNAL(hash, key, klen);
+    } else if (!hash)
        PERL_HASH(hash, key, klen);
 
 #ifdef DYNAMIC_ENV_FETCH
        PERL_HASH(hash, key, klen);
 
 #ifdef DYNAMIC_ENV_FETCH
@@ -980,14 +1161,17 @@ Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
     for (; entry; entry = HeNEXT(entry)) {
        if (HeHASH(entry) != hash)              /* strings can't be equal */
            continue;
     for (; entry; entry = HeNEXT(entry)) {
        if (HeHASH(entry) != hash)              /* strings can't be equal */
            continue;
-       if (HeKLEN(entry) != klen)
+       if (HeKLEN(entry) != (I32)klen)
            continue;
        if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
            continue;
            continue;
        if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen))        /* is this it? */
            continue;
-       if (HeKUTF8(entry) != (char)is_utf8)
+       if ((HeKFLAGS(entry) ^ k_flags) & HVhek_UTF8)
            continue;
            continue;
-       if (key != keysave)
+       if (k_flags & HVhek_FREEKEY)
            Safefree(key);
            Safefree(key);
+       /* If we find the key, but the value is a placeholder, return false. */
+       if (HeVAL(entry) == &PL_sv_placeholder)
+           return FALSE;
        return TRUE;
     }
 #ifdef DYNAMIC_ENV_FETCH  /* is it out there? */
        return TRUE;
     }
 #ifdef DYNAMIC_ENV_FETCH  /* is it out there? */
@@ -998,15 +1182,18 @@ Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
            sv = newSVpvn(env,len);
            SvTAINTED_on(sv);
            (void)hv_store_ent(hv,keysv,sv,hash);
            sv = newSVpvn(env,len);
            SvTAINTED_on(sv);
            (void)hv_store_ent(hv,keysv,sv,hash);
+            if (k_flags & HVhek_FREEKEY)
+                Safefree(key);
            return TRUE;
        }
     }
 #endif
            return TRUE;
        }
     }
 #endif
-    if (key != keysave)
-       Safefree(key);
+    if (k_flags & HVhek_FREEKEY)
+        Safefree(key);
     return FALSE;
 }
 
     return FALSE;
 }
 
+
 STATIC void
 S_hsplit(pTHX_ HV *hv)
 {
 STATIC void
 S_hsplit(pTHX_ HV *hv)
 {
@@ -1019,6 +1206,8 @@ S_hsplit(pTHX_ HV *hv)
     register HE **bep;
     register HE *entry;
     register HE **oentry;
     register HE **bep;
     register HE *entry;
     register HE **oentry;
+    int longest_chain = 0;
+    int was_shared;
 
     PL_nomemok = TRUE;
 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
 
     PL_nomemok = TRUE;
 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
@@ -1049,24 +1238,103 @@ S_hsplit(pTHX_ HV *hv)
     aep = (HE**)a;
 
     for (i=0; i<oldsize; i++,aep++) {
     aep = (HE**)a;
 
     for (i=0; i<oldsize; i++,aep++) {
+       int left_length = 0;
+       int right_length = 0;
+
        if (!*aep)                              /* non-existent */
            continue;
        bep = aep+oldsize;
        for (oentry = aep, entry = *aep; entry; entry = *oentry) {
        if (!*aep)                              /* non-existent */
            continue;
        bep = aep+oldsize;
        for (oentry = aep, entry = *aep; entry; entry = *oentry) {
-           if ((HeHASH(entry) & newsize) != i) {
+           if ((HeHASH(entry) & newsize) != (U32)i) {
                *oentry = HeNEXT(entry);
                HeNEXT(entry) = *bep;
                if (!*bep)
                    xhv->xhv_fill++; /* HvFILL(hv)++ */
                *bep = entry;
                *oentry = HeNEXT(entry);
                HeNEXT(entry) = *bep;
                if (!*bep)
                    xhv->xhv_fill++; /* HvFILL(hv)++ */
                *bep = entry;
+               right_length++;
                continue;
            }
                continue;
            }
-           else
+           else {
                oentry = &HeNEXT(entry);
                oentry = &HeNEXT(entry);
+               left_length++;
+           }
        }
        if (!*aep)                              /* everything moved */
            xhv->xhv_fill--; /* HvFILL(hv)-- */
        }
        if (!*aep)                              /* everything moved */
            xhv->xhv_fill--; /* HvFILL(hv)-- */
+       /* I think we don't actually need to keep track of the longest length,
+          merely flag if anything is too long. But for the moment while
+          developing this code I'll track it.  */
+       if (left_length > longest_chain)
+           longest_chain = left_length;
+       if (right_length > longest_chain)
+           longest_chain = right_length;
+    }
+
+
+    /* Pick your policy for "hashing isn't working" here:  */
+    if (longest_chain <= HV_MAX_LENGTH_BEFORE_SPLIT /* split worked?  */
+       || HvREHASH(hv)) {
+       return;
+    }
+
+    if (hv == PL_strtab) {
+       /* Urg. Someone is doing something nasty to the string table.
+          Can't win.  */
+       return;
+    }
+
+    /* Awooga. Awooga. Pathological data.  */
+    /*PerlIO_printf(PerlIO_stderr(), "%p %d of %d with %d/%d buckets\n", hv,
+      longest_chain, HvTOTALKEYS(hv), HvFILL(hv),  1+HvMAX(hv));*/
+
+    ++newsize;
+    Newz(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
+    was_shared = HvSHAREKEYS(hv);
+
+    xhv->xhv_fill = 0;
+    HvSHAREKEYS_off(hv);
+    HvREHASH_on(hv);
+
+    aep = (HE **) xhv->xhv_array;
+
+    for (i=0; i<newsize; i++,aep++) {
+       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.  */
+           HE *next = HeNEXT(entry);
+           UV hash;
+
+           /* Rehash it */
+           PERL_HASH_INTERNAL(hash, HeKEY(entry), HeKLEN(entry));
+
+           if (was_shared) {
+               /* Unshare it.  */
+               HEK *new_hek
+                   = save_hek_flags(HeKEY(entry), HeKLEN(entry),
+                                    hash, HeKFLAGS(entry));
+               unshare_hek (HeKEY_hek(entry));
+               HeKEY_hek(entry) = new_hek;
+           } else {
+               /* Not shared, so simply write the new hash in. */
+               HeHASH(entry) = hash;
+           }
+           /*PerlIO_printf(PerlIO_stderr(), "%d ", HeKFLAGS(entry));*/
+           HEK_REHASH_on(HeKEY_hek(entry));
+           /*PerlIO_printf(PerlIO_stderr(), "%d\n", HeKFLAGS(entry));*/
+
+           /* Copy oentry to the correct new chain.  */
+           bep = ((HE**)a) + (hash & (I32) xhv->xhv_max);
+           if (!*bep)
+                   xhv->xhv_fill++; /* HvFILL(hv)++ */
+           HeNEXT(entry) = *bep;
+           *bep = entry;
+
+           entry = next;
+       }
     }
     }
+    Safefree (xhv->xhv_array);
+    xhv->xhv_array = a;                /* HvARRAY(hv) = a */
 }
 
 void
 }
 
 void
@@ -1098,13 +1366,13 @@ Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
        PL_nomemok = TRUE;
 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
        Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
        PL_nomemok = TRUE;
 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
        Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
-        if (!a) {
+       if (!a) {
          PL_nomemok = FALSE;
          return;
        }
 #else
        New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
          PL_nomemok = FALSE;
          return;
        }
 #else
        New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
-        if (!a) {
+       if (!a) {
          PL_nomemok = FALSE;
          return;
        }
          PL_nomemok = FALSE;
          return;
        }
@@ -1170,6 +1438,7 @@ Perl_newHV(pTHX)
 #ifndef NODEFAULT_SHAREKEYS
     HvSHAREKEYS_on(hv);         /* key-sharing on by default */
 #endif
 #ifndef NODEFAULT_SHAREKEYS
     HvSHAREKEYS_on(hv);         /* key-sharing on by default */
 #endif
+
     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 */
     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 */
@@ -1180,36 +1449,76 @@ Perl_newHV(pTHX)
 HV *
 Perl_newHVhv(pTHX_ HV *ohv)
 {
 HV *
 Perl_newHVhv(pTHX_ HV *ohv)
 {
-    register HV *hv;
-    STRLEN hv_max = ohv ? HvMAX(ohv) : 0;
-    STRLEN hv_fill = ohv ? HvFILL(ohv) : 0;
-
-    hv = newHV();
-    while (hv_max && hv_max + 1 >= hv_fill * 2)
-       hv_max = hv_max / 2;    /* Is always 2^n-1 */
-    HvMAX(hv) = hv_max;
-    if (!hv_fill)
+    HV *hv = newHV();
+    STRLEN hv_max, hv_fill;
+
+    if (!ohv || (hv_fill = HvFILL(ohv)) == 0)
        return hv;
        return hv;
+    hv_max = HvMAX(ohv);
+
+    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);
+       char *a;
+       New(0, a, PERL_HV_ARRAY_ALLOC_BYTES(hv_max+1), char);
+       ents = (HE**)a;
+
+       /* In each bucket... */
+       for (i = 0; i <= hv_max; i++) {
+           HE *prev = NULL, *ent = NULL, *oent = oents[i];
+
+           if (!oent) {
+               ents[i] = NULL;
+               continue;
+           }
+
+           /* 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);
+
+               ent = new_HE();
+               HeVAL(ent)     = newSVsv(HeVAL(oent));
+               HeKEY_hek(ent)
+                    = shared ? share_hek_flags(key, len, hash, flags)
+                             :  save_hek_flags(key, len, hash, flags);
+               if (prev)
+                   HeNEXT(prev) = ent;
+               else
+                   ents[i] = ent;
+               prev = ent;
+               HeNEXT(ent) = NULL;
+           }
+       }
 
 
-#if 0
-    if (! SvTIED_mg((SV*)ohv, PERL_MAGIC_tied)) {
-       /* Quick way ???*/
+       HvMAX(hv)   = hv_max;
+       HvFILL(hv)  = hv_fill;
+       HvTOTALKEYS(hv)  = HvTOTALKEYS(ohv);
+       HvARRAY(hv) = ents;
     }
     }
-    else
-#endif
-    {
+    else {
+       /* Iterate over ohv, copying keys and values one at a time. */
        HE *entry;
        HE *entry;
-       I32 hv_riter = HvRITER(ohv);    /* current root of iterator */
-       HE *hv_eiter = HvEITER(ohv);    /* current entry of iterator */
-       
-       /* Slow way */
+       I32 riter = HvRITER(ohv);
+       HE *eiter = HvEITER(ohv);
+
+       /* Can we use fewer buckets? (hv_max is always 2^n-1) */
+       while (hv_max && hv_max + 1 >= hv_fill * 2)
+           hv_max = hv_max / 2;
+       HvMAX(hv) = hv_max;
+
        hv_iterinit(ohv);
        hv_iterinit(ohv);
-       while ((entry = hv_iternext(ohv))) {
-           hv_store(hv, HeKEY(entry), HeKLEN_UTF8(entry),
-                    newSVsv(HeVAL(entry)), HeHASH(entry));
+       while ((entry = hv_iternext_flags(ohv, 0))) {
+           hv_store_flags(hv, HeKEY(entry), HeKLEN(entry),
+                           newSVsv(HeVAL(entry)), HeHASH(entry),
+                           HeKFLAGS(entry));
        }
        }
-       HvRITER(ohv) = hv_riter;
-       HvEITER(ohv) = hv_eiter;
+       HvRITER(ohv) = riter;
+       HvEITER(ohv) = eiter;
     }
 
     return hv;
     }
 
     return hv;
@@ -1228,7 +1537,7 @@ Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
     SvREFCNT_dec(val);
     if (HeKLEN(entry) == HEf_SVKEY) {
        SvREFCNT_dec(HeKEY_sv(entry));
     SvREFCNT_dec(val);
     if (HeKLEN(entry) == HEf_SVKEY) {
        SvREFCNT_dec(HeKEY_sv(entry));
-        Safefree(HeKEY_hek(entry));
+       Safefree(HeKEY_hek(entry));
     }
     else if (HvSHAREKEYS(hv))
        unshare_hek(HeKEY_hek(entry));
     }
     else if (HvSHAREKEYS(hv))
        unshare_hek(HeKEY_hek(entry));
@@ -1270,16 +1579,101 @@ Perl_hv_clear(pTHX_ HV *hv)
     register XPVHV* xhv;
     if (!hv)
        return;
     register XPVHV* xhv;
     if (!hv)
        return;
+
+    DEBUG_A(Perl_hv_assert(aTHX_ hv));
+
     xhv = (XPVHV*)SvANY(hv);
     xhv = (XPVHV*)SvANY(hv);
+
+    if (SvREADONLY(hv) && xhv->xhv_array != NULL) {
+       /* 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];
+           for (; entry; entry = HeNEXT(entry)) {
+               /* not already placeholder */
+               if (HeVAL(entry) != &PL_sv_placeholder) {
+                   if (HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
+                       SV* keysv = hv_iterkeysv(entry);
+                       Perl_croak(aTHX_
+       "Attempt to delete readonly key '%"SVf"' from a restricted hash",
+                                  keysv);
+                   }
+                   SvREFCNT_dec(HeVAL(entry));
+                   HeVAL(entry) = &PL_sv_placeholder;
+                   xhv->xhv_placeholders++; /* HvPLACEHOLDERS(hv)++ */
+               }
+           }
+       }
+       return;
+    }
+
     hfreeentries(hv);
     hfreeentries(hv);
-    xhv->xhv_fill = 0; /* HvFILL(hv) = 0 */
-    xhv->xhv_keys = 0; /* HvKEYS(hv) = 0 */
+    xhv->xhv_placeholders = 0; /* HvPLACEHOLDERS(hv) = 0 */
     if (xhv->xhv_array /* HvARRAY(hv) */)
        (void)memzero(xhv->xhv_array /* HvARRAY(hv) */,
                      (xhv->xhv_max+1 /* HvMAX(hv)+1 */) * sizeof(HE*));
 
     if (SvRMAGICAL(hv))
        mg_clear((SV*)hv);
     if (xhv->xhv_array /* HvARRAY(hv) */)
        (void)memzero(xhv->xhv_array /* HvARRAY(hv) */,
                      (xhv->xhv_max+1 /* HvMAX(hv)+1 */) * sizeof(HE*));
 
     if (SvRMAGICAL(hv))
        mg_clear((SV*)hv);
+
+    HvHASKFLAGS_off(hv);
+    HvREHASH_off(hv);
+}
+
+/*
+=for apidoc hv_clear_placeholders
+
+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,
+but will still allow the hash to have a value reaasigned 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.
+
+=cut
+*/
+
+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;
+    }
 }
 
 STATIC void
 }
 
 STATIC void
@@ -1299,6 +1693,12 @@ S_hfreeentries(pTHX_ HV *hv)
     riter = 0;
     max = HvMAX(hv);
     array = HvARRAY(hv);
     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**); 
+    HvFILL(hv) = 0;
+    ((XPVHV*) SvANY(hv))->xhv_keys = 0;
+
     entry = array[0];
     for (;;) {
        if (entry) {
     entry = array[0];
     for (;;) {
        if (entry) {
@@ -1312,6 +1712,7 @@ S_hfreeentries(pTHX_ HV *hv)
            entry = array[riter];
        }
     }
            entry = array[riter];
        }
     }
+    HvARRAY(hv) = array;
     (void)hv_iterinit(hv);
 }
 
     (void)hv_iterinit(hv);
 }
 
@@ -1329,17 +1730,19 @@ Perl_hv_undef(pTHX_ HV *hv)
     register XPVHV* xhv;
     if (!hv)
        return;
     register XPVHV* xhv;
     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)) {
     xhv = (XPVHV*)SvANY(hv);
     hfreeentries(hv);
     Safefree(xhv->xhv_array /* HvARRAY(hv) */);
     if (HvNAME(hv)) {
+        if(PL_stashcache)
+           hv_delete(PL_stashcache, HvNAME(hv), strlen(HvNAME(hv)), G_DISCARD);
        Safefree(HvNAME(hv));
        HvNAME(hv) = 0;
     }
     xhv->xhv_max   = 7;        /* HvMAX(hv) = 7 (it's a normal hash) */
     xhv->xhv_array = 0;        /* HvARRAY(hv) = 0 */
        Safefree(HvNAME(hv));
        HvNAME(hv) = 0;
     }
     xhv->xhv_max   = 7;        /* HvMAX(hv) = 7 (it's a normal hash) */
     xhv->xhv_array = 0;        /* HvARRAY(hv) = 0 */
-    xhv->xhv_fill  = 0;        /* HvFILL(hv) = 0 */
-    xhv->xhv_keys  = 0;        /* HvKEYS(hv) = 0 */
+    xhv->xhv_placeholders = 0; /* HvPLACEHOLDERS(hv) = 0 */
 
     if (SvRMAGICAL(hv))
        mg_clear((SV*)hv);
 
     if (SvRMAGICAL(hv))
        mg_clear((SV*)hv);
@@ -1356,6 +1759,7 @@ NOTE: Before version 5.004_65, C<hv_iterinit> used to return the number of
 hash buckets that happen to be in use.  If you still need that esoteric
 value, you can get it through the macro C<HvFILL(tb)>.
 
 hash buckets that happen to be in use.  If you still need that esoteric
 value, you can get it through the macro C<HvFILL(tb)>.
 
+
 =cut
 */
 
 =cut
 */
 
@@ -1376,20 +1780,48 @@ Perl_hv_iterinit(pTHX_ HV *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 */
     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 xhv->xhv_keys; /* HvKEYS(hv) */
+    return XHvTOTALKEYS(xhv);
 }
 }
-
 /*
 =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>.
 
+You may call C<hv_delete> or C<hv_delete_ent> on the hash entry that the
+iterator currently points to, without losing your place or invalidating your
+iterator.  Note that in this case the current entry is deleted from the hash
+with your iterator holding the last reference to it.  Your iterator is flagged
+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.
+
 =cut
 */
 
 HE *
 Perl_hv_iternext(pTHX_ HV *hv)
 {
 =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>.
+The C<flags> value will normally be zero; if HV_ITERNEXT_WANTPLACEHOLDERS is
+set the placeholders keys (for restricted hashes) will be returned in addition
+to normal keys. By default placeholders are automatically skipped over.
+Currently a placeholder is implemented with a value that is
+C<&Perl_sv_placeholder>. Note that the implementation of placeholders and
+restricted hashes may change, and the implementation currently is
+insufficiently abstracted for any change to be tidy.
+
+=cut
+*/
+
+HE *
+Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
+{
     register XPVHV* xhv;
     register HE *entry;
     HE *oldentry;
     register XPVHV* xhv;
     register HE *entry;
     HE *oldentry;
@@ -1419,11 +1851,11 @@ Perl_hv_iternext(pTHX_ HV *hv)
            HeKLEN(entry) = HEf_SVKEY;
        }
        magic_nextpack((SV*) hv,mg,key);
            HeKLEN(entry) = HEf_SVKEY;
        }
        magic_nextpack((SV*) hv,mg,key);
-        if (SvOK(key)) {
+       if (SvOK(key)) {
            /* force key to stay around until next time */
            HeSVKEY_set(entry, SvREFCNT_inc(key));
            return entry;               /* beware, hent_val is not set */
            /* force key to stay around until next time */
            HeSVKEY_set(entry, SvREFCNT_inc(key));
            return entry;               /* beware, hent_val is not set */
-        }
+       }
        if (HeVAL(entry))
            SvREFCNT_dec(HeVAL(entry));
        Safefree(HeKEY_hek(entry));
        if (HeVAL(entry))
            SvREFCNT_dec(HeVAL(entry));
        Safefree(HeKEY_hek(entry));
@@ -1440,16 +1872,41 @@ Perl_hv_iternext(pTHX_ HV *hv)
        Newz(506, xhv->xhv_array /* HvARRAY(hv) */,
             PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
             char);
        Newz(506, xhv->xhv_array /* HvARRAY(hv) */,
             PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
             char);
+    /* At start of hash, entry is NULL.  */
     if (entry)
     if (entry)
+    {
        entry = HeNEXT(entry);
        entry = HeNEXT(entry);
+        if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) {
+            /*
+             * Skip past any placeholders -- don't want to include them in
+             * any iteration.
+             */
+            while (entry && HeVAL(entry) == &PL_sv_placeholder) {
+                entry = HeNEXT(entry);
+            }
+       }
+    }
     while (!entry) {
     while (!entry) {
+       /* OK. Come to the end of the current list.  Grab the next one.  */
+
        xhv->xhv_riter++; /* HvRITER(hv)++ */
        xhv->xhv_riter++; /* HvRITER(hv)++ */
-       if (xhv->xhv_riter > xhv->xhv_max /* HvRITER(hv) > HvMAX(hv) */) {
+       if (xhv->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 */
            break;
        }
        /* entry = (HvARRAY(hv))[HvRITER(hv)]; */
        entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
            xhv->xhv_riter = -1; /* HvRITER(hv) = -1 */
            break;
        }
        /* entry = (HvARRAY(hv))[HvRITER(hv)]; */
        entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
+
+        if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) {
+            /* If we have an entry, but it's a placeholder, don't count it.
+              Try the next.  */
+           while (entry && HeVAL(entry) == &PL_sv_placeholder)
+               entry = HeNEXT(entry);
+       }
+       /* Will loop again if this linked list starts NULL
+          (for HV_ITERNEXT_WANTPLACEHOLDERS)
+          or if we run through it and find only placeholders.  */
     }
 
     if (oldentry && HvLAZYDEL(hv)) {           /* was deleted earlier? */
     }
 
     if (oldentry && HvLAZYDEL(hv)) {           /* was deleted earlier? */
@@ -1457,6 +1914,9 @@ Perl_hv_iternext(pTHX_ HV *hv)
        hv_free_ent(hv, oldentry);
     }
 
        hv_free_ent(hv, oldentry);
     }
 
+    /*if (HvREHASH(hv) && entry && !HeKREHASH(entry))
+      PerlIO_printf(PerlIO_stderr(), "Awooga %p %p\n", hv, entry);*/
+
     xhv->xhv_eiter = entry; /* HvEITER(hv) = entry */
     return entry;
 }
     xhv->xhv_eiter = entry; /* HvEITER(hv) = entry */
     return entry;
 }
@@ -1499,11 +1959,39 @@ 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)
-       return sv_mortalcopy(HeKEY_sv(entry));
-    else
-       return sv_2mortal(newSVpvn_share((HeKLEN(entry) ? HeKEY(entry) : ""),
-                                        HeKLEN_UTF8(entry), HeHASH(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));
 }
 
 /*
 }
 
 /*
@@ -1543,7 +2031,7 @@ SV *
 Perl_hv_iternextsv(pTHX_ HV *hv, char **key, I32 *retlen)
 {
     HE *he;
 Perl_hv_iternextsv(pTHX_ HV *hv, char **key, I32 *retlen)
 {
     HE *he;
-    if ( (he = hv_iternext(hv)) == NULL)
+    if ( (he = hv_iternext_flags(hv, 0)) == NULL)
        return NULL;
     *key = hv_iterkey(he, retlen);
     return hv_iterval(hv, he);
        return NULL;
     *key = hv_iterkey(he, retlen);
     return hv_iterval(hv, he);
@@ -1563,35 +2051,60 @@ Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how)
     sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
 }
 
     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));
 }
 
 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.
  */
 void
 Perl_unsharepvn(pTHX_ const char *str, I32 len, U32 hash)
 {
 /* possibly free a shared string if no one has access to it
  * len and hash must both be valid for str.
  */
 void
 Perl_unsharepvn(pTHX_ const char *str, I32 len, U32 hash)
 {
+    unshare_hek_or_pvn (NULL, str, len, hash);
+}
+
+
+void
+Perl_unshare_hek(pTHX_ HEK *hek)
+{
+    unshare_hek_or_pvn(hek, NULL, 0, 0);
+}
+
+/* possibly free a shared string if no one has access to it
+   hek if non-NULL takes priority over the other 3, else str, len and hash
+   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)
+{
     register XPVHV* xhv;
     register HE *entry;
     register HE **oentry;
     register I32 i = 1;
     I32 found = 0;
     bool is_utf8 = FALSE;
     register XPVHV* xhv;
     register HE *entry;
     register HE **oentry;
     register I32 i = 1;
     I32 found = 0;
     bool is_utf8 = FALSE;
+    int k_flags = 0;
     const char *save = str;
 
     const char *save = str;
 
-    if (len < 0) {
-      len = -len;
-      is_utf8 = TRUE;
-      if (!(PL_hints & HINT_UTF8_DISTINCT)) {
-         STRLEN tmplen = len;
-         /* See the note in hv_fetch(). --jhi */
-         str = (char*)bytes_from_utf8((U8*)str, &tmplen, &is_utf8);
-         len = tmplen;
-      }
+    if (hek) {
+        hash = HEK_HASH(hek);
+    } else if (len < 0) {
+        STRLEN tmplen = -len;
+        is_utf8 = TRUE;
+        /* See the note in hv_fetch(). --jhi */
+        str = (char*)bytes_from_utf8((U8*)str, &tmplen, &is_utf8);
+        len = tmplen;
+        if (is_utf8)
+            k_flags = HVhek_UTF8;
+        if (str != save)
+            k_flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
     }
 
     /* what follows is the moral equivalent of:
     }
 
     /* what follows is the moral equivalent of:
@@ -1604,31 +2117,48 @@ Perl_unsharepvn(pTHX_ const char *str, I32 len, U32 hash)
     LOCK_STRTAB_MUTEX;
     /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
     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, oentry = &HeNEXT(entry), entry = *oentry) {
-       if (HeHASH(entry) != hash)              /* strings can't be equal */
-           continue;
-       if (HeKLEN(entry) != len)
-           continue;
-       if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len)) /* is this it? */
-           continue;
-       if (HeKUTF8(entry) != (char)is_utf8)
-           continue;
-       found = 1;
-       if (--HeVAL(entry) == Nullsv) {
-           *oentry = HeNEXT(entry);
-           if (i && !*oentry)
-               xhv->xhv_fill--; /* HvFILL(hv)-- */
-           Safefree(HeKEY_hek(entry));
-           del_HE(entry);
-           xhv->xhv_keys--; /* HvKEYS(hv)-- */
-       }
-       break;
+    if (hek) {
+        for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
+            if (HeKEY_hek(entry) != hek)
+                continue;
+            found = 1;
+            break;
+        }
+    } else {
+        int flags_masked = k_flags & HVhek_MASK;
+        for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
+            if (HeHASH(entry) != hash)         /* strings can't be equal */
+                continue;
+            if (HeKLEN(entry) != len)
+                continue;
+            if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len))    /* is this it? */
+                continue;
+            if (HeKFLAGS(entry) != flags_masked)
+                continue;
+            found = 1;
+            break;
+        }
+    }
+
+    if (found) {
+        if (--HeVAL(entry) == Nullsv) {
+            *oentry = HeNEXT(entry);
+            if (i && !*oentry)
+                xhv->xhv_fill--; /* HvFILL(hv)-- */
+            Safefree(HeKEY_hek(entry));
+            del_HE(entry);
+            xhv->xhv_keys--; /* HvKEYS(hv)-- */
+        }
     }
     }
+
     UNLOCK_STRTAB_MUTEX;
     UNLOCK_STRTAB_MUTEX;
-    if (str != save)
-       Safefree(str);
     if (!found && ckWARN_d(WARN_INTERNAL))
     if (!found && ckWARN_d(WARN_INTERNAL))
-       Perl_warner(aTHX_ WARN_INTERNAL, "Attempt to free non-existent shared string '%s'",str);
+       Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
+                    "Attempt to free non-existent shared string '%s'%s",
+                    hek ? HEK_KEY(hek) : str,
+                    (k_flags & HVhek_UTF8) ? " (utf8)" : "");
+    if (k_flags & HVhek_FREEKEY)
+       Safefree(str);
 }
 
 /* get a (constant) string ptr from the global string table
 }
 
 /* get a (constant) string ptr from the global string table
@@ -1638,29 +2168,47 @@ Perl_unsharepvn(pTHX_ const char *str, I32 len, U32 hash)
 HEK *
 Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash)
 {
 HEK *
 Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash)
 {
-    register XPVHV* xhv;
-    register HE *entry;
-    register HE **oentry;
-    register I32 i = 1;
-    I32 found = 0;
     bool is_utf8 = FALSE;
     bool is_utf8 = FALSE;
+    int flags = 0;
     const char *save = str;
 
     if (len < 0) {
     const char *save = str;
 
     if (len < 0) {
-      len = -len;
+      STRLEN tmplen = -len;
       is_utf8 = TRUE;
       is_utf8 = TRUE;
-      if (!(PL_hints & HINT_UTF8_DISTINCT)) {
-         STRLEN tmplen = len;
-         /* See the note in hv_fetch(). --jhi */
-         str = (char*)bytes_from_utf8((U8*)str, &tmplen, &is_utf8);
-         len = tmplen;
-      }
+      /* See the note in hv_fetch(). --jhi */
+      str = (char*)bytes_from_utf8((U8*)str, &tmplen, &is_utf8);
+      len = tmplen;
+      /* If we were able to downgrade here, then than means that we were passed
+         in a key which only had chars 0-255, but was utf8 encoded.  */
+      if (is_utf8)
+          flags = HVhek_UTF8;
+      /* If we found we were able to downgrade the string to bytes, then
+         we should flag that it needs upgrading on keys or each.  Also flag
+         that we need share_hek_flags to free the string.  */
+      if (str != save)
+          flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
     }
 
     }
 
+    return share_hek_flags (str, len, hash, 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 I32 i = 1;
+    I32 found = 0;
+    int flags_masked = flags & HVhek_MASK;
+
     /* what follows is the moral equivalent of:
 
     if (!(Svp = hv_fetch(PL_strtab, str, len, FALSE)))
     /* what follows is the moral equivalent of:
 
     if (!(Svp = hv_fetch(PL_strtab, str, len, FALSE)))
-       hv_store(PL_strtab, str, len, Nullsv, hash);
+       hv_store(PL_strtab, str, len, Nullsv, hash);
+
+       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);
     /* assert(xhv_array != 0) */
     */
     xhv = (XPVHV*)SvANY(PL_strtab);
     /* assert(xhv_array != 0) */
@@ -1674,28 +2222,100 @@ Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash)
            continue;
        if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len)) /* is this it? */
            continue;
            continue;
        if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len)) /* is this it? */
            continue;
-       if (HeKUTF8(entry) != (char)is_utf8)
+       if (HeKFLAGS(entry) != flags_masked)
            continue;
        found = 1;
        break;
     }
     if (!found) {
        entry = new_HE();
            continue;
        found = 1;
        break;
     }
     if (!found) {
        entry = new_HE();
-       HeKEY_hek(entry) = save_hek(str, is_utf8?-len:len, hash);
+       HeKEY_hek(entry) = save_hek_flags(str, len, hash, flags);
        HeVAL(entry) = Nullsv;
        HeNEXT(entry) = *oentry;
        *oentry = entry;
        xhv->xhv_keys++; /* HvKEYS(hv)++ */
        if (i) {                                /* initial entry? */
            xhv->xhv_fill++; /* HvFILL(hv)++ */
        HeVAL(entry) = Nullsv;
        HeNEXT(entry) = *oentry;
        *oentry = entry;
        xhv->xhv_keys++; /* HvKEYS(hv)++ */
        if (i) {                                /* initial entry? */
            xhv->xhv_fill++; /* HvFILL(hv)++ */
-           if (xhv->xhv_keys > xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */)
+       } else if (xhv->xhv_keys > (IV)xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */) {
                hsplit(PL_strtab);
        }
     }
 
     ++HeVAL(entry);                            /* use value slot as REFCNT */
     UNLOCK_STRTAB_MUTEX;
                hsplit(PL_strtab);
        }
     }
 
     ++HeVAL(entry);                            /* use value slot as REFCNT */
     UNLOCK_STRTAB_MUTEX;
-    if (str != save)
+
+    if (flags & HVhek_FREEKEY)
        Safefree(str);
        Safefree(str);
+
     return HeKEY_hek(entry);
 }
     return HeKEY_hek(entry);
 }
+
+
+/*
+=for apidoc hv_assert
+
+Check that a hash is in an internally consistent state.
+
+=cut
+*/
+
+void
+Perl_hv_assert(pTHX_ HV *hv)
+{
+  HE* entry;
+  int withflags = 0;
+  int placeholders = 0;
+  int real = 0;
+  int bad = 0;
+  I32 riter = HvRITER(hv);
+  HE *eiter = HvEITER(hv);
+
+  (void)hv_iterinit(hv);
+
+  while ((entry = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))) {
+    /* sanity check the values */
+    if (HeVAL(entry) == &PL_sv_placeholder) {
+      placeholders++;
+    } else {
+      real++;
+    }
+    /* sanity check the keys */
+    if (HeSVKEY(entry)) {
+      /* Don't know what to check on SV keys.  */
+    } else if (HeKUTF8(entry)) {
+      withflags++;
+       if (HeKWASUTF8(entry)) {
+        PerlIO_printf(Perl_debug_log,
+                      "hash key has both WASUFT8 and UTF8: '%.*s'\n",
+                      (int) HeKLEN(entry),  HeKEY(entry));
+        bad = 1;
+       }
+    } else if (HeKWASUTF8(entry)) {
+      withflags++;
+    }
+  }
+  if (!SvTIED_mg((SV*)hv, PERL_MAGIC_tied)) {
+    if (HvUSEDKEYS(hv) != real) {
+      PerlIO_printf(Perl_debug_log, "Count %d key(s), but hash reports %d\n",
+                   (int) real, (int) HvUSEDKEYS(hv));
+      bad = 1;
+    }
+    if (HvPLACEHOLDERS(hv) != placeholders) {
+      PerlIO_printf(Perl_debug_log,
+                   "Count %d placeholder(s), but hash reports %d\n",
+                   (int) placeholders, (int) HvPLACEHOLDERS(hv));
+      bad = 1;
+    }
+  }
+  if (withflags && ! HvHASKFLAGS(hv)) {
+    PerlIO_printf(Perl_debug_log,
+                 "Hash has HASKFLAGS off but I count %d key(s) with flags\n",
+                 withflags);
+    bad = 1;
+  }
+  if (bad) {
+    sv_dump((SV *)hv);
+  }
+  HvRITER(hv) = riter;         /* Restore hash iterator state */
+  HvEITER(hv) = eiter;
+}
Unnamed repository; edit this file 'description' to name the repository.