X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/bdee33e435b03e47d573fcaecde743ced828beef..9f815e241cf04d04fc645970753438216a0ed024:/hv.c

diff --git a/hv.c b/hv.c
index 6d7c25a..cabaac7 100644
--- 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, 2004, 2005, 2006, 2007, by Larry Wall and others
+ *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
+ *    2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 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.
@@ -9,7 +9,11 @@
  */
 
 /*
- * "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
+ *
+ *     [p.278 of _The Lord of the Rings_, II/iii: "The Ring Goes South"]
  */
 
 /* 
@@ -40,8 +44,11 @@ STATIC void
 S_more_he(pTHX)
 {
     dVAR;
-    HE* he = (HE*) Perl_get_arena(aTHX_ PERL_ARENA_SIZE, HE_SVSLOT);
-    HE * const heend = &he[PERL_ARENA_SIZE / sizeof(HE) - 1];
+    /* We could generate this at compile time via (another) auxiliary C
+       program?  */
+    const size_t arena_size = Perl_malloc_good_size(PERL_ARENA_SIZE);
+    HE* he = (HE*) Perl_get_arena(aTHX_ arena_size, HE_SVSLOT);
+    HE * const heend = &he[arena_size / sizeof(HE) - 1];
 
     PL_body_roots[HE_SVSLOT] = he;
     while (he < heend) {
@@ -91,6 +98,8 @@ S_save_hek_flags(const char *str, I32 len, U32 hash, int flags)
     char *k;
     register HEK *hek;
 
+    PERL_ARGS_ASSERT_SAVE_HEK_FLAGS;
+
     Newx(k, HEK_BASESIZE + len + 2, char);
     hek = (HEK*)k;
     Copy(str, HEK_KEY(hek), len, char);
@@ -125,10 +134,15 @@ Perl_free_tied_hv_pool(pTHX)
 HEK *
 Perl_hek_dup(pTHX_ HEK *source, CLONE_PARAMS* param)
 {
-    HEK *shared = (HEK*)ptr_table_fetch(PL_ptr_table, source);
+    HEK *shared;
 
+    PERL_ARGS_ASSERT_HEK_DUP;
     PERL_UNUSED_ARG(param);
 
+    if (!source)
+	return NULL;
+
+    shared = (HEK*)ptr_table_fetch(PL_ptr_table, source);
     if (shared) {
 	/* We already shared this hash key.  */
 	(void)share_hek_hek(shared);
@@ -147,6 +161,8 @@ Perl_he_dup(pTHX_ const HE *e, bool shared, CLONE_PARAMS* param)
 {
     HE *ret;
 
+    PERL_ARGS_ASSERT_HE_DUP;
+
     if (!e)
 	return NULL;
     /* look for it in the table first */
@@ -161,7 +177,7 @@ Perl_he_dup(pTHX_ const HE *e, bool shared, CLONE_PARAMS* param)
     HeNEXT(ret) = he_dup(HeNEXT(e),shared, param);
     if (HeKLEN(e) == HEf_SVKEY) {
 	char *k;
-	Newx(k, HEK_BASESIZE + sizeof(SV*), char);
+	Newx(k, HEK_BASESIZE + sizeof(const SV *), char);
 	HeKEY_hek(ret) = (HEK*)k;
 	HeKEY_sv(ret) = SvREFCNT_inc(sv_dup(HeKEY_sv(e), param));
     }
@@ -196,6 +212,9 @@ S_hv_notallowed(pTHX_ int flags, const char *key, I32 klen,
 		const char *msg)
 {
     SV * const sv = sv_newmortal();
+
+    PERL_ARGS_ASSERT_HV_NOTALLOWED;
+
     if (!(flags & HVhek_FREEKEY)) {
 	sv_setpvn(sv, key, klen);
     }
@@ -236,39 +255,6 @@ 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, hash);
-    return hek ? &HeVAL(hek) : NULL;
-}
-
-/* XXX This looks like an ideal candidate to inline */
-SV**
-Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val,
-                 register U32 hash, int flags)
-{
-    HE * const hek = hv_fetch_common (hv, NULL, key, klen, flags,
-			       (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
-    return hek ? &HeVAL(hek) : NULL;
-}
-
-/*
 =for apidoc hv_store_ent
 
 Stores C<val> in a hash.  The hash key is specified as C<key>.  The C<hash>
@@ -294,43 +280,11 @@ 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
-*/
-
-/* XXX This looks like an ideal candidate to inline */
-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
 
 Returns the SV which corresponds to the specified key in the hash.  The
@@ -341,30 +295,6 @@ 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.
 
-=cut
-*/
-
-SV**
-Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 lval)
-{
-    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,
-			   lval ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) : HV_FETCH_JUST_SV,
-			   NULL, 0);
-    return hek ? &HeVAL(hek) : NULL;
-}
-
-/*
 =for apidoc hv_exists_ent
 
 Returns a boolean indicating whether the specified hash key exists. C<hash>
@@ -374,14 +304,6 @@ computed.
 =cut
 */
 
-/* XXX This looks like an ideal candidate to inline */
-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 */
 /*
@@ -401,16 +323,29 @@ information on how to use this function on tied hashes.
 =cut
 */
 
-HE *
-Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
+/* Common code for hv_delete()/hv_exists()/hv_fetch()/hv_store()  */
+void *
+Perl_hv_common_key_len(pTHX_ HV *hv, const char *key, I32 klen_i32,
+		       const int action, SV *val, const U32 hash)
 {
-    return hv_fetch_common(hv, keysv, NULL, 0, 0, 
-			   (lval ? HV_FETCH_LVALUE : 0), NULL, hash);
+    STRLEN klen;
+    int flags;
+
+    PERL_ARGS_ASSERT_HV_COMMON_KEY_LEN;
+
+    if (klen_i32 < 0) {
+	klen = -klen_i32;
+	flags = HVhek_UTF8;
+    } else {
+	klen = klen_i32;
+	flags = 0;
+    }
+    return hv_common(hv, NULL, key, klen, flags, action, val, hash);
 }
 
-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)
+void *
+Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
+	       int flags, int action, SV *val, register U32 hash)
 {
     dVAR;
     XPVHV* xhv;
@@ -419,46 +354,75 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     SV *sv;
     bool is_utf8;
     int masked_flags;
+    const int return_svp = action & HV_FETCH_JUST_SV;
 
     if (!hv)
 	return NULL;
+    if (SvTYPE(hv) == SVTYPEMASK)
+	return NULL;
+
+    assert(SvTYPE(hv) == SVt_PVHV);
 
     if (SvSMAGICAL(hv) && SvGMAGICAL(hv) && !(action & HV_DISABLE_UVAR_XKEY)) {
-	keysv = hv_magic_uvar_xkey(hv, keysv, key, klen, flags, action);
-	/* If a fetch-as-store fails on the fetch, then the action is to
-	   recurse once into "hv_store". If we didn't do this, then that
-	   recursive call would call the key conversion routine again.
-	   However, as we replace the original key with the converted
-	   key, this would result in a double conversion, which would show
-	   up as a bug if the conversion routine is not idempotent.  */
+	MAGIC* mg;
+	if ((mg = mg_find((const SV *)hv, PERL_MAGIC_uvar))) {
+	    struct ufuncs * const uf = (struct ufuncs *)mg->mg_ptr;
+	    if (uf->uf_set == NULL) {
+		SV* obj = mg->mg_obj;
+
+		if (!keysv) {
+		    keysv = newSVpvn_flags(key, klen, SVs_TEMP |
+					   ((flags & HVhek_UTF8)
+					    ? SVf_UTF8 : 0));
+		}
+		
+		mg->mg_obj = keysv;         /* pass key */
+		uf->uf_index = action;      /* pass action */
+		magic_getuvar(MUTABLE_SV(hv), mg);
+		keysv = mg->mg_obj;         /* may have changed */
+		mg->mg_obj = obj;
+
+		/* If the key may have changed, then we need to invalidate
+		   any passed-in computed hash value.  */
+		hash = 0;
+	    }
+	}
     }
     if (keysv) {
 	if (flags & HVhek_FREEKEY)
 	    Safefree(key);
 	key = SvPV_const(keysv, klen);
-	flags = 0;
 	is_utf8 = (SvUTF8(keysv) != 0);
+	if (SvIsCOW_shared_hash(keysv)) {
+	    flags = HVhek_KEYCANONICAL | (is_utf8 ? HVhek_UTF8 : 0);
+	} else {
+	    flags = 0;
+	}
     } else {
 	is_utf8 = ((flags & HVhek_UTF8) ? TRUE : FALSE);
     }
 
+    if (action & HV_DELETE) {
+	return (void *) hv_delete_common(hv, keysv, key, klen,
+					 flags | (is_utf8 ? HVhek_UTF8 : 0),
+					 action, hash);
+    }
+
     xhv = (XPVHV*)SvANY(hv);
     if (SvMAGICAL(hv)) {
 	if (SvRMAGICAL(hv) && !(action & (HV_FETCH_ISSTORE|HV_FETCH_ISEXISTS))) {
-	    if ( mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv))
+	    if (mg_find((const SV *)hv, PERL_MAGIC_tied)
+		|| SvGMAGICAL((const SV *)hv))
 	    {
-		/* XXX should be able to skimp on the HE/HEK here when
+		/* FIXME 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 = newSVpvn_utf8(key, klen, is_utf8);
+  		} else {
 		    keysv = newSVsv(keysv);
 		}
                 sv = sv_newmortal();
-                mg_copy((SV*)hv, sv, (char *)keysv, HEf_SVKEY);
+                mg_copy(MUTABLE_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;
@@ -467,7 +431,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 		else {
 		    char *k;
 		    entry = new_HE();
-		    Newx(k, HEK_BASESIZE + sizeof(SV*), char);
+		    Newx(k, HEK_BASESIZE + sizeof(const SV *), char);
 		    HeKEY_hek(entry) = (HEK*)k;
 		}
 		HeNEXT(entry) = NULL;
@@ -476,16 +440,19 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 		sv_upgrade(sv, SVt_PVLV);
 		LvTYPE(sv) = 'T';
 		 /* so we can free entry when freeing sv */
-		LvTARG(sv) = (SV*)entry;
+		LvTARG(sv) = MUTABLE_SV(entry);
 
 		/* XXX remove at some point? */
 		if (flags & HVhek_FREEKEY)
 		    Safefree(key);
 
-		return entry;
+		if (return_svp) {
+		    return entry ? (void *) &HeVAL(entry) : NULL;
+		}
+		return (void *) entry;
 	    }
 #ifdef ENV_IS_CASELESS
-	    else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
+	    else if (mg_find((const SV *)hv, PERL_MAGIC_env)) {
 		U32 i;
 		for (i = 0; i < klen; ++i)
 		    if (isLOWER(key[i])) {
@@ -494,32 +461,34 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 			const char * const 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, NULL, nkey, klen,
-						HVhek_FREEKEY, /* free nkey */
-						0 /* non-LVAL fetch */
-						| HV_DISABLE_UVAR_XKEY,
-						NULL /* no value */,
-						0 /* compute hash */);
-			if (!entry && (action & HV_FETCH_LVALUE)) {
+			void *result = hv_common(hv, NULL, nkey, klen,
+						 HVhek_FREEKEY, /* free nkey */
+						 0 /* non-LVAL fetch */
+						 | HV_DISABLE_UVAR_XKEY
+						 | return_svp,
+						 NULL /* no value */,
+						 0 /* compute hash */);
+			if (!result && (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
-						    | HV_DISABLE_UVAR_XKEY,
-						    newSV(0), hash);
+			    result = hv_common(hv, keysv, key, klen, flags,
+					       HV_FETCH_ISSTORE
+					       | HV_DISABLE_UVAR_XKEY
+					       | return_svp,
+					       newSV(0), hash);
 			} else {
 			    if (flags & HVhek_FREEKEY)
 				Safefree(key);
 			}
-			return entry;
+			return result;
 		    }
 	    }
 #endif
 	} /* ISFETCH */
 	else if (SvRMAGICAL(hv) && (action & HV_FETCH_ISEXISTS)) {
-	    if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
+	    if (mg_find((const SV *)hv, PERL_MAGIC_tied)
+		|| SvGMAGICAL((const SV *)hv)) {
 		/* I don't understand why hv_exists_ent has svret and sv,
 		   whereas hv_exists only had one.  */
 		SV * const svret = sv_newmortal();
@@ -527,14 +496,13 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 
 		if (keysv || is_utf8) {
 		    if (!keysv) {
-			keysv = newSVpvn(key, klen);
-			SvUTF8_on(keysv);
+			keysv = newSVpvn_utf8(key, klen, TRUE);
 		    } else {
 			keysv = newSVsv(keysv);
 		    }
-		    mg_copy((SV*)hv, sv, (char *)sv_2mortal(keysv), HEf_SVKEY);
+		    mg_copy(MUTABLE_SV(hv), sv, (char *)sv_2mortal(keysv), HEf_SVKEY);
 		} else {
-		    mg_copy((SV*)hv, sv, key, klen);
+		    mg_copy(MUTABLE_SV(hv), sv, key, klen);
 		}
 		if (flags & HVhek_FREEKEY)
 		    Safefree(key);
@@ -542,10 +510,10 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 		/* This cast somewhat evil, but I'm merely using NULL/
 		   not NULL to return the boolean exists.
 		   And I know hv is not NULL.  */
-		return SvTRUE(svret) ? (HE *)hv : NULL;
+		return SvTRUE(svret) ? (void *)hv : NULL;
 		}
 #ifdef ENV_IS_CASELESS
-	    else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
+	    else if (mg_find((const SV *)hv, PERL_MAGIC_env)) {
 		/* XXX This code isn't UTF8 clean.  */
 		char * const keysave = (char * const)key;
 		/* Will need to free this, so set FREEKEY flag.  */
@@ -570,15 +538,14 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 		const bool save_taint = PL_tainted;
 		if (keysv || is_utf8) {
 		    if (!keysv) {
-			keysv = newSVpvn(key, klen);
-			SvUTF8_on(keysv);
+			keysv = newSVpvn_utf8(key, klen, TRUE);
 		    }
 		    if (PL_tainting)
 			PL_tainted = SvTAINTED(keysv);
 		    keysv = sv_2mortal(newSVsv(keysv));
-		    mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
+		    mg_copy(MUTABLE_SV(hv), val, (char*)keysv, HEf_SVKEY);
 		} else {
-		    mg_copy((SV*)hv, val, key, klen);
+		    mg_copy(MUTABLE_SV(hv), val, key, klen);
 		}
 
 		TAINT_IF(save_taint);
@@ -588,7 +555,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 		    return NULL;
 		}
 #ifdef ENV_IS_CASELESS
-		else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
+		else if (mg_find((const SV *)hv, PERL_MAGIC_env)) {
 		    /* XXX This code isn't UTF8 clean.  */
 		    const char *keysave = key;
 		    /* Will need to free this, so set FREEKEY flag.  */
@@ -611,7 +578,8 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     if (!HvARRAY(hv)) {
 	if ((action & (HV_FETCH_LVALUE | HV_FETCH_ISSTORE))
 #ifdef DYNAMIC_ENV_FETCH  /* if it's an %ENV lookup, we may get it on the fly */
-		 || (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env))
+		 || (SvRMAGICAL((const SV *)hv)
+		     && mg_find((const SV *)hv, PERL_MAGIC_env))
 #endif
 								  ) {
 	    char *array;
@@ -631,11 +599,11 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
             if (flags & HVhek_FREEKEY)
                 Safefree(key);
 
-	    return 0;
+	    return NULL;
 	}
     }
 
-    if (is_utf8) {
+    if (is_utf8 & !(flags & HVhek_KEYCANONICAL)) {
 	char * const keysave = (char *)key;
 	key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
         if (is_utf8)
@@ -646,6 +614,11 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 	    if (flags & HVhek_FREEKEY)
 		Safefree(keysave);
             flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
+	    /* If the caller calculated a hash, it was on the sequence of
+	       octets that are the UTF-8 form. We've now changed the sequence
+	       of octets stored to that of the equivalent byte representation,
+	       so the hash we need is different.  */
+	    hash = 0;
 	}
     }
 
@@ -747,19 +720,23 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 	}
 	if (flags & HVhek_FREEKEY)
 	    Safefree(key);
+	if (return_svp) {
+	    return entry ? (void *) &HeVAL(entry) : NULL;
+	}
 	return entry;
     }
 #ifdef DYNAMIC_ENV_FETCH  /* %ENV lookup?  If so, try to fetch the value now */
     if (!(action & HV_FETCH_ISSTORE) 
-	&& SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
+	&& SvRMAGICAL((const SV *)hv)
+	&& mg_find((const SV *)hv, PERL_MAGIC_env)) {
 	unsigned long len;
 	const char * const env = PerlEnv_ENVgetenv_len(key,&len);
 	if (env) {
 	    sv = newSVpvn(env,len);
 	    SvTAINTED_on(sv);
-	    return hv_fetch_common(hv, keysv, key, klen, flags,
-				   HV_FETCH_ISSTORE|HV_DISABLE_UVAR_XKEY, sv,
-				   hash);
+	    return hv_common(hv, keysv, key, klen, flags,
+			     HV_FETCH_ISSTORE|HV_DISABLE_UVAR_XKEY|return_svp,
+			     sv, hash);
 	}
     }
 #endif
