In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/5bec93bead1c10563a402404de095bbdf398790f?hp=1cd16d8ac049ac3ffe94281e35fe9270b854408d>
- Log ----------------------------------------------------------------- commit 5bec93bead1c10563a402404de095bbdf398790f Author: David Mitchell <[email protected]> Date: Tue Mar 6 14:26:27 2012 +0000 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. ----------------------------------------------------------------------- Summary of changes: hv.c | 5 ++++- sv.c | 21 +++++++++------------ sv.h | 1 + 3 files changed, 14 insertions(+), 13 deletions(-) diff --git a/hv.c b/hv.c index 3fb3975..6b66251 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 ec08780..40f8d1d 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 935f4ff..60ff740 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 { -- Perl5 Master Repository
