This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
HP-UX 10.20 still *needs* -Ae for HP C-ANSI-C to be ANSI
[perl5.git] / hv.c
diff --git a/hv.c b/hv.c
index da1f487..ca945f6 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1,7 +1,7 @@
 /*    hv.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 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.
@@ -80,6 +80,7 @@ S_more_he(pTHX)
 STATIC HEK *
 S_save_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags)
 {
+    int flags_masked = flags & HVhek_MASK;
     char *k;
     register HEK *hek;
 
@@ -89,7 +90,10 @@ S_save_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags)
     HEK_KEY(hek)[len] = 0;
     HEK_LEN(hek) = len;
     HEK_HASH(hek) = hash;
-    HEK_FLAGS(hek) = (unsigned char)flags;
+    HEK_FLAGS(hek) = (unsigned char)flags_masked;
+
+    if (flags & HVhek_FREEKEY)
+       Safefree(str);
     return hek;
 }
 
@@ -168,6 +172,126 @@ S_hv_notallowed(pTHX_ int flags, const char *key, I32 klen,
 /* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
  * contains an SV* */
 
+#define HV_FETCH_ISSTORE   0x01
+#define HV_FETCH_ISEXISTS  0x02
+#define HV_FETCH_LVALUE    0x04
+#define HV_FETCH_JUST_SV   0x08
+
+/*
+=for apidoc hv_store
+
+Stores an SV in a hash.  The hash key is specified as C<key> and C<klen> is
+the length of the key.  The C<hash> parameter is the precomputed hash
+value; if it is zero then Perl will compute it.  The return value will be
+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
+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.
+
+=cut
+*/
+
+SV**
+Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen_i32, SV *val, U32 hash)
+{
+    HE *hek;
+    STRLEN klen;
+    int flags;
+
+    if (klen_i32 < 0) {
+       klen = -klen_i32;
+       flags = HVhek_UTF8;
+    } else {
+       klen = klen_i32;
+       flags = 0;
+    }
+    hek = hv_fetch_common (hv, NULL, key, klen, flags,
+                          (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, 0);
+    return hek ? &HeVAL(hek) : NULL;
+}
+
+SV**
+Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val,
+                 register U32 hash, int flags)
+{
+    HE *hek = hv_fetch_common (hv, NULL, key, klen, flags,
+                              (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
+    return hek ? &HeVAL(hek) : NULL;
+}
+
+/*
+=for apidoc hv_store_ent
+
+Stores C<val> in a hash.  The hash key is specified as C<key>.  The C<hash>
+parameter is the precomputed hash value; if it is zero then Perl will
+compute it.  The return value is the new hash entry so created.  It will be
+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 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
+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.
+
+=cut
+*/
+
+HE *
+Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash)
+{
+  return hv_fetch_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISSTORE, val, hash);
+}
+
+/*
+=for apidoc hv_exists
+
+Returns a boolean indicating whether the specified hash key exists.  The
+C<klen> is the length of the key.
+
+=cut
+*/
+
+bool
+Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen_i32)
+{
+    STRLEN klen;
+    int flags;
+
+    if (klen_i32 < 0) {
+       klen = -klen_i32;
+       flags = HVhek_UTF8;
+    } else {
+       klen = klen_i32;
+       flags = 0;
+    }
+    return hv_fetch_common(hv, NULL, key, klen, flags, HV_FETCH_ISEXISTS, 0, 0)
+       ? TRUE : FALSE;
+}
+
 /*
 =for apidoc hv_fetch
 
@@ -182,11 +306,6 @@ information on how to use this function on tied hashes.
 =cut
 */
 
-#define HV_FETCH_ISSTORE   0x01
-#define HV_FETCH_ISEXISTS  0x02
-#define HV_FETCH_LVALUE    0x04
-#define HV_FETCH_JUST_SV   0x08
-
 SV**
 Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 lval)
 {
@@ -207,6 +326,23 @@ Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 lval)
     return hek ? &HeVAL(hek) : NULL;
 }
 
