Use a union for storing the shared hash key reference count, rather
[p5sagit/p5-mst-13.2.git] / hv.c
diff --git a/hv.c b/hv.c
index 5ae5078..0ab2558 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1,7 +1,7 @@
 /*    hv.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 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.
@@ -39,6 +39,7 @@ static const char S_strtab_error[]
 STATIC void
 S_more_he(pTHX)
 {
+    dVAR;
     HE* he;
     HE* heend;
     Newx(he, PERL_ARENA_SIZE/sizeof(HE), HE);
@@ -64,6 +65,7 @@ S_more_he(pTHX)
 STATIC HE*
 S_new_he(pTHX)
 {
+    dVAR;
     HE* he;
     void ** const root = &PL_body_roots[HE_SVSLOT];
 
@@ -115,6 +117,7 @@ S_save_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags)
 void
 Perl_free_tied_hv_pool(pTHX)
 {
+    dVAR;
     HE *he = PL_hv_fetch_ent_mh;
     while (he) {
        HE * const ohe = he;
@@ -430,7 +433,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     int masked_flags;
 
     if (!hv)
-       return 0;
+       return NULL;
 
     if (keysv) {
        if (flags & HVhek_FREEKEY)
@@ -444,8 +447,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 
     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();
 
@@ -507,7 +509,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,
-                                                   NEWSV(61,0), hash);
+                                                   newSV(0), hash);
                        } else {
                            if (flags & HVhek_FREEKEY)
                                Safefree(key);
@@ -550,7 +552,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);
-               is_utf8 = 0;
+               is_utf8 = FALSE;
                hash = 0;
                keysv = 0;
 
@@ -593,7 +595,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);
-                   is_utf8 = 0;
+                   is_utf8 = FALSE;
                    hash = 0;
                    keysv = 0;
 
@@ -693,7 +695,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.  */
-                   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;
@@ -727,7 +729,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                        break;
                    }
                    /* LVAL fetch which actaully needs a store.  */
-                   val = NEWSV(61,0);
+                   val = newSV(0);
                    HvPLACEHOLDERS(hv)--;
                } else {
                    /* store */
@@ -774,7 +776,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
        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
@@ -917,13 +919,14 @@ SV *
 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;
-       k_flags |= HVhek_UTF8;
+       k_flags = HVhek_UTF8;
     } else {
        klen = klen_i32;
+       k_flags = 0;
     }
     return hv_delete_common(hv, NULL, key, klen, k_flags, flags, 0);
 }
@@ -955,7 +958,6 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     register HE *entry;
     register HE **oentry;
     HE *const *first_entry;
-    SV *sv;
     bool is_utf8;
     int masked_flags;
 
@@ -978,6 +980,7 @@ 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) {
+           SV *sv;
            entry = hv_fetch_common(hv, keysv, key, klen,
                                    k_flags & ~HVhek_FREEKEY, HV_FETCH_LVALUE,
                                    Nullsv, hash);
@@ -1048,6 +1051,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) {
+       SV *sv;
        if (HeHASH(entry) != hash)              /* strings can't be equal */
            continue;
        if (HeKLEN(entry) != (I32)klen)
@@ -1064,13 +1068,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 (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");
@@ -1126,6 +1129,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 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;
@@ -1295,6 +1299,7 @@ S_hsplit(pTHX_ HV *hv)
 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;
@@ -1363,8 +1368,9 @@ Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
        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]))
@@ -1392,7 +1398,7 @@ HV *
 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);
@@ -1428,7 +1434,7 @@ Perl_newHVhv(pTHX_ HV *ohv)
 
        /* In each bucket... */
        for (i = 0; i <= hv_max; i++) {
-           HE *prev = NULL, *ent = NULL;
+           HE *prev = NULL;
            HE *oent = oents[i];
 
            if (!oent) {
@@ -1442,8 +1448,8 @@ Perl_newHVhv(pTHX_ HV *ohv)
                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)
@@ -1489,6 +1495,7 @@ Perl_newHVhv(pTHX_ HV *ohv)
 void
 Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
 {
+    dVAR;
     SV *val;
 
     if (!entry)
@@ -1511,6 +1518,7 @@ Perl_hv_free_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  */
@@ -1550,7 +1558,7 @@ Perl_hv_clear(pTHX_ HV *hv)
                /* 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);
@@ -1608,19 +1616,16 @@ Perl_hv_clear_placeholders(pTHX_ HV *hv)
     i = HvMAX(hv);
     do {
        /* Loop down the linked list heads  */
-       bool first = 1;
+       bool first = TRUE;
        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 (HvEITER_get(hv))
+               if (entry == HvEITER_get(hv))
                    HvLAZYDEL_on(hv);
                else
                    hv_free_ent(hv, entry);
@@ -1635,7 +1640,7 @@ Perl_hv_clear_placeholders(pTHX_ HV *hv)
                }
            } else {
                oentry = &HeNEXT(entry);
-               first = 0;
+               first = FALSE;
            }
        }
     } while (--i >= 0);
