X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/9912016d365be3d37ae7439a7720746c1e7ca637..28b98f76c447cec8a7ac29d73752c2c930de819a:/hv.c diff --git a/hv.c b/hv.c index 48f21e9..d542462 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. @@ -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. @@ -906,9 +910,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; @@ -1109,12 +1113,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; + HE **aep; int longest_chain = 0; int was_shared; @@ -1167,7 +1171,7 @@ S_hsplit(pTHX_ HV *hv) int right_length = 0; HE **oentry = aep; HE *entry = *aep; - register HE **bep; + HE **bep; if (!entry) /* non-existent */ continue; @@ -1226,7 +1230,7 @@ S_hsplit(pTHX_ HV *hv) aep = HvARRAY(hv); for (i=0; ixhv_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; @@ -1333,7 +1337,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; @@ -1458,6 +1462,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; @@ -1479,6 +1486,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; @@ -1545,7 +1555,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 */ @@ -1554,7 +1567,7 @@ void Perl_hv_clear(pTHX_ HV *hv) { dVAR; - register XPVHV* xhv; + XPVHV* xhv; if (!hv) return; @@ -1562,6 +1575,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; @@ -1599,6 +1614,7 @@ Perl_hv_clear(pTHX_ HV *hv) mro_isa_changed_in(hv); HvEITER_set(hv, NULL); } + LEAVE; } /* @@ -1759,10 +1775,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 @@ -1772,8 +1792,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; @@ -1798,6 +1819,10 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags) ); 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); @@ -1839,6 +1864,7 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags) 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; } @@ -1847,10 +1873,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; } /* @@ -1910,6 +1940,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; } @@ -2120,7 +2151,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 @@ -2181,7 +2212,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). @@ -2306,7 +2337,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. @@ -2317,8 +2348,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; @@ -2332,7 +2363,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); } @@ -2345,6 +2376,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; @@ -2352,6 +2384,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; @@ -2368,6 +2401,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; } } @@ -2573,9 +2607,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; @@ -2695,10 +2729,10 @@ STATIC HEK * S_share_hek_flags(pTHX_ const char *str, I32 len, register 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; @@ -3045,14 +3079,13 @@ 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 - ) - return - flags & REFCOUNTED_HE_EXISTS - ? (chain->refcounted_he_data[0] & HVrhek_typemask) - == HVrhek_delete - ? NULL - : &PL_sv_yes - : sv_2mortal(refcounted_he_value(chain)); + ) { + 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 flags & REFCOUNTED_HE_EXISTS ? NULL : &PL_sv_placeholder; } @@ -3494,8 +3527,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: */