+/*
+=for apidoc hv_exists_ent
+
+Returns a boolean indicating whether the specified hash key exists. C<hash>
+can be a valid precomputed hash value, or 0 to ask for it to be
+computed.
+
+=cut
+*/
+
+bool
+Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
+{
+    return hv_fetch_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISEXISTS, 0, hash)
+       ? TRUE : FALSE;
+}
+
 /* returns an HE * structure with the all fields set */
 /* note that hent_val will be a mortal sv for MAGICAL hashes */
 /*
@@ -233,7 +369,7 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
                           (lval ? HV_FETCH_LVALUE : 0), Nullsv, hash);
 }
 
-HE *
+STATIC HE *
 S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                  int flags, int action, SV *val, register U32 hash)
 {
@@ -249,6 +385,8 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
        return 0;
 
     if (keysv) {
+       if (flags & HVhek_FREEKEY)
+           Safefree(key);
        key = SvPV(keysv, klen);
        flags = 0;
        is_utf8 = (SvUTF8(keysv) != 0);
@@ -305,25 +443,28 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                U32 i;
                for (i = 0; i < klen; ++i)
                    if (isLOWER(key[i])) {
-                       const char *keysave = key;
-                       /* Will need to free this, so set FREEKEY flag
-                          on call to hv_fetch_common.  */
-                       key = savepvn(key,klen);
-                       key = (const char*)strupr((char*)key);
-
-                       if (flags & HVhek_FREEKEY)
-                           Safefree(keysave);
-
-                       /* This isn't strictly the same as the old hv_fetch
-                          magic, which made a call to hv_fetch, followed
-                          by a call to hv_store if that failed and lvalue
-                          was true.
-                          Which I believe could have been done by simply
-                          passing the lvalue through to the first hv_fetch.
-                          So I will do that here.  */
-                       return hv_fetch_common(hv, Nullsv, key, klen,
-                                              HVhek_FREEKEY,
-                                              action, Nullsv, 0);
+                       /* Would be nice if we had a routine to do the
+                          copy and upercase in a single pass through.  */
+                       char *nkey = strupr(savepvn(key,klen));
+                       /* Note that this fetch is for nkey (the uppercased
+                          key) whereas the store is for key (the original)  */
+                       entry = hv_fetch_common(hv, Nullsv, nkey, klen,
+                                               HVhek_FREEKEY, /* free nkey */
+                                               0 /* non-LVAL fetch */,
+                                               Nullsv /* no value */,
+                                               0 /* compute hash */);
+                       if (!entry && (action & HV_FETCH_LVALUE)) {
+                           /* This call will free key if necessary.
+                              Do it this way to encourage compiler to tail
+                              call optimise.  */
+                           entry = hv_fetch_common(hv, keysv, key, klen,
+                                                   flags, HV_FETCH_ISSTORE,
+                                                   NEWSV(61,0), hash);
+                       } else {
+                           if (flags & HVhek_FREEKEY)
+                               Safefree(key);
+                       }
+                       return entry;
                    }
            }
 #endif
@@ -479,9 +620,8 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     else
 #endif
     {
-       /* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
-       oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
-       entry = *oentry;
+       /* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
+       entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
     }
     for (; entry; ++n_links, entry = HeNEXT(entry)) {
        if (HeHASH(entry) != hash)              /* strings can't be equal */
@@ -551,13 +691,14 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
        return 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)) {
+    if (!(action & HV_FETCH_ISSTORE) 
+       && SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
        unsigned long len;
        char *env = PerlEnv_ENVgetenv_len(key,&len);
        if (env) {
            sv = newSVpvn(env,len);
            SvTAINTED_on(sv);
-           return hv_fetch_common(hv,keysv,key,keylen,HV_FETCH_ISSTORE,sv,
+           return hv_fetch_common(hv,keysv,key,klen,flags,HV_FETCH_ISSTORE,sv,
                                   hash);
        }
     }
@@ -590,16 +731,17 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 
     /* Welcome to hv_store...  */
 
-    if (!oentry) {
+    if (!xhv->xhv_array) {
        /* Not sure if we can get here.  I think the only case of oentry being
           NULL is for %ENV with dynamic env fetch.  But that should disappear
           with magic in the previous code.  */
        Newz(503, xhv->xhv_array /* HvARRAY(hv) */,
             PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
             char);
-       oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
     }
 
+    oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
+
     entry = new_HE();
     /* share_hek_flags will do the free for us.  This might be considered
        bad API design.  */
@@ -653,92 +795,32 @@ S_hv_magic_check(pTHX_ HV *hv, bool *needs_copy, bool *needs_store)
 }
 
 /*
-=for apidoc hv_store
-
-Stores an SV in a hash.  The hash key is specified as C<key> and C<klen> is
-the length of the key.  The C<hash> parameter is the precomputed hash
-value; if it is zero then Perl will compute it.  The return value will be
-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
-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.
-
-=cut
-*/
-
-SV**
-Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen_i32, SV *val, U32 hash)
-{
-    HE *hek;
-    STRLEN klen;
-    int flags;
-
-    if (klen_i32 < 0) {
-       klen = -klen_i32;
-       flags = HVhek_UTF8;
-    } else {
-       klen = klen_i32;
-       flags = 0;
-    }
-    hek = hv_fetch_common (hv, NULL, key, klen, flags,
-                          (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, 0);
-    return hek ? &HeVAL(hek) : NULL;
-}
-
-SV**
-Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val,
-                 register U32 hash, int flags)
-{
-    HE *hek = hv_fetch_common (hv, NULL, key, klen, flags,
-                              (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
-    return hek ? &HeVAL(hek) : NULL;
-}
-
-/*
-=for apidoc hv_store_ent
-
-Stores C<val> in a hash.  The hash key is specified as C<key>.  The C<hash>
-parameter is the precomputed hash value; if it is zero then Perl will
-compute it.  The return value is the new hash entry so created.  It will be
-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 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
-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.
+=for apidoc hv_scalar
 
-See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
-information on how to use this function on tied hashes.
+Evaluates the hash in scalar context and returns the result. Handles magic when the hash is tied.
 
 =cut
 */
 
-HE *
-Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash)
+SV *
+Perl_hv_scalar(pTHX_ HV *hv)
 {
-  return hv_fetch_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISSTORE, val, hash);
+    MAGIC *mg;
+    SV *sv;
+    
+    if ((SvRMAGICAL(hv) && (mg = mg_find((SV*)hv, PERL_MAGIC_tied)))) {
+        sv = magic_scalarpack(hv, mg);
+        return sv;
+    } 
+
+    sv = sv_newmortal();
+    if (HvFILL((HV*)hv)) 
+        Perl_sv_setpvf(aTHX_ sv, "%ld/%ld",
+                (long)HvFILL(hv), (long)HvMAX(hv) + 1);
+    else
+        sv_setiv(sv, 0);
+    
+    return sv;
 }
 
 /*
@@ -784,7 +866,7 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
     return hv_delete_common(hv, keysv, NULL, 0, 0, flags, hash);
 }
 
-SV *
+STATIC SV *
 S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                   int k_flags, I32 d_flags, U32 hash)
 {
@@ -800,6 +882,8 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
        return Nullsv;
 
     if (keysv) {
+       if (k_flags & HVhek_FREEKEY)
+           Safefree(key);
        key = SvPV(keysv, klen);
        k_flags = 0;
        is_utf8 = (SvUTF8(keysv) != 0);
@@ -829,22 +913,20 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                    }           
                    return Nullsv;              /* element cannot be deleted */
                }
