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
Use both cache entries for Perl_sv_pos_b2u().
[perl5.git] / hv.c
diff --git a/hv.c b/hv.c
index 63149ac..86070e3 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1,7 +1,7 @@
 /*    hv.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
 /*    hv.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 2006, 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.
@@ -39,14 +39,14 @@ static const char S_strtab_error[]
 STATIC void
 S_more_he(pTHX)
 {
 STATIC void
 S_more_he(pTHX)
 {
+    dVAR;
     HE* he;
     HE* heend;
     HE* he;
     HE* heend;
-    Newx(he, PERL_ARENA_SIZE/sizeof(HE), HE);
-    HeNEXT(he) = PL_he_arenaroot;
-    PL_he_arenaroot = he;
+
+    he = (HE*) Perl_get_arena(aTHX_ PERL_ARENA_SIZE);
 
     heend = &he[PERL_ARENA_SIZE / sizeof(HE) - 1];
 
     heend = &he[PERL_ARENA_SIZE / sizeof(HE) - 1];
-    PL_he_root = ++he;
+    PL_body_roots[HE_SVSLOT] = he;
     while (he < heend) {
        HeNEXT(he) = (HE*)(he + 1);
        he++;
     while (he < heend) {
        HeNEXT(he) = (HE*)(he + 1);
        he++;
@@ -64,12 +64,15 @@ S_more_he(pTHX)
 STATIC HE*
 S_new_he(pTHX)
 {
 STATIC HE*
 S_new_he(pTHX)
 {
+    dVAR;
     HE* he;
     HE* he;
+    void ** const root = &PL_body_roots[HE_SVSLOT];
+
     LOCK_SV_MUTEX;
     LOCK_SV_MUTEX;
-    if (!PL_he_root)
+    if (!*root)
        S_more_he(aTHX);
        S_more_he(aTHX);
-    he = PL_he_root;
-    PL_he_root = HeNEXT(he);
+    he = *root;
+    *root = HeNEXT(he);
     UNLOCK_SV_MUTEX;
     return he;
 }
     UNLOCK_SV_MUTEX;
     return he;
 }
@@ -78,8 +81,8 @@ S_new_he(pTHX)
 #define del_HE(p) \
     STMT_START { \
        LOCK_SV_MUTEX; \
 #define del_HE(p) \
     STMT_START { \
        LOCK_SV_MUTEX; \
-       HeNEXT(p) = (HE*)PL_he_root; \
-       PL_he_root = p; \
+       HeNEXT(p) = (HE*)(PL_body_roots[HE_SVSLOT]);    \
+       PL_body_roots[HE_SVSLOT] = p; \
        UNLOCK_SV_MUTEX; \
     } STMT_END
 
        UNLOCK_SV_MUTEX; \
     } STMT_END
 
@@ -88,7 +91,7 @@ S_new_he(pTHX)
 #endif
 
 STATIC HEK *
 #endif
 
 STATIC HEK *
-S_save_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags)
+S_save_hek_flags(const char *str, I32 len, U32 hash, int flags)
 {
     const int flags_masked = flags & HVhek_MASK;
     char *k;
 {
     const int flags_masked = flags & HVhek_MASK;
     char *k;
@@ -107,12 +110,13 @@ S_save_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags)
     return hek;
 }
 
     return hek;
 }
 
-/* free the pool of temporary HE/HEK pairs retunrned by hv_fetch_ent
+/* free the pool of temporary HE/HEK pairs returned by hv_fetch_ent
  * for tied hashes */
 
 void
 Perl_free_tied_hv_pool(pTHX)
 {
  * for tied hashes */
 
 void
 Perl_free_tied_hv_pool(pTHX)
 {
+    dVAR;
     HE *he = PL_hv_fetch_ent_mh;
     while (he) {
        HE * const ohe = he;
     HE *he = PL_hv_fetch_ent_mh;
     while (he) {
        HE * const ohe = he;
@@ -120,7 +124,7 @@ Perl_free_tied_hv_pool(pTHX)
        he = HeNEXT(he);
        del_HE(ohe);
     }
        he = HeNEXT(he);
        del_HE(ohe);
     }
-    PL_hv_fetch_ent_mh = Nullhe;
+    PL_hv_fetch_ent_mh = NULL;
 }
 
 #if defined(USE_ITHREADS)
 }
 
 #if defined(USE_ITHREADS)
@@ -145,12 +149,12 @@ Perl_hek_dup(pTHX_ HEK *source, CLONE_PARAMS* param)
 }
 
 HE *
 }
 
 HE *
-Perl_he_dup(pTHX_ HE *e, bool shared, CLONE_PARAMS* param)
+Perl_he_dup(pTHX_ const HE *e, bool shared, CLONE_PARAMS* param)
 {
     HE *ret;
 
     if (!e)
 {
     HE *ret;
 
     if (!e)
-       return Nullhe;
+       return NULL;
     /* look for it in the table first */
     ret = (HE*)ptr_table_fetch(PL_ptr_table, e);
     if (ret)
     /* look for it in the table first */
     ret = (HE*)ptr_table_fetch(PL_ptr_table, e);
     if (ret)
@@ -265,6 +269,7 @@ Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen_i32, SV *val, U32 hash)
     return hek ? &HeVAL(hek) : NULL;
 }
 
     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)
 SV**
 Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val,
                  register U32 hash, int flags)
@@ -303,6 +308,7 @@ information on how to use this function on tied hashes.
 =cut
 */
 
 =cut
 */
 
+/* XXX This looks like an ideal candidate to inline */
 HE *
 Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash)
 {
 HE *
 Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash)
 {
@@ -364,8 +370,8 @@ Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 lval)
        flags = 0;
     }
     hek = hv_fetch_common (hv, NULL, key, klen, flags,
        flags = 0;
     }
     hek = hv_fetch_common (hv, NULL, key, klen, flags,
-                          HV_FETCH_JUST_SV | (lval ? HV_FETCH_LVALUE : 0),
-                          Nullsv, 0);
+                          lval ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) : HV_FETCH_JUST_SV,
+                          NULL, 0);
     return hek ? &HeVAL(hek) : NULL;
 }
 
     return hek ? &HeVAL(hek) : NULL;
 }
 
@@ -379,6 +385,7 @@ computed.
 =cut
 */
 
 =cut
 */
 
+/* XXX This looks like an ideal candidate to inline */
 bool
 Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
 {
 bool
 Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
 {
@@ -409,7 +416,7 @@ HE *
 Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
 {
     return hv_fetch_common(hv, keysv, NULL, 0, 0, 
 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), Nullsv, hash);
+                          (lval ? HV_FETCH_LVALUE : 0), NULL, hash);
 }
 
 STATIC HE *
 }
 
 STATIC HE *
@@ -425,7 +432,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     int masked_flags;
 
     if (!hv)
     int masked_flags;
 
     if (!hv)
