3 * Copyright (C) 1991, 1992, 1993, 1996, 1997, 1998, 1999,
4 * 2000, 2001, 2002, 2003, 2005, 2006, 2007, 2008, by Larry Wall and others
6 * You may distribute under the terms of either the GNU General Public
7 * License or the Artistic License, as specified in the README file.
11 /* entry in hash value chain */
13 /* Keep hent_next first in this structure, because sv_free_arenas take
14 advantage of this to share code between the he arenas and the SV
16 HE *hent_next; /* next entry in chain */
17 HEK *hent_hek; /* hash key */
19 SV *hent_val; /* scalar value that was hashed */
20 Size_t hent_refcount; /* references for this shared hash key */
24 /* hash key -- defined separately for use as shared pointer */
26 U32 hek_hash; /* hash of key */
27 I32 hek_len; /* length of hash key */
28 char hek_key[1]; /* variable-length hash key */
29 /* the hash-key is \0-terminated */
30 /* after the \0 there is a byte for flags, such as whether the key
35 struct he shared_he_he;
36 struct hek shared_he_hek;
40 Don't access this directly.
41 Use the funcs in mro.c
45 AV *(*resolve)(pTHX_ HV* stash, U32 level);
48 U16 kflags; /* For the hash API - set HVhek_UTF8 if name is UTF-8 */
53 /* a hash holding the different MROs private data. */
55 /* a pointer directly to the current MROs private data. If mro_linear_all
56 is NULL, this owns the SV reference, else it is just a pointer to a
57 value stored in and owned by mro_linear_all. */
58 SV *mro_linear_current;
59 HV *mro_nextmethod; /* next::method caching */
60 U32 cache_gen; /* Bumping this invalidates our method cache */
61 U32 pkg_gen; /* Bumps when local methods/@ISA change */
62 const struct mro_alg *mro_which; /* which mro alg is in use? */
63 HV *isa; /* Everything this class @ISA */
66 #define MRO_GET_PRIVATE_DATA(smeta, which) \
67 (((smeta)->mro_which && (which) == (smeta)->mro_which) \
68 ? (smeta)->mro_linear_current \
69 : Perl_mro_get_private_data(aTHX_ (smeta), (which)))
72 Don't access this directly.
76 HEK *xhvnameu_name; /* When xhv_name_count is 0 */
77 HEK **xhvnameu_names; /* When xhv_name_count is non-0 */
81 union _xhvnameu xhv_name_u; /* name, if a symbol table */
82 AV *xhv_backreferences; /* back references for weak references */
83 HE *xhv_eiter; /* current entry of iterator */
84 I32 xhv_riter; /* current root of iterator */
86 /* Concerning xhv_name_count: When non-zero, xhv_name_u contains a pointer
87 * to an array of HEK pointers, this being the length. The first element is
88 * the name of the stash, which may be NULL. If xhv_name_count is positive,
89 * then *xhv_name is one of the effective names. If xhv_name_count is nega-
90 * tive, then xhv_name_u.xhvnameu_names[1] is the first effective name.
93 struct mro_meta *xhv_mro_meta;
94 HV * xhv_super; /* SUPER method cache */
98 /* This structure must match the beginning of struct xpvmg in sv.h. */
100 HV* xmg_stash; /* class package */
102 STRLEN xhv_keys; /* total keys, including placeholders */
103 STRLEN xhv_max; /* subscript of last element of xhv_array */
107 /* The use of a temporary pointer and the casting games
108 * is needed to serve the dual purposes of
109 * (a) the hashed data being interpreted as "unsigned char" (new since 5.8,
110 * a "char" can be either signed or unsigned, depending on the compiler)
111 * (b) catering for old code that uses a "char"
113 * The "hash seed" feature was added in Perl 5.8.1 to perturb the results
114 * to avoid "algorithmic complexity attacks".
116 * If USE_HASH_SEED is defined, hash randomisation is done by default
117 * If USE_HASH_SEED_EXPLICIT is defined, hash randomisation is done
118 * only if the environment variable PERL_HASH_SEED is set.
119 * (see also perl.c:perl_parse() and S_init_tls_and_interp() and util.c:get_hash_seed())
121 #ifndef PERL_HASH_SEED
122 # if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT)
123 # define PERL_HASH_SEED PL_hash_seed
125 # define PERL_HASH_SEED "PeRlHaShhAcKpErl"
129 #define PERL_HASH_SEED_U32 *((U32*)PERL_HASH_SEED)
130 #define PERL_HASH_SEED_U64_1 (((U64*)PERL_HASH_SEED)[0])
131 #define PERL_HASH_SEED_U64_2 (((U64*)PERL_HASH_SEED)[1])
133 /* legacy - only mod_perl should be doing this. */
134 #ifdef PERL_HASH_INTERNAL_ACCESS
135 #define PERL_HASH_INTERNAL(hash,str,len) PERL_HASH(hash,str,len)
138 /* Uncomment one of the following lines to use an alternative hash algorithm.
139 #define PERL_HASH_FUNC_SDBM
140 #define PERL_HASH_FUNC_DJB2
141 #define PERL_HASH_FUNC_SUPERFAST
142 #define PERL_HASH_FUNC_MURMUR3
143 #define PERL_HASH_FUNC_SIPHASH
144 #define PERL_HASH_FUNC_ONE_AT_A_TIME
147 #if !(defined(PERL_HASH_FUNC_SDBM) || defined(PERL_HASH_FUNC_DJB2) || defined(PERL_HASH_FUNC_SUPERFAST) || defined(PERL_HASH_FUNC_MURMUR3) || defined(PERL_HASH_FUNC_ONE_AT_A_TIME))
148 #define PERL_HASH_FUNC_MURMUR3
151 #if defined(PERL_HASH_FUNC_SIPHASH)
152 #define PERL_HASH_FUNC "SIPHASH"
153 #define PERL_HASH_SEED_BYTES 16
155 /* This is SipHash by Jean-Philippe Aumasson and Daniel J. Bernstein.
156 * The authors claim it is relatively secure compared to the alternatives
157 * and that performance wise it is a suitable hash for languages like Perl.
160 * https://www.131002.net/siphash/
162 * This implementation seems to perform slightly slower than one-at-a-time for
163 * short keys, but degrades slower for longer keys. Murmur Hash outperforms it
164 * regardless of keys size.
169 #define PERL_HASH_NEEDS_TWO_SEEDS
175 #define ROTL(x,b) (U64)( ((x) << (b)) | ( (x) >> (64 - (b))) )
177 #define U32TO8_LE(p, v) \
178 (p)[0] = (U8)((v) ); (p)[1] = (U8)((v) >> 8); \
179 (p)[2] = (U8)((v) >> 16); (p)[3] = (U8)((v) >> 24);
181 #define U64TO8_LE(p, v) \
182 U32TO8_LE((p), (U32)((v) )); \
183 U32TO8_LE((p) + 4, (U32)((v) >> 32));
185 #define U8TO64_LE(p) \
186 (((U64)((p)[0]) ) | \
187 ((U64)((p)[1]) << 8) | \
188 ((U64)((p)[2]) << 16) | \
189 ((U64)((p)[3]) << 24) | \
190 ((U64)((p)[4]) << 32) | \
191 ((U64)((p)[5]) << 40) | \
192 ((U64)((p)[6]) << 48) | \
193 ((U64)((p)[7]) << 56))
197 v0_PeRlHaSh += v1_PeRlHaSh; v1_PeRlHaSh=ROTL(v1_PeRlHaSh,13); v1_PeRlHaSh ^= v0_PeRlHaSh; v0_PeRlHaSh=ROTL(v0_PeRlHaSh,32); \
198 v2_PeRlHaSh += v3_PeRlHaSh; v3_PeRlHaSh=ROTL(v3_PeRlHaSh,16); v3_PeRlHaSh ^= v2_PeRlHaSh; \
199 v0_PeRlHaSh += v3_PeRlHaSh; v3_PeRlHaSh=ROTL(v3_PeRlHaSh,21); v3_PeRlHaSh ^= v0_PeRlHaSh; \
200 v2_PeRlHaSh += v1_PeRlHaSh; v1_PeRlHaSh=ROTL(v1_PeRlHaSh,17); v1_PeRlHaSh ^= v2_PeRlHaSh; v2_PeRlHaSh=ROTL(v2_PeRlHaSh,32); \
204 #define PERL_HASH(hash,str,len) STMT_START { \
205 const char * const strtmp_PeRlHaSh = (str); \
206 const unsigned char *in_PeRlHaSh = (const unsigned char *)strtmp_PeRlHaSh; \
207 const U32 inlen_PeRlHaSh = (len); \
208 /* "somepseudorandomlygeneratedbytes" */ \
209 U64 v0_PeRlHaSh = 0x736f6d6570736575ULL; \
210 U64 v1_PeRlHaSh = 0x646f72616e646f6dULL; \
211 U64 v2_PeRlHaSh = 0x6c7967656e657261ULL; \
212 U64 v3_PeRlHaSh = 0x7465646279746573ULL; \
215 U64 k0_PeRlHaSh = PERL_HASH_SEED_U64_1; \
216 U64 k1_PeRlHaSh = PERL_HASH_SEED_U64_2; \
218 const int left_PeRlHaSh = inlen_PeRlHaSh & 7; \
219 const U8 *end_PeRlHaSh = in_PeRlHaSh + inlen_PeRlHaSh - left_PeRlHaSh; \
221 b_PeRlHaSh = ( ( U64 )(len) ) << 56; \
222 v3_PeRlHaSh ^= k1_PeRlHaSh; \
223 v2_PeRlHaSh ^= k0_PeRlHaSh; \
224 v1_PeRlHaSh ^= k1_PeRlHaSh; \
225 v0_PeRlHaSh ^= k0_PeRlHaSh; \
227 for ( ; in_PeRlHaSh != end_PeRlHaSh; in_PeRlHaSh += 8 ) \
229 m_PeRlHaSh = U8TO64_LE( in_PeRlHaSh ); \
230 v3_PeRlHaSh ^= m_PeRlHaSh; \
233 v0_PeRlHaSh ^= m_PeRlHaSh; \
236 switch( left_PeRlHaSh ) \
238 case 7: b_PeRlHaSh |= ( ( U64 )in_PeRlHaSh[ 6] ) << 48; \
239 case 6: b_PeRlHaSh |= ( ( U64 )in_PeRlHaSh[ 5] ) << 40; \
240 case 5: b_PeRlHaSh |= ( ( U64 )in_PeRlHaSh[ 4] ) << 32; \
241 case 4: b_PeRlHaSh |= ( ( U64 )in_PeRlHaSh[ 3] ) << 24; \
242 case 3: b_PeRlHaSh |= ( ( U64 )in_PeRlHaSh[ 2] ) << 16; \
243 case 2: b_PeRlHaSh |= ( ( U64 )in_PeRlHaSh[ 1] ) << 8; \
244 case 1: b_PeRlHaSh |= ( ( U64 )in_PeRlHaSh[ 0] ); break; \
248 v3_PeRlHaSh ^= b_PeRlHaSh; \
251 v0_PeRlHaSh ^= b_PeRlHaSh; \
253 v2_PeRlHaSh ^= 0xff; \
258 b_PeRlHaSh = v0_PeRlHaSh ^ v1_PeRlHaSh ^ v2_PeRlHaSh ^ v3_PeRlHaSh; \
259 (hash)= (U32)(b_PeRlHaSh & U32_MAX); \
262 #elif defined(PERL_HASH_FUNC_SUPERFAST)
263 #define PERL_HASH_FUNC "SUPERFAST"
264 /* FYI: This is the "Super-Fast" algorithm mentioned by Bob Jenkins in
265 * (http://burtleburtle.net/bob/hash/doobs.html)
266 * It is by Paul Hsieh (c) 2004 and is analysed here
267 * http://www.azillionmonkeys.com/qed/hash.html
268 * license terms are here:
269 * http://www.azillionmonkeys.com/qed/weblicense.html
272 #if (defined(__GNUC__) && defined(__i386__)) || defined(__WATCOMC__) \
273 || defined(_MSC_VER) || defined (__BORLANDC__) || defined (__TURBOC__)
274 #define get16bits(d) (*((const U16 *) (d)))
277 #if !defined (get16bits)
278 #define get16bits(d) ((((const U8 *)(d))[1] << UINT32_C(8))\
279 +((const U8 *)(d))[0])
281 #define PERL_HASH(hash,str,len) \
283 register const char * const strtmp_PeRlHaSh = (str); \
284 register const unsigned char *str_PeRlHaSh = (const unsigned char *)strtmp_PeRlHaSh; \
285 register U32 len_PeRlHaSh = (len); \
286 register U32 hash_PeRlHaSh = PERL_HASH_SEED_U32 ^ len; \
287 register U32 tmp_PeRlHaSh; \
288 register int rem_PeRlHaSh= len_PeRlHaSh & 3; \
289 len_PeRlHaSh >>= 2; \
291 for (;len_PeRlHaSh > 0; len_PeRlHaSh--) { \
292 hash_PeRlHaSh += get16bits (str_PeRlHaSh); \
293 tmp_PeRlHaSh = (get16bits (str_PeRlHaSh+2) << 11) ^ hash_PeRlHaSh; \
294 hash_PeRlHaSh = (hash_PeRlHaSh << 16) ^ tmp_PeRlHaSh; \
295 str_PeRlHaSh += 2 * sizeof (U16); \
296 hash_PeRlHaSh += hash_PeRlHaSh >> 11; \
299 /* Handle end cases */ \
300 switch (rem_PeRlHaSh) { \
301 case 3: hash_PeRlHaSh += get16bits (str_PeRlHaSh); \
302 hash_PeRlHaSh ^= hash_PeRlHaSh << 16; \
303 hash_PeRlHaSh ^= str_PeRlHaSh[sizeof (U16)] << 18; \
304 hash_PeRlHaSh += hash_PeRlHaSh >> 11; \
306 case 2: hash_PeRlHaSh += get16bits (str_PeRlHaSh); \
307 hash_PeRlHaSh ^= hash_PeRlHaSh << 11; \
308 hash_PeRlHaSh += hash_PeRlHaSh >> 17; \
310 case 1: hash_PeRlHaSh += *str_PeRlHaSh; \
311 hash_PeRlHaSh ^= hash_PeRlHaSh << 10; \
312 hash_PeRlHaSh += hash_PeRlHaSh >> 1; \
315 /* Force "avalanching" of final 127 bits */ \
316 hash_PeRlHaSh ^= hash_PeRlHaSh << 3; \
317 hash_PeRlHaSh += hash_PeRlHaSh >> 5; \
318 hash_PeRlHaSh ^= hash_PeRlHaSh << 4; \
319 hash_PeRlHaSh += hash_PeRlHaSh >> 17; \
320 hash_PeRlHaSh ^= hash_PeRlHaSh << 25; \
321 (hash) = (hash_PeRlHaSh + (hash_PeRlHaSh >> 6)); \
324 #elif defined(PERL_HASH_FUNC_MURMUR3)
325 #define PERL_HASH_FUNC "MURMUR3"
326 #define PERL_HASH_SEED_BYTES 4
328 /*-----------------------------------------------------------------------------
329 * MurmurHash3 was written by Austin Appleby, and is placed in the public
332 * This implementation was originally written by Shane Day, and is also public domain,
333 * and was modified to function as a macro similar to other perl hash functions by
336 * This is a portable ANSI C implementation of MurmurHash3_x86_32 (Murmur3A)
337 * with support for progressive processing.
339 * If you want to understand the MurmurHash algorithm you would be much better
340 * off reading the original source. Just point your browser at:
341 * http://code.google.com/p/smhasher/source/browse/trunk/MurmurHash3.cpp
345 * We can only process entire 32 bit chunks of input, except for the very end
346 * that may be shorter.
348 * To handle endianess I simply use a macro that reads a U32 and define
349 * that macro to be a direct read on little endian machines, a read and swap
350 * on big endian machines, or a byte-by-byte read if the endianess is unknown.
354 /*-----------------------------------------------------------------------------
355 * Endianess, misalignment capabilities and util macros
357 * The following 3 macros are defined in this section. The other macros defined
358 * are only needed to help derive these 3.
360 * MURMUR_READ_UINT32(x) Read a little endian unsigned 32-bit int
361 * MURMUR_UNALIGNED_SAFE Defined if READ_UINT32 works on non-word boundaries
362 * MURMUR_ROTL32(x,r) Rotate x left by r bits
365 /* Convention is to define __BYTE_ORDER == to one of these values */
366 #if !defined(__BIG_ENDIAN)
367 #define __BIG_ENDIAN 4321
369 #if !defined(__LITTLE_ENDIAN)
370 #define __LITTLE_ENDIAN 1234
374 #if defined(_M_IX86) || defined(__i386__) || defined(__i386) || defined(i386)
375 #define __BYTE_ORDER __LITTLE_ENDIAN
376 #define MURMUR_UNALIGNED_SAFE
379 /* gcc 'may' define __LITTLE_ENDIAN__ or __BIG_ENDIAN__ to 1 (Note the trailing __),
380 * or even _LITTLE_ENDIAN or _BIG_ENDIAN (Note the single _ prefix) */
381 #if !defined(__BYTE_ORDER)
382 #if defined(__LITTLE_ENDIAN__) && __LITTLE_ENDIAN__==1 || defined(_LITTLE_ENDIAN) && _LITTLE_ENDIAN==1
383 #define __BYTE_ORDER __LITTLE_ENDIAN
384 #elif defined(__BIG_ENDIAN__) && __BIG_ENDIAN__==1 || defined(_BIG_ENDIAN) && _BIG_ENDIAN==1
385 #define __BYTE_ORDER __BIG_ENDIAN
389 /* gcc (usually) defines xEL/EB macros for ARM and MIPS endianess */
390 #if !defined(__BYTE_ORDER)
391 #if defined(__ARMEL__) || defined(__MIPSEL__)
392 #define __BYTE_ORDER __LITTLE_ENDIAN
394 #if defined(__ARMEB__) || defined(__MIPSEB__)
395 #define __BYTE_ORDER __BIG_ENDIAN
399 /* Now find best way we can to READ_UINT32 */
400 #if __BYTE_ORDER==__LITTLE_ENDIAN
401 /* CPU endian matches murmurhash algorithm, so read 32-bit word directly */
402 #define MURMUR_READ_UINT32(ptr) (*((U32*)(ptr)))
403 #elif __BYTE_ORDER==__BIG_ENDIAN
404 /* TODO: Add additional cases below where a compiler provided bswap32 is available */
405 #if defined(__GNUC__) && (__GNUC__>4 || (__GNUC__==4 && __GNUC_MINOR__>=3))
406 #define MURMUR_READ_UINT32(ptr) (__builtin_bswap32(*((U32*)(ptr))))
408 /* Without a known fast bswap32 we're just as well off doing this */
409 #define MURMUR_READ_UINT32(ptr) (ptr[0]|ptr[1]<<8|ptr[2]<<16|ptr[3]<<24)
410 #define MURMUR_UNALIGNED_SAFE
413 /* Unknown endianess so last resort is to read individual bytes */
414 #define MURMUR_READ_UINT32(ptr) (ptr[0]|ptr[1]<<8|ptr[2]<<16|ptr[3]<<24)
416 /* Since we're not doing word-reads we can skip the messing about with realignment */
417 #define MURMUR_UNALIGNED_SAFE
420 /* Find best way to ROTL32 */
421 #if defined(_MSC_VER)
422 #include <stdlib.h> /* Microsoft put _rotl declaration in here */
423 #define MURMUR_ROTL32(x,r) _rotl(x,r)
425 /* gcc recognises this code and generates a rotate instruction for CPUs with one */
426 #define MURMUR_ROTL32(x,r) (((U32)x << r) | ((U32)x >> (32 - r)))
430 /*-----------------------------------------------------------------------------
431 * Core murmurhash algorithm macros */
433 #define MURMUR_C1 (0xcc9e2d51)
434 #define MURMUR_C2 (0x1b873593)
435 #define MURMUR_C3 (0xe6546b64)
436 #define MURMUR_C4 (0x85ebca6b)
437 #define MURMUR_C5 (0xc2b2ae35)
439 /* This is the main processing body of the algorithm. It operates
440 * on each full 32-bits of input. */
441 #define MURMUR_DOBLOCK(h1, k1) STMT_START { \
443 k1 = MURMUR_ROTL32(k1,15); \
447 h1 = MURMUR_ROTL32(h1,13); \
448 h1 = h1 * 5 + MURMUR_C3; \
452 /* Append unaligned bytes to carry, forcing hash churn if we have 4 bytes */
453 /* cnt=bytes to process, h1=name of h1 var, c=carry, n=bytes in c, ptr/len=payload */
454 #define MURMUR_DOBYTES(cnt, h1, c, n, ptr, len) STMT_START { \
455 int MURMUR_DOBYTES_i = cnt; \
456 while(MURMUR_DOBYTES_i--) { \
457 c = c>>8 | *ptr++<<24; \
460 MURMUR_DOBLOCK(h1, c); \
466 /* process the last 1..3 bytes and finalize */
467 #define MURMUR_FINALIZE(hash, PeRlHaSh_len, PeRlHaSh_k1, PeRlHaSh_h1, PeRlHaSh_carry, PeRlHaSh_bytes_in_carry, PeRlHaSh_ptr, PeRlHaSh_total_length) STMT_START { \
468 /* Advance over whole 32-bit chunks, possibly leaving 1..3 bytes */\
469 PeRlHaSh_len -= PeRlHaSh_len/4*4; \
471 /* Append any remaining bytes into carry */ \
472 MURMUR_DOBYTES(PeRlHaSh_len, PeRlHaSh_h1, PeRlHaSh_carry, PeRlHaSh_bytes_in_carry, PeRlHaSh_ptr, PeRlHaSh_len); \
474 if (PeRlHaSh_bytes_in_carry) { \
475 PeRlHaSh_k1 = PeRlHaSh_carry >> ( 4 - PeRlHaSh_bytes_in_carry ) * 8; \
476 PeRlHaSh_k1 *= MURMUR_C1; \
477 PeRlHaSh_k1 = MURMUR_ROTL32(PeRlHaSh_k1,15); \
478 PeRlHaSh_k1 *= MURMUR_C2; \
479 PeRlHaSh_h1 ^= PeRlHaSh_k1; \
481 PeRlHaSh_h1 ^= PeRlHaSh_total_length; \
484 PeRlHaSh_h1 ^= PeRlHaSh_h1 >> 16; \
485 PeRlHaSh_h1 *= MURMUR_C4; \
486 PeRlHaSh_h1 ^= PeRlHaSh_h1 >> 13; \
487 PeRlHaSh_h1 *= MURMUR_C5; \
488 PeRlHaSh_h1 ^= PeRlHaSh_h1 >> 16; \
489 (hash)= PeRlHaSh_h1; \
492 /* now we create the hash function */
494 #if defined(UNALIGNED_SAFE)
495 #define PERL_HASH(hash,str,len) STMT_START { \
496 register const char * const s_PeRlHaSh_tmp = (str); \
497 register const unsigned char *PeRlHaSh_ptr = (const unsigned char *)s_PeRlHaSh_tmp; \
498 register I32 PeRlHaSh_len = len; \
500 U32 PeRlHaSh_h1 = PERL_HASH_SEED_U32; \
502 U32 PeRlHaSh_carry = 0; \
504 const unsigned char *PeRlHaSh_end; \
506 int PeRlHaSh_bytes_in_carry = 0; /* bytes in carry */ \
507 I32 PeRlHaSh_total_length= PeRlHaSh_len; \
509 /* This CPU handles unaligned word access */ \
510 /* Process 32-bit chunks */ \
511 PeRlHaSh_end = PeRlHaSh_ptr + PeRlHaSh_len/4*4; \
512 for( ; PeRlHaSh_ptr < PeRlHaSh_end ; PeRlHaSh_ptr+=4) { \
513 PeRlHaSh_k1 = MURMUR_READ_UINT32(PeRlHaSh_ptr); \
514 MURMUR_DOBLOCK(PeRlHaSh_h1, PeRlHaSh_k1); \
517 MURMUR_FINALIZE(hash, PeRlHaSh_len, PeRlHaSh_k1, PeRlHaSh_h1, PeRlHaSh_carry, PeRlHaSh_bytes_in_carry, PeRlHaSh_ptr, PeRlHaSh_total_length);\
520 #define PERL_HASH(hash,str,len) STMT_START { \
521 register const char * const s_PeRlHaSh_tmp = (str); \
522 register const unsigned char *PeRlHaSh_ptr = (const unsigned char *)s_PeRlHaSh_tmp; \
523 register I32 PeRlHaSh_len = len; \
525 U32 PeRlHaSh_h1 = PERL_HASH_SEED_U32; \
527 U32 PeRlHaSh_carry = 0; \
529 const unsigned char *PeRlHaSh_end; \
531 int PeRlHaSh_bytes_in_carry = 0; /* bytes in carry */ \
532 I32 PeRlHaSh_total_length= PeRlHaSh_len; \
534 /* This CPU does not handle unaligned word access */ \
536 /* Consume enough so that the next data byte is word aligned */ \
537 int PeRlHaSh_i = -(long)PeRlHaSh_ptr & 3; \
538 if(PeRlHaSh_i && PeRlHaSh_i <= PeRlHaSh_len) { \
539 MURMUR_DOBYTES(PeRlHaSh_i, PeRlHaSh_h1, PeRlHaSh_carry, PeRlHaSh_bytes_in_carry, PeRlHaSh_ptr, PeRlHaSh_len);\
542 /* We're now aligned. Process in aligned blocks. Specialise for each possible carry count */ \
543 PeRlHaSh_end = PeRlHaSh_ptr + PeRlHaSh_len/4*4; \
544 switch(PeRlHaSh_bytes_in_carry) { /* how many bytes in carry */ \
545 case 0: /* c=[----] w=[3210] b=[3210]=w c'=[----] */ \
546 for( ; PeRlHaSh_ptr < PeRlHaSh_end ; PeRlHaSh_ptr+=4) { \
547 PeRlHaSh_k1 = MURMUR_READ_UINT32(PeRlHaSh_ptr); \
548 MURMUR_DOBLOCK(PeRlHaSh_h1, PeRlHaSh_k1); \
551 case 1: /* c=[0---] w=[4321] b=[3210]=c>>24|w<<8 c'=[4---] */ \
552 for( ; PeRlHaSh_ptr < PeRlHaSh_end ; PeRlHaSh_ptr+=4) { \
553 PeRlHaSh_k1 = PeRlHaSh_carry>>24; \
554 PeRlHaSh_carry = MURMUR_READ_UINT32(PeRlHaSh_ptr); \
555 PeRlHaSh_k1 |= PeRlHaSh_carry<<8; \
556 MURMUR_DOBLOCK(PeRlHaSh_h1, PeRlHaSh_k1); \
559 case 2: /* c=[10--] w=[5432] b=[3210]=c>>16|w<<16 c'=[54--] */ \
560 for( ; PeRlHaSh_ptr < PeRlHaSh_end ; PeRlHaSh_ptr+=4) { \
561 PeRlHaSh_k1 = PeRlHaSh_carry>>16; \
562 PeRlHaSh_carry = MURMUR_READ_UINT32(PeRlHaSh_ptr); \
563 PeRlHaSh_k1 |= PeRlHaSh_carry<<16; \
564 MURMUR_DOBLOCK(PeRlHaSh_h1, PeRlHaSh_k1); \
567 case 3: /* c=[210-] w=[6543] b=[3210]=c>>8|w<<24 c'=[654-] */ \
568 for( ; PeRlHaSh_ptr < PeRlHaSh_end ; PeRlHaSh_ptr+=4) { \
569 PeRlHaSh_k1 = PeRlHaSh_carry>>8; \
570 PeRlHaSh_carry = MURMUR_READ_UINT32(PeRlHaSh_ptr); \
571 PeRlHaSh_k1 |= PeRlHaSh_carry<<24; \
572 MURMUR_DOBLOCK(PeRlHaSh_h1, PeRlHaSh_k1); \
576 MURMUR_FINALIZE(hash, PeRlHaSh_len, PeRlHaSh_k1, PeRlHaSh_h1, PeRlHaSh_carry, PeRlHaSh_bytes_in_carry, PeRlHaSh_ptr, PeRlHaSh_total_length);\
580 #elif defined(PERL_HASH_FUNC_DJB2)
581 #define PERL_HASH_FUNC "DJB2"
582 #define PERL_HASH_SEED_BYTES 4
583 #define PERL_HASH(hash,str,len) \
585 register const char * const s_PeRlHaSh_tmp = (str); \
586 register const unsigned char *s_PeRlHaSh = (const unsigned char *)s_PeRlHaSh_tmp; \
587 register I32 i_PeRlHaSh = len; \
588 register U32 hash_PeRlHaSh = PERL_HASH_SEED_U32 ^ len; \
589 while (i_PeRlHaSh--) { \
590 hash_PeRlHaSh = ((hash_PeRlHaSh << 5) + hash_PeRlHaSh) + *s_PeRlHaSh++; \
592 (hash) = hash_PeRlHaSh;\
595 #elif defined(PERL_HASH_FUNC_SDBM)
596 #define PERL_HASH_FUNC "SDBM"
597 #define PERL_HASH_SEED_BYTES 4
598 #define PERL_HASH(hash,str,len) \
600 register const char * const s_PeRlHaSh_tmp = (str); \
601 register const unsigned char *s_PeRlHaSh = (const unsigned char *)s_PeRlHaSh_tmp; \
602 register I32 i_PeRlHaSh = len; \
603 register U32 hash_PeRlHaSh = PERL_HASH_SEED_U32 ^ len; \
604 while (i_PeRlHaSh--) { \
605 hash_PeRlHaSh = (hash_PeRlHaSh << 6) + (hash_PeRlHaSh << 16) - hash_PeRlHaSh + *s_PeRlHaSh++; \
607 (hash) = hash_PeRlHaSh;\
610 #elif defined(PERL_HASH_FUNC_ONE_AT_A_TIME)
611 /* DEFAULT/HISTORIC HASH FUNCTION */
612 #define PERL_HASH_FUNC "ONE_AT_A_TIME"
613 #define PERL_HASH_SEED_BYTES 4
615 /* FYI: This is the "One-at-a-Time" algorithm by Bob Jenkins
616 * from requirements by Colin Plumb.
617 * (http://burtleburtle.net/bob/hash/doobs.html) */
618 #define PERL_HASH(hash,str,len) \
620 register const char * const s_PeRlHaSh_tmp = (str); \
621 register const unsigned char *s_PeRlHaSh = (const unsigned char *)s_PeRlHaSh_tmp; \
622 register I32 i_PeRlHaSh = len; \
623 register U32 hash_PeRlHaSh = PERL_HASH_SEED_U32 ^ len; \
624 while (i_PeRlHaSh--) { \
625 hash_PeRlHaSh += (U8)*s_PeRlHaSh++; \
626 hash_PeRlHaSh += (hash_PeRlHaSh << 10); \
627 hash_PeRlHaSh ^= (hash_PeRlHaSh >> 6); \
629 hash_PeRlHaSh += (hash_PeRlHaSh << 3); \
630 hash_PeRlHaSh ^= (hash_PeRlHaSh >> 11); \
631 (hash) = (hash_PeRlHaSh + (hash_PeRlHaSh << 15)); \
635 #error "No hash function defined!"
638 =head1 Hash Manipulation Functions
640 =for apidoc AmU||HEf_SVKEY
641 This flag, used in the length slot of hash entries and magic structures,
642 specifies the structure contains an C<SV*> pointer where a C<char*> pointer
643 is to be expected. (For information only--not to be used).
647 =for apidoc AmU||Nullhv
650 (deprecated - use C<(HV *)NULL> instead)
652 =head1 Hash Manipulation Functions
654 =for apidoc Am|char*|HvNAME|HV* stash
655 Returns the package name of a stash, or NULL if C<stash> isn't a stash.
656 See C<SvSTASH>, C<CvSTASH>.
658 =for apidoc Am|STRLEN|HvNAMELEN|HV *stash
659 Returns the length of the stash's name.
661 =for apidoc Am|unsigned char|HvNAMEUTF8|HV *stash
662 Returns true if the name is in UTF8 encoding.
664 =for apidoc Am|char*|HvENAME|HV* stash
665 Returns the effective name of a stash, or NULL if there is none. The
666 effective name represents a location in the symbol table where this stash
667 resides. It is updated automatically when packages are aliased or deleted.
668 A stash that is no longer in the symbol table has no effective name. This
669 name is preferable to C<HvNAME> for use in MRO linearisations and isa
672 =for apidoc Am|STRLEN|HvENAMELEN|HV *stash
673 Returns the length of the stash's effective name.
675 =for apidoc Am|unsigned char|HvENAMEUTF8|HV *stash
676 Returns true if the effective name is in UTF8 encoding.
678 =for apidoc Am|void*|HeKEY|HE* he
679 Returns the actual pointer stored in the key slot of the hash entry. The
680 pointer may be either C<char*> or C<SV*>, depending on the value of
681 C<HeKLEN()>. Can be assigned to. The C<HePV()> or C<HeSVKEY()> macros are
682 usually preferable for finding the value of a key.
684 =for apidoc Am|STRLEN|HeKLEN|HE* he
685 If this is negative, and amounts to C<HEf_SVKEY>, it indicates the entry
686 holds an C<SV*> key. Otherwise, holds the actual length of the key. Can
687 be assigned to. The C<HePV()> macro is usually preferable for finding key
690 =for apidoc Am|SV*|HeVAL|HE* he
691 Returns the value slot (type C<SV*>) stored in the hash entry. Can be assigned
698 =for apidoc Am|U32|HeHASH|HE* he
699 Returns the computed hash stored in the hash entry.
701 =for apidoc Am|char*|HePV|HE* he|STRLEN len
702 Returns the key slot of the hash entry as a C<char*> value, doing any
703 necessary dereferencing of possibly C<SV*> keys. The length of the string
704 is placed in C<len> (this is a macro, so do I<not> use C<&len>). If you do
705 not care about what the length of the key is, you may use the global
706 variable C<PL_na>, though this is rather less efficient than using a local
707 variable. Remember though, that hash keys in perl are free to contain
708 embedded nulls, so using C<strlen()> or similar is not a good way to find
709 the length of hash keys. This is very similar to the C<SvPV()> macro
710 described elsewhere in this document. See also C<HeUTF8>.
712 If you are using C<HePV> to get values to pass to C<newSVpvn()> to create a
713 new SV, you should consider using C<newSVhek(HeKEY_hek(he))> as it is more
716 =for apidoc Am|char*|HeUTF8|HE* he
717 Returns whether the C<char *> value returned by C<HePV> is encoded in UTF-8,
718 doing any necessary dereferencing of possibly C<SV*> keys. The value returned
719 will be 0 or non-0, not necessarily 1 (or even a value with any low bits set),
720 so B<do not> blindly assign this to a C<bool> variable, as C<bool> may be a
723 =for apidoc Am|SV*|HeSVKEY|HE* he
724 Returns the key as an C<SV*>, or C<NULL> if the hash entry does not
725 contain an C<SV*> key.
727 =for apidoc Am|SV*|HeSVKEY_force|HE* he
728 Returns the key as an C<SV*>. Will create and return a temporary mortal
729 C<SV*> if the hash entry contains only a C<char*> key.
731 =for apidoc Am|SV*|HeSVKEY_set|HE* he|SV* sv
732 Sets the key to a given C<SV*>, taking care to set the appropriate flags to
733 indicate the presence of an C<SV*> key, and returns the same
739 /* these hash entry flags ride on hent_klen (for use only in magic/tied HVs) */
740 #define HEf_SVKEY -2 /* hent_key is an SV* */
743 # define Nullhv Null(HV*)
745 #define HvARRAY(hv) ((hv)->sv_u.svu_hash)
746 #define HvFILL(hv) Perl_hv_fill(aTHX_ (const HV *)(hv))
747 #define HvMAX(hv) ((XPVHV*) SvANY(hv))->xhv_max
748 /* This quite intentionally does no flag checking first. That's your
750 #define HvAUX(hv) ((struct xpvhv_aux*)&(HvARRAY(hv)[HvMAX(hv)+1]))
751 #define HvRITER(hv) (*Perl_hv_riter_p(aTHX_ MUTABLE_HV(hv)))
752 #define HvEITER(hv) (*Perl_hv_eiter_p(aTHX_ MUTABLE_HV(hv)))
753 #define HvRITER_set(hv,r) Perl_hv_riter_set(aTHX_ MUTABLE_HV(hv), r)
754 #define HvEITER_set(hv,e) Perl_hv_eiter_set(aTHX_ MUTABLE_HV(hv), e)
755 #define HvRITER_get(hv) (SvOOK(hv) ? HvAUX(hv)->xhv_riter : -1)
756 #define HvEITER_get(hv) (SvOOK(hv) ? HvAUX(hv)->xhv_eiter : NULL)
757 #define HvNAME(hv) HvNAME_get(hv)
758 #define HvNAMELEN(hv) HvNAMELEN_get(hv)
759 #define HvENAME(hv) HvENAME_get(hv)
760 #define HvENAMELEN(hv) HvENAMELEN_get(hv)
762 /* Checking that hv is a valid package stash is the
763 caller's responsibility */
764 #define HvMROMETA(hv) (HvAUX(hv)->xhv_mro_meta \
765 ? HvAUX(hv)->xhv_mro_meta \
766 : Perl_mro_meta_init(aTHX_ hv))
768 #define HvNAME_HEK_NN(hv) \
770 HvAUX(hv)->xhv_name_count \
771 ? *HvAUX(hv)->xhv_name_u.xhvnameu_names \
772 : HvAUX(hv)->xhv_name_u.xhvnameu_name \
774 /* This macro may go away without notice. */
775 #define HvNAME_HEK(hv) \
776 (SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name ? HvNAME_HEK_NN(hv) : NULL)
777 #define HvNAME_get(hv) \
778 ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvNAME_HEK_NN(hv)) \
779 ? HEK_KEY(HvNAME_HEK_NN(hv)) : NULL)
780 #define HvNAMELEN_get(hv) \
781 ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvNAME_HEK_NN(hv)) \
782 ? HEK_LEN(HvNAME_HEK_NN(hv)) : 0)
783 #define HvNAMEUTF8(hv) \
784 ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvNAME_HEK_NN(hv)) \
785 ? HEK_UTF8(HvNAME_HEK_NN(hv)) : 0)
786 #define HvENAME_HEK_NN(hv) \
788 HvAUX(hv)->xhv_name_count > 0 ? HvAUX(hv)->xhv_name_u.xhvnameu_names[0] : \
789 HvAUX(hv)->xhv_name_count < -1 ? HvAUX(hv)->xhv_name_u.xhvnameu_names[1] : \
790 HvAUX(hv)->xhv_name_count == -1 ? NULL : \
791 HvAUX(hv)->xhv_name_u.xhvnameu_name \
793 #define HvENAME_HEK(hv) \
794 (SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name ? HvENAME_HEK_NN(hv) : NULL)
795 #define HvENAME_get(hv) \
796 ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvAUX(hv)->xhv_name_count != -1) \
797 ? HEK_KEY(HvENAME_HEK_NN(hv)) : NULL)
798 #define HvENAMELEN_get(hv) \
799 ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvAUX(hv)->xhv_name_count != -1) \
800 ? HEK_LEN(HvENAME_HEK_NN(hv)) : 0)
801 #define HvENAMEUTF8(hv) \
802 ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvAUX(hv)->xhv_name_count != -1) \
803 ? HEK_UTF8(HvENAME_HEK_NN(hv)) : 0)
805 /* the number of keys (including any placeholders) */
806 #define XHvTOTALKEYS(xhv) ((xhv)->xhv_keys)
809 * HvKEYS gets the number of keys that actually exist(), and is provided
810 * for backwards compatibility with old XS code. The core uses HvUSEDKEYS
811 * (keys, excluding placeholders) and HvTOTALKEYS (including placeholders)
813 #define HvKEYS(hv) HvUSEDKEYS(hv)
814 #define HvUSEDKEYS(hv) (HvTOTALKEYS(hv) - HvPLACEHOLDERS_get(hv))
815 #define HvTOTALKEYS(hv) XHvTOTALKEYS((XPVHV*) SvANY(hv))
816 #define HvPLACEHOLDERS(hv) (*Perl_hv_placeholders_p(aTHX_ MUTABLE_HV(hv)))
817 #define HvPLACEHOLDERS_get(hv) (SvMAGIC(hv) ? Perl_hv_placeholders_get(aTHX_ (const HV *)hv) : 0)
818 #define HvPLACEHOLDERS_set(hv,p) Perl_hv_placeholders_set(aTHX_ MUTABLE_HV(hv), p)
820 #define HvSHAREKEYS(hv) (SvFLAGS(hv) & SVphv_SHAREKEYS)
821 #define HvSHAREKEYS_on(hv) (SvFLAGS(hv) |= SVphv_SHAREKEYS)
822 #define HvSHAREKEYS_off(hv) (SvFLAGS(hv) &= ~SVphv_SHAREKEYS)
824 /* This is an optimisation flag. It won't be set if all hash keys have a 0
825 * flag. Currently the only flags relate to utf8.
826 * Hence it won't be set if all keys are 8 bit only. It will be set if any key
827 * is utf8 (including 8 bit keys that were entered as utf8, and need upgrading
828 * when retrieved during iteration. It may still be set when there are no longer
830 * See HVhek_ENABLEHVKFLAGS for the trigger.
832 #define HvHASKFLAGS(hv) (SvFLAGS(hv) & SVphv_HASKFLAGS)
833 #define HvHASKFLAGS_on(hv) (SvFLAGS(hv) |= SVphv_HASKFLAGS)
834 #define HvHASKFLAGS_off(hv) (SvFLAGS(hv) &= ~SVphv_HASKFLAGS)
836 #define HvLAZYDEL(hv) (SvFLAGS(hv) & SVphv_LAZYDEL)
837 #define HvLAZYDEL_on(hv) (SvFLAGS(hv) |= SVphv_LAZYDEL)
838 #define HvLAZYDEL_off(hv) (SvFLAGS(hv) &= ~SVphv_LAZYDEL)
841 # define Nullhe Null(HE*)
843 #define HeNEXT(he) (he)->hent_next
844 #define HeKEY_hek(he) (he)->hent_hek
845 #define HeKEY(he) HEK_KEY(HeKEY_hek(he))
846 #define HeKEY_sv(he) (*(SV**)HeKEY(he))
847 #define HeKLEN(he) HEK_LEN(HeKEY_hek(he))
848 #define HeKUTF8(he) HEK_UTF8(HeKEY_hek(he))
849 #define HeKWASUTF8(he) HEK_WASUTF8(HeKEY_hek(he))
850 #define HeKLEN_UTF8(he) (HeKUTF8(he) ? -HeKLEN(he) : HeKLEN(he))
851 #define HeKFLAGS(he) HEK_FLAGS(HeKEY_hek(he))
852 #define HeVAL(he) (he)->he_valu.hent_val
853 #define HeHASH(he) HEK_HASH(HeKEY_hek(he))
854 #define HePV(he,lp) ((HeKLEN(he) == HEf_SVKEY) ? \
855 SvPV(HeKEY_sv(he),lp) : \
856 ((lp = HeKLEN(he)), HeKEY(he)))
857 #define HeUTF8(he) ((HeKLEN(he) == HEf_SVKEY) ? \
858 SvUTF8(HeKEY_sv(he)) : \
861 #define HeSVKEY(he) ((HeKEY(he) && \
862 HeKLEN(he) == HEf_SVKEY) ? \
865 #define HeSVKEY_force(he) (HeKEY(he) ? \
866 ((HeKLEN(he) == HEf_SVKEY) ? \
868 newSVpvn_flags(HeKEY(he), \
869 HeKLEN(he), SVs_TEMP)) : \
871 #define HeSVKEY_set(he,sv) ((HeKLEN(he) = HEf_SVKEY), (HeKEY_sv(he) = sv))
874 # define Nullhek Null(HEK*)
876 #define HEK_BASESIZE STRUCT_OFFSET(HEK, hek_key[0])
877 #define HEK_HASH(hek) (hek)->hek_hash
878 #define HEK_LEN(hek) (hek)->hek_len
879 #define HEK_KEY(hek) (hek)->hek_key
880 #define HEK_FLAGS(hek) (*((unsigned char *)(HEK_KEY(hek))+HEK_LEN(hek)+1))
882 #define HVhek_UTF8 0x01 /* Key is utf8 encoded. */
883 #define HVhek_WASUTF8 0x02 /* Key is bytes here, but was supplied as utf8. */
884 #define HVhek_UNSHARED 0x08 /* This key isn't a shared hash key. */
885 #define HVhek_FREEKEY 0x100 /* Internal flag to say key is malloc()ed. */
886 #define HVhek_PLACEHOLD 0x200 /* Internal flag to create placeholder.
887 * (may change, but Storable is a core module) */
888 #define HVhek_KEYCANONICAL 0x400 /* Internal flag - key is in canonical form.
889 If the string is UTF-8, it cannot be
890 converted to bytes. */
891 #define HVhek_MASK 0xFF
893 #define HVhek_ENABLEHVKFLAGS (HVhek_MASK & ~(HVhek_UNSHARED))
895 #define HEK_UTF8(hek) (HEK_FLAGS(hek) & HVhek_UTF8)
896 #define HEK_UTF8_on(hek) (HEK_FLAGS(hek) |= HVhek_UTF8)
897 #define HEK_UTF8_off(hek) (HEK_FLAGS(hek) &= ~HVhek_UTF8)
898 #define HEK_WASUTF8(hek) (HEK_FLAGS(hek) & HVhek_WASUTF8)
899 #define HEK_WASUTF8_on(hek) (HEK_FLAGS(hek) |= HVhek_WASUTF8)
900 #define HEK_WASUTF8_off(hek) (HEK_FLAGS(hek) &= ~HVhek_WASUTF8)
902 /* calculate HV array allocation */
903 #ifndef PERL_USE_LARGE_HV_ALLOC
904 /* Default to allocating the correct size - default to assuming that malloc()
905 is not broken and is efficient at allocating blocks sized at powers-of-two.
907 # define PERL_HV_ARRAY_ALLOC_BYTES(size) ((size) * sizeof(HE*))
909 # define MALLOC_OVERHEAD 16
910 # define PERL_HV_ARRAY_ALLOC_BYTES(size) \
912 ? (size) * sizeof(HE*) \
913 : (size) * sizeof(HE*) * 2 - MALLOC_OVERHEAD)
916 /* Flags for hv_iternext_flags. */
917 #define HV_ITERNEXT_WANTPLACEHOLDERS 0x01 /* Don't skip placeholders. */
919 #define hv_iternext(hv) hv_iternext_flags(hv, 0)
920 #define hv_magic(hv, gv, how) sv_magic(MUTABLE_SV(hv), MUTABLE_SV(gv), how, NULL, 0)
921 #define hv_undef(hv) Perl_hv_undef_flags(aTHX_ hv, 0)
923 #define Perl_sharepvn(pv, len, hash) HEK_KEY(share_hek(pv, len, hash))
924 #define sharepvn(pv, len, hash) Perl_sharepvn(pv, len, hash)
926 #define share_hek_hek(hek) \
927 (++(((struct shared_he *)(((char *)hek) \
928 - STRUCT_OFFSET(struct shared_he, \
930 ->shared_he_he.he_valu.hent_refcount), \
933 #define hv_store_ent(hv, keysv, val, hash) \
934 ((HE *) hv_common((hv), (keysv), NULL, 0, 0, HV_FETCH_ISSTORE, \
937 #define hv_exists_ent(hv, keysv, hash) \
938 (hv_common((hv), (keysv), NULL, 0, 0, HV_FETCH_ISEXISTS, 0, (hash)) \
940 #define hv_fetch_ent(hv, keysv, lval, hash) \
941 ((HE *) hv_common((hv), (keysv), NULL, 0, 0, \
942 ((lval) ? HV_FETCH_LVALUE : 0), NULL, (hash)))
943 #define hv_delete_ent(hv, key, flags, hash) \
944 (MUTABLE_SV(hv_common((hv), (key), NULL, 0, 0, (flags) | HV_DELETE, \
947 #define hv_store_flags(hv, key, klen, val, hash, flags) \
948 ((SV**) hv_common((hv), NULL, (key), (klen), (flags), \
949 (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), (val), \
952 #define hv_store(hv, key, klen, val, hash) \
953 ((SV**) hv_common_key_len((hv), (key), (klen), \
954 (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), \
957 #define hv_exists(hv, key, klen) \
958 (hv_common_key_len((hv), (key), (klen), HV_FETCH_ISEXISTS, NULL, 0) \
961 #define hv_fetch(hv, key, klen, lval) \
962 ((SV**) hv_common_key_len((hv), (key), (klen), (lval) \
963 ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) \
964 : HV_FETCH_JUST_SV, NULL, 0))
966 #define hv_delete(hv, key, klen, flags) \
967 (MUTABLE_SV(hv_common_key_len((hv), (key), (klen), \
968 (flags) | HV_DELETE, NULL, 0)))
970 /* This refcounted he structure is used for storing the hints used for lexical
971 pragmas. Without threads, it's basically struct he + refcount.
972 With threads, life gets more complex as the structure needs to be shared
973 between threads (because it hangs from OPs, which are shared), hence the
974 alternate definition and mutex. */
976 struct refcounted_he;
978 /* flags for the refcounted_he API */
979 #define REFCOUNTED_HE_KEY_UTF8 0x00000001
981 # define REFCOUNTED_HE_EXISTS 0x00000002
986 /* Gosh. This really isn't a good name any longer. */
987 struct refcounted_he {
988 struct refcounted_he *refcounted_he_next; /* next entry in chain */
990 U32 refcounted_he_hash;
991 U32 refcounted_he_keylen;
993 HEK *refcounted_he_hek; /* hint key */
996 IV refcounted_he_u_iv;
997 UV refcounted_he_u_uv;
998 STRLEN refcounted_he_u_len;
999 void *refcounted_he_u_ptr; /* Might be useful in future */
1000 } refcounted_he_val;
1001 U32 refcounted_he_refcnt; /* reference count */
1002 /* First byte is flags. Then NUL-terminated value. Then for ithreads,
1003 non-NUL terminated key. */
1004 char refcounted_he_data[1];
1008 =for apidoc m|SV *|refcounted_he_fetch_pvs|const struct refcounted_he *chain|const char *key|U32 flags
1010 Like L</refcounted_he_fetch_pvn>, but takes a literal string instead of
1011 a string/length pair, and no precomputed hash.
1016 #define refcounted_he_fetch_pvs(chain, key, flags) \
1017 Perl_refcounted_he_fetch_pvn(aTHX_ chain, STR_WITH_LEN(key), 0, flags)
1020 =for apidoc m|struct refcounted_he *|refcounted_he_new_pvs|struct refcounted_he *parent|const char *key|SV *value|U32 flags
1022 Like L</refcounted_he_new_pvn>, but takes a literal string instead of
1023 a string/length pair, and no precomputed hash.
1028 #define refcounted_he_new_pvs(parent, key, value, flags) \
1029 Perl_refcounted_he_new_pvn(aTHX_ parent, STR_WITH_LEN(key), 0, value, flags)
1031 /* Flag bits are HVhek_UTF8, HVhek_WASUTF8, then */
1032 #define HVrhek_undef 0x00 /* Value is undef. */
1033 #define HVrhek_delete 0x10 /* Value is placeholder - signifies delete. */
1034 #define HVrhek_IV 0x20 /* Value is IV. */
1035 #define HVrhek_UV 0x30 /* Value is UV. */
1036 #define HVrhek_PV 0x40 /* Value is a (byte) string. */
1037 #define HVrhek_PV_UTF8 0x50 /* Value is a (utf8) string. */
1038 /* Two spare. As these have to live in the optree, you can't store anything
1039 interpreter specific, such as SVs. :-( */
1040 #define HVrhek_typemask 0x70
1043 /* A big expression to find the key offset */
1044 #define REF_HE_KEY(chain) \
1045 ((((chain->refcounted_he_data[0] & 0x60) == 0x40) \
1046 ? chain->refcounted_he_val.refcounted_he_u_len + 1 : 0) \
1047 + 1 + chain->refcounted_he_data)
1050 # ifdef USE_ITHREADS
1051 # define HINTS_REFCNT_LOCK MUTEX_LOCK(&PL_hints_mutex)
1052 # define HINTS_REFCNT_UNLOCK MUTEX_UNLOCK(&PL_hints_mutex)
1054 # define HINTS_REFCNT_LOCK NOOP
1055 # define HINTS_REFCNT_UNLOCK NOOP
1060 # define HINTS_REFCNT_INIT MUTEX_INIT(&PL_hints_mutex)
1061 # define HINTS_REFCNT_TERM MUTEX_DESTROY(&PL_hints_mutex)
1063 # define HINTS_REFCNT_INIT NOOP
1064 # define HINTS_REFCNT_TERM NOOP
1068 * Passed in PERL_MAGIC_uvar calls
1070 #define HV_DISABLE_UVAR_XKEY 0x01
1071 /* We need to ensure that these don't clash with G_DISCARD, which is 2, as it
1072 is documented as being passed to hv_delete(). */
1073 #define HV_FETCH_ISSTORE 0x04
1074 #define HV_FETCH_ISEXISTS 0x08
1075 #define HV_FETCH_LVALUE 0x10
1076 #define HV_FETCH_JUST_SV 0x20
1077 #define HV_DELETE 0x40
1078 #define HV_FETCH_EMPTY_HE 0x80 /* Leave HeVAL null. */
1080 /* Must not conflict with HVhek_UTF8 */
1081 #define HV_NAME_SETALL 0x02
1086 Creates a new HV. The reference count is set to 1.
1091 #define newHV() MUTABLE_HV(newSV_type(SVt_PVHV))
1095 * c-indentation-style: bsd
1097 * indent-tabs-mode: nil
1100 * ex: set ts=8 sts=4 sw=4 et: