fix slowdown in nested hash freeing

Commit 104d7b69 made sv_clear free hashes iteratively rather than recursively;
however, my code didn't record the current hash index when freeing a
nested hash, which made the code go quadratic when freeing a large hash
with inner hashes, e.g.:

    my $r; $r->{$_} = { a => 1 } for 1..10_0000;

This was noticeable on such things as CPAN.pm being very slow to exit.

This commit fixes this by squirrelling away the old hash index in the
now-unused SvMAGIC field of the hash being freed.

3 files changed, 14 insertions, 13 deletions

diff --git a/hv.c b/hv.c
index 3fb3975cbc..6b662518f6 100644
--- a/hv.c
+++ b/hv.c
@@ -1863,7 +1863,10 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
 	xhv->xhv_max   = 7;	/* HvMAX(hv) = 7 (it's a normal hash) */
 	HvARRAY(hv) = 0;
     }
-    HvPLACEHOLDERS_set(hv, 0);
+    /* if we're freeing the HV, the SvMAGIC field has been reused for
+     * other purposes, and so there can't be any placeholder magic */
+    if (SvREFCNT(hv))
+	HvPLACEHOLDERS_set(hv, 0);
 
     if (SvRMAGICAL(hv))
 	mg_clear(MUTABLE_SV(hv));
diff --git a/sv.c b/sv.c
index ec08780d98..40f8d1d696 100644
--- a/sv.c
+++ b/sv.c
@@ -6114,14 +6114,12 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
 		SvSTASH(sv) = (HV*)iter_sv;
 		iter_sv = sv;
 
-		/* XXX ideally we should save the old value of hash_index
-		 * too, but I can't think of any place to hide it. The
-		 * effect of not saving it is that for freeing hashes of
-		 * hashes, we become quadratic in scanning the HvARRAY of
-		 * the top hash looking for new entries to free; but
-		 * hopefully this will be dwarfed by the freeing of all
-		 * the nested hashes. */
+		/* save old hash_index in unused SvMAGIC field */
+		assert(!SvMAGICAL(sv));
+		assert(!SvMAGIC(sv));
+		((XPVMG*) SvANY(sv))->xmg_u.xmg_hash_index = hash_index;
 		hash_index = 0;
+
 		next_sv = Perl_hfree_next_entry(aTHX_ (HV*)sv, &hash_index);
 		goto get_next_sv; /* process this new sv */
 	    }
@@ -6285,13 +6283,12 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
 		    /* no more elements of current HV to free */
 		    sv = iter_sv;
 		    type = SvTYPE(sv);
-		    /* Restore previous value of iter_sv, squirrelled away */
+		    /* Restore previous values of iter_sv and hash_index,
+		     * squirrelled away */
 		    assert(!SvOBJECT(sv));
 		    iter_sv = (SV*)SvSTASH(sv);
-
-		    /* ideally we should restore the old hash_index here,
-		     * but we don't currently save the old value */
-		    hash_index = 0;
+		    assert(!SvMAGICAL(sv));
+		    hash_index = ((XPVMG*) SvANY(sv))->xmg_u.xmg_hash_index;
 
 		    /* free any remaining detritus from the hash struct */
 		    Perl_hv_undef_flags(aTHX_ MUTABLE_HV(sv), HV_NAME_SETALL);
diff --git a/sv.h b/sv.h
index 935f4fff15..60ff740501 100644
--- a/sv.h
+++ b/sv.h
@@ -440,6 +440,7 @@ union _xivu {
 union _xmgu {
     MAGIC*  xmg_magic;		/* linked list of magicalness */
     HV*	    xmg_ourstash;	/* Stash for our (when SvPAD_OUR is true) */
+    STRLEN  xmg_hash_index;	/* used while freeing hash entries */
 };
 
 struct xpv {