X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/fbe13c605d92f73c90ff4702b76a97c5e12927a7..642792efb41bf5397a25525f6d51b5473c104938:/hv.h diff --git a/hv.h b/hv.h index c6cc0fa..2c5e796 100644 --- a/hv.h +++ b/hv.h @@ -28,6 +28,13 @@ # define PERL_HASH_ITER_BUCKET(iter) (((iter)->xhv_riter) ^ ((iter)->xhv_rand)) #endif +#ifdef PERL_USE_UNSHARED_KEYS_IN_LARGE_HASHES +#define LARGE_HASH_HEURISTIC(hv,new_max) S_large_hash_heuristic(aTHX_ (hv), (new_max)) +#else +#define LARGE_HASH_HEURISTIC(hv,new_max) 0 +#endif + + /* entry in hash value chain */ struct he { /* Keep hent_next first in this structure, because sv_free_arenas take @@ -36,19 +43,24 @@ struct he { HE *hent_next; /* next entry in chain */ HEK *hent_hek; /* hash key */ union { - SV *hent_val; /* scalar value that was hashed */ - Size_t hent_refcount; /* references for this shared hash key */ + SV *hent_val; /* scalar value that was hashed */ + Size_t hent_refcount; /* references for this shared hash key */ } he_valu; }; /* hash key -- defined separately for use as shared pointer */ struct hek { - U32 hek_hash; /* hash of key */ - I32 hek_len; /* length of hash key */ - char hek_key[1]; /* variable-length hash key */ + U32 hek_hash; /* computed hash of key */ + I32 hek_len; /* length of the hash key */ + /* Be careful! Sometimes we store a pointer in the hek_key + * buffer, which means it must be 8 byte aligned or things + * dont work on aligned platforms like HPUX + * Also beware, the last byte of the hek_key buffer is a + * hidden flags byte about the key. */ + char hek_key[1]; /* variable-length hash key */ /* the hash-key is \0-terminated */ /* after the \0 there is a byte for flags, such as whether the key - is UTF-8 */ + is UTF-8 or WAS-UTF-8, or an SV */ }; struct shared_he { @@ -82,6 +94,7 @@ struct mro_meta { const struct mro_alg *mro_which; /* which mro alg is in use? */ HV *isa; /* Everything this class @ISA */ HV *super; /* SUPER method cache */ + CV *destroy; /* DESTROY method if destroy_gen non-zero */ U32 destroy_gen; /* Generation number of DESTROY cache */ }; @@ -118,7 +131,6 @@ struct xpvhv_aux { U32 xhv_last_rand; /* last random value for hash traversal, used to detect each() after insert for warnings */ #endif - U32 xhv_fill_lazy; U32 xhv_aux_flags; /* assorted extra flags */ }; @@ -134,32 +146,38 @@ struct xpvhv { STRLEN xhv_max; /* subscript of last element of xhv_array */ }; -/* -=head1 Hash Manipulation Functions +struct xpvhv_with_aux { + HV *xmg_stash; /* class package */ + union _xmgu xmg_u; + STRLEN xhv_keys; /* total keys, including placeholders */ + STRLEN xhv_max; /* subscript of last element of xhv_array */ + struct xpvhv_aux xhv_aux; +}; -=for apidoc AmU||HEf_SVKEY +/* +=for apidoc AmnU||HEf_SVKEY This flag, used in the length slot of hash entries and magic structures, specifies the structure contains an C pointer where a C pointer is to be expected. (For information only--not to be used). -=head1 Handy Values - -=for apidoc AmU||Nullhv +=for apidoc ADmnU||Nullhv Null HV pointer. (deprecated - use C<(HV *)NULL> instead) -=head1 Hash Manipulation Functions - =for apidoc Am|char*|HvNAME|HV* stash -Returns the package name of a stash, or NULL if C isn't a stash. +Returns the package name of a stash, or C if C isn't a stash. See C>, C>. =for apidoc Am|STRLEN|HvNAMELEN|HV *stash Returns the length of the stash's name. +Disfavored forms of HvNAME and HvNAMELEN; suppress mention of them +=for apidoc Cmh|char*|HvNAME_get|HV* stash +=for apidoc Amh|I32|HvNAMELEN_get|HV* stash + =for apidoc Am|unsigned char|HvNAMEUTF8|HV *stash -Returns true if the name is in UTF8 encoding. +Returns true if the name is in UTF-8 encoding. =for apidoc Am|char*|HvENAME|HV* stash Returns the effective name of a stash, or NULL if there is none. The @@ -173,7 +191,7 @@ caches. Returns the length of the stash's effective name. =for apidoc Am|unsigned char|HvENAMEUTF8|HV *stash -Returns true if the effective name is in UTF8 encoding. +Returns true if the effective name is in UTF-8 encoding. =for apidoc Am|void*|HeKEY|HE* he Returns the actual pointer stored in the key slot of the hash entry. The @@ -239,18 +257,6 @@ C. #define PERL_HASH_DEFAULT_HvMAX 7 -/* During hsplit(), if HvMAX(hv)+1 (the new bucket count) is >= this value, - * we preallocate the HvAUX() struct. - * The assumption being that we are using so much space anyway we might - * as well allocate the extra bytes and speed up later keys() - * or each() operations. We don't do this to small hashes as we assume - * that a) it will be easy/fast to resize them to add the iterator, and b) that - * many of them will be objects which won't be traversed. Larger hashes however - * will take longer to extend, and the size of the aux struct is swamped by the - * overall length of the bucket array. - * */ -#define PERL_HV_ALLOC_AUX_SIZE (1 << 9) - /* these hash entry flags ride on hent_klen (for use only in magic/tied HVs) */ #define HEf_SVKEY -2 /* hent_key is an SV* */ @@ -258,11 +264,21 @@ C. # define Nullhv Null(HV*) #endif #define HvARRAY(hv) ((hv)->sv_u.svu_hash) + +/* + +=for apidoc Am|STRLEN|HvFILL|HV *const hv + +See L. + +=cut + +*/ #define HvFILL(hv) Perl_hv_fill(aTHX_ MUTABLE_HV(hv)) #define HvMAX(hv) ((XPVHV*) SvANY(hv))->xhv_max /* This quite intentionally does no flag checking first. That's your responsibility. */ -#define HvAUX(hv) ((struct xpvhv_aux*)&(HvARRAY(hv)[HvMAX(hv)+1])) +#define HvAUX(hv) (&(((struct xpvhv_with_aux*) SvANY(hv))->xhv_aux)) #define HvRITER(hv) (*Perl_hv_riter_p(aTHX_ MUTABLE_HV(hv))) #define HvEITER(hv) (*Perl_hv_eiter_p(aTHX_ MUTABLE_HV(hv))) #define HvRITER_set(hv,r) Perl_hv_riter_set(aTHX_ MUTABLE_HV(hv), r) @@ -291,16 +307,16 @@ C. ) /* This macro may go away without notice. */ #define HvNAME_HEK(hv) \ - (SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name ? HvNAME_HEK_NN(hv) : NULL) + (SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name ? HvNAME_HEK_NN(hv) : NULL) #define HvNAME_get(hv) \ - ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvNAME_HEK_NN(hv)) \ - ? HEK_KEY(HvNAME_HEK_NN(hv)) : NULL) + ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvNAME_HEK_NN(hv)) \ + ? HEK_KEY(HvNAME_HEK_NN(hv)) : NULL) #define HvNAMELEN_get(hv) \ - ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvNAME_HEK_NN(hv)) \ - ? HEK_LEN(HvNAME_HEK_NN(hv)) : 0) + ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvNAME_HEK_NN(hv)) \ + ? HEK_LEN(HvNAME_HEK_NN(hv)) : 0) #define HvNAMEUTF8(hv) \ - ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvNAME_HEK_NN(hv)) \ - ? HEK_UTF8(HvNAME_HEK_NN(hv)) : 0) + ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvNAME_HEK_NN(hv)) \ + ? HEK_UTF8(HvNAME_HEK_NN(hv)) : 0) #define HvENAME_HEK_NN(hv) \ ( \ HvAUX(hv)->xhv_name_count > 0 ? HvAUX(hv)->xhv_name_u.xhvnameu_names[0] : \ @@ -309,19 +325,16 @@ C. HvAUX(hv)->xhv_name_u.xhvnameu_name \ ) #define HvENAME_HEK(hv) \ - (SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name ? HvENAME_HEK_NN(hv) : NULL) + (SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name ? HvENAME_HEK_NN(hv) : NULL) #define HvENAME_get(hv) \ ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvAUX(hv)->xhv_name_count != -1) \ - ? HEK_KEY(HvENAME_HEK_NN(hv)) : NULL) + ? HEK_KEY(HvENAME_HEK_NN(hv)) : NULL) #define HvENAMELEN_get(hv) \ ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvAUX(hv)->xhv_name_count != -1) \ - ? HEK_LEN(HvENAME_HEK_NN(hv)) : 0) + ? HEK_LEN(HvENAME_HEK_NN(hv)) : 0) #define HvENAMEUTF8(hv) \ ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvAUX(hv)->xhv_name_count != -1) \ - ? HEK_UTF8(HvENAME_HEK_NN(hv)) : 0) - -/* the number of keys (including any placeholders) */ -#define XHvTOTALKEYS(xhv) ((xhv)->xhv_keys) + ? HEK_UTF8(HvENAME_HEK_NN(hv)) : 0) /* * HvKEYS gets the number of keys that actually exist(), and is provided @@ -330,11 +343,18 @@ C. */ #define HvKEYS(hv) HvUSEDKEYS(hv) #define HvUSEDKEYS(hv) (HvTOTALKEYS(hv) - HvPLACEHOLDERS_get(hv)) -#define HvTOTALKEYS(hv) XHvTOTALKEYS((XPVHV*) SvANY(hv)) +#define HvTOTALKEYS(hv) (((XPVHV*) SvANY(hv))->xhv_keys) #define HvPLACEHOLDERS(hv) (*Perl_hv_placeholders_p(aTHX_ MUTABLE_HV(hv))) #define HvPLACEHOLDERS_get(hv) (SvMAGIC(hv) ? Perl_hv_placeholders_get(aTHX_ (const HV *)hv) : 0) #define HvPLACEHOLDERS_set(hv,p) Perl_hv_placeholders_set(aTHX_ MUTABLE_HV(hv), p) +/* This (now) flags whether *new* keys in the hash will be allocated from the + * shared string table. We have a heuristic to call HvSHAREKEYS_off() if a hash + * is "getting large". After which, the first keys in that hash will be from + * the shared string table, but subsequent keys will not be. + * + * If we didn't do this, we'd have to reallocate all keys when we switched this + * flag, which would be work for no real gain. */ #define HvSHAREKEYS(hv) (SvFLAGS(hv) & SVphv_SHAREKEYS) #define HvSHAREKEYS_on(hv) (SvFLAGS(hv) |= SVphv_SHAREKEYS) #define HvSHAREKEYS_off(hv) (SvFLAGS(hv) &= ~SVphv_SHAREKEYS) @@ -370,24 +390,24 @@ C. #define HeVAL(he) (he)->he_valu.hent_val #define HeHASH(he) HEK_HASH(HeKEY_hek(he)) #define HePV(he,lp) ((HeKLEN(he) == HEf_SVKEY) ? \ - SvPV(HeKEY_sv(he),lp) : \ - ((lp = HeKLEN(he)), HeKEY(he))) + SvPV(HeKEY_sv(he),lp) : \ + ((lp = HeKLEN(he)), HeKEY(he))) #define HeUTF8(he) ((HeKLEN(he) == HEf_SVKEY) ? \ - SvUTF8(HeKEY_sv(he)) : \ - (U32)HeKUTF8(he)) + SvUTF8(HeKEY_sv(he)) : \ + (U32)HeKUTF8(he)) #define HeSVKEY(he) ((HeKEY(he) && \ - HeKLEN(he) == HEf_SVKEY) ? \ - HeKEY_sv(he) : NULL) + HeKLEN(he) == HEf_SVKEY) ? \ + HeKEY_sv(he) : NULL) #define HeSVKEY_force(he) (HeKEY(he) ? \ - ((HeKLEN(he) == HEf_SVKEY) ? \ - HeKEY_sv(he) : \ - newSVpvn_flags(HeKEY(he), \ + ((HeKLEN(he) == HEf_SVKEY) ? \ + HeKEY_sv(he) : \ + newSVpvn_flags(HeKEY(he), \ HeKLEN(he), \ SVs_TEMP | \ ( HeKUTF8(he) ? SVf_UTF8 : 0 ))) : \ - &PL_sv_undef) + &PL_sv_undef) #define HeSVKEY_set(he,sv) ((HeKLEN(he) = HEf_SVKEY), (HeKEY_sv(he) = sv)) #ifndef PERL_CORE @@ -401,16 +421,15 @@ C. #define HVhek_UTF8 0x01 /* Key is utf8 encoded. */ #define HVhek_WASUTF8 0x02 /* Key is bytes here, but was supplied as utf8. */ -#define HVhek_UNSHARED 0x08 /* This key isn't a shared hash key. */ -#define HVhek_FREEKEY 0x100 /* Internal flag to say key is malloc()ed. */ +#define HVhek_NOTSHARED 0x04 /* This key isn't a shared hash key. */ +/* the following flags are options for functions, they are not stored in heks */ +#define HVhek_FREEKEY 0x100 /* Internal flag to say key is Newx()ed. */ #define HVhek_PLACEHOLD 0x200 /* Internal flag to create placeholder. * (may change, but Storable is a core module) */ #define HVhek_KEYCANONICAL 0x400 /* Internal flag - key is in canonical form. - If the string is UTF-8, it cannot be - converted to bytes. */ -#define HVhek_MASK 0xFF - -#define HVhek_ENABLEHVKFLAGS (HVhek_MASK & ~(HVhek_UNSHARED)) + If the string is UTF-8, it cannot be + converted to bytes. */ +#define HVhek_ENABLEHVKFLAGS (HVhek_UTF8|HVhek_WASUTF8) #define HEK_UTF8(hek) (HEK_FLAGS(hek) & HVhek_UTF8) #define HEK_UTF8_on(hek) (HEK_FLAGS(hek) |= HVhek_UTF8) @@ -428,9 +447,9 @@ C. #else # define MALLOC_OVERHEAD 16 # define PERL_HV_ARRAY_ALLOC_BYTES(size) \ - (((size) < 64) \ - ? (size) * sizeof(HE*) \ - : (size) * sizeof(HE*) * 2 - MALLOC_OVERHEAD) + (((size) < 64) \ + ? (size) * sizeof(HE*) \ + : (size) * sizeof(HE*) * 2 - MALLOC_OVERHEAD) #endif /* Flags for hv_iternext_flags. */ @@ -445,62 +464,83 @@ C. #define share_hek_hek(hek) \ (++(((struct shared_he *)(((char *)hek) \ - - STRUCT_OFFSET(struct shared_he, \ - shared_he_hek))) \ - ->shared_he_he.he_valu.hent_refcount), \ + - STRUCT_OFFSET(struct shared_he, \ + shared_he_hek))) \ + ->shared_he_he.he_valu.hent_refcount), \ hek) #define hv_store_ent(hv, keysv, val, hash) \ ((HE *) hv_common((hv), (keysv), NULL, 0, 0, HV_FETCH_ISSTORE, \ - (val), (hash))) + (val), (hash))) #define hv_exists_ent(hv, keysv, hash) \ - (hv_common((hv), (keysv), NULL, 0, 0, HV_FETCH_ISEXISTS, 0, (hash)) \ - ? TRUE : FALSE) + cBOOL(hv_common((hv), (keysv), NULL, 0, 0, HV_FETCH_ISEXISTS, 0, (hash))) #define hv_fetch_ent(hv, keysv, lval, hash) \ ((HE *) hv_common((hv), (keysv), NULL, 0, 0, \ - ((lval) ? HV_FETCH_LVALUE : 0), NULL, (hash))) + ((lval) ? HV_FETCH_LVALUE : 0), NULL, (hash))) #define hv_delete_ent(hv, key, flags, hash) \ (MUTABLE_SV(hv_common((hv), (key), NULL, 0, 0, (flags) | HV_DELETE, \ - NULL, (hash)))) + NULL, (hash)))) #define hv_store_flags(hv, key, klen, val, hash, flags) \ ((SV**) hv_common((hv), NULL, (key), (klen), (flags), \ - (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), (val), \ - (hash))) + (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), (val), \ + (hash))) #define hv_store(hv, key, klen, val, hash) \ ((SV**) hv_common_key_len((hv), (key), (klen), \ - (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), \ - (val), (hash))) + (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), \ + (val), (hash))) + + #define hv_exists(hv, key, klen) \ - (hv_common_key_len((hv), (key), (klen), HV_FETCH_ISEXISTS, NULL, 0) \ - ? TRUE : FALSE) + cBOOL(hv_common_key_len((hv), (key), (klen), HV_FETCH_ISEXISTS, NULL, 0)) #define hv_fetch(hv, key, klen, lval) \ ((SV**) hv_common_key_len((hv), (key), (klen), (lval) \ - ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) \ - : HV_FETCH_JUST_SV, NULL, 0)) + ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) \ + : HV_FETCH_JUST_SV, NULL, 0)) #define hv_delete(hv, key, klen, flags) \ (MUTABLE_SV(hv_common_key_len((hv), (key), (klen), \ - (flags) | HV_DELETE, NULL, 0))) + (flags) | HV_DELETE, NULL, 0))) + +/* Provide 's' suffix subs for constant strings (and avoid needing to count + * chars). See STR_WITH_LEN in handy.h - because these are macros we cant use + * STR_WITH_LEN to do the work, we have to unroll it. */ +#define hv_existss(hv, key) \ + hv_exists((hv), ASSERT_IS_LITERAL(key), (sizeof(key)-1)) + +#define hv_fetchs(hv, key, lval) \ + hv_fetch((hv), ASSERT_IS_LITERAL(key), (sizeof(key)-1), (lval)) + +#define hv_deletes(hv, key, flags) \ + hv_delete((hv), ASSERT_IS_LITERAL(key), (sizeof(key)-1), (flags)) + +#define hv_name_sets(hv, name, flags) \ + hv_name_set((hv),ASSERT_IS_LITERAL(name),(sizeof(name)-1), flags) + +#define hv_stores(hv, key, val) \ + hv_store((hv), ASSERT_IS_LITERAL(key), (sizeof(key)-1), (val), 0) #ifdef PERL_CORE # define hv_storehek(hv, hek, val) \ hv_common((hv), NULL, HEK_KEY(hek), HEK_LEN(hek), HEK_UTF8(hek), \ - HV_FETCH_ISSTORE|HV_FETCH_JUST_SV, (val), HEK_HASH(hek)) + HV_FETCH_ISSTORE|HV_FETCH_JUST_SV, (val), HEK_HASH(hek)) # define hv_fetchhek(hv, hek, lval) \ ((SV **) \ hv_common((hv), NULL, HEK_KEY(hek), HEK_LEN(hek), HEK_UTF8(hek), \ - (lval) \ - ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) \ - : HV_FETCH_JUST_SV, \ - NULL, HEK_HASH(hek))) + (lval) \ + ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) \ + : HV_FETCH_JUST_SV, \ + NULL, HEK_HASH(hek))) # define hv_deletehek(hv, hek, flags) \ hv_common((hv), NULL, HEK_KEY(hek), HEK_LEN(hek), HEK_UTF8(hek), \ - (flags)|HV_DELETE, NULL, HEK_HASH(hek)) + (flags)|HV_DELETE, NULL, HEK_HASH(hek)) +#define hv_existshek(hv, hek) \ + cBOOL(hv_common((hv), NULL, HEK_KEY(hek), HEK_LEN(hek), HEK_UTF8(hek), \ + HV_FETCH_ISEXISTS, NULL, HEK_HASH(hek))) #endif /* This refcounted he structure is used for storing the hints used for lexical @@ -513,9 +553,7 @@ struct refcounted_he; /* flags for the refcounted_he API */ #define REFCOUNTED_HE_KEY_UTF8 0x00000001 -#ifdef PERL_CORE -# define REFCOUNTED_HE_EXISTS 0x00000002 -#endif +#define REFCOUNTED_HE_EXISTS 0x00000002 #ifdef PERL_CORE @@ -529,10 +567,10 @@ struct refcounted_he { HEK *refcounted_he_hek; /* hint key */ #endif union { - IV refcounted_he_u_iv; - UV refcounted_he_u_uv; - STRLEN refcounted_he_u_len; - void *refcounted_he_u_ptr; /* Might be useful in future */ + IV refcounted_he_u_iv; + UV refcounted_he_u_uv; + STRLEN refcounted_he_u_len; + void *refcounted_he_u_ptr; /* Might be useful in future */ } refcounted_he_val; U32 refcounted_he_refcnt; /* reference count */ /* First byte is flags. Then NUL-terminated value. Then for ithreads, @@ -541,10 +579,10 @@ struct refcounted_he { }; /* -=for apidoc m|SV *|refcounted_he_fetch_pvs|const struct refcounted_he *chain|const char *key|U32 flags +=for apidoc m|SV *|refcounted_he_fetch_pvs|const struct refcounted_he *chain|"key"|U32 flags -Like L, but takes a literal string instead of -a string/length pair, and no precomputed hash. +Like L, but takes a literal string +instead of a string/length pair, and no precomputed hash. =cut */ @@ -553,10 +591,10 @@ a string/length pair, and no precomputed hash. Perl_refcounted_he_fetch_pvn(aTHX_ chain, STR_WITH_LEN(key), 0, flags) /* -=for apidoc m|struct refcounted_he *|refcounted_he_new_pvs|struct refcounted_he *parent|const char *key|SV *value|U32 flags +=for apidoc m|struct refcounted_he *|refcounted_he_new_pvs|struct refcounted_he *parent|"key"|SV *value|U32 flags -Like L, but takes a literal string instead of -a string/length pair, and no precomputed hash. +Like L, but takes a literal string +instead of a string/length pair, and no precomputed hash. =cut */ @@ -578,9 +616,9 @@ a string/length pair, and no precomputed hash. #ifdef USE_ITHREADS /* A big expression to find the key offset */ #define REF_HE_KEY(chain) \ - ((((chain->refcounted_he_data[0] & 0x60) == 0x40) \ - ? chain->refcounted_he_val.refcounted_he_u_len + 1 : 0) \ - + 1 + chain->refcounted_he_data) + ((((chain->refcounted_he_data[0] & 0x60) == 0x40) \ + ? chain->refcounted_he_val.refcounted_he_u_len + 1 : 0) \ + + 1 + chain->refcounted_he_data) #endif # ifdef USE_ITHREADS