-           }
 #ifdef ENV_IS_CASELESS
-           else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
-               /* XXX This code isn't UTF8 clean.  */
-               keysv = sv_2mortal(newSVpvn(key,klen));
-               key = strupr(SvPVX(keysv));
-
-                if (k_flags & HVhek_FREEKEY) {
-                    Safefree(keysave);
+               else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
+                   /* XXX This code isn't UTF8 clean.  */
+                   keysv = sv_2mortal(newSVpvn(key,klen));
+                   if (k_flags & HVhek_FREEKEY) {
+                       Safefree(key);
+                   }
+                   key = strupr(SvPVX(keysv));
+                   is_utf8 = 0;
+                   k_flags = 0;
+                   hash = 0;
                }
-
-               is_utf8 = 0;
-               k_flags = 0;
-               hash = 0;
-           }
 #endif
+           }
        }
     }
     xhv = (XPVHV*)SvANY(hv);
@@ -878,7 +960,6 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
         } else {
             PERL_HASH(hash, key, klen);
         }
-       PERL_HASH(hash, key, klen);
     }
 
     masked_flags = (k_flags & HVhek_MASK);
@@ -896,34 +977,21 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
            continue;
        if ((HeKFLAGS(entry) ^ masked_flags) & HVhek_UTF8)
            continue;
-        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;
+         if (k_flags & HVhek_FREEKEY)
+            Safefree(key);
+         return Nullsv;
        }
        else if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
            S_hv_notallowed(aTHX_ k_flags, key, klen,
                            "delete readonly key '%"SVf"' from"
                            );
        }
+        if (k_flags & HVhek_FREEKEY)
+            Safefree(key);
 
        if (d_flags & G_DISCARD)
            sv = Nullsv;
@@ -939,6 +1007,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
         * an error.
         */
        if (SvREADONLY(hv)) {
+           SvREFCNT_dec(HeVAL(entry));
            HeVAL(entry) = &PL_sv_placeholder;
            /* We'll be saving this slot, so the number of allocated keys
             * doesn't go down, but the number placeholders goes up */
@@ -968,49 +1037,6 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     return Nullsv;
 }
 
