X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=hv.c;h=2d04dda6ac5a126302c69179b051ad1e60d67ea4;hb=d1888197290ee9e2faa25012d62b59909e6c3e32;hp=78d028065d06b1d5f7e911830e17836bff1880fa;hpb=086cb327289a4871101f072239f753777e628728;p=p5sagit%2Fp5-mst-13.2.git diff --git a/hv.c b/hv.c index 78d0280..2d04dda 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, by Larry Wall and others + * 2000, 2001, 2002, 2003, 2004, 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. @@ -14,6 +14,16 @@ /* =head1 Hash Manipulation Functions + +A HV structure represents a Perl hash. It consists mainly of an array +of pointers, each of which points to a linked list of HE structures. The +array is indexed by the hash function of the key, so each linked list +represents all the hash entries with the same hash value. Each HE contains +a pointer to the actual value, plus a pointer to a HEK structure which +holds the key and hash value. + +=cut + */ #include "EXTERN.h" @@ -80,6 +90,7 @@ S_more_he(pTHX) STATIC HEK * S_save_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags) { + int flags_masked = flags & HVhek_MASK; char *k; register HEK *hek; @@ -89,7 +100,10 @@ S_save_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags) HEK_KEY(hek)[len] = 0; HEK_LEN(hek) = len; HEK_HASH(hek) = hash; - HEK_FLAGS(hek) = (unsigned char)flags; + HEK_FLAGS(hek) = (unsigned char)flags_masked; + + if (flags & HVhek_FREEKEY) + Safefree(str); return hek; } @@ -214,7 +228,7 @@ Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen_i32, SV *val, U32 hash) flags = 0; } hek = hv_fetch_common (hv, NULL, key, klen, flags, - (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, 0); + (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash); return hek ? &HeVAL(hek) : NULL; } @@ -365,7 +379,7 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash) (lval ? HV_FETCH_LVALUE : 0), Nullsv, hash); } -HE * +STATIC HE * S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, int flags, int action, SV *val, register U32 hash) { @@ -501,6 +515,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, key = (const char*)strupr((char*)key); is_utf8 = 0; hash = 0; + keysv = 0; if (flags & HVhek_FREEKEY) { Safefree(keysave); @@ -543,6 +558,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, key = (const char*)strupr((char*)key); is_utf8 = 0; hash = 0; + keysv = 0; if (flags & HVhek_FREEKEY) { Safefree(keysave); @@ -862,7 +878,7 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash) return hv_delete_common(hv, keysv, NULL, 0, 0, flags, hash); } -SV * +STATIC SV * S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, int k_flags, I32 d_flags, U32 hash) { @@ -956,7 +972,6 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, } else { PERL_HASH(hash, key, klen); } - PERL_HASH(hash, key, klen); } masked_flags = (k_flags & HVhek_MASK); @@ -974,34 +989,21 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, continue; if ((HeKFLAGS(entry) ^ masked_flags) & HVhek_UTF8) continue; - if (k_flags & HVhek_FREEKEY) - Safefree(key); /* if placeholder is here, it's already been deleted.... */ if (HeVAL(entry) == &PL_sv_placeholder) { - if (SvREADONLY(hv)) - return Nullsv; /* if still SvREADONLY, leave it deleted. */ - - /* okay, really delete the placeholder. */ - *oentry = HeNEXT(entry); - if (i && !*oentry) - xhv->xhv_fill--; /* HvFILL(hv)-- */ - if (entry == xhv->xhv_eiter /* HvEITER(hv) */) - HvLAZYDEL_on(hv); - else - hv_free_ent(hv, entry); - xhv->xhv_keys--; /* HvKEYS(hv)-- */ - if (xhv->xhv_keys == 0) - HvHASKFLAGS_off(hv); - xhv->xhv_placeholders--; - return Nullsv; + if (k_flags & HVhek_FREEKEY) + Safefree(key); + return Nullsv; } else if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) { S_hv_notallowed(aTHX_ k_flags, key, klen, "delete readonly key '%"SVf"' from" ); } + if (k_flags & HVhek_FREEKEY) + Safefree(key); if (d_flags & G_DISCARD) sv = Nullsv; @@ -1017,6 +1019,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, * an error. */ if (SvREADONLY(hv)) { + SvREFCNT_dec(HeVAL(entry)); HeVAL(entry) = &PL_sv_placeholder; /* We'll be saving this slot, so the number of allocated keys * doesn't go down, but the number placeholders goes up */ @@ -1061,6 +1064,17 @@ S_hsplit(pTHX_ HV *hv) int longest_chain = 0; int was_shared; + /*PerlIO_printf(PerlIO_stderr(), "hsplit called for %p which had %d\n", + hv, (int) oldsize);*/ + + if (HvPLACEHOLDERS(hv) && !SvREADONLY(hv)) { + /* Can make this clear any placeholders first for non-restricted hashes, + even though Storable rebuilds restricted hashes by putting in all the + placeholders (first) before turning on the readonly flag, because + Storable always pre-splits the hash. */ + hv_clear_placeholders(hv); + } + PL_nomemok = TRUE; #if defined(STRANGE_MALLOC) || defined(MYMALLOC) Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char); @@ -1482,7 +1496,7 @@ Clears any placeholders from a hash. If a restricted hash has any of its keys marked as readonly and the key is subsequently deleted, the key is not actually deleted but is marked by assigning it a value of &PL_sv_placeholder. This tags it so it will be ignored by future operations such as iterating over the hash, -but will still allow the hash to have a value reaasigned to the key at some +but will still allow the hash to have a value reassigned to the key at some future point. This function clears any such placeholder keys from the hash. See Hash::Util::lock_keys() for an example of its use. @@ -1492,42 +1506,48 @@ See Hash::Util::lock_keys() for an example of its use. void Perl_hv_clear_placeholders(pTHX_ HV *hv) { - I32 items; - items = (I32)HvPLACEHOLDERS(hv); - if (items) { - HE *entry; - I32 riter = HvRITER(hv); - HE *eiter = HvEITER(hv); - hv_iterinit(hv); - /* This may look suboptimal with the items *after* the iternext, but - it's quite deliberate. We only get here with items==0 if we've - just deleted the last placeholder in the hash. If we've just done - that then it means that the hash is in lazy delete mode, and the - HE is now only referenced in our iterator. If we just quit the loop - and discarded our iterator then the HE leaks. So we do the && the - other way to ensure iternext is called just one more time, which - has the side effect of triggering the lazy delete. */ - while ((entry = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS)) - && items) { - SV *val = hv_iterval(hv, entry); - - if (val == &PL_sv_placeholder) { - - /* It seems that I have to go back in the front of the hash - API to delete a hash, even though I have a HE structure - pointing to the very entry I want to delete, and could hold - onto the previous HE that points to it. And it's easier to - go in with SVs as I can then specify the precomputed hash, - and don't have fun and games with utf8 keys. */ - SV *key = hv_iterkeysv(entry); - - hv_delete_ent (hv, key, G_DISCARD, HeHASH(entry)); - items--; - } - } - HvRITER(hv) = riter; - HvEITER(hv) = eiter; - } + I32 items = (I32)HvPLACEHOLDERS(hv); + I32 i = HvMAX(hv); + + if (items == 0) + return; + + do { + /* Loop down the linked list heads */ + int first = 1; + HE **oentry = &(HvARRAY(hv))[i]; + HE *entry = *oentry; + + if (!entry) + continue; + + for (; entry; entry = *oentry) { + if (HeVAL(entry) == &PL_sv_placeholder) { + *oentry = HeNEXT(entry); + if (first && !*oentry) + HvFILL(hv)--; /* This linked list is now empty. */ + if (HvEITER(hv)) + HvLAZYDEL_on(hv); + else + hv_free_ent(hv, entry); + + if (--items == 0) { + /* Finished. */ + HvTOTALKEYS(hv) -= HvPLACEHOLDERS(hv); + if (HvKEYS(hv) == 0) + HvHASKFLAGS_off(hv); + HvPLACEHOLDERS(hv) = 0; + return; + } + } else { + oentry = &HeNEXT(entry); + first = 0; + } + } + } while (--i >= 0); + /* You can't get here, hence assertion should always fail. */ + assert (items == 0); + assert (0); } STATIC void @@ -2008,9 +2028,10 @@ S_unshare_hek_or_pvn(pTHX_ HEK *hek, const char *str, I32 len, U32 hash) UNLOCK_STRTAB_MUTEX; if (!found && ckWARN_d(WARN_INTERNAL)) Perl_warner(aTHX_ packWARN(WARN_INTERNAL), - "Attempt to free non-existent shared string '%s'%s", + "Attempt to free non-existent shared string '%s'%s" + pTHX__FORMAT, hek ? HEK_KEY(hek) : str, - (k_flags & HVhek_UTF8) ? " (utf8)" : ""); + ((k_flags & HVhek_UTF8) ? " (utf8)" : "") pTHX__VALUE); if (k_flags & HVhek_FREEKEY) Safefree(str); } @@ -2083,7 +2104,7 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags) } if (!found) { entry = new_HE(); - HeKEY_hek(entry) = save_hek_flags(str, len, hash, flags); + HeKEY_hek(entry) = save_hek_flags(str, len, hash, flags_masked); HeVAL(entry) = Nullsv; HeNEXT(entry) = *oentry; *oentry = entry;