@@ -773,7 +750,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 	/* Not doing some form of store, so return failure.  */
 	if (flags & HVhek_FREEKEY)
 	    Safefree(key);
-	return 0;
+	return NULL;
     }
     if (action & HV_FETCH_LVALUE) {
 	val = newSV(0);
@@ -782,9 +759,15 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 	       which in turn might do some tied magic. So we need to make that
 	       magic check happen.  */
 	    /* gonna assign to this, so it better be there */
-	    return hv_fetch_common(hv, keysv, key, klen, flags,
-				   HV_FETCH_ISSTORE|HV_DISABLE_UVAR_XKEY, val,
-				   hash);
+	    /* If a fetch-as-store fails on the fetch, then the action is to
+	       recurse once into "hv_store". If we didn't do this, then that
+	       recursive call would call the key conversion routine again.
+	       However, as we replace the original key with the converted
+	       key, this would result in a double conversion, which would show
+	       up as a bug if the conversion routine is not idempotent.  */
+	    return hv_common(hv, keysv, key, klen, flags,
+			     HV_FETCH_ISSTORE|HV_DISABLE_UVAR_XKEY|return_svp,
+			     val, hash);
 	    /* XXX Surely that could leak if the fetch-was-store fails?
 	       Just like the hv_fetch.  */
 	}