-/*
-=for apidoc hv_exists
-
-Returns a boolean indicating whether the specified hash key exists.  The
-C<klen> is the length of the key.
-
-=cut
-*/
-
-bool
-Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen_i32)
-{
-    STRLEN klen;
-    int flags;
-
-    if (klen_i32 < 0) {
-       klen = -klen_i32;
-       flags = HVhek_UTF8;
-    } else {
-       klen = klen_i32;
-       flags = 0;
-    }
-    return hv_fetch_common(hv, NULL, key, klen, flags, HV_FETCH_ISEXISTS, 0, 0)
-       ? TRUE : FALSE;
-}
-
-/*
-=for apidoc hv_exists_ent
-
-Returns a boolean indicating whether the specified hash key exists. C<hash>
-can be a valid precomputed hash value, or 0 to ask for it to be
-computed.
-
-=cut
-*/
-
-bool
-Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
-{
-    return hv_fetch_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISEXISTS, 0, hash)
-       ? TRUE : FALSE;
-}
-
 STATIC void
 S_hsplit(pTHX_ HV *hv)
 {
@@ -1026,6 +1052,17 @@ S_hsplit(pTHX_ HV *hv)
     int longest_chain = 0;
     int was_shared;
 
+    /*PerlIO_printf(PerlIO_stderr(), "hsplit called for %p which had %d\n",
+      hv, (int) oldsize);*/
+
+    if (HvPLACEHOLDERS(hv) && !SvREADONLY(hv)) {
+      /* Can make this clear any placeholders first for non-restricted hashes,
+        even though Storable rebuilds restricted hashes by putting in all the
+        placeholders (first) before turning on the readonly flag, because
+        Storable always pre-splits the hash.  */
+      hv_clear_placeholders(hv);
+    }
+              
     PL_nomemok = TRUE;
 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
     Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
@@ -1422,7 +1459,7 @@ Perl_hv_clear(pTHX_ HV *hv)
                }
            }
        }
-       return;
+       goto reset;
     }
 
     hfreeentries(hv);
@@ -1436,6 +1473,8 @@ Perl_hv_clear(pTHX_ HV *hv)
 
     HvHASKFLAGS_off(hv);
     HvREHASH_off(hv);
+    reset:
+    HvEITER(hv) = NULL;
 }
 
 /*
@@ -1455,42 +1494,48 @@ See Hash::Util::lock_keys() for an example of its use.
 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;
-    }
+    I32 items = (I32)HvPLACEHOLDERS(hv);
+    I32 i = HvMAX(hv);
+
+    if (items == 0)
+       return;
+
+    do {
+       /* Loop down the linked list heads  */
+       int first = 1;
+       HE **oentry = &(HvARRAY(hv))[i];
+       HE *entry = *oentry;
+
+       if (!entry)
+           continue;
+
+       for (; entry; entry = *oentry) {
+           if (HeVAL(entry) == &PL_sv_placeholder) {
+               *oentry = HeNEXT(entry);
+               if (first && !*oentry)
+                   HvFILL(hv)--; /* This linked list is now empty.  */
+               if (HvEITER(hv))
+                   HvLAZYDEL_on(hv);
+               else
+                   hv_free_ent(hv, entry);
+
+               if (--items == 0) {
+                   /* Finished.  */
+                   HvTOTALKEYS(hv) -= HvPLACEHOLDERS(hv);
+                   if (HvKEYS(hv) == 0)
+                       HvHASKFLAGS_off(hv);
+                   HvPLACEHOLDERS(hv) = 0;
+                   return;
+               }
+           } else {
+               oentry = &HeNEXT(entry);
+               first = 0;
+           }
+       }
+    } while (--i >= 0);
+    /* You can't get here, hence assertion should always fail.  */
+    assert (items == 0);
+    assert (0);
 }
 
 STATIC void
@@ -1971,9 +2016,10 @@ S_unshare_hek_or_pvn(pTHX_ HEK *hek, const char *str, I32 len, U32 hash)
     UNLOCK_STRTAB_MUTEX;
     if (!found && ckWARN_d(WARN_INTERNAL))
        Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
-                    "Attempt to free non-existent shared string '%s'%s",
+                    "Attempt to free non-existent shared string '%s'%s"
+                    pTHX__FORMAT,
                     hek ? HEK_KEY(hek) : str,
-                    (k_flags & HVhek_UTF8) ? " (utf8)" : "");
+                    ((k_flags & HVhek_UTF8) ? " (utf8)" : "") pTHX__VALUE);
     if (k_flags & HVhek_FREEKEY)
        Safefree(str);
 }
@@ -2046,7 +2092,7 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
     }
     if (!found) {
        entry = new_HE();
-       HeKEY_hek(entry) = save_hek_flags(str, len, hash, flags);
+       HeKEY_hek(entry) = save_hek_flags(str, len, hash, flags_masked);
        HeVAL(entry) = Nullsv;
        HeNEXT(entry) = *oentry;
        *oentry = entry;