Improve description of the -s switch.
[p5sagit/p5-mst-13.2.git] / hv.c
diff --git a/hv.c b/hv.c
index d770ece..8ac9fb8 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.
@@ -1610,17 +1610,14 @@ Perl_hv_clear_placeholders(pTHX_ HV *hv)
        /* Loop down the linked list heads  */
        bool first = 1;
        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);
@@ -1647,85 +1644,137 @@ Perl_hv_clear_placeholders(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;
 
-    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);
 
-    /* If there are weak references to this HV, we need to avoid freeing them
-       up here.
-    */
-    if (iter) {
-       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);
-           sv_magic((SV*)hv, (SV*)iter->xhv_backreferences,
-                    PERL_MAGIC_backref, NULL, 0);
-           iter->xhv_backreferences = 0;
-       }
+       name = iter->xhv_name;
+       iter->xhv_name = NULL;
+    } else {
+       name = NULL;
     }
 
-    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;
+    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.  */
 
-    HvFILL(hv) = 0;
-    ((XPVHV*) SvANY(hv))->xhv_keys = 0;
+    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 **array = HvARRAY(hv);
+       I32 i = HvMAX(hv);
 
-    entry = array[0];
-    for (;;) {
-       if (entry) {
-           register HE * const oentry = entry;
-           entry = HeNEXT(entry);
-           hv_free_ent(hv, oentry);
+       /* 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(HE*); /* HvEITER(hv) = Null(HE*) */
+
+           /* 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*) */
+    };
+       
+    HvARRAY(hv) = orig_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;
     }
-
-    HvARRAY(hv) = array;
 }
 
 /*
@@ -2208,7 +2257,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.  */
@@ -2332,9 +2381,8 @@ STATIC HEK *
 S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
 {
     register HE *entry;
-    register HE **oentry;
-    I32 found = 0;
     const int flags_masked = flags & HVhek_MASK;
+    const U32 hindex = hash & (I32) HvMAX(PL_strtab);
 
     /* what follows is the moral equivalent of:
 
@@ -2347,8 +2395,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;
-    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)
@@ -2357,17 +2405,18 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
            continue;
        if (HeKFLAGS(entry) != flags_masked)
            continue;
-       found = 1;
        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.  */
-       const HE *old_first = *oentry;
        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,
@@ -2391,11 +2440,11 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
           we're up to.  */
        HeKEY_hek(entry) = hek;
        HeVAL(entry) = Nullsv;
-       HeNEXT(entry) = *oentry;
-       *oentry = entry;
+       HeNEXT(entry) = next;
+       *head = entry;
 
        xhv->xhv_keys++; /* HvKEYS(hv)++ */
-       if (!old_first) {                       /* initial entry? */
+       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);