@@ -1676,16 +1681,15 @@ S_hfreeentries(pTHX_ HV *hv)
        /* 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 **array = HvARRAY(hv);
-       register HE *entry;
-       I32 riter = 0;
-       I32 max = HvMAX(hv);
+       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
@@ -1729,19 +1733,17 @@ S_hfreeentries(pTHX_ HV *hv)
        HvFILL(hv) = 0;
        ((XPVHV*) SvANY(hv))->xhv_keys = 0;
 
-       entry = array[0];
-       for (;;) {
-           if (entry) {
+
+       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);
            }
-           if (!entry) {
-               if (++riter > max)
-                   break;
-               entry = array[riter];
-           }
-       }
+       } 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
@@ -1769,7 +1771,7 @@ S_hfreeentries(pTHX_ HV *hv)
        if (--attempts == 0) {
            Perl_die(aTHX_ "panic: hfreeentries failed to free hash - something is repeatedly re-creating entries");
        }
-    };
+    }
        
     HvARRAY(hv) = orig_array;
 
@@ -1794,6 +1796,7 @@ Undefines the hash.
 void
 Perl_hv_undef(pTHX_ HV *hv)
 {
+    dVAR;
     register XPVHV* xhv;
     const char *name;
 
@@ -1864,7 +1867,7 @@ Perl_hv_iterinit(pTHX_ HV *hv)
        Perl_croak(aTHX_ "Bad hash");
 
     if (SvOOK(hv)) {
-       struct xpvhv_aux *iter = HvAUX(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);
@@ -1873,7 +1876,7 @@ Perl_hv_iterinit(pTHX_ HV *hv)
        iter->xhv_riter = -1;   /* HvRITER(hv) = -1 */
        iter->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
     } else {
-       S_hv_auxinit(aTHX_ hv);
+       hv_auxinit(hv);
     }
 
     /* used to be xhv->xhv_fill before 5.004_65 */
@@ -1887,7 +1890,7 @@ Perl_hv_riter_p(pTHX_ HV *hv) {
     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);
 }
 
@@ -1898,7 +1901,7 @@ Perl_hv_eiter_p(pTHX_ HV *hv) {
     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);
 }
 
@@ -1915,7 +1918,7 @@ Perl_hv_riter_set(pTHX_ HV *hv, I32 riter) {
        if (riter == -1)
            return;
 
-       iter = S_hv_auxinit(aTHX_ hv);
+       iter = hv_auxinit(hv);
     }
     iter->xhv_riter = riter;
 }
@@ -1935,7 +1938,7 @@ Perl_hv_eiter_set(pTHX_ HV *hv, HE *eiter) {
        if (!eiter)
            return;
 
-       iter = S_hv_auxinit(aTHX_ hv);
+       iter = hv_auxinit(hv);
     }
     iter->xhv_eiter = eiter;
 }
@@ -1943,6 +1946,7 @@ Perl_hv_eiter_set(pTHX_ HV *hv, HE *eiter) {
 void
 Perl_hv_name_set(pTHX_ HV *hv, const char *name, I32 len, int flags)
 {
+    dVAR;
     struct xpvhv_aux *iter;
     U32 hash;
 
@@ -1957,7 +1961,7 @@ Perl_hv_name_set(pTHX_ HV *hv, const char *name, I32 len, int flags)
        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;
@@ -1965,9 +1969,7 @@ Perl_hv_name_set(pTHX_ HV *hv, const char *name, I32 len, int flags)
 
 AV **
 Perl_hv_backreferences_p(pTHX_ HV *hv) {
-    struct xpvhv_aux *iter;
-
-    iter = SvOOK(hv) ? HvAUX(hv) : S_hv_auxinit(aTHX_ hv);
+    struct xpvhv_aux * const iter = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv);
     return &(iter->xhv_backreferences);
 }
 
@@ -2255,6 +2257,7 @@ Perl_unshare_hek(pTHX_ HEK *hek)
 STATIC void
 S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
 {
+    dVAR;
     register XPVHV* xhv;
     HE *entry;
     register HE **oentry;
@@ -2263,7 +2266,7 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
     bool is_utf8 = FALSE;
     int k_flags = 0;
     const char * const save = str;
-    struct shared_he *he = 0;
+    struct shared_he *he = NULL;
 
     if (hek) {
        /* Find the shared he which is just before us in memory.  */
@@ -2276,8 +2279,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;
-       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;
        }
@@ -2296,7 +2299,7 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
             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 == Nullsv)
            hv_delete(PL_strtab, str, len, G_DISCARD, hash);
@@ -2330,7 +2333,7 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
     }
 
     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.  */
@@ -2386,6 +2389,7 @@ 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)
 {
+    dVAR;
     register HE *entry;
     const int flags_masked = flags & HVhek_MASK;
     const U32 hindex = hash & (I32) HvMAX(PL_strtab);
@@ -2445,7 +2449,7 @@ 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;
-       HeVAL(entry) = Nullsv;
+       entry->he_valu.hent_refcount = 0;
        HeNEXT(entry) = next;
        *head = entry;
 
@@ -2457,7 +2461,7 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
        }
     }
 
-    ++HeVAL(entry);                            /* use value slot as REFCNT */
+    ++entry->he_valu.hent_refcount;
     UNLOCK_STRTAB_MUTEX;
 
     if (flags & HVhek_FREEKEY)