-       return 0;
+       return NULL;
 
     if (keysv) {
        if (flags & HVhek_FREEKEY)
 
     if (keysv) {
        if (flags & HVhek_FREEKEY)
@@ -439,8 +446,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 
     xhv = (XPVHV*)SvANY(hv);
     if (SvMAGICAL(hv)) {
 
     xhv = (XPVHV*)SvANY(hv);
     if (SvMAGICAL(hv)) {
-       if (SvRMAGICAL(hv) && !(action & (HV_FETCH_ISSTORE|HV_FETCH_ISEXISTS)))
-         {
+       if (SvRMAGICAL(hv) && !(action & (HV_FETCH_ISSTORE|HV_FETCH_ISEXISTS))) {
            if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
                sv = sv_newmortal();
 
            if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
                sv = sv_newmortal();
 
@@ -467,7 +473,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                    Newx(k, HEK_BASESIZE + sizeof(SV*), char);
                    HeKEY_hek(entry) = (HEK*)k;
                }
                    Newx(k, HEK_BASESIZE + sizeof(SV*), char);
                    HeKEY_hek(entry) = (HEK*)k;
                }
-               HeNEXT(entry) = Nullhe;
+               HeNEXT(entry) = NULL;
                HeSVKEY_set(entry, keysv);
                HeVAL(entry) = sv;
                sv_upgrade(sv, SVt_PVLV);
                HeSVKEY_set(entry, keysv);
                HeVAL(entry) = sv;
                sv_upgrade(sv, SVt_PVLV);
@@ -488,13 +494,13 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                    if (isLOWER(key[i])) {
                        /* Would be nice if we had a routine to do the
                           copy and upercase in a single pass through.  */
                    if (isLOWER(key[i])) {
                        /* Would be nice if we had a routine to do the
                           copy and upercase in a single pass through.  */
-                       const char *nkey = strupr(savepvn(key,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)  */
                        /* 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,
+                       entry = hv_fetch_common(hv, NULL, nkey, klen,
                                                HVhek_FREEKEY, /* free nkey */
                                                0 /* non-LVAL fetch */,
                                                HVhek_FREEKEY, /* free nkey */
                                                0 /* non-LVAL fetch */,
-                                               Nullsv /* no value */,
+                                               NULL /* no value */,
                                                0 /* compute hash */);
                        if (!entry && (action & HV_FETCH_LVALUE)) {
                            /* This call will free key if necessary.
                                                0 /* compute hash */);
                        if (!entry && (action & HV_FETCH_LVALUE)) {
                            /* This call will free key if necessary.
@@ -502,7 +508,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                               call optimise.  */
                            entry = hv_fetch_common(hv, keysv, key, klen,
                                                    flags, HV_FETCH_ISSTORE,
                               call optimise.  */
                            entry = hv_fetch_common(hv, keysv, key, klen,
                                                    flags, HV_FETCH_ISSTORE,
-                                                   NEWSV(61,0), hash);
+                                                   newSV(0), hash);
                        } else {
                            if (flags & HVhek_FREEKEY)
                                Safefree(key);
                        } else {
                            if (flags & HVhek_FREEKEY)
                                Safefree(key);
@@ -545,7 +551,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                /* Will need to free this, so set FREEKEY flag.  */
                key = savepvn(key,klen);
                key = (const char*)strupr((char*)key);
                /* Will need to free this, so set FREEKEY flag.  */
                key = savepvn(key,klen);
                key = (const char*)strupr((char*)key);
-               is_utf8 = 0;
+               is_utf8 = FALSE;
                hash = 0;
                keysv = 0;
 
                hash = 0;
                keysv = 0;
 
@@ -579,7 +585,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                if (!HvARRAY(hv) && !needs_store) {
                    if (flags & HVhek_FREEKEY)
                        Safefree(key);
                if (!HvARRAY(hv) && !needs_store) {
                    if (flags & HVhek_FREEKEY)
                        Safefree(key);
-                   return Nullhe;
+                   return NULL;
                }
 #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)) {
@@ -588,7 +594,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                    /* Will need to free this, so set FREEKEY flag.  */
                    key = savepvn(key,klen);
                    key = (const char*)strupr((char*)key);
                    /* Will need to free this, so set FREEKEY flag.  */
                    key = savepvn(key,klen);
                    key = (const char*)strupr((char*)key);
-                   is_utf8 = 0;
+                   is_utf8 = FALSE;
                    hash = 0;
                    keysv = 0;
 
                    hash = 0;
                    keysv = 0;
 
@@ -630,7 +636,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     }
 
     if (is_utf8) {
     }
 
     if (is_utf8) {
-       char * const keysave = (char * const)key;
+       char * const keysave = (char *)key;
        key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
         if (is_utf8)
            flags |= HVhek_UTF8;
        key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
         if (is_utf8)
            flags |= HVhek_UTF8;
@@ -662,7 +668,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     masked_flags = (flags & HVhek_MASK);
 
 #ifdef DYNAMIC_ENV_FETCH
     masked_flags = (flags & HVhek_MASK);
 
 #ifdef DYNAMIC_ENV_FETCH
-    if (!HvARRAY(hv)) entry = Null(HE*);
+    if (!HvARRAY(hv)) entry = NULL;
     else
 #endif
     {
     else
 #endif
     {
@@ -688,7 +694,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                    /* 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.  */
                    /* 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,
+                   HEK * const new_hek = share_hek_flags(key, klen, hash,
                                                   masked_flags);
                    unshare_hek (HeKEY_hek(entry));
                    HeKEY_hek(entry) = new_hek;
                                                   masked_flags);
                    unshare_hek (HeKEY_hek(entry));
                    HeKEY_hek(entry) = new_hek;
@@ -722,7 +728,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                        break;
                    }
                    /* LVAL fetch which actaully needs a store.  */
                        break;
                    }
                    /* LVAL fetch which actaully needs a store.  */
-                   val = NEWSV(61,0);
+                   val = newSV(0);
                    HvPLACEHOLDERS(hv)--;
                } else {
                    /* store */
                    HvPLACEHOLDERS(hv)--;
                } else {
                    /* store */
@@ -758,7 +764,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 #endif
 
     if (!entry && SvREADONLY(hv) && !(action & HV_FETCH_ISEXISTS)) {
 #endif
 
     if (!entry && SvREADONLY(hv) && !(action & HV_FETCH_ISEXISTS)) {
-       S_hv_notallowed(aTHX_ flags, key, klen,
+       hv_notallowed(flags, key, klen,
                        "Attempt to access disallowed key '%"SVf"' in"
                        " a restricted hash");
     }
                        "Attempt to access disallowed key '%"SVf"' in"
                        " a restricted hash");
     }
@@ -769,7 +775,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
        return 0;
     }
     if (action & HV_FETCH_LVALUE) {
        return 0;
     }
     if (action & HV_FETCH_LVALUE) {
-       val = NEWSV(61,0);
+       val = newSV(0);
        if (SvMAGICAL(hv)) {
            /* At this point the old hv_fetch code would call to hv_store,
               which in turn might do some tied magic. So we need to make that
        if (SvMAGICAL(hv)) {
            /* At this point the old hv_fetch code would call to hv_store,
               which in turn might do some tied magic. So we need to make that
@@ -824,7 +830,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     {
        const HE *counter = HeNEXT(entry);
 
     {
        const HE *counter = HeNEXT(entry);
 
-       xhv->xhv_keys++; /* HvKEYS(hv)++ */
+       xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */
        if (!counter) {                         /* initial entry? */
            xhv->xhv_fill++; /* HvFILL(hv)++ */
        } else if (xhv->xhv_keys > (IV)xhv->xhv_max) {
        if (!counter) {                         /* initial entry? */
            xhv->xhv_fill++; /* HvFILL(hv)++ */
        } else if (xhv->xhv_keys > (IV)xhv->xhv_max) {
@@ -851,7 +857,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 }
 
 STATIC void
 }
 
 STATIC void
-S_hv_magic_check(pTHX_ HV *hv, bool *needs_copy, bool *needs_store)
+S_hv_magic_check(HV *hv, bool *needs_copy, bool *needs_store)
 {
     const MAGIC *mg = SvMAGIC(hv);
     *needs_copy = FALSE;
 {
     const MAGIC *mg = SvMAGIC(hv);
     *needs_copy = FALSE;
@@ -859,9 +865,7 @@ S_hv_magic_check(pTHX_ HV *hv, bool *needs_copy, bool *needs_store)
     while (mg) {
        if (isUPPER(mg->mg_type)) {
            *needs_copy = TRUE;
     while (mg) {
        if (isUPPER(mg->mg_type)) {
            *needs_copy = TRUE;
-           switch (mg->mg_type) {
-           case PERL_MAGIC_tied:
-           case PERL_MAGIC_sig:
+           if (mg->mg_type == PERL_MAGIC_tied) {
                *needs_store = FALSE;
                return; /* We've set all there is to set. */
            }
                *needs_store = FALSE;
                return; /* We've set all there is to set. */
            }
@@ -881,13 +885,13 @@ Evaluates the hash in scalar context and returns the result. Handles magic when
 SV *
 Perl_hv_scalar(pTHX_ HV *hv)
 {
 SV *
 Perl_hv_scalar(pTHX_ HV *hv)
 {
-    MAGIC *mg;
     SV *sv;
     SV *sv;
-    
-    if ((SvRMAGICAL(hv) && (mg = mg_find((SV*)hv, PERL_MAGIC_tied)))) {
-        sv = magic_scalarpack(hv, mg);
-        return sv;
-    } 
+
+    if (SvRMAGICAL(hv)) {
+       MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_tied);
+       if (mg)
+           return magic_scalarpack(hv, mg);
+    }
 
     sv = sv_newmortal();
     if (HvFILL((HV*)hv)) 
 
     sv = sv_newmortal();
     if (HvFILL((HV*)hv)) 
@@ -914,13 +918,14 @@ SV *
 Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 flags)
 {
     STRLEN klen;
 Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 flags)
 {
     STRLEN klen;
-    int k_flags = 0;
+    int k_flags;
 
     if (klen_i32 < 0) {
        klen = -klen_i32;
 
     if (klen_i32 < 0) {
        klen = -klen_i32;
-       k_flags |= HVhek_UTF8;
+       k_flags = HVhek_UTF8;
     } else {
        klen = klen_i32;
     } else {
        klen = klen_i32;
+       k_flags = 0;
     }
     return hv_delete_common(hv, NULL, key, klen, k_flags, flags, 0);
 }
     }
     return hv_delete_common(hv, NULL, key, klen, k_flags, flags, 0);
 }
@@ -936,6 +941,7 @@ precomputed hash value, or 0 to ask for it to be computed.
 =cut
 */
 
 =cut
 */
 
+/* XXX This looks like an ideal candidate to inline */
 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)
 {
@@ -951,12 +957,11 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     register HE *entry;
     register HE **oentry;
     HE *const *first_entry;
     register HE *entry;
     register HE **oentry;
     HE *const *first_entry;
-    SV *sv;
     bool is_utf8;
     int masked_flags;
 
     if (!hv)
     bool is_utf8;
     int masked_flags;
 
     if (!hv)
-       return Nullsv;
+       return NULL;
 
     if (keysv) {
        if (k_flags & HVhek_FREEKEY)
 
     if (keysv) {
        if (k_flags & HVhek_FREEKEY)
@@ -974,9 +979,10 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
        hv_magic_check (hv, &needs_copy, &needs_store);
 
        if (needs_copy) {
        hv_magic_check (hv, &needs_copy, &needs_store);
 
        if (needs_copy) {
+           SV *sv;
            entry = hv_fetch_common(hv, keysv, key, klen,
                                    k_flags & ~HVhek_FREEKEY, HV_FETCH_LVALUE,
            entry = hv_fetch_common(hv, keysv, key, klen,
                                    k_flags & ~HVhek_FREEKEY, HV_FETCH_LVALUE,
-                                   Nullsv, hash);
+                                   NULL, hash);
            sv = entry ? HeVAL(entry) : NULL;
            if (sv) {
                if (SvMAGICAL(sv)) {
            sv = entry ? HeVAL(entry) : NULL;
            if (sv) {
                if (SvMAGICAL(sv)) {
@@ -988,7 +994,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                        sv_unmagic(sv, PERL_MAGIC_tiedelem);
                        return sv;
                    }           
                        sv_unmagic(sv, PERL_MAGIC_tiedelem);
                        return sv;
                    }           
-                   return Nullsv;              /* element cannot be deleted */
+                   return NULL;                /* 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)) {
@@ -1008,10 +1014,10 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     }
     xhv = (XPVHV*)SvANY(hv);
     if (!HvARRAY(hv))
     }
     xhv = (XPVHV*)SvANY(hv);
     if (!HvARRAY(hv))
-       return Nullsv;
+       return NULL;
 
     if (is_utf8) {
 
     if (is_utf8) {
-       const char *keysave = key;
+       const char * const keysave = key;
        key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
 
         if (is_utf8)
        key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
 
         if (is_utf8)
@@ -1044,6 +1050,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     first_entry = oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)];
     entry = *oentry;
     for (; entry; oentry = &HeNEXT(entry), entry = *oentry) {
     first_entry = oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)];
     entry = *oentry;
     for (; entry; oentry = &HeNEXT(entry), entry = *oentry) {
+       SV *sv;
        if (HeHASH(entry) != hash)              /* strings can't be equal */
            continue;
        if (HeKLEN(entry) != (I32)klen)
        if (HeHASH(entry) != hash)              /* strings can't be equal */
            continue;
        if (HeKLEN(entry) != (I32)klen)
@@ -1060,13 +1067,12 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
        }
 
        /* if placeholder is here, it's already been deleted.... */
        }
 
        /* if placeholder is here, it's already been deleted.... */
-       if (HeVAL(entry) == &PL_sv_placeholder)
-       {
-         if (k_flags & HVhek_FREEKEY)
-            Safefree(key);
-         return Nullsv;
+       if (HeVAL(entry) == &PL_sv_placeholder) {
+           if (k_flags & HVhek_FREEKEY)
+               Safefree(key);
+           return NULL;
        }
        }
-       else if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
+       if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
            S_hv_notallowed(aTHX_ k_flags, key, klen,
                            "Attempt to delete readonly key '%"SVf"' from"
                            " a restricted hash");
            S_hv_notallowed(aTHX_ k_flags, key, klen,
                            "Attempt to delete readonly key '%"SVf"' from"
                            " a restricted hash");
@@ -1075,7 +1081,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
             Safefree(key);
 
        if (d_flags & G_DISCARD)
             Safefree(key);
 
        if (d_flags & G_DISCARD)
-           sv = Nullsv;
+           sv = NULL;
        else {
            sv = sv_2mortal(HeVAL(entry));
            HeVAL(entry) = &PL_sv_placeholder;
        else {
            sv = sv_2mortal(HeVAL(entry));
            HeVAL(entry) = &PL_sv_placeholder;
@@ -1102,7 +1108,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                HvLAZYDEL_on(hv);
            else
                hv_free_ent(hv, entry);
                HvLAZYDEL_on(hv);
            else
                hv_free_ent(hv, entry);
-           xhv->xhv_keys--; /* HvKEYS(hv)-- */
+           xhv->xhv_keys--; /* HvTOTALKEYS(hv)-- */
            if (xhv->xhv_keys == 0)
                HvHASKFLAGS_off(hv);
        }
            if (xhv->xhv_keys == 0)
                HvHASKFLAGS_off(hv);
        }
@@ -1116,12 +1122,13 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 
     if (k_flags & HVhek_FREEKEY)
        Safefree(key);
 
     if (k_flags & HVhek_FREEKEY)
        Safefree(key);
-    return Nullsv;
+    return NULL;
 }
 
 STATIC void
 S_hsplit(pTHX_ HV *hv)
 {
 }
 
 STATIC void
 S_hsplit(pTHX_ HV *hv)
 {
+    dVAR;
     register XPVHV* xhv = (XPVHV*)SvANY(hv);
     const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
     register I32 newsize = oldsize * 2;
     register XPVHV* xhv = (XPVHV*)SvANY(hv);
     const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
     register I32 newsize = oldsize * 2;
@@ -1261,7 +1268,7 @@ S_hsplit(pTHX_ HV *hv)
 
            if (was_shared) {
                /* Unshare it.  */
 
            if (was_shared) {
                /* Unshare it.  */
-               HEK *new_hek
+               HEK * const new_hek
                    = save_hek_flags(HeKEY(entry), HeKLEN(entry),
                                     hash, HeKFLAGS(entry));
                unshare_hek (HeKEY_hek(entry));
                    = save_hek_flags(HeKEY(entry), HeKLEN(entry),
                                     hash, HeKFLAGS(entry));
                unshare_hek (HeKEY_hek(entry));
@@ -1291,6 +1298,7 @@ S_hsplit(pTHX_ HV *hv)
 void
 Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
 {
 void
 Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
 {
+    dVAR;
     register XPVHV* xhv = (XPVHV*)SvANY(hv);
     const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
     register I32 newsize;
     register XPVHV* xhv = (XPVHV*)SvANY(hv);
     const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
     register I32 newsize;
@@ -1359,8 +1367,9 @@ Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
        if (!*aep)                              /* non-existent */
            continue;
        for (oentry = aep, entry = *aep; entry; entry = *oentry) {
        if (!*aep)                              /* non-existent */
            continue;
        for (oentry = aep, entry = *aep; entry; entry = *oentry) {
-           register I32 j;
-           if ((j = (HeHASH(entry) & newsize)) != i) {
+           register I32 j = (HeHASH(entry) & newsize);
+
+           if (j != i) {
                j -= i;
                *oentry = HeNEXT(entry);
                if (!(HeNEXT(entry) = aep[j]))
                j -= i;
                *oentry = HeNEXT(entry);
                if (!(HeNEXT(entry) = aep[j]))
@@ -1388,7 +1397,7 @@ HV *
 Perl_newHV(pTHX)
 {
     register XPVHV* xhv;
 Perl_newHV(pTHX)
 {
     register XPVHV* xhv;
-    HV * const hv = (HV*)NEWSV(502,0);
+    HV * const hv = (HV*)newSV(0);
 
     sv_upgrade((SV *)hv, SVt_PVHV);
     xhv = (XPVHV*)SvANY(hv);
 
     sv_upgrade((SV *)hv, SVt_PVHV);
     xhv = (XPVHV*)SvANY(hv);
@@ -1417,14 +1426,15 @@ Perl_newHVhv(pTHX_ HV *ohv)
        /* It's an ordinary hash, so copy it fast. AMS 20010804 */
        STRLEN i;
        const bool shared = !!HvSHAREKEYS(ohv);
        /* It's an ordinary hash, so copy it fast. AMS 20010804 */
        STRLEN i;
        const bool shared = !!HvSHAREKEYS(ohv);
-       HE **ents, **oents = (HE **)HvARRAY(ohv);
+       HE **ents, ** const oents = (HE **)HvARRAY(ohv);
        char *a;
        Newx(a, PERL_HV_ARRAY_ALLOC_BYTES(hv_max+1), char);
        ents = (HE**)a;
 
        /* In each bucket... */
        for (i = 0; i <= hv_max; i++) {
        char *a;
        Newx(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];
+           HE *prev = NULL;
+           HE *oent = oents[i];
 
            if (!oent) {
                ents[i] = NULL;
 
            if (!oent) {
                ents[i] = NULL;
@@ -1432,13 +1442,13 @@ Perl_newHVhv(pTHX_ HV *ohv)
            }
 
            /* Copy the linked list of entries. */
            }
 
            /* Copy the linked list of entries. */
-           for (oent = oents[i]; oent; oent = HeNEXT(oent)) {
+           for (; oent; oent = HeNEXT(oent)) {
                const U32 hash   = HeHASH(oent);
                const char * const key = HeKEY(oent);
                const STRLEN len = HeKLEN(oent);
                const int flags  = HeKFLAGS(oent);
                const U32 hash   = HeHASH(oent);
                const char * const key = HeKEY(oent);
                const STRLEN len = HeKLEN(oent);
                const int flags  = HeKFLAGS(oent);
+               HE * const ent   = new_HE();
 
 
-               ent = new_HE();
                HeVAL(ent)     = newSVsv(HeVAL(oent));
                HeKEY_hek(ent)
                     = shared ? share_hek_flags(key, len, hash, flags)
                HeVAL(ent)     = newSVsv(HeVAL(oent));
                HeKEY_hek(ent)
                     = shared ? share_hek_flags(key, len, hash, flags)
@@ -1456,7 +1466,7 @@ Perl_newHVhv(pTHX_ HV *ohv)
        HvFILL(hv)  = hv_fill;
        HvTOTALKEYS(hv)  = HvTOTALKEYS(ohv);
        HvARRAY(hv) = ents;
        HvFILL(hv)  = hv_fill;
        HvTOTALKEYS(hv)  = HvTOTALKEYS(ohv);
        HvARRAY(hv) = ents;
-    }
+    } /* not magical */
     else {
        /* Iterate over ohv, copying keys and values one at a time. */
        HE *entry;
     else {
        /* Iterate over ohv, copying keys and values one at a time. */
        HE *entry;
@@ -1484,6 +1494,7 @@ Perl_newHVhv(pTHX_ HV *ohv)
 void
 Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
 {
 void
 Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
 {
+    dVAR;
     SV *val;
 
     if (!entry)
     SV *val;
 
     if (!entry)
@@ -1506,6 +1517,7 @@ Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
 void
 Perl_hv_delayfree_ent(pTHX_ HV *hv, register HE *entry)
 {
 void
 Perl_hv_delayfree_ent(pTHX_ HV *hv, register HE *entry)
 {
+    dVAR;
     if (!entry)
        return;
     /* SvREFCNT_inc to counter the SvREFCNT_dec in hv_free_ent  */
     if (!entry)
        return;
     /* SvREFCNT_inc to counter the SvREFCNT_dec in hv_free_ent  */
@@ -1545,7 +1557,7 @@ Perl_hv_clear(pTHX_ HV *hv)
                /* not already placeholder */
                if (HeVAL(entry) != &PL_sv_placeholder) {
                    if (HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
                /* not already placeholder */
                if (HeVAL(entry) != &PL_sv_placeholder) {
                    if (HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
-                       SV* keysv = hv_iterkeysv(entry);
+                       SV* const keysv = hv_iterkeysv(entry);
                        Perl_croak(aTHX_
        "Attempt to delete readonly key '%"SVf"' from a restricted hash",
                                   keysv);
                        Perl_croak(aTHX_
        "Attempt to delete readonly key '%"SVf"' from a restricted hash",
                                   keysv);
@@ -1603,19 +1615,16 @@ Perl_hv_clear_placeholders(pTHX_ HV *hv)
     i = HvMAX(hv);
     do {
        /* Loop down the linked list heads  */
     i = HvMAX(hv);
     do {
        /* Loop down the linked list heads  */
-       bool first = 1;
+       bool first = TRUE;
        HE **oentry = &(HvARRAY(hv))[i];
        HE **oentry = &(HvARRAY(hv))[i];
-       HE *entry = *oentry;
-
-       if (!entry)
-           continue;
+       HE *entry;
 
 
-       for (; entry; entry = *oentry) {
+       while ((entry = *oentry)) {
            if (HeVAL(entry) == &PL_sv_placeholder) {
                *oentry = HeNEXT(entry);
                if (first && !*oentry)
                    HvFILL(hv)--; /* This linked list is now empty.  */
            if (HeVAL(entry) == &PL_sv_placeholder) {
                *oentry = HeNEXT(entry);
                if (first && !*oentry)
                    HvFILL(hv)--; /* This linked list is now empty.  */
-               if (HvEITER_get(hv))
+               if (entry == HvEITER_get(hv))
                    HvLAZYDEL_on(hv);
                else
                    hv_free_ent(hv, entry);
                    HvLAZYDEL_on(hv);
                else
                    hv_free_ent(hv, entry);
@@ -1630,7 +1639,7 @@ Perl_hv_clear_placeholders(pTHX_ HV *hv)
                }
            } else {
                oentry = &HeNEXT(entry);
                }
            } else {
                oentry = &HeNEXT(entry);
-               first = 0;
+               first = FALSE;
            }
        }
     } while (--i >= 0);
            }
        }
     } while (--i >= 0);
@@ -1642,70 +1651,137 @@ Perl_hv_clear_placeholders(pTHX_ HV *hv)
 STATIC void
 S_hfreeentries(pTHX_ HV *hv)
 {
 STATIC void
 S_hfreeentries(pTHX_ HV *hv)
 {
-    register HE **array;
-    register HE *entry;
-    I32 riter;
-    I32 max;
-    struct xpvhv_aux *iter;
+    /* This is the array that we're going to restore  */
+    HE **orig_array;
+    HEK *name;
+    int attempts = 100;
 
     if (!HvARRAY(hv))
        return;
 
 
     if (!HvARRAY(hv))
        return;
 
-    iter =  SvOOK(hv) ? HvAUX(hv) : 0;
+    if (SvOOK(hv)) {
+       /* If the hash is actually a symbol table with a name, look after the
+          name.  */
+       struct xpvhv_aux *iter = HvAUX(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**); 
-    SvFLAGS(hv) &= ~SVf_OOK;
+       name = iter->xhv_name;
+       iter->xhv_name = NULL;
+    } else {
+       name = NULL;
+    }
 
 
-    HvFILL(hv) = 0;
-    ((XPVHV*) SvANY(hv))->xhv_keys = 0;
+    orig_array = HvARRAY(hv);
+    /* orig_array remains unchanged throughout the loop. If after freeing all
+       the entries it turns out that one of the little blighters has triggered
+       an action that has caused HvARRAY to be re-allocated, then we set
+       array to the new HvARRAY, and try again.  */
 
 
-    entry = array[0];
-    for (;;) {
-       if (entry) {
-           register HE * const oentry = entry;
-           entry = HeNEXT(entry);
-           hv_free_ent(hv, oentry);
+    while (1) {
+       /* This is the one we're going to try to empty.  First time round
+          it's the original array.  (Hopefully there will only be 1 time
+          round) */
+       HE ** const array = HvARRAY(hv);
+       I32 i = HvMAX(hv);
+
+       /* Because we have taken xhv_name out, the only allocated pointer
+          in the aux structure that might exist is the backreference array.
+       */
+
+       if (SvOOK(hv)) {
+           HE *entry;
+           struct xpvhv_aux *iter = HvAUX(hv);
+           /* If there are weak references to this HV, we need to avoid
+              freeing them up here.  In particular we need to keep the AV
+              visible as what we're deleting might well have weak references
+              back to this HV, so the for loop below may well trigger
+              the removal of backreferences from this array.  */
+
+           if (iter->xhv_backreferences) {
+               /* So donate them to regular backref magic to keep them safe.
+                  The sv_magic will increase the reference count of the AV,
+                  so we need to drop it first. */
+               SvREFCNT_dec(iter->xhv_backreferences);
+               if (AvFILLp(iter->xhv_backreferences) == -1) {
+                   /* Turns out that the array is empty. Just free it.  */
+                   SvREFCNT_dec(iter->xhv_backreferences);
+
+               } else {
+                   sv_magic((SV*)hv, (SV*)iter->xhv_backreferences,
+                            PERL_MAGIC_backref, NULL, 0);
+               }
+               iter->xhv_backreferences = NULL;
+           }
+
+           entry = iter->xhv_eiter; /* HvEITER(hv) */
+           if (entry && HvLAZYDEL(hv)) {       /* was deleted earlier? */
+               HvLAZYDEL_off(hv);
+               hv_free_ent(hv, entry);
+           }
+           iter->xhv_riter = -1;       /* HvRITER(hv) = -1 */
+           iter->xhv_eiter = NULL;     /* HvEITER(hv) = NULL */
+
+           /* There are now no allocated pointers in the aux structure.  */
+
+           SvFLAGS(hv) &= ~SVf_OOK; /* Goodbye, aux structure.  */
+           /* What aux structure?  */
        }
        }
-       if (!entry) {
-           if (++riter > max)
-               break;
-           entry = array[riter];
+
+       /* 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;
+       HvFILL(hv) = 0;
+       ((XPVHV*) SvANY(hv))->xhv_keys = 0;
+
+
+       do {
+           /* Loop down the linked list heads  */
+           HE *entry = array[i];
+
+           while (entry) {
+               register HE * const oentry = entry;
+               entry = HeNEXT(entry);
+               hv_free_ent(hv, oentry);
+           }
+       } while (--i >= 0);
+
+       /* As there are no allocated pointers in the aux structure, it's now
+          safe to free the array we just cleaned up, if it's not the one we're
+          going to put back.  */
+       if (array != orig_array) {
+           Safefree(array);
        }
        }
-    }
 
 
-    if (SvOOK(hv)) {
-       /* Someone attempted to iterate or set the hash name while we had
-          the array set to 0.  */
-       assert(HvARRAY(hv));
+       if (!HvARRAY(hv)) {
+           /* Good. No-one added anything this time round.  */
+           break;
+       }
 
 
-       if (HvAUX(hv)->xhv_name)
-           unshare_hek_or_pvn(HvAUX(hv)->xhv_name, 0, 0, 0);
-       /* SvOOK_off calls sv_backoff, which isn't correct.  */
+       if (SvOOK(hv)) {
+           /* Someone attempted to iterate or set the hash name while we had
+              the array set to 0.  We'll catch backferences on the next time
+              round the while loop.  */
+           assert(HvARRAY(hv));
 
 
-       Safefree(HvARRAY(hv));
-       HvARRAY(hv) = 0;
-       SvFLAGS(hv) &= ~SVf_OOK;
-    }
+           if (HvAUX(hv)->xhv_name) {
+               unshare_hek_or_pvn(HvAUX(hv)->xhv_name, 0, 0, 0);
+           }
+       }
 
 
-    /* FIXME - things will still go horribly wrong (or at least leak) if
-       people attempt to add elements to the hash while we're undef()ing it  */
-    if (iter) {
-       entry = iter->xhv_eiter; /* HvEITER(hv) */
-       if (entry && HvLAZYDEL(hv)) {   /* was deleted earlier? */
-           HvLAZYDEL_off(hv);
-           hv_free_ent(hv, entry);
+       if (--attempts == 0) {
+           Perl_die(aTHX_ "panic: hfreeentries failed to free hash - something is repeatedly re-creating entries");
        }
        }
-       iter->xhv_riter = -1;   /* HvRITER(hv) = -1 */
-       iter->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
-       SvFLAGS(hv) |= SVf_OOK;
     }
     }
+       
+    HvARRAY(hv) = orig_array;
 
 
-    HvARRAY(hv) = array;
+    /* If the hash was actually a symbol table, put the name back.  */
+    if (name) {
+       /* We have restored the original array.  If name is non-NULL, then
+          the original array had an aux structure at the end. So this is
+          valid:  */
+       SvFLAGS(hv) |= SVf_OOK;
+       HvAUX(hv)->xhv_name = name;
+    }
 }
 
 /*
 }
 
 /*
@@ -1719,8 +1795,10 @@ Undefines the hash.
 void
 Perl_hv_undef(pTHX_ HV *hv)
 {
 void
 Perl_hv_undef(pTHX_ HV *hv)
 {
+    dVAR;
     register XPVHV* xhv;
     const char *name;
     register XPVHV* xhv;
     const char *name;
+
     if (!hv)
        return;
     DEBUG_A(Perl_hv_assert(aTHX_ hv));
     if (!hv)
        return;
     DEBUG_A(Perl_hv_assert(aTHX_ hv));
@@ -1729,7 +1807,7 @@ Perl_hv_undef(pTHX_ HV *hv)
     if ((name = HvNAME_get(hv))) {
         if(PL_stashcache)
            hv_delete(PL_stashcache, name, HvNAMELEN_get(hv), G_DISCARD);
     if ((name = HvNAME_get(hv))) {
         if(PL_stashcache)
            hv_delete(PL_stashcache, name, HvNAMELEN_get(hv), G_DISCARD);
-       Perl_hv_name_set(aTHX_ hv, 0, 0, 0);
+       hv_name_set(hv, NULL, 0, 0);
     }
     SvFLAGS(hv) &= ~SVf_OOK;
     Safefree(HvARRAY(hv));
     }
     SvFLAGS(hv) &= ~SVf_OOK;
     Safefree(HvARRAY(hv));
@@ -1742,7 +1820,7 @@ Perl_hv_undef(pTHX_ HV *hv)
 }
 
 static struct xpvhv_aux*
 }
 
 static struct xpvhv_aux*
-S_hv_auxinit(pTHX_ HV *hv) {
+S_hv_auxinit(HV *hv) {
     struct xpvhv_aux *iter;
     char *array;
 
     struct xpvhv_aux *iter;
     char *array;
 
@@ -1760,9 +1838,9 @@ S_hv_auxinit(pTHX_ HV *hv) {
     iter = HvAUX(hv);
 
     iter->xhv_riter = -1;      /* HvRITER(hv) = -1 */
     iter = HvAUX(hv);
 
     iter->xhv_riter = -1;      /* HvRITER(hv) = -1 */
-    iter->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
+    iter->xhv_eiter = NULL;    /* HvEITER(hv) = NULL */
     iter->xhv_name = 0;
     iter->xhv_name = 0;
-
+    iter->xhv_backreferences = 0;
     return iter;
 }
 
     return iter;
 }
 
@@ -1784,22 +1862,20 @@ value, you can get it through the macro C<HvFILL(tb)>.
 I32
 Perl_hv_iterinit(pTHX_ HV *hv)
 {
 I32
 Perl_hv_iterinit(pTHX_ HV *hv)
 {
-    HE *entry;
-
     if (!hv)
        Perl_croak(aTHX_ "Bad hash");
 
     if (SvOOK(hv)) {
     if (!hv)
        Perl_croak(aTHX_ "Bad hash");
 
     if (SvOOK(hv)) {
-       struct xpvhv_aux *iter = HvAUX(hv);
-       entry = iter->xhv_eiter; /* HvEITER(hv) */
+       struct xpvhv_aux * const iter = HvAUX(hv);
+       HE * const entry = iter->xhv_eiter; /* HvEITER(hv) */
        if (entry && HvLAZYDEL(hv)) {   /* was deleted earlier? */
            HvLAZYDEL_off(hv);
            hv_free_ent(hv, entry);
        }
        iter->xhv_riter = -1;   /* HvRITER(hv) = -1 */
        if (entry && HvLAZYDEL(hv)) {   /* was deleted earlier? */
            HvLAZYDEL_off(hv);
            hv_free_ent(hv, entry);
        }
        iter->xhv_riter = -1;   /* HvRITER(hv) = -1 */
-       iter->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
+       iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */
     } else {
     } else {
-       S_hv_auxinit(aTHX_ hv);
+       hv_auxinit(hv);
     }
 
     /* used to be xhv->xhv_fill before 5.004_65 */
     }
 
     /* used to be xhv->xhv_fill before 5.004_65 */
@@ -1813,7 +1889,7 @@ Perl_hv_riter_p(pTHX_ HV *hv) {
     if (!hv)
        Perl_croak(aTHX_ "Bad hash");
 
     if (!hv)
        Perl_croak(aTHX_ "Bad hash");
 
-    iter = SvOOK(hv) ? HvAUX(hv) : S_hv_auxinit(aTHX_ hv);
+    iter = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv);
     return &(iter->xhv_riter);
 }
 
     return &(iter->xhv_riter);
 }
 
@@ -1824,7 +1900,7 @@ Perl_hv_eiter_p(pTHX_ HV *hv) {
     if (!hv)
        Perl_croak(aTHX_ "Bad hash");
 
     if (!hv)
        Perl_croak(aTHX_ "Bad hash");
 
-    iter = SvOOK(hv) ? HvAUX(hv) : S_hv_auxinit(aTHX_ hv);
+    iter = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv);
     return &(iter->xhv_eiter);
 }
 
     return &(iter->xhv_eiter);
 }
 
@@ -1841,7 +1917,7 @@ Perl_hv_riter_set(pTHX_ HV *hv, I32 riter) {
        if (riter == -1)
            return;
 
        if (riter == -1)
            return;
 
-       iter = S_hv_auxinit(aTHX_ hv);
+       iter = hv_auxinit(hv);
     }
     iter->xhv_riter = riter;
 }
     }
     iter->xhv_riter = riter;
 }
@@ -1861,17 +1937,22 @@ Perl_hv_eiter_set(pTHX_ HV *hv, HE *eiter) {
        if (!eiter)
            return;
 
        if (!eiter)
            return;
 
-       iter = S_hv_auxinit(aTHX_ hv);
+       iter = hv_auxinit(hv);
     }
     iter->xhv_eiter = eiter;
 }
 
 void
     }
     iter->xhv_eiter = eiter;
 }
 
 void
-Perl_hv_name_set(pTHX_ HV *hv, const char *name, I32 len, int flags)
+Perl_hv_name_set(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
 {
 {
+    dVAR;
     struct xpvhv_aux *iter;
     U32 hash;
     struct xpvhv_aux *iter;
     U32 hash;
-    (void)flags;
+
+    PERL_UNUSED_ARG(flags);
+
+    if (len > I32_MAX)
+       Perl_croak(aTHX_ "panic: hv name too long (%"UVuf")", (UV) len);
 
     if (SvOOK(hv)) {
        iter = HvAUX(hv);
 
     if (SvOOK(hv)) {
        iter = HvAUX(hv);
@@ -1882,13 +1963,37 @@ Perl_hv_name_set(pTHX_ HV *hv, const char *name, I32 len, int flags)
        if (name == 0)
            return;
 
        if (name == 0)
            return;
 
-       iter = S_hv_auxinit(aTHX_ hv);
+       iter = hv_auxinit(hv);
     }
     PERL_HASH(hash, name, len);
     iter->xhv_name = name ? share_hek(name, len, hash) : 0;
 }
 
     }
     PERL_HASH(hash, name, len);
     iter->xhv_name = name ? share_hek(name, len, hash) : 0;
 }
 
+AV **
+Perl_hv_backreferences_p(pTHX_ HV *hv) {
+    struct xpvhv_aux * const iter = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv);
+    PERL_UNUSED_CONTEXT;
+    return &(iter->xhv_backreferences);
+}
+
+void
+Perl_hv_kill_backrefs(pTHX_ HV *hv) {
+    AV *av;
+
+    if (!SvOOK(hv))
+       return;
+
+    av = HvAUX(hv)->xhv_backreferences;
+
+    if (av) {
+       HvAUX(hv)->xhv_backreferences = 0;
+       Perl_sv_kill_backrefs(aTHX_ (SV*) hv, av);
+    }
+}
+
 /*
 /*
+hv_iternext is implemented as a macro in hv.h
+
 =for apidoc hv_iternext
 
 Returns entries from a hash iterator.  See C<hv_iterinit>.
 =for apidoc hv_iternext
 
 Returns entries from a hash iterator.  See C<hv_iterinit>.
@@ -1901,16 +2006,6 @@ to free the entry on the next call to C<hv_iternext>, so you must not discard
 your iterator immediately else the entry will leak - call C<hv_iternext> to
 trigger the resource deallocation.
 
 your iterator immediately else the entry will leak - call C<hv_iternext> to
 trigger the resource deallocation.
 
-=cut
-*/
-
-HE *
-Perl_hv_iternext(pTHX_ HV *hv)
-{
-    return hv_iternext_flags(hv, 0);
-}
-
-/*
 =for apidoc hv_iternext_flags
 
 Returns entries from a hash iterator.  See C<hv_iterinit> and C<hv_iternext>.
 =for apidoc hv_iternext_flags
 
 Returns entries from a hash iterator.  See C<hv_iterinit> and C<hv_iternext>.
@@ -1950,7 +2045,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
     oldentry = entry = iter->xhv_eiter; /* HvEITER(hv) */
 
     if ((mg = SvTIED_mg((SV*)hv, PERL_MAGIC_tied))) {
     oldentry = entry = iter->xhv_eiter; /* HvEITER(hv) */
 
     if ((mg = SvTIED_mg((SV*)hv, PERL_MAGIC_tied))) {
-       SV *key = sv_newmortal();
+       SV * const key = sv_newmortal();
        if (entry) {
            sv_setsv(key, HeSVKEY_force(entry));
            SvREFCNT_dec(HeSVKEY(entry));       /* get rid of previous key */
        if (entry) {
            sv_setsv(key, HeSVKEY_force(entry));
            SvREFCNT_dec(HeSVKEY(entry));       /* get rid of previous key */
@@ -1970,19 +2065,28 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
        magic_nextpack((SV*) hv,mg,key);
        if (SvOK(key)) {
            /* force key to stay around until next time */
        magic_nextpack((SV*) hv,mg,key);
        if (SvOK(key)) {
            /* force key to stay around until next time */
-           HeSVKEY_set(entry, SvREFCNT_inc(key));
+           HeSVKEY_set(entry, SvREFCNT_inc_simple_NN(key));
            return entry;               /* beware, hent_val is not set */
        }
        if (HeVAL(entry))
            SvREFCNT_dec(HeVAL(entry));
        Safefree(HeKEY_hek(entry));
        del_HE(entry);
            return entry;               /* beware, hent_val is not set */
        }
        if (HeVAL(entry))
            SvREFCNT_dec(HeVAL(entry));
        Safefree(HeKEY_hek(entry));
        del_HE(entry);
-       iter->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
-       return Null(HE*);
+       iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */
+       return NULL;
     }
 #ifdef DYNAMIC_ENV_FETCH  /* set up %ENV for iteration */
     }
 #ifdef DYNAMIC_ENV_FETCH  /* set up %ENV for iteration */
-    if (!entry && SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env))
+    if (!entry && SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
        prime_env_iter();
        prime_env_iter();
+#ifdef VMS
+       /* The prime_env_iter() on VMS just loaded up new hash values
+        * so the iteration count needs to be reset back to the beginning
+        */
+       hv_iterinit(hv);
+       iter = HvAUX(hv);
+       oldentry = entry = iter->xhv_eiter; /* HvEITER(hv) */
+#endif
+    }
 #endif
 
     /* hv_iterint now ensures this.  */
 #endif
 
     /* hv_iterint now ensures this.  */
@@ -2050,7 +2154,7 @@ Perl_hv_iterkey(pTHX_ register HE *entry, I32 *retlen)
 {
     if (HeKLEN(entry) == HEf_SVKEY) {
        STRLEN len;
 {
     if (HeKLEN(entry) == HEf_SVKEY) {
        STRLEN len;
-       char *p = SvPV(HeKEY_sv(entry), len);
+       char * const p = SvPV(HeKEY_sv(entry), len);
        *retlen = len;
        return p;
     }
        *retlen = len;
        return p;
     }
@@ -2091,7 +2195,7 @@ Perl_hv_iterval(pTHX_ HV *hv, register HE *entry)
 {
     if (SvRMAGICAL(hv)) {
        if (mg_find((SV*)hv, PERL_MAGIC_tied)) {
 {
     if (SvRMAGICAL(hv)) {
        if (mg_find((SV*)hv, PERL_MAGIC_tied)) {
-           SV* sv = sv_newmortal();
+           SV* const sv = sv_newmortal();
            if (HeKLEN(entry) == HEf_SVKEY)
                mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
            else
            if (HeKLEN(entry) == HEf_SVKEY)
                mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
            else
@@ -2114,14 +2218,18 @@ operation.
 SV *
 Perl_hv_iternextsv(pTHX_ HV *hv, char **key, I32 *retlen)
 {
 SV *
 Perl_hv_iternextsv(pTHX_ HV *hv, char **key, I32 *retlen)
 {
-    HE *he;
-    if ( (he = hv_iternext_flags(hv, 0)) == NULL)
+    HE * const he = hv_iternext_flags(hv, 0);
+
+    if (!he)
        return NULL;
     *key = hv_iterkey(he, retlen);
     return hv_iterval(hv, he);
 }
 
 /*
        return NULL;
     *key = hv_iterkey(he, retlen);
     return hv_iterval(hv, he);
 }
 
 /*
+
+Now a macro in hv.h
+
 =for apidoc hv_magic
 
 Adds magic to a hash.  See C<sv_magic>.
 =for apidoc hv_magic
 
 Adds magic to a hash.  See C<sv_magic>.
@@ -2129,22 +2237,6 @@ Adds magic to a hash.  See C<sv_magic>.
 =cut
 */
 
 =cut
 */
 
-void
-Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how)
-{
-    sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
-}
-
-#if 0 /* use the macro from hv.h instead */
-
-char*  
-Perl_sharepvn(pTHX_ const char *sv, I32 len, U32 hash)
-{
-    return HEK_KEY(share_hek(sv, len, hash));
-}
-
-#endif
-
 /* possibly free a shared string if no one has access to it
  * len and hash must both be valid for str.
  */
 /* possibly free a shared string if no one has access to it
  * len and hash must both be valid for str.
  */
@@ -2168,15 +2260,16 @@ Perl_unshare_hek(pTHX_ HEK *hek)
 STATIC void
 S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
 {
 STATIC void
 S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
 {
+    dVAR;
     register XPVHV* xhv;
     register XPVHV* xhv;
-    register HE *entry;
+    HE *entry;
     register HE **oentry;
     HE **first;
     bool found = 0;
     bool is_utf8 = FALSE;
     int k_flags = 0;
     register HE **oentry;
     HE **first;
     bool found = 0;
     bool is_utf8 = FALSE;
     int k_flags = 0;
-    const char *save = str;
-    struct shared_he *he = 0;
+    const char * const save = str;
+    struct shared_he *he = NULL;
 
     if (hek) {
        /* Find the shared he which is just before us in memory.  */
 
     if (hek) {
        /* Find the shared he which is just before us in memory.  */
@@ -2189,8 +2282,8 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
        assert (he->shared_he_he.hent_hek == hek);
 
        LOCK_STRTAB_MUTEX;
        assert (he->shared_he_he.hent_hek == hek);
 
        LOCK_STRTAB_MUTEX;
-       if (he->shared_he_he.hent_val - 1) {
-           --he->shared_he_he.hent_val;
+       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;
            return;
        }
@@ -2209,9 +2302,9 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
             k_flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
     }
 
             k_flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
     }
 
-    /* what follows is the moral equivalent of:
+    /* what follows was the moral equivalent of:
     if ((Svp = hv_fetch(PL_strtab, tmpsv, FALSE, hash))) {
     if ((Svp = hv_fetch(PL_strtab, tmpsv, FALSE, hash))) {
-       if (--*Svp == Nullsv)
+       if (--*Svp == NULL)
            hv_delete(PL_strtab, str, len, G_DISCARD, hash);
     } */
     xhv = (XPVHV*)SvANY(PL_strtab);
            hv_delete(PL_strtab, str, len, G_DISCARD, hash);
     } */
     xhv = (XPVHV*)SvANY(PL_strtab);
@@ -2243,14 +2336,14 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
     }
 
     if (found) {
     }
 
     if (found) {
-        if (--HeVAL(entry) == Nullsv) {
+        if (--he->shared_he_he.he_valu.hent_refcount == 0) {
             *oentry = HeNEXT(entry);
             if (!*first) {
                /* There are now no entries in our slot.  */
                 xhv->xhv_fill--; /* HvFILL(hv)-- */
            }
             Safefree(entry);
             *oentry = HeNEXT(entry);
             if (!*first) {
                /* There are now no entries in our slot.  */
                 xhv->xhv_fill--; /* HvFILL(hv)-- */
            }
             Safefree(entry);
-            xhv->xhv_keys--; /* HvKEYS(hv)-- */
+            xhv->xhv_keys--; /* HvTOTALKEYS(hv)-- */
         }
     }
 
         }
     }
 
@@ -2274,7 +2367,7 @@ Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash)
 {
     bool is_utf8 = FALSE;
     int flags = 0;
 {
     bool is_utf8 = FALSE;
     int flags = 0;
-    const char *save = str;
+    const char * const save = str;
 
     if (len < 0) {
       STRLEN tmplen = -len;
 
     if (len < 0) {
       STRLEN tmplen = -len;
@@ -2299,15 +2392,15 @@ Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash)
 STATIC HEK *
 S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
 {
 STATIC HEK *
 S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
 {
+    dVAR;
     register HE *entry;
     register HE *entry;
-    register HE **oentry;
-    I32 found = 0;
     const int flags_masked = flags & HVhek_MASK;
     const int flags_masked = flags & HVhek_MASK;
+    const U32 hindex = hash & (I32) HvMAX(PL_strtab);
 
     /* 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, NULL, hash);
 
        Can't rehash the shared string table, so not sure if it's worth
        counting the number of entries in the linked list
 
        Can't rehash the shared string table, so not sure if it's worth
        counting the number of entries in the linked list
@@ -2315,8 +2408,8 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
     register XPVHV * const xhv = (XPVHV*)SvANY(PL_strtab);
     /* assert(xhv_array != 0) */
     LOCK_STRTAB_MUTEX;
     register XPVHV * const xhv = (XPVHV*)SvANY(PL_strtab);
     /* assert(xhv_array != 0) */
     LOCK_STRTAB_MUTEX;
-    oentry = &(HvARRAY(PL_strtab))[hash & (I32) HvMAX(PL_strtab)];
-    for (entry = *oentry; entry; entry = HeNEXT(entry)) {
+    entry = (HvARRAY(PL_strtab))[hindex];
+    for (;entry; entry = HeNEXT(entry)) {
        if (HeHASH(entry) != hash)              /* strings can't be equal */
            continue;
        if (HeKLEN(entry) != len)
        if (HeHASH(entry) != hash)              /* strings can't be equal */
            continue;
        if (HeKLEN(entry) != len)
@@ -2325,17 +2418,18 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
            continue;
        if (HeKFLAGS(entry) != flags_masked)
            continue;
            continue;
        if (HeKFLAGS(entry) != flags_masked)
            continue;
-       found = 1;
        break;
     }
        break;
     }
-    if (!found) {
+
+    if (!entry) {
        /* What used to be head of the list.
           If this is NULL, then we're the first entry for this slot, which
           means we need to increate fill.  */
        /* What used to be head of the list.
           If this is NULL, then we're the first entry for this slot, which
           means we need to increate fill.  */
-       const HE *old_first = *oentry;
        struct shared_he *new_entry;
        HEK *hek;
        char *k;
        struct shared_he *new_entry;
        HEK *hek;
        char *k;
+       HE **const head = &HvARRAY(PL_strtab)[hindex];
+       HE *const next = *head;
 
        /* We don't actually store a HE from the arena and a regular HEK.
           Instead we allocate one chunk of memory big enough for both,
 
        /* We don't actually store a HE from the arena and a regular HEK.
           Instead we allocate one chunk of memory big enough for both,
@@ -2358,19 +2452,19 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
        /* Still "point" to the HEK, so that other code need not know what
           we're up to.  */
        HeKEY_hek(entry) = hek;
        /* Still "point" to the HEK, so that other code need not know what
           we're up to.  */
        HeKEY_hek(entry) = hek;
-       HeVAL(entry) = Nullsv;
-       HeNEXT(entry) = *oentry;
-       *oentry = entry;
+       entry->he_valu.hent_refcount = 0;
+       HeNEXT(entry) = next;
+       *head = entry;
 
 
-       xhv->xhv_keys++; /* HvKEYS(hv)++ */
-       if (!old_first) {                       /* initial entry? */
+       xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */
+       if (!next) {                    /* initial entry? */
            xhv->xhv_fill++; /* HvFILL(hv)++ */
        } else if (xhv->xhv_keys > (IV)xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */) {
                hsplit(PL_strtab);
        }
     }
 
            xhv->xhv_fill++; /* HvFILL(hv)++ */
        } else if (xhv->xhv_keys > (IV)xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */) {
                hsplit(PL_strtab);
        }
     }
 
-    ++HeVAL(entry);                            /* use value slot as REFCNT */
+    ++entry->he_valu.hent_refcount;
     UNLOCK_STRTAB_MUTEX;
 
     if (flags & HVhek_FREEKEY)
     UNLOCK_STRTAB_MUTEX;
 
     if (flags & HVhek_FREEKEY)
@@ -2451,7 +2545,7 @@ Perl_hv_assert(pTHX_ HV *hv)
     }
     /* sanity check the keys */
     if (HeSVKEY(entry)) {
     }
     /* sanity check the keys */
     if (HeSVKEY(entry)) {
-      /* Don't know what to check on SV keys.  */
+      /*EMPTY*/ /* Don't know what to check on SV keys.  */
     } else if (HeKUTF8(entry)) {
       withflags++;
        if (HeKWASUTF8(entry)) {
     } else if (HeKUTF8(entry)) {
       withflags++;
        if (HeKWASUTF8(entry)) {
Unnamed repository; edit this file 'description' to name the repository.