@@ -855,13 +838,19 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 	}
     }
 
-    return entry;
+    if (return_svp) {
+	return entry ? (void *) &HeVAL(entry) : NULL;
+    }
+    return (void *) entry;
 }
 
 STATIC void
 S_hv_magic_check(HV *hv, bool *needs_copy, bool *needs_store)
 {
     const MAGIC *mg = SvMAGIC(hv);
+
+    PERL_ARGS_ASSERT_HV_MAGIC_CHECK;
+
     *needs_copy = FALSE;
     *needs_store = TRUE;
     while (mg) {
@@ -889,14 +878,16 @@ Perl_hv_scalar(pTHX_ HV *hv)
 {
     SV *sv;
 
+    PERL_ARGS_ASSERT_HV_SCALAR;
+
     if (SvRMAGICAL(hv)) {
-	MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_tied);
+	MAGIC * const mg = mg_find((const SV *)hv, PERL_MAGIC_tied);
 	if (mg)
 	    return magic_scalarpack(hv, mg);
     }
 
     sv = sv_newmortal();
-    if (HvFILL((HV*)hv)) 
+    if (HvFILL((const HV *)hv)) 
         Perl_sv_setpvf(aTHX_ sv, "%ld/%ld",
                 (long)HvFILL(hv), (long)HvMAX(hv) + 1);
     else
@@ -913,26 +904,6 @@ hash and returned to the caller.  The C<klen> is the length of the key.
 The C<flags> value will normally be zero; if set to G_DISCARD then NULL
 will be returned.
 
-=cut
-*/
-
-SV *
-Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 flags)
-{
-    STRLEN klen;
-    int k_flags;
-
-    if (klen_i32 < 0) {
-	klen = -klen_i32;
-	k_flags = HVhek_UTF8;
-    } else {
-	klen = klen_i32;
-	k_flags = 0;
-    }
-    return hv_delete_common(hv, NULL, key, klen, k_flags, flags, 0);
-}
-
-/*
 =for apidoc hv_delete_ent
 
 Deletes a key/value pair in the hash.  The value SV is removed from the
@@ -943,13 +914,6 @@ precomputed hash value, or 0 to ask for it to be computed.
 =cut
 */
 
-/* XXX This looks like an ideal candidate to inline */
-SV *
-Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
-{
-    return hv_delete_common(hv, keysv, NULL, 0, 0, flags, hash);
-}
-
 STATIC SV *
 S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 		   int k_flags, I32 d_flags, U32 hash)
@@ -959,25 +923,9 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     register HE *entry;
     register HE **oentry;
     HE *const *first_entry;
-    bool is_utf8;
+    bool is_utf8 = (k_flags & HVhek_UTF8) ? TRUE : FALSE;
     int masked_flags;
 
-    if (!hv)
-	return NULL;
-
-    if (SvSMAGICAL(hv) && SvGMAGICAL(hv)
-	&& !(d_flags & HV_DISABLE_UVAR_XKEY))
-	keysv = hv_magic_uvar_xkey(hv, keysv, key, klen, k_flags, HV_DELETE);
-    if (keysv) {
-	if (k_flags & HVhek_FREEKEY)
-	    Safefree(key);
-	key = SvPV_const(keysv, klen);
-	k_flags = 0;
-	is_utf8 = (SvUTF8(keysv) != 0);
-    } else {
-	is_utf8 = ((k_flags & HVhek_UTF8) ? TRUE : FALSE);
-    }
-
     if (SvRMAGICAL(hv)) {
 	bool needs_copy;
 	bool needs_store;
@@ -985,10 +933,10 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 
 	if (needs_copy) {
 	    SV *sv;
-	    entry = hv_fetch_common(hv, keysv, key, klen,
-				    k_flags & ~HVhek_FREEKEY,
-				    HV_FETCH_LVALUE|HV_DISABLE_UVAR_XKEY,
-				    NULL, hash);
+	    entry = (HE *) hv_common(hv, keysv, key, klen,
+				     k_flags & ~HVhek_FREEKEY,
+				     HV_FETCH_LVALUE|HV_DISABLE_UVAR_XKEY,
+				     NULL, hash);
 	    sv = entry ? HeVAL(entry) : NULL;
 	    if (sv) {
 		if (SvMAGICAL(sv)) {
@@ -1003,9 +951,9 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 		    return NULL;		/* element cannot be deleted */
 		}
 #ifdef ENV_IS_CASELESS
-		else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
+		else if (mg_find((const SV *)hv, PERL_MAGIC_env)) {
 		    /* XXX This code isn't UTF8 clean.  */
-		    keysv = sv_2mortal(newSVpvn(key,klen));
+		    keysv = newSVpvn_flags(key, klen, SVs_TEMP);
 		    if (k_flags & HVhek_FREEKEY) {
 			Safefree(key);
 		    }
@@ -1038,7 +986,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 	    }
 	    k_flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
 	}
-        HvHASKFLAGS_on((SV*)hv);
+        HvHASKFLAGS_on(MUTABLE_SV(hv));
     }
 
     if (HvREHASH(hv)) {
@@ -1145,6 +1093,8 @@ S_hsplit(pTHX_ HV *hv)
     int longest_chain = 0;
     int was_shared;
 
+    PERL_ARGS_ASSERT_HSPLIT;
+
     /*PerlIO_printf(PerlIO_stderr(), "hsplit called for %p which had %d\n",
       (void*)hv, (int) oldsize);*/
 
@@ -1165,7 +1115,7 @@ S_hsplit(pTHX_ HV *hv)
       return;
     }
     if (SvOOK(hv)) {
-	Copy(&a[oldsize * sizeof(HE*)], &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux);
+	Move(&a[oldsize * sizeof(HE*)], &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux);
     }
 #else
     Newx(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
@@ -1314,6 +1264,8 @@ Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
     register HE *entry;
     register HE **oentry;
 
+    PERL_ARGS_ASSERT_HV_KSPLIT;
+
     newsize = (I32) newmax;			/* possible truncation here */
     if (newsize != newmax || newmax <= oldsize)
 	return;
@@ -1391,30 +1343,6 @@ Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
     }
 }
 
