X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/cb1f05e8fe9a1c7a7e2de8048f1404df951311b0..cd346b2859236d69de687d1baa46c23e19af2202:/hv.c diff --git a/hv.c b/hv.c index 7d58438..966a12f 100644 --- a/hv.c +++ b/hv.c @@ -19,10 +19,10 @@ /* =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 +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 +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. @@ -35,7 +35,7 @@ holds the key and hash value. #define PERL_HASH_INTERNAL_ACCESS #include "perl.h" -#define HV_MAX_LENGTH_BEFORE_SPLIT 14 +#define DO_HSPLIT(xhv) ((xhv)->xhv_keys > (xhv)->xhv_max) /* HvTOTALKEYS(hv) > HvMAX(hv) */ static const char S_strtab_error[] = "Cannot modify shared string table in hv_%s"; @@ -78,7 +78,7 @@ S_save_hek_flags(const char *str, I32 len, U32 hash, int flags) { const int flags_masked = flags & HVhek_MASK; char *k; - register HEK *hek; + HEK *hek; PERL_ARGS_ASSERT_SAVE_HEK_FLAGS; @@ -277,7 +277,10 @@ negative the key is assumed to be in UTF-8-encoded Unicode. Returns the SV which corresponds to the specified key in the hash. The absolute value of C is the length of the key. If C is negative the key is assumed to be in UTF-8-encoded Unicode. If -C is set then the fetch will be part of a store. Check that the +C is set then the fetch will be part of a store. This means that if +there is no value in the hash associated with the given key, then one is +created and a pointer to it is returned. The C it points to can be +assigned to. But always check that the return value is non-null before dereferencing it to an C. See L for more @@ -285,7 +288,8 @@ information on how to use this function on tied hashes. =for apidoc hv_exists_ent -Returns a boolean indicating whether the specified hash key exists. C +Returns a boolean indicating whether +the specified hash key exists. C can be a valid precomputed hash value, or 0 to ask for it to be computed. @@ -333,7 +337,7 @@ Perl_hv_common_key_len(pTHX_ HV *hv, const char *key, I32 klen_i32, void * Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, - int flags, int action, SV *val, register U32 hash) + int flags, int action, SV *val, U32 hash) { dVAR; XPVHV* xhv; @@ -384,7 +388,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if (SvIsCOW_shared_hash(keysv)) { flags = HVhek_KEYCANONICAL | (is_utf8 ? HVhek_UTF8 : 0); } else { - flags = 0; + flags = is_utf8 ? HVhek_UTF8 : 0; } } else { is_utf8 = ((flags & HVhek_UTF8) ? TRUE : FALSE); @@ -392,8 +396,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if (action & HV_DELETE) { return (void *) hv_delete_common(hv, keysv, key, klen, - flags | (is_utf8 ? HVhek_UTF8 : 0), - action, hash); + flags, action, hash); } xhv = (XPVHV*)SvANY(hv); @@ -523,13 +526,13 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, bool needs_store; hv_magic_check (hv, &needs_copy, &needs_store); if (needs_copy) { - const bool save_taint = PL_tainted; + const bool save_taint = TAINT_get; /* Unused var warning under NO_TAINT_SUPPORT */ if (keysv || is_utf8) { if (!keysv) { keysv = newSVpvn_utf8(key, klen, TRUE); } - if (PL_tainting) - PL_tainted = SvTAINTED(keysv); + if (TAINTING_get) + TAINT_set(SvTAINTED(keysv)); keysv = sv_2mortal(newSVsv(keysv)); mg_copy(MUTABLE_SV(hv), val, (char*)keysv, HEf_SVKEY); } else { @@ -591,7 +594,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, } } - if (is_utf8 & !(flags & HVhek_KEYCANONICAL)) { + if (is_utf8 && !(flags & HVhek_KEYCANONICAL)) { char * const keysave = (char *)key; key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8); if (is_utf8) @@ -610,18 +613,12 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, } } - if (HvREHASH(hv) || (!hash && !(keysv && (SvIsCOW_shared_hash(keysv))))) - PERL_HASH_INTERNAL_(hash, key, klen, HvREHASH(hv)); - else if (!hash) - hash = SvSHARED_HASH(keysv); - - /* We don't have a pointer to the hv, so we have to replicate the - flag into every HEK, so that hv_iterkeysv can see it. - And yes, you do need this even though you are not "storing" because - you can flip the flags below if doing an lval lookup. (And that - was put in to give the semantics Andreas was expecting.) */ - if (HvREHASH(hv)) - flags |= HVhek_REHASH; + if (!hash) { + if (keysv && (SvIsCOW_shared_hash(keysv))) + hash = SvSHARED_HASH(keysv); + else + PERL_HASH(hash, key, klen); + } masked_flags = (flags & HVhek_MASK); @@ -797,29 +794,9 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if (masked_flags & HVhek_ENABLEHVKFLAGS) HvHASKFLAGS_on(hv); - { - const HE *counter = HeNEXT(entry); - - xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */ - if (!counter) { /* initial entry? */ - } else if (xhv->xhv_keys > xhv->xhv_max) { - /* Use only the old HvUSEDKEYS(hv) > HvMAX(hv) condition to limit - bucket splits on a rehashed hash, as we're not going to - split it again, and if someone is lucky (evil) enough to - get all the keys in one list they could exhaust our memory - as we repeatedly double the number of buckets on every - entry. Linear search feels a less worse thing to do. */ - hsplit(hv); - } else if(!HvREHASH(hv)) { - U32 n_links = 1; - - while ((counter = HeNEXT(counter))) - n_links++; - - if (n_links > HV_MAX_LENGTH_BEFORE_SPLIT) { - hsplit(hv); - } - } + xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */ + if ( DO_HSPLIT(xhv) ) { + hsplit(hv); } if (return_svp) { @@ -906,9 +883,9 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, int k_flags, I32 d_flags, U32 hash) { dVAR; - register XPVHV* xhv; - register HE *entry; - register HE **oentry; + XPVHV* xhv; + HE *entry; + HE **oentry; bool is_utf8 = (k_flags & HVhek_UTF8) ? TRUE : FALSE; int masked_flags; @@ -956,7 +933,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if (!HvARRAY(hv)) return NULL; - if (is_utf8) { + if (is_utf8 && !(k_flags & HVhek_KEYCANONICAL)) { const char * const keysave = key; key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8); @@ -975,10 +952,12 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, HvHASKFLAGS_on(MUTABLE_SV(hv)); } - if (HvREHASH(hv) || (!hash && !(keysv && (SvIsCOW_shared_hash(keysv))))) - PERL_HASH_INTERNAL_(hash, key, klen, HvREHASH(hv)); - else if (!hash) - hash = SvSHARED_HASH(keysv); + if (!hash) { + if (keysv && (SvIsCOW_shared_hash(keysv))) + hash = SvSHARED_HASH(keysv); + else + PERL_HASH(hash, key, klen); + } masked_flags = (k_flags & HVhek_MASK); @@ -1049,21 +1028,13 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, mro_changes = 1; } - if (d_flags & G_DISCARD) { - sv = HeVAL(entry); - HeVAL(entry) = &PL_sv_placeholder; - if (sv) { - /* deletion of method from stash */ - if (isGV(sv) && isGV_with_GP(sv) && GvCVu(sv) - && HvENAME_get(hv)) - mro_method_changed_in(hv); - SvREFCNT_dec(sv); - sv = NULL; - } - } - else { - sv = sv_2mortal(HeVAL(entry)); - HeVAL(entry) = &PL_sv_placeholder; + sv = d_flags & G_DISCARD ? HeVAL(entry) : sv_2mortal(HeVAL(entry)); + HeVAL(entry) = &PL_sv_placeholder; + if (sv) { + /* deletion of method from stash */ + if (isGV(sv) && isGV_with_GP(sv) && GvCVu(sv) + && HvENAME_get(hv)) + mro_method_changed_in(hv); } /* @@ -1091,6 +1062,11 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, HvHASKFLAGS_off(hv); } + if (d_flags & G_DISCARD) { + SvREFCNT_dec(sv); + sv = NULL; + } + if (mro_changes == 1) mro_isa_changed_in(hv); else if (mro_changes == 2) mro_package_moved(NULL, stash, gv, 1); @@ -1112,14 +1088,12 @@ STATIC void S_hsplit(pTHX_ HV *hv) { dVAR; - register XPVHV* const xhv = (XPVHV*)SvANY(hv); + XPVHV* const xhv = (XPVHV*)SvANY(hv); const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */ - register I32 newsize = oldsize * 2; - register I32 i; + I32 newsize = oldsize * 2; + I32 i; char *a = (char*) HvARRAY(hv); - register HE **aep; - int longest_chain = 0; - int was_shared; + HE **aep; PERL_ARGS_ASSERT_HSPLIT; @@ -1166,11 +1140,9 @@ S_hsplit(pTHX_ HV *hv) aep = (HE**)a; for (i=0; i longest_chain) - longest_chain = left_length; - if (right_length > longest_chain) - longest_chain = right_length; - } - - - /* Pick your policy for "hashing isn't working" here: */ - if (longest_chain <= HV_MAX_LENGTH_BEFORE_SPLIT /* split worked? */ - || HvREHASH(hv)) { - return; - } - - if (hv == PL_strtab) { - /* Urg. Someone is doing something nasty to the string table. - Can't win. */ - return; - } - - /* Awooga. Awooga. Pathological data. */ - /*PerlIO_printf(PerlIO_stderr(), "%p %d of %d with %d/%d buckets\n", (void*)hv, - longest_chain, HvTOTALKEYS(hv), HvFILL(hv), 1+HvMAX(hv));*/ - - ++newsize; - Newxz(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize) - + (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0), char); - if (SvOOK(hv)) { - Copy(HvAUX(hv), &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux); - } - - was_shared = HvSHAREKEYS(hv); - - HvSHAREKEYS_off(hv); - HvREHASH_on(hv); - - aep = HvARRAY(hv); - - for (i=0; ixhv_max); - HeNEXT(entry) = *bep; - *bep = entry; - - entry = next; - } } - Safefree (HvARRAY(hv)); - HvARRAY(hv) = (HE **)a; } void Perl_hv_ksplit(pTHX_ HV *hv, IV newmax) { dVAR; - register XPVHV* xhv = (XPVHV*)SvANY(hv); + XPVHV* xhv = (XPVHV*)SvANY(hv); const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */ - register I32 newsize; - register I32 i; - register char *a; - register HE **aep; + I32 newsize; + I32 i; + char *a; + HE **aep; PERL_ARGS_ASSERT_HV_KSPLIT; @@ -1336,7 +1233,7 @@ Perl_hv_ksplit(pTHX_ HV *hv, IV newmax) if (!entry) /* non-existent */ continue; do { - register I32 j = (HeHASH(entry) & newsize); + I32 j = (HeHASH(entry) & newsize); if (j != i) { j -= i; @@ -1358,7 +1255,7 @@ Perl_newHVhv(pTHX_ HV *ohv) HV * const hv = newHV(); STRLEN hv_max; - if (!ohv || !HvTOTALKEYS(ohv)) + if (!ohv || (!HvTOTALKEYS(ohv) && !SvMAGICAL((const SV *)ohv))) return hv; hv_max = HvMAX(ohv); @@ -1421,9 +1318,13 @@ Perl_newHVhv(pTHX_ HV *ohv) hv_iterinit(ohv); while ((entry = hv_iternext_flags(ohv, 0))) { - SV *const val = HeVAL(entry); - (void)hv_store_flags(hv, HeKEY(entry), HeKLEN(entry), - SvIMMORTAL(val) ? val : newSVsv(val), + SV *val = hv_iterval(ohv,entry); + SV * const keysv = HeSVKEY(entry); + val = SvIMMORTAL(val) ? val : newSVsv(val); + if (keysv) + (void)hv_store_ent(hv, keysv, val, 0); + else + (void)hv_store_flags(hv, HeKEY(entry), HeKLEN(entry), val, HeHASH(entry), HeKFLAGS(entry)); } HvRITER_set(ohv, riter); @@ -1457,6 +1358,9 @@ Perl_hv_copy_hints_hv(pTHX_ HV *const ohv) const I32 riter = HvRITER_get(ohv); HE * const eiter = HvEITER_get(ohv); + ENTER; + SAVEFREESV(hv); + while (hv_max && hv_max + 1 >= hv_fill * 2) hv_max = hv_max / 2; HvMAX(hv) = hv_max; @@ -1478,6 +1382,9 @@ Perl_hv_copy_hints_hv(pTHX_ HV *const ohv) } HvRITER_set(ohv, riter); HvEITER_set(ohv, eiter); + + SvREFCNT_inc_simple_void_NN(hv); + LEAVE; } hv_magic(hv, NULL, PERL_MAGIC_hints); return hv; @@ -1485,7 +1392,7 @@ Perl_hv_copy_hints_hv(pTHX_ HV *const ohv) /* like hv_free_ent, but returns the SV rather than freeing it */ STATIC SV* -S_hv_free_ent_ret(pTHX_ HV *hv, register HE *entry) +S_hv_free_ent_ret(pTHX_ HV *hv, HE *entry) { dVAR; SV *val; @@ -1495,8 +1402,6 @@ S_hv_free_ent_ret(pTHX_ HV *hv, register HE *entry) if (!entry) return NULL; val = HeVAL(entry); - if (val && isGV(val) && isGV_with_GP(val) && GvCVu(val) && HvENAME(hv)) - mro_method_changed_in(hv); /* deletion of method from stash */ if (HeKLEN(entry) == HEf_SVKEY) { SvREFCNT_dec(HeKEY_sv(entry)); Safefree(HeKEY_hek(entry)); @@ -1511,7 +1416,7 @@ S_hv_free_ent_ret(pTHX_ HV *hv, register HE *entry) void -Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry) +Perl_hv_free_ent(pTHX_ HV *hv, HE *entry) { dVAR; SV *val; @@ -1526,7 +1431,7 @@ Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry) void -Perl_hv_delayfree_ent(pTHX_ HV *hv, register HE *entry) +Perl_hv_delayfree_ent(pTHX_ HV *hv, HE *entry) { dVAR; @@ -1546,7 +1451,10 @@ Perl_hv_delayfree_ent(pTHX_ HV *hv, register HE *entry) =for apidoc hv_clear Frees the all the elements of a hash, leaving it empty. -The XS equivalent of %hash = (). See also L. +The XS equivalent of C<%hash = ()>. See also L. + +If any destructors are triggered as a result, the hv itself may +be freed. =cut */ @@ -1555,7 +1463,7 @@ void Perl_hv_clear(pTHX_ HV *hv) { dVAR; - register XPVHV* xhv; + XPVHV* xhv; if (!hv) return; @@ -1563,6 +1471,8 @@ Perl_hv_clear(pTHX_ HV *hv) xhv = (XPVHV*)SvANY(hv); + ENTER; + SAVEFREESV(SvREFCNT_inc_simple_NN(hv)); if (SvREADONLY(hv) && HvARRAY(hv) != NULL) { /* restricted hash: convert all keys to placeholders */ STRLEN i; @@ -1593,13 +1503,13 @@ Perl_hv_clear(pTHX_ HV *hv) mg_clear(MUTABLE_SV(hv)); HvHASKFLAGS_off(hv); - HvREHASH_off(hv); } if (SvOOK(hv)) { if(HvENAME_get(hv)) mro_isa_changed_in(hv); HvEITER_set(hv, NULL); } + LEAVE; } /* @@ -1760,10 +1670,14 @@ Perl_hfree_next_entry(pTHX_ HV *hv, STRLEN *indexp) /* =for apidoc hv_undef -Undefines the hash. The XS equivalent of undef(%hash). +Undefines the hash. The XS equivalent of C. As well as freeing all the elements of the hash (like hv_clear()), this also frees any auxiliary data and storage associated with the hash. + +If any destructors are triggered as a result, the hv itself may +be freed. + See also L. =cut @@ -1773,8 +1687,9 @@ void Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags) { dVAR; - register XPVHV* xhv; + XPVHV* xhv; const char *name; + const bool save = !!SvREFCNT(hv); if (!hv) return; @@ -1792,13 +1707,20 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags) /* note that the code following prior to hfreeentries is duplicated * in sv_clear(), and changes here should be done there too */ if (PL_phase != PERL_PHASE_DESTRUCT && (name = HvNAME(hv))) { - if (PL_stashcache) + if (PL_stashcache) { + DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing PL_stashcache for '%" + HEKf"'\n", HvNAME_HEK(hv))); (void)hv_delete(PL_stashcache, name, HEK_UTF8(HvNAME_HEK(hv)) ? -HvNAMELEN_get(hv) : HvNAMELEN_get(hv), G_DISCARD ); + } hv_name_set(hv, NULL, 0, 0); } + if (save) { + ENTER; + SAVEFREESV(SvREFCNT_inc_simple_NN(hv)); + } hfreeentries(hv); if (SvOOK(hv)) { struct xpvhv_aux * const aux = HvAUX(hv); @@ -1807,39 +1729,44 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags) if ((name = HvENAME_get(hv))) { if (PL_phase != PERL_PHASE_DESTRUCT) mro_isa_changed_in(hv); - if (PL_stashcache) + if (PL_stashcache) { + DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing PL_stashcache for effective name '%" + HEKf"'\n", HvENAME_HEK(hv))); (void)hv_delete( PL_stashcache, name, HEK_UTF8(HvENAME_HEK(hv)) ? -HvENAMELEN_get(hv) : HvENAMELEN_get(hv), G_DISCARD ); + } } /* If this call originated from sv_clear, then we must check for * effective names that need freeing, as well as the usual name. */ name = HvNAME(hv); if (flags & HV_NAME_SETALL ? !!aux->xhv_name_u.xhvnameu_name : !!name) { - if (name && PL_stashcache) + if (name && PL_stashcache) { + DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing PL_stashcache for name '%" + HEKf"'\n", HvNAME_HEK(hv))); (void)hv_delete(PL_stashcache, name, (HEK_UTF8(HvNAME_HEK(hv)) ? -HvNAMELEN_get(hv) : HvNAMELEN_get(hv)), G_DISCARD); + } hv_name_set(hv, NULL, 0, flags); } if((meta = aux->xhv_mro_meta)) { if (meta->mro_linear_all) { - SvREFCNT_dec(MUTABLE_SV(meta->mro_linear_all)); - meta->mro_linear_all = NULL; - /* This is just acting as a shortcut pointer. */ - meta->mro_linear_current = NULL; - } else if (meta->mro_linear_current) { + SvREFCNT_dec_NN(meta->mro_linear_all); + /* mro_linear_current is just acting as a shortcut pointer, + hence the else. */ + } + else /* Only the current MRO is stored, so this owns the data. */ SvREFCNT_dec(meta->mro_linear_current); - meta->mro_linear_current = NULL; - } SvREFCNT_dec(meta->mro_nextmethod); SvREFCNT_dec(meta->isa); Safefree(meta); aux->xhv_mro_meta = NULL; } + SvREFCNT_dec(aux->xhv_super); if (!aux->xhv_name_u.xhvnameu_name && ! aux->xhv_backreferences) SvFLAGS(hv) &= ~SVf_OOK; } @@ -1848,10 +1775,14 @@ 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)); + if (save) LEAVE; } /* @@ -1911,6 +1842,7 @@ S_hv_auxinit(HV *hv) { iter->xhv_name_count = 0; iter->xhv_backreferences = 0; iter->xhv_mro_meta = NULL; + iter->xhv_super = NULL; return iter; } @@ -2121,7 +2053,7 @@ hek_eq_pvn_flags(pTHX_ const HEK *hek, const char* pv, const I32 pvlen, const U3 /* =for apidoc hv_ename_add -Adds a name to a stash's internal list of effective names. See +Adds a name to a stash's internal list of effective names. See C. This is called when a stash is assigned to a new location in the symbol @@ -2182,7 +2114,7 @@ Perl_hv_ename_add(pTHX_ HV *hv, const char *name, U32 len, U32 flags) /* =for apidoc hv_ename_delete -Removes a name from a stash's internal list of effective names. If this is +Removes a name from a stash's internal list of effective names. If this is the name returned by C, then another name in the list will take its place (C will use it). @@ -2281,7 +2213,7 @@ Perl_hv_kill_backrefs(pTHX_ HV *hv) { HvAUX(hv)->xhv_backreferences = 0; Perl_sv_kill_backrefs(aTHX_ MUTABLE_SV(hv), av); if (SvTYPE(av) == SVt_PVAV) - SvREFCNT_dec(av); + SvREFCNT_dec_NN(av); } } @@ -2307,7 +2239,7 @@ The C value will normally be zero; if HV_ITERNEXT_WANTPLACEHOLDERS is set the placeholders keys (for restricted hashes) will be returned in addition to normal keys. By default placeholders are automatically skipped over. Currently a placeholder is implemented with a value that is -C<&Perl_sv_placeholder>. Note that the implementation of placeholders and +C<&PL_sv_placeholder>. Note that the implementation of placeholders and restricted hashes may change, and the implementation currently is insufficiently abstracted for any change to be tidy. @@ -2318,8 +2250,8 @@ HE * Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) { dVAR; - register XPVHV* xhv; - register HE *entry; + XPVHV* xhv; + HE *entry; HE *oldentry; MAGIC* mg; struct xpvhv_aux *iter; @@ -2333,7 +2265,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) if (!SvOOK(hv)) { /* Too many things (well, pp_each at least) merrily assume that you can - call iv_iternext without calling hv_iterinit, so we'll have to deal + call hv_iternext without calling hv_iterinit, so we'll have to deal with it. */ hv_iterinit(hv); } @@ -2346,6 +2278,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) if (entry) { sv_setsv(key, HeSVKEY_force(entry)); SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */ + HeSVKEY_set(entry, NULL); } else { char *k; @@ -2353,6 +2286,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) /* one HE per MAGICAL hash */ iter->xhv_eiter = entry = new_HE(); /* HvEITER(hv) = new_HE() */ + HvLAZYDEL_on(hv); /* make sure entry gets freed */ Zero(entry, 1, HE); Newxz(k, HEK_BASESIZE + sizeof(const SV *), char); hek = (HEK*)k; @@ -2369,6 +2303,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) Safefree(HeKEY_hek(entry)); del_HE(entry); iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */ + HvLAZYDEL_off(hv); return NULL; } } @@ -2437,9 +2372,6 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) hv_free_ent(hv, oldentry); } - /*if (HvREHASH(hv) && entry && !HeKREHASH(entry)) - PerlIO_printf(PerlIO_stderr(), "Awooga %p %p\n", (void*)hv, (void*)entry);*/ - iter->xhv_eiter = entry; /* HvEITER(hv) = entry */ return entry; } @@ -2454,7 +2386,7 @@ C. */ char * -Perl_hv_iterkey(pTHX_ register HE *entry, I32 *retlen) +Perl_hv_iterkey(pTHX_ HE *entry, I32 *retlen) { PERL_ARGS_ASSERT_HV_ITERKEY; @@ -2482,7 +2414,7 @@ see C. */ SV * -Perl_hv_iterkeysv(pTHX_ register HE *entry) +Perl_hv_iterkeysv(pTHX_ HE *entry) { PERL_ARGS_ASSERT_HV_ITERKEYSV; @@ -2499,7 +2431,7 @@ C. */ SV * -Perl_hv_iterval(pTHX_ HV *hv, register HE *entry) +Perl_hv_iterval(pTHX_ HV *hv, HE *entry) { PERL_ARGS_ASSERT_HV_ITERVAL; @@ -2574,9 +2506,9 @@ STATIC void S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash) { dVAR; - register XPVHV* xhv; + XPVHV* xhv; HE *entry; - register HE **oentry; + HE **oentry; bool is_utf8 = FALSE; int k_flags = 0; const char * const save = str; @@ -2662,7 +2594,7 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash) * len and hash must both be valid for str. */ HEK * -Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash) +Perl_share_hek(pTHX_ const char *str, I32 len, U32 hash) { bool is_utf8 = FALSE; int flags = 0; @@ -2684,6 +2616,7 @@ Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash) we should flag that it needs upgrading on keys or each. Also flag that we need share_hek_flags to free the string. */ if (str != save) { + dVAR; PERL_HASH(hash, str, len); flags |= HVhek_WASUTF8 | HVhek_FREEKEY; } @@ -2693,13 +2626,13 @@ 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) +S_share_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags) { dVAR; - register HE *entry; + HE *entry; const int flags_masked = flags & HVhek_MASK; const U32 hindex = hash & (I32) HvMAX(PL_strtab); - register XPVHV * const xhv = (XPVHV*)SvANY(PL_strtab); + XPVHV * const xhv = (XPVHV*)SvANY(PL_strtab); PERL_ARGS_ASSERT_SHARE_HEK_FLAGS; @@ -2763,8 +2696,8 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags) xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */ if (!next) { /* initial entry? */ - } else if (xhv->xhv_keys > xhv->xhv_max /* HvUSEDKEYS(hv) > HvMAX(hv) */) { - hsplit(PL_strtab); + } else if ( DO_HSPLIT(xhv) ) { + hsplit(PL_strtab); } } @@ -2995,7 +2928,7 @@ Perl_refcounted_he_fetch_pvn(pTHX_ const struct refcounted_he *chain, U8 utf8_flag; PERL_ARGS_ASSERT_REFCOUNTED_HE_FETCH_PVN; - if (flags & ~REFCOUNTED_HE_KEY_UTF8) + if (flags & ~(REFCOUNTED_HE_KEY_UTF8|REFCOUNTED_HE_EXISTS)) Perl_croak(aTHX_ "panic: refcounted_he_fetch_pvn bad flags %"UVxf, (UV)flags); if (!chain) @@ -3046,10 +2979,15 @@ Perl_refcounted_he_fetch_pvn(pTHX_ const struct refcounted_he *chain, memEQ(HEK_KEY(chain->refcounted_he_hek), keypv, keylen) && utf8_flag == (HEK_FLAGS(chain->refcounted_he_hek) & HVhek_UTF8) #endif - ) + ) { + if (flags & REFCOUNTED_HE_EXISTS) + return (chain->refcounted_he_data[0] & HVrhek_typemask) + == HVrhek_delete + ? NULL : &PL_sv_yes; return sv_2mortal(refcounted_he_value(chain)); + } } - return &PL_sv_placeholder; + return flags & REFCOUNTED_HE_EXISTS ? NULL : &PL_sv_placeholder; } /* @@ -3489,8 +3427,8 @@ Perl_hv_assert(pTHX_ HV *hv) * Local variables: * c-indentation-style: bsd * c-basic-offset: 4 - * indent-tabs-mode: t + * indent-tabs-mode: nil * End: * - * ex: set ts=8 sts=4 sw=4 noet: + * ex: set ts=8 sts=4 sw=4 et: */