X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=hv.c;h=69bbdcff68f9fb5f879545fbc965799a320cf997;hb=6bc89f92370990b836308b02c6551b4e758e7401;hp=c90fbb20c7c353a6a04ccbc41df9068f2391d104;hpb=1b8791d118104352beb2148b6b5cd8c57952ebb2;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/hv.c b/hv.c
index c90fbb2..69bbdcf 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, 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)
@@ -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;
@@ -1489,6 +1494,7 @@ Perl_newHVhv(pTHX_ HV *ohv)
 void
 Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
 {
+    dVAR;
     SV *val;
 
     if (!entry)
@@ -1511,6 +1517,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  */
@@ -1610,17 +1617,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,109 +1651,136 @@ 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;
-    AV *new_backrefs = NULL;
+    /* 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);
+
+	name = iter->xhv_name;
+	iter->xhv_name = NULL;
+    } else {
+	name = NULL;
+    }
 
-    /* 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);
-	    if (AvFILLp(iter->xhv_backreferences) == -1) {
-		/* Turns out that the array is empty. Just free it.  */
+    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.  */
+
+    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);
+
+	/* 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);
+		} else {
+		    sv_magic((SV*)hv, (SV*)iter->xhv_backreferences,
+			     PERL_MAGIC_backref, NULL, 0);
+		}
+		iter->xhv_backreferences = NULL;
 	    }
-	    iter->xhv_backreferences = 0;
-	}
-    }
 
-    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;
+	    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*) */
 
-    HvFILL(hv) = 0;
-    ((XPVHV*) SvANY(hv))->xhv_keys = 0;
+	    /* There are now no allocated pointers in the aux structure.  */
 
-    entry = array[0];
-    for (;;) {
-	if (entry) {
-	    register HE * const oentry = entry;
-	    entry = HeNEXT(entry);
-	    hv_free_ent(hv, oentry);
+	    SvFLAGS(hv) &= ~SVf_OOK; /* Goodbye, aux structure.  */
+	    /* What aux structure?  */
 	}
-	if (!entry) {
-	    if (++riter > max)
-		break;
-	    entry = array[riter];
-	}
-    }
 
-    if (SvOOK(hv)) {
-	/* Someone attempted to iterate or set the hash name while we had
-	   the array set to 0.  */
-	assert(HvARRAY(hv));
-
-	if(HvAUX(hv)->xhv_backreferences) {
-	    if (iter) {
-		/* Erk. They caused the backreference AV to be put back
-		   into the hash aux structure */
-		assert (!iter->xhv_backreferences);
-		iter->xhv_backreferences = HvAUX(hv)->xhv_backreferences;
-	    } else {
-		/* Erk. They created a backreference array when there was none
-		   before.  */
-		new_backrefs = HvAUX(hv)->xhv_backreferences;
+	/* 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 (HvAUX(hv)->xhv_name) {
-	    unshare_hek_or_pvn(HvAUX(hv)->xhv_name, 0, 0, 0);
+
+	if (!HvARRAY(hv)) {
+	    /* Good. No-one added anything this time round.  */
+	    break;
 	}
-	/* SvOOK_off calls sv_backoff, which isn't correct.  */
 
-	Safefree(HvARRAY(hv));
-	HvARRAY(hv) = 0;
-	SvFLAGS(hv) &= ~SVf_OOK;
-    }
+	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));
 
-    /* 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 (HvAUX(hv)->xhv_name) {
+		unshare_hek_or_pvn(HvAUX(hv)->xhv_name, 0, 0, 0);
+	    }
 	}
-	iter->xhv_riter = -1; 	/* HvRITER(hv) = -1 */
-	iter->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
-	SvFLAGS(hv) |= SVf_OOK;
-    }
 
-    HvARRAY(hv) = array;
-
-    if (new_backrefs) {
-	/* Don't lose the backreferences array  */
-	*Perl_hv_backreferences_p(aTHX_ hv) = new_backrefs;
+	if (--attempts == 0) {
+	    Perl_die(aTHX_ "panic: hfreeentries failed to free hash - something is repeatedly re-creating entries");
+	}
+    };
+	
+    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;
     }
 }
 
@@ -1764,6 +1795,7 @@ Undefines the hash.
 void
 Perl_hv_undef(pTHX_ HV *hv)
 {
+    dVAR;
     register XPVHV* xhv;
     const char *name;
 
@@ -1913,6 +1945,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;
 
@@ -2225,6 +2258,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;
@@ -2233,7 +2267,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.  */
@@ -2356,6 +2390,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);