-/*
-=for apidoc newHV
-
-Creates a new HV.  The reference count is set to 1.
-
-=cut
-*/
-
-HV *
-Perl_newHV(pTHX)
-{
-    register XPVHV* xhv;
-    HV * const hv = (HV*)newSV_type(SVt_PVHV);
-    xhv = (XPVHV*)SvANY(hv);
-    assert(!SvOK(hv));
-#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 */
-    return hv;
-}
-
 HV *
 Perl_newHVhv(pTHX_ HV *ohv)
 {
@@ -1425,7 +1353,7 @@ Perl_newHVhv(pTHX_ HV *ohv)
 	return hv;
     hv_max = HvMAX(ohv);
 
-    if (!SvMAGICAL((SV *)ohv)) {
+    if (!SvMAGICAL((const SV *)ohv)) {
 	/* It's an ordinary hash, so copy it fast. AMS 20010804 */
 	STRLEN i;
 	const bool shared = !!HvSHAREKEYS(ohv);
@@ -1451,8 +1379,9 @@ Perl_newHVhv(pTHX_ HV *ohv)
 		const STRLEN len = HeKLEN(oent);
 		const int flags  = HeKFLAGS(oent);
 		HE * const ent   = new_HE();
+		SV *const val    = HeVAL(oent);
 
-		HeVAL(ent)     = newSVsv(HeVAL(oent));
+		HeVAL(ent) = SvIMMORTAL(val) ? val : newSVsv(val);
 		HeKEY_hek(ent)
                     = shared ? share_hek_flags(key, len, hash, flags)
                              :  save_hek_flags(key, len, hash, flags);
@@ -1483,9 +1412,10 @@ Perl_newHVhv(pTHX_ HV *ohv)
 
 	hv_iterinit(ohv);
 	while ((entry = hv_iternext_flags(ohv, 0))) {
-	    hv_store_flags(hv, HeKEY(entry), HeKLEN(entry),
-                           newSVsv(HeVAL(entry)), HeHASH(entry),
-                           HeKFLAGS(entry));
+	    SV *const val = HeVAL(entry);
+	    (void)hv_store_flags(hv, HeKEY(entry), HeKLEN(entry),
+			         SvIMMORTAL(val) ? val : newSVsv(val),
+				 HeHASH(entry), HeKFLAGS(entry));
 	}
 	HvRITER_set(ohv, riter);
 	HvEITER_set(ohv, eiter);
@@ -1515,10 +1445,12 @@ Perl_hv_copy_hints_hv(pTHX_ HV *const ohv)
 	hv_iterinit(ohv);
 	while ((entry = hv_iternext_flags(ohv, 0))) {
 	    SV *const sv = newSVsv(HeVAL(entry));
+	    SV *heksv = newSVhek(HeKEY_hek(entry));
 	    sv_magic(sv, NULL, PERL_MAGIC_hintselem,
-		     (char *)newSVhek (HeKEY_hek(entry)), HEf_SVKEY);
-	    hv_store_flags(hv, HeKEY(entry), HeKLEN(entry),
-			   sv, HeHASH(entry), HeKFLAGS(entry));
+		     (char *)heksv, HEf_SVKEY);
+	    SvREFCNT_dec(heksv);
+	    (void)hv_store_flags(hv, HeKEY(entry), HeKLEN(entry),
+				 sv, HeHASH(entry), HeKFLAGS(entry));
 	}
 	HvRITER_set(ohv, riter);
 	HvEITER_set(ohv, eiter);
@@ -1533,11 +1465,13 @@ Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
     dVAR;
     SV *val;
 
+    PERL_ARGS_ASSERT_HV_FREE_ENT;
+
     if (!entry)
 	return;
     val = HeVAL(entry);
-    if (val && isGV(val) && GvCVu(val) && HvNAME_get(hv))
-        mro_method_changed_in(hv);	/* deletion of method from stash */
+    if (HvNAME(hv) && anonymise_cv(HvNAME_HEK(hv), val) && GvCVu(val))
+	mro_method_changed_in(hv);
     SvREFCNT_dec(val);
     if (HeKLEN(entry) == HEf_SVKEY) {
 	SvREFCNT_dec(HeKEY_sv(entry));
@@ -1550,10 +1484,41 @@ Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
     del_HE(entry);
 }
 
+static I32
+S_anonymise_cv(pTHX_ HEK *stash, SV *val)
+{
+    CV *cv;
+
+    PERL_ARGS_ASSERT_ANONYMISE_CV;
+
+    if (val && isGV(val) && isGV_with_GP(val) && (cv = GvCV(val))) {
+	if ((SV *)CvGV(cv) == val) {
+	    GV *anongv;
+
+	    if (stash) {
+		SV *gvname = newSVhek(stash);
+		sv_catpvs(gvname, "::__ANON__");
+		anongv = gv_fetchsv(gvname, GV_ADDMULTI, SVt_PVCV);
+		SvREFCNT_dec(gvname);
+	    } else {
+		anongv = gv_fetchpvs("__ANON__::__ANON__", GV_ADDMULTI,
+				     SVt_PVCV);
+	    }
+	    CvGV(cv) = anongv;
+	    CvANON_on(cv);
+	    return 1;
+	}
+    }
+    return 0;
+}
+
 void
 Perl_hv_delayfree_ent(pTHX_ HV *hv, register HE *entry)
 {
     dVAR;
+
+    PERL_ARGS_ASSERT_HV_DELAYFREE_ENT;
+
     if (!entry)
 	return;
     /* SvREFCNT_inc to counter the SvREFCNT_dec in hv_free_ent  */
@@ -1613,7 +1578,7 @@ Perl_hv_clear(pTHX_ HV *hv)
 	Zero(HvARRAY(hv), xhv->xhv_max+1 /* HvMAX(hv)+1 */, HE*);
 
     if (SvRMAGICAL(hv))
-	mg_clear((SV*)hv);
+	mg_clear(MUTABLE_SV(hv));
 
     HvHASKFLAGS_off(hv);
     HvREHASH_off(hv);
@@ -1645,6 +1610,8 @@ Perl_hv_clear_placeholders(pTHX_ HV *hv)
     dVAR;
     const U32 items = (U32)HvPLACEHOLDERS_get(hv);
 
+    PERL_ARGS_ASSERT_HV_CLEAR_PLACEHOLDERS;
+
     if (items)
 	clear_placeholders(hv, items);
 }
@@ -1655,6 +1622,8 @@ S_clear_placeholders(pTHX_ HV *hv, U32 items)
     dVAR;
     I32 i;
 
+    PERL_ARGS_ASSERT_CLEAR_PLACEHOLDERS;
+
     if (items == 0)
 	return;
 
@@ -1702,9 +1671,27 @@ S_hfreeentries(pTHX_ HV *hv)
     HEK *name;
     int attempts = 100;
 
+    PERL_ARGS_ASSERT_HFREEENTRIES;
+
     if (!orig_array)
 	return;
 
+    if (HvNAME(hv) && orig_array != NULL) {
+	/* symbol table: make all the contained subs ANON */
+	STRLEN i;
+	XPVHV *xhv = (XPVHV*)SvANY(hv);
+
+	for (i = 0; i <= xhv->xhv_max; i++) {
+	    HE *entry = (HvARRAY(hv))[i];
+	    for (; entry; entry = HeNEXT(entry)) {
+		SV *val = HeVAL(entry);
+		/* we need to put the subs in the __ANON__ symtable, as
+		 * this one is being cleared. */
+		anonymise_cv(NULL, val);
+	    }
+	}
+    }
+
     if (SvOOK(hv)) {
 	/* If the hash is actually a symbol table with a name, look after the
 	   name.  */
@@ -1752,7 +1739,8 @@ S_hfreeentries(pTHX_ HV *hv)
 		    SvREFCNT_dec(iter->xhv_backreferences);
 
 		} else {
-		    sv_magic((SV*)hv, (SV*)iter->xhv_backreferences,
+		    sv_magic(MUTABLE_SV(hv),
+			     MUTABLE_SV(iter->xhv_backreferences),
 			     PERL_MAGIC_backref, NULL, 0);
 		}
 		iter->xhv_backreferences = NULL;
@@ -1767,9 +1755,19 @@ S_hfreeentries(pTHX_ HV *hv)
 	    iter->xhv_eiter = NULL;	/* HvEITER(hv) = NULL */
 
             if((meta = iter->xhv_mro_meta)) {
-                if(meta->mro_linear_dfs) SvREFCNT_dec(meta->mro_linear_dfs);
-                if(meta->mro_linear_c3)  SvREFCNT_dec(meta->mro_linear_c3);
+		if (meta->mro_linear_all) {
+		    SvREFCNT_dec(MUTABLE_SV(meta->mro_linear_all));
+		    meta->mro_linear_all = NULL;
+		    /* This is just acting as a shortcut pointer.  */
+		    meta->mro_linear_current = NULL;
+		} else if (meta->mro_linear_current) {
+		    /* Only the current MRO is stored, so this owns the data.
+		     */
+		    SvREFCNT_dec(meta->mro_linear_current);
+		    meta->mro_linear_current = NULL;
+		}
                 if(meta->mro_nextmethod) SvREFCNT_dec(meta->mro_nextmethod);
+                SvREFCNT_dec(meta->isa);
                 Safefree(meta);
                 iter->xhv_mro_meta = NULL;
             }
@@ -1863,8 +1861,8 @@ Perl_hv_undef(pTHX_ HV *hv)
 
     hfreeentries(hv);
     if (name) {
-        if(PL_stashcache)
-	    hv_delete(PL_stashcache, name, HvNAMELEN_get(hv), G_DISCARD);
+        if (PL_stashcache)
+	    (void)hv_delete(PL_stashcache, name, HvNAMELEN_get(hv), G_DISCARD);
 	hv_name_set(hv, NULL, 0, 0);
     }
     SvFLAGS(hv) &= ~SVf_OOK;
@@ -1874,7 +1872,7 @@ Perl_hv_undef(pTHX_ HV *hv)
     HvPLACEHOLDERS_set(hv, 0);
 
     if (SvRMAGICAL(hv))
-	mg_clear((SV*)hv);
+	mg_clear(MUTABLE_SV(hv));
 }
 
 static struct xpvhv_aux*
@@ -1882,6 +1880,8 @@ S_hv_auxinit(HV *hv) {
     struct xpvhv_aux *iter;
     char *array;
 
+    PERL_ARGS_ASSERT_HV_AUXINIT;
+
     if (!HvARRAY(hv)) {
 	Newxz(array, PERL_HV_ARRAY_ALLOC_BYTES(HvMAX(hv) + 1)
 	    + sizeof(struct xpvhv_aux), char);
@@ -1921,6 +1921,10 @@ value, you can get it through the macro C<HvFILL(tb)>.
 I32
 Perl_hv_iterinit(pTHX_ HV *hv)
 {
+    PERL_ARGS_ASSERT_HV_ITERINIT;
+
+    /* FIXME: Are we not NULL, or do we croak? Place bets now! */
+
     if (!hv)
 	Perl_croak(aTHX_ "Bad hash");
 
@@ -1945,6 +1949,8 @@ I32 *
 Perl_hv_riter_p(pTHX_ HV *hv) {
     struct xpvhv_aux *iter;
 
+    PERL_ARGS_ASSERT_HV_RITER_P;
+
     if (!hv)
 	Perl_croak(aTHX_ "Bad hash");
 
@@ -1956,6 +1962,8 @@ HE **
 Perl_hv_eiter_p(pTHX_ HV *hv) {
     struct xpvhv_aux *iter;
 
+    PERL_ARGS_ASSERT_HV_EITER_P;
+
     if (!hv)
 	Perl_croak(aTHX_ "Bad hash");
 
@@ -1967,6 +1975,8 @@ void
 Perl_hv_riter_set(pTHX_ HV *hv, I32 riter) {
     struct xpvhv_aux *iter;
 
+    PERL_ARGS_ASSERT_HV_RITER_SET;
+
     if (!hv)
 	Perl_croak(aTHX_ "Bad hash");
 
@@ -1985,6 +1995,8 @@ void
 Perl_hv_eiter_set(pTHX_ HV *hv, HE *eiter) {
     struct xpvhv_aux *iter;
 
+    PERL_ARGS_ASSERT_HV_EITER_SET;
+
     if (!hv)
 	Perl_croak(aTHX_ "Bad hash");
 
@@ -2008,6 +2020,7 @@ Perl_hv_name_set(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
     struct xpvhv_aux *iter;
     U32 hash;
 
+    PERL_ARGS_ASSERT_HV_NAME_SET;
     PERL_UNUSED_ARG(flags);
 
     if (len > I32_MAX)
@@ -2031,7 +2044,10 @@ Perl_hv_name_set(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
 AV **
 Perl_hv_backreferences_p(pTHX_ HV *hv) {
     struct xpvhv_aux * const iter = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv);
+
+    PERL_ARGS_ASSERT_HV_BACKREFERENCES_P;
     PERL_UNUSED_CONTEXT;
+
     return &(iter->xhv_backreferences);
 }
 
@@ -2039,6 +2055,8 @@ void
 Perl_hv_kill_backrefs(pTHX_ HV *hv) {
     AV *av;
 
+    PERL_ARGS_ASSERT_HV_KILL_BACKREFS;
+
     if (!SvOOK(hv))
 	return;
 
@@ -2046,7 +2064,8 @@ Perl_hv_kill_backrefs(pTHX_ HV *hv) {
 
     if (av) {
 	HvAUX(hv)->xhv_backreferences = 0;
-	Perl_sv_kill_backrefs(aTHX_ (SV*) hv, av);
+	Perl_sv_kill_backrefs(aTHX_ MUTABLE_SV(hv), av);
+	SvREFCNT_dec(av);
     }
 }
 
@@ -2089,6 +2108,8 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
     MAGIC* mg;
     struct xpvhv_aux *iter;
 
+    PERL_ARGS_ASSERT_HV_ITERNEXT_FLAGS;
+
     if (!hv)
 	Perl_croak(aTHX_ "Bad hash");
 
@@ -2104,7 +2125,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
 
     oldentry = entry = iter->xhv_eiter; /* HvEITER(hv) */
     if (SvMAGICAL(hv) && SvRMAGICAL(hv)) {
-	if ( ( mg = mg_find((SV*)hv, PERL_MAGIC_tied) ) ) {
+	if ( ( mg = mg_find((const SV *)hv, PERL_MAGIC_tied) ) ) {
             SV * const key = sv_newmortal();
             if (entry) {
                 sv_setsv(key, HeSVKEY_force(entry));
@@ -2117,19 +2138,18 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
                 /* one HE per MAGICAL hash */
                 iter->xhv_eiter = entry = new_HE(); /* HvEITER(hv) = new_HE() */
                 Zero(entry, 1, HE);
-                Newxz(k, HEK_BASESIZE + sizeof(SV*), char);
+                Newxz(k, HEK_BASESIZE + sizeof(const SV *), char);
                 hek = (HEK*)k;
                 HeKEY_hek(entry) = hek;
                 HeKLEN(entry) = HEf_SVKEY;
             }
-            magic_nextpack((SV*) hv,mg,key);
+            magic_nextpack(MUTABLE_SV(hv),mg,key);
             if (SvOK(key)) {
                 /* force key to stay around until next time */
                 HeSVKEY_set(entry, SvREFCNT_inc_simple_NN(key));
                 return entry;               /* beware, hent_val is not set */
             }
-            if (HeVAL(entry))
-                SvREFCNT_dec(HeVAL(entry));
+            SvREFCNT_dec(HeVAL(entry));
             Safefree(HeKEY_hek(entry));
             del_HE(entry);
             iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */
@@ -2137,7 +2157,8 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
         }
     }
 #if defined(DYNAMIC_ENV_FETCH) && !defined(__riscos__)  /* set up %ENV for iteration */
-    if (!entry && SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
+    if (!entry && SvRMAGICAL((const SV *)hv)
+	&& mg_find((const SV *)hv, PERL_MAGIC_env)) {
 	prime_env_iter();
 #ifdef VMS
 	/* The prime_env_iter() on VMS just loaded up new hash values
@@ -2167,26 +2188,31 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
             }
 	}
     }
-    while (!entry) {
-	/* OK. Come to the end of the current list.  Grab the next one.  */
 
-	iter->xhv_riter++; /* HvRITER(hv)++ */
-	if (iter->xhv_riter > (I32)xhv->xhv_max /* HvRITER(hv) > HvMAX(hv) */) {
-	    /* There is no next one.  End of the hash.  */
-	    iter->xhv_riter = -1; /* HvRITER(hv) = -1 */
-	    break;
-	}
-	entry = (HvARRAY(hv))[iter->xhv_riter];
+    /* Skip the entire loop if the hash is empty.   */
+    if ((flags & HV_ITERNEXT_WANTPLACEHOLDERS)
+	? HvTOTALKEYS(hv) : HvUSEDKEYS(hv)) {
+	while (!entry) {
+	    /* OK. Come to the end of the current list.  Grab the next one.  */
 
-        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);
+	    iter->xhv_riter++; /* HvRITER(hv)++ */
+	    if (iter->xhv_riter > (I32)xhv->xhv_max /* HvRITER(hv) > HvMAX(hv) */) {
+		/* There is no next one.  End of the hash.  */
+		iter->xhv_riter = -1; /* HvRITER(hv) = -1 */
+		break;
+	    }
+	    entry = (HvARRAY(hv))[iter->xhv_riter];
+
+	    if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) {
+		/* If we have an entry, but it's a placeholder, don't count it.
+		   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.  */
 	}
-	/* 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? */
@@ -2213,6 +2239,8 @@ C<hv_iterinit>.
 char *
 Perl_hv_iterkey(pTHX_ register HE *entry, I32 *retlen)
 {
+    PERL_ARGS_ASSERT_HV_ITERKEY;
+
     if (HeKLEN(entry) == HEf_SVKEY) {
 	STRLEN len;
 	char * const p = SvPV(HeKEY_sv(entry), len);
@@ -2239,6 +2267,8 @@ see C<hv_iterinit>.
 SV *
 Perl_hv_iterkeysv(pTHX_ register HE *entry)
 {
+    PERL_ARGS_ASSERT_HV_ITERKEYSV;
+
     return sv_2mortal(newSVhek(HeKEY_hek(entry)));
 }
 
@@ -2254,13 +2284,15 @@ C<hv_iterkey>.
 SV *
 Perl_hv_iterval(pTHX_ HV *hv, register HE *entry)
 {
+    PERL_ARGS_ASSERT_HV_ITERVAL;
+
     if (SvRMAGICAL(hv)) {
-	if (mg_find((SV*)hv, PERL_MAGIC_tied)) {
+	if (mg_find((const SV *)hv, PERL_MAGIC_tied)) {
 	    SV* const sv = sv_newmortal();
 	    if (HeKLEN(entry) == HEf_SVKEY)
-		mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
+		mg_copy(MUTABLE_SV(hv), sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
 	    else
-		mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry));
+		mg_copy(MUTABLE_SV(hv), sv, HeKEY(entry), HeKLEN(entry));
 	    return sv;
 	}
     }
@@ -2281,6 +2313,8 @@ Perl_hv_iternextsv(pTHX_ HV *hv, char **key, I32 *retlen)
 {
     HE * const he = hv_iternext_flags(hv, 0);
 
+    PERL_ARGS_ASSERT_HV_ITERNEXTSV;
+
     if (!he)
 	return NULL;
     *key = hv_iterkey(he, retlen);
@@ -2342,13 +2376,10 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
 	   shared hek  */
 	assert (he->shared_he_he.hent_hek == hek);
 
-	LOCK_STRTAB_MUTEX;
 	if (he->shared_he_he.he_valu.hent_refcount - 1) {
 	    --he->shared_he_he.he_valu.hent_refcount;
-	    UNLOCK_STRTAB_MUTEX;
 	    return;
 	}
-	UNLOCK_STRTAB_MUTEX;
 
         hash = HEK_HASH(hek);
     } else if (len < 0) {
@@ -2370,7 +2401,6 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
     } */
     xhv = (XPVHV*)SvANY(PL_strtab);
     /* assert(xhv_array != 0) */
-    LOCK_STRTAB_MUTEX;
     first = oentry = &(HvARRAY(PL_strtab))[hash & (I32) HvMAX(PL_strtab)];
     if (he) {
 	const HE *const he_he = &(he->shared_he_he);
@@ -2405,13 +2435,12 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
         }
     }
 
-    UNLOCK_STRTAB_MUTEX;
-    if (!entry && ckWARN_d(WARN_INTERNAL))
-	Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
-                    "Attempt to free non-existent shared string '%s'%s"
-                    pTHX__FORMAT,
-                    hek ? HEK_KEY(hek) : str,
-                    ((k_flags & HVhek_UTF8) ? " (utf8)" : "") pTHX__VALUE);
+    if (!entry)
+	Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
+			 "Attempt to free non-existent shared string '%s'%s"
+			 pTHX__FORMAT,
+			 hek ? HEK_KEY(hek) : str,
+			 ((k_flags & HVhek_UTF8) ? " (utf8)" : "") pTHX__VALUE);
     if (k_flags & HVhek_FREEKEY)
 	Safefree(str);
 }
@@ -2427,6 +2456,8 @@ Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash)
     int flags = 0;
     const char * const save = str;
 
+    PERL_ARGS_ASSERT_SHARE_HEK;
+
     if (len < 0) {
       STRLEN tmplen = -len;
       is_utf8 = TRUE;
@@ -2454,6 +2485,9 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
     register HE *entry;
     const int flags_masked = flags & HVhek_MASK;
     const U32 hindex = hash & (I32) HvMAX(PL_strtab);
+    register XPVHV * const xhv = (XPVHV*)SvANY(PL_strtab);
+
+    PERL_ARGS_ASSERT_SHARE_HEK_FLAGS;
 
     /* what follows is the moral equivalent of:
 
@@ -2463,9 +2497,8 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
 	Can't rehash the shared string table, so not sure if it's worth
 	counting the number of entries in the linked list
     */
-    register XPVHV * const xhv = (XPVHV*)SvANY(PL_strtab);
+
     /* assert(xhv_array != 0) */
-    LOCK_STRTAB_MUTEX;
     entry = (HvARRAY(PL_strtab))[hindex];
     for (;entry; entry = HeNEXT(entry)) {
 	if (HeHASH(entry) != hash)		/* strings can't be equal */
@@ -2523,7 +2556,6 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
     }
 
     ++entry->he_valu.hent_refcount;
-    UNLOCK_STRTAB_MUTEX;
 
     if (flags & HVhek_FREEKEY)
 	Safefree(str);
@@ -2531,40 +2563,16 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
     return HeKEY_hek(entry);
 }
 
-STATIC SV *
-S_hv_magic_uvar_xkey(pTHX_ HV* hv, SV* keysv, const char *const key,
-		     const STRLEN klen, const int k_flags, int action)
-{
-    MAGIC* mg;
-    if ((mg = mg_find((SV*)hv, PERL_MAGIC_uvar))) {
-	struct ufuncs * const uf = (struct ufuncs *)mg->mg_ptr;
-	if (uf->uf_set == NULL) {
-	    SV* obj = mg->mg_obj;
-
-	    if (!keysv) {
-		keysv = sv_2mortal(newSVpvn(key, klen));
-		if (k_flags & HVhek_UTF8)
-		    SvUTF8_on(keysv);
-	    }
-		
-	    mg->mg_obj = keysv;         /* pass key */
-	    uf->uf_index = action;      /* pass action */
-	    magic_getuvar((SV*)hv, mg);
-	    keysv = mg->mg_obj;         /* may have changed */
-	    mg->mg_obj = obj;
-	}
-    }
-    return keysv;
-}
-
 I32 *
 Perl_hv_placeholders_p(pTHX_ HV *hv)
 {
     dVAR;
-    MAGIC *mg = mg_find((SV*)hv, PERL_MAGIC_rhash);
+    MAGIC *mg = mg_find((const SV *)hv, PERL_MAGIC_rhash);
+
+    PERL_ARGS_ASSERT_HV_PLACEHOLDERS_P;
 
     if (!mg) {
-	mg = sv_magicext((SV*)hv, 0, PERL_MAGIC_rhash, 0, 0, 0);
+	mg = sv_magicext(MUTABLE_SV(hv), 0, PERL_MAGIC_rhash, 0, 0, 0);
 
 	if (!mg) {
 	    Perl_die(aTHX_ "panic: hv_placeholders_p");
@@ -2575,10 +2583,12 @@ Perl_hv_placeholders_p(pTHX_ HV *hv)
 
 
 I32
-Perl_hv_placeholders_get(pTHX_ HV *hv)
+Perl_hv_placeholders_get(pTHX_ const HV *hv)
 {
     dVAR;
-    MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_rhash);
+    MAGIC * const mg = mg_find((const SV *)hv, PERL_MAGIC_rhash);
+
+    PERL_ARGS_ASSERT_HV_PLACEHOLDERS_GET;
 
     return mg ? mg->mg_len : 0;
 }
@@ -2587,12 +2597,14 @@ void
 Perl_hv_placeholders_set(pTHX_ HV *hv, I32 ph)
 {
     dVAR;
-    MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_rhash);
+    MAGIC * const mg = mg_find((const SV *)hv, PERL_MAGIC_rhash);
+
+    PERL_ARGS_ASSERT_HV_PLACEHOLDERS_SET;
 
     if (mg) {
 	mg->mg_len = ph;
     } else if (ph) {
-	if (!sv_magicext((SV*)hv, 0, PERL_MAGIC_rhash, 0, 0, ph))
+	if (!sv_magicext(MUTABLE_SV(hv), 0, PERL_MAGIC_rhash, 0, 0, ph))
 	    Perl_die(aTHX_ "panic: hv_placeholders_set");
     }
     /* else we don't need to add magic to record 0 placeholders.  */
@@ -2603,6 +2615,9 @@ S_refcounted_he_value(pTHX_ const struct refcounted_he *he)
 {
     dVAR;
     SV *value;
+
+    PERL_ARGS_ASSERT_REFCOUNTED_HE_VALUE;
+
     switch(he->refcounted_he_data[0] & HVrhek_typemask) {
     case HVrhek_undef:
 	value = newSV(0);
@@ -2750,49 +2765,53 @@ Perl_refcounted_he_fetch(pTHX_ const struct refcounted_he *chain, SV *keysv,
     /* Just to be awkward, if you're using this interface the UTF-8-or-not-ness
        of your key has to exactly match that which is stored.  */
     SV *value = &PL_sv_placeholder;
-    bool is_utf8;
 
-    if (keysv) {
-	if (flags & HVhek_FREEKEY)
-	    Safefree(key);
-	key = SvPV_const(keysv, klen);
-	flags = 0;
-	is_utf8 = (SvUTF8(keysv) != 0);
-    } else {
-	is_utf8 = ((flags & HVhek_UTF8) ? TRUE : FALSE);
-    }
+    if (chain) {
+	/* No point in doing any of this if there's nothing to find.  */
+	bool is_utf8;
 
-    if (!hash) {
-	if (keysv && (SvIsCOW_shared_hash(keysv))) {
-            hash = SvSHARED_HASH(keysv);
-        } else {
-            PERL_HASH(hash, key, klen);
-        }
-    }
+	if (keysv) {
+	    if (flags & HVhek_FREEKEY)
+		Safefree(key);
+	    key = SvPV_const(keysv, klen);
+	    flags = 0;
+	    is_utf8 = (SvUTF8(keysv) != 0);
+	} else {
+	    is_utf8 = ((flags & HVhek_UTF8) ? TRUE : FALSE);
+	}
 
-    for (; chain; chain = chain->refcounted_he_next) {
+	if (!hash) {
+	    if (keysv && (SvIsCOW_shared_hash(keysv))) {
+		hash = SvSHARED_HASH(keysv);
+	    } else {
+		PERL_HASH(hash, key, klen);
+	    }
+	}
+
+	for (; chain; chain = chain->refcounted_he_next) {
 #ifdef USE_ITHREADS
-	if (hash != chain->refcounted_he_hash)
-	    continue;
-	if (klen != chain->refcounted_he_keylen)
-	    continue;
-	if (memNE(REF_HE_KEY(chain),key,klen))
-	    continue;
-	if (!!is_utf8 != !!(chain->refcounted_he_data[0] & HVhek_UTF8))
-	    continue;
+	    if (hash != chain->refcounted_he_hash)
+		continue;
+	    if (klen != chain->refcounted_he_keylen)
+		continue;
+	    if (memNE(REF_HE_KEY(chain),key,klen))
+		continue;
+	    if (!!is_utf8 != !!(chain->refcounted_he_data[0] & HVhek_UTF8))
+		continue;
 #else
-	if (hash != HEK_HASH(chain->refcounted_he_hek))
-	    continue;
-	if (klen != (STRLEN)HEK_LEN(chain->refcounted_he_hek))
-	    continue;
-	if (memNE(HEK_KEY(chain->refcounted_he_hek),key,klen))
-	    continue;
-	if (!!is_utf8 != !!HEK_UTF8(chain->refcounted_he_hek))
-	    continue;
+	    if (hash != HEK_HASH(chain->refcounted_he_hek))
+		continue;
+	    if (klen != (STRLEN)HEK_LEN(chain->refcounted_he_hek))
+		continue;
+	    if (memNE(HEK_KEY(chain->refcounted_he_hek),key,klen))
+		continue;
+	    if (!!is_utf8 != !!HEK_UTF8(chain->refcounted_he_hek))
+		continue;
 #endif
 
-	value = sv_2mortal(refcounted_he_value(chain));
-	break;
+	    value = sv_2mortal(refcounted_he_value(chain));
+	    break;
+	}
     }
 
     if (flags & HVhek_FREEKEY)
@@ -2815,21 +2834,18 @@ struct refcounted_he *
 Perl_refcounted_he_new(pTHX_ struct refcounted_he *const parent,
 		       SV *const key, SV *const value) {
     dVAR;
-    struct refcounted_he *he;
     STRLEN key_len;
     const char *key_p = SvPV_const(key, key_len);
     STRLEN value_len = 0;
     const char *value_p = NULL;
     char value_type;
     char flags;
-    STRLEN key_offset;
-    U32 hash;
     bool is_utf8 = SvUTF8(key) ? TRUE : FALSE;
 
     if (SvPOK(value)) {
 	value_type = HVrhek_PV;
     } else if (SvIOK(value)) {
-	value_type = HVrhek_IV;
+	value_type = SvUOK((const SV *)value) ? HVrhek_UV : HVrhek_IV;
     } else if (value == &PL_sv_placeholder) {
 	value_type = HVrhek_delete;
     } else if (!SvOK(value)) {
@@ -2839,13 +2855,42 @@ Perl_refcounted_he_new(pTHX_ struct refcounted_he *const parent,
     }
 
     if (value_type == HVrhek_PV) {
+	/* Do it this way so that the SvUTF8() test is after the SvPV, in case
+	   the value is overloaded, and doesn't yet have the UTF-8flag set.  */
 	value_p = SvPV_const(value, value_len);
-	key_offset = value_len + 2;
-    } else {
-	value_len = 0;
-	key_offset = 1;
+	if (SvUTF8(value))
+	    value_type = HVrhek_PV_UTF8;
+    }
+    flags = value_type;
+
+    if (is_utf8) {
+	/* Hash keys are always stored normalised to (yes) ISO-8859-1.
+	   As we're going to be building hash keys from this value in future,
+	   normalise it now.  */
+	key_p = (char*)bytes_from_utf8((const U8*)key_p, &key_len, &is_utf8);
+	flags |= is_utf8 ? HVhek_UTF8 : HVhek_WASUTF8;
     }
 
+    return refcounted_he_new_common(parent, key_p, key_len, flags, value_type,
+				    ((value_type == HVrhek_PV
+				      || value_type == HVrhek_PV_UTF8) ?
+				     (void *)value_p : (void *)value),
+				    value_len);
+}
+
+static struct refcounted_he *
+S_refcounted_he_new_common(pTHX_ struct refcounted_he *const parent,
+			   const char *const key_p, const STRLEN key_len,
+			   const char flags, char value_type,
+			   const void *value, const STRLEN value_len) {
+    dVAR;
+    struct refcounted_he *he;
+    U32 hash;
+    const bool is_pv = value_type == HVrhek_PV || value_type == HVrhek_PV_UTF8;
+    STRLEN key_offset = is_pv ? value_len + 2 : 1;
+
+    PERL_ARGS_ASSERT_REFCOUNTED_HE_NEW_COMMON;
+
 #ifdef USE_ITHREADS
     he = (struct refcounted_he*)
 	PerlMemShared_malloc(sizeof(struct refcounted_he) - 1
@@ -2857,33 +2902,17 @@ Perl_refcounted_he_new(pTHX_ struct refcounted_he *const parent,
 			     + key_offset);
 #endif
 
-
     he->refcounted_he_next = parent;
 
-    if (value_type == HVrhek_PV) {
-	Copy(value_p, he->refcounted_he_data + 1, value_len + 1, char);
+    if (is_pv) {
+	Copy((char *)value, he->refcounted_he_data + 1, value_len + 1, char);
 	he->refcounted_he_val.refcounted_he_u_len = value_len;
-	/* Do it this way so that the SvUTF8() test is after the SvPV, in case
-	   the value is overloaded, and doesn't yet have the UTF-8flag set.  */
-	if (SvUTF8(value))
-	    value_type = HVrhek_PV_UTF8;
     } else if (value_type == HVrhek_IV) {
-	if (SvUOK(value)) {
-	    he->refcounted_he_val.refcounted_he_u_uv = SvUVX(value);
-	    value_type = HVrhek_UV;
-	} else {
-	    he->refcounted_he_val.refcounted_he_u_iv = SvIVX(value);
-	}
+	he->refcounted_he_val.refcounted_he_u_iv = SvIVX((const SV *)value);
+    } else if (value_type == HVrhek_UV) {
+	he->refcounted_he_val.refcounted_he_u_uv = SvUVX((const SV *)value);
     }
-    flags = value_type;
 
-    if (is_utf8) {
-	/* Hash keys are always stored normalised to (yes) ISO-8859-1.
-	   As we're going to be building hash keys from this value in future,
-	   normalise it now.  */
-	key_p = (char*)bytes_from_utf8((const U8*)key_p, &key_len, &is_utf8);
-	flags |= is_utf8 ? HVhek_UTF8 : HVhek_WASUTF8;
-    }
     PERL_HASH(hash, key_p, key_len);
 
 #ifdef USE_ITHREADS
@@ -2942,6 +2971,49 @@ Perl_refcounted_he_free(pTHX_ struct refcounted_he *he) {
     }
 }
 
+const char *
+Perl_fetch_cop_label(pTHX_ struct refcounted_he *const chain, STRLEN *len,
+		     U32 *flags) {
+    if (!chain)
+	return NULL;
+#ifdef USE_ITHREADS
+    if (chain->refcounted_he_keylen != 1)
+	return NULL;
+    if (*REF_HE_KEY(chain) != ':')
+	return NULL;
+#else
+    if ((STRLEN)HEK_LEN(chain->refcounted_he_hek) != 1)
+	return NULL;
+    if (*HEK_KEY(chain->refcounted_he_hek) != ':')
+	return NULL;
+#endif
+    /* Stop anyone trying to really mess us up by adding their own value for
+       ':' into %^H  */
+    if ((chain->refcounted_he_data[0] & HVrhek_typemask) != HVrhek_PV
+	&& (chain->refcounted_he_data[0] & HVrhek_typemask) != HVrhek_PV_UTF8)
+	return NULL;
+
+    if (len)
+	*len = chain->refcounted_he_val.refcounted_he_u_len;
+    if (flags) {
+	*flags = ((chain->refcounted_he_data[0] & HVrhek_typemask)
+		  == HVrhek_PV_UTF8) ? SVf_UTF8 : 0;
+    }
+    return chain->refcounted_he_data + 1;
+}
+
+/* As newSTATEOP currently gets passed plain char* labels, we will only provide
+   that interface. Once it works out how to pass in length and UTF-8 ness, this
+   function will need superseding.  */
+struct refcounted_he *
+Perl_store_cop_label(pTHX_ struct refcounted_he *const chain, const char *label)
+{
+    PERL_ARGS_ASSERT_STORE_COP_LABEL;
+
+    return refcounted_he_new_common(chain, ":", 1, HVrhek_PV, HVrhek_PV,
+				    label, strlen(label));
+}
+
 /*
 =for apidoc hv_assert
 
@@ -2964,6 +3036,8 @@ Perl_hv_assert(pTHX_ HV *hv)
     const I32 riter = HvRITER_get(hv);
     HE *eiter = HvEITER_get(hv);
 
+    PERL_ARGS_ASSERT_HV_ASSERT;
+
     (void)hv_iterinit(hv);
 
     while ((entry = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))) {
@@ -2986,7 +3060,7 @@ Perl_hv_assert(pTHX_ HV *hv)
 	} else if (HeKWASUTF8(entry))
 	    withflags++;
     }
-    if (!SvTIED_mg((SV*)hv, PERL_MAGIC_tied)) {
+    if (!SvTIED_mg((const SV *)hv, PERL_MAGIC_tied)) {
 	static const char bad_count[] = "Count %d %s(s), but hash reports %d\n";
 	const int nhashkeys = HvUSEDKEYS(hv);
 	const int nhashplaceholders = HvPLACEHOLDERS_get(hv);
@@ -3007,7 +3081,7 @@ Perl_hv_assert(pTHX_ HV *hv)
 	bad = 1;
     }
     if (bad) {
-	sv_dump((SV *)hv);
+	sv_dump(MUTABLE_SV(hv));
     }
     HvRITER_set(hv, riter);		/* Restore hash iterator state */
     HvEITER_set(hv, eiter);