This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix slowdown in nested hash freeing
authorDavid Mitchell <davem@iabyn.com>
Tue, 6 Mar 2012 14:26:27 +0000 (14:26 +0000)
committerDavid Mitchell <davem@iabyn.com>
Tue, 6 Mar 2012 14:26:27 +0000 (14:26 +0000)
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.

hv.c
sv.c
sv.h

diff --git a/hv.c b/hv.c
index 3fb3975..6b66251 100644 (file)
--- 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 ec08780..40f8d1d 100644 (file)
--- 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 935f4ff..60ff740 100644 (file)
--- 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 {