This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
The MurmurHash3 code can use the existing perl.h #defines for endianness.
[perl5.git] / hv.h
CommitLineData
a0d0e21e 1/* hv.h
79072805 2 *
4bb101f2 3 * Copyright (C) 1991, 1992, 1993, 1996, 1997, 1998, 1999,
62a1a1ef 4 * 2000, 2001, 2002, 2003, 2005, 2006, 2007, 2008, by Larry Wall and others
79072805
LW
5 *
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.
8 *
79072805
LW
9 */
10
5cbe4eec 11/* entry in hash value chain */
79072805 12struct he {
6f51351d
NC
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
15 body arenas */
5cbe4eec
MLF
16 HE *hent_next; /* next entry in chain */
17 HEK *hent_hek; /* hash key */
de616631
NC
18 union {
19 SV *hent_val; /* scalar value that was hashed */
20 Size_t hent_refcount; /* references for this shared hash key */
21 } he_valu;
bbce6d69 22};
23
5cbe4eec 24/* hash key -- defined separately for use as shared pointer */
ff68c719 25struct hek {
5cbe4eec
MLF
26 U32 hek_hash; /* hash of key */
27 I32 hek_len; /* length of hash key */
28 char hek_key[1]; /* variable-length hash key */
e05949c7 29 /* the hash-key is \0-terminated */
1e54db1a
JH
30 /* after the \0 there is a byte for flags, such as whether the key
31 is UTF-8 */
79072805
LW
32};
33
cbae3960
NC
34struct shared_he {
35 struct he shared_he_he;
36 struct hek shared_he_hek;
37};
bfcb3514
NC
38
39/* Subject to change.
40 Don't access this directly.
e1a479c5 41 Use the funcs in mro.c
bfcb3514 42*/
e1a479c5 43
b2685f0c
NC
44struct mro_alg {
45 AV *(*resolve)(pTHX_ HV* stash, U32 level);
46 const char *name;
47 U16 length;
48 U16 kflags; /* For the hash API - set HVhek_UTF8 if name is UTF-8 */
49 U32 hash; /* or 0 */
50};
e1a479c5
BB
51
52struct mro_meta {
9953ff72
NC
53 /* a hash holding the different MROs private data. */
54 HV *mro_linear_all;
3a6fa573
NC
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;
dd69841b
BB
59 HV *mro_nextmethod; /* next::method caching */
60 U32 cache_gen; /* Bumping this invalidates our method cache */
70cd14a1 61 U32 pkg_gen; /* Bumps when local methods/@ISA change */
3d76853f 62 const struct mro_alg *mro_which; /* which mro alg is in use? */
a49ba3fc 63 HV *isa; /* Everything this class @ISA */
e1a479c5
BB
64};
65
123892d9
NC
66#define MRO_GET_PRIVATE_DATA(smeta, which) \
67 (((smeta)->mro_which && (which) == (smeta)->mro_which) \
3a6fa573 68 ? (smeta)->mro_linear_current \
123892d9
NC
69 : Perl_mro_get_private_data(aTHX_ (smeta), (which)))
70
e1a479c5
BB
71/* Subject to change.
72 Don't access this directly.
73*/
74
15d9236d
NC
75union _xhvnameu {
76 HEK *xhvnameu_name; /* When xhv_name_count is 0 */
77 HEK **xhvnameu_names; /* When xhv_name_count is non-0 */
78};
79
bfcb3514 80struct xpvhv_aux {
15d9236d 81 union _xhvnameu xhv_name_u; /* name, if a symbol table */
86f55936 82 AV *xhv_backreferences; /* back references for weak references */
bfcb3514
NC
83 HE *xhv_eiter; /* current entry of iterator */
84 I32 xhv_riter; /* current root of iterator */
7dc86639 85
15d9236d 86/* Concerning xhv_name_count: When non-zero, xhv_name_u contains a pointer
78b79c77
FC
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-
15d9236d 90 * tive, then xhv_name_u.xhvnameu_names[1] is the first effective name.
78b79c77
FC
91 */
92 I32 xhv_name_count;
bc85b3a1 93 struct mro_meta *xhv_mro_meta;
aae43805 94 HV * xhv_super; /* SUPER method cache */
78b79c77 95};
bfcb3514 96
5cbe4eec 97/* hash structure: */
6ee623d5 98/* This structure must match the beginning of struct xpvmg in sv.h. */
79072805 99struct xpvhv {
6e128786
NC
100 HV* xmg_stash; /* class package */
101 union _xmgu xmg_u;
359164a0 102 STRLEN xhv_keys; /* total keys, including placeholders */
c8e503bf 103 STRLEN xhv_max; /* subscript of last element of xhv_array */
79072805
LW
104};
105
5cbe4eec 106/* hash a key */
5afd6d42
JH
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,
df805c3e 110 * a "char" can be either signed or unsigned, depending on the compiler)
5afd6d42 111 * (b) catering for old code that uses a "char"
830b38bd 112 *
504f80c1
JH
113 * The "hash seed" feature was added in Perl 5.8.1 to perturb the results
114 * to avoid "algorithmic complexity attacks".
830b38bd
JH
115 *
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.
7dc86639 119 * (see also perl.c:perl_parse() and S_init_tls_and_interp() and util.c:get_hash_seed())
5afd6d42 120 */
830b38bd
JH
121#ifndef PERL_HASH_SEED
122# if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT)
7dc86639 123# define PERL_HASH_SEED PL_hash_seed
830b38bd 124# else
7dc86639 125# define PERL_HASH_SEED "PeRlHaShhAcKpErl"
830b38bd 126# endif
504f80c1 127#endif
f8d50d94 128
7dc86639
YO
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])
bf6bd887 132
7dc86639 133/* legacy - only mod_perl should be doing this. */
3d78eb94 134#ifdef PERL_HASH_INTERNAL_ACCESS
7dc86639
YO
135#define PERL_HASH_INTERNAL(hash,str,len) PERL_HASH(hash,str,len)
136#endif
137
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
145*/
146
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
149#endif
150
151#if defined(PERL_HASH_FUNC_SIPHASH)
152#define PERL_HASH_FUNC "SIPHASH"
153#define PERL_HASH_SEED_BYTES 16
154
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.
158 * See:
159 *
160 * https://www.131002.net/siphash/
161 *
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.
165 *
166 * It is 64 bit only.
167 */
168
169#define PERL_HASH_NEEDS_TWO_SEEDS
170
171#ifndef U64
172#define U64 uint64_t
173#endif
174
175#define ROTL(x,b) (U64)( ((x) << (b)) | ( (x) >> (64 - (b))) )
176
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);
180
181#define U64TO8_LE(p, v) \
182 U32TO8_LE((p), (U32)((v) )); \
183 U32TO8_LE((p) + 4, (U32)((v) >> 32));
184
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))
194
195#define SIPROUND \
196 do { \
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); \
201 } while(0)
202
203/* SipHash-2-4 */
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; \
213\
214 U64 b_PeRlHaSh; \
215 U64 k0_PeRlHaSh = PERL_HASH_SEED_U64_1; \
216 U64 k1_PeRlHaSh = PERL_HASH_SEED_U64_2; \
217 U64 m_PeRlHaSh; \
218 const int left_PeRlHaSh = inlen_PeRlHaSh & 7; \
219 const U8 *end_PeRlHaSh = in_PeRlHaSh + inlen_PeRlHaSh - left_PeRlHaSh; \
220\
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; \
226\
227 for ( ; in_PeRlHaSh != end_PeRlHaSh; in_PeRlHaSh += 8 ) \
228 { \
229 m_PeRlHaSh = U8TO64_LE( in_PeRlHaSh ); \
230 v3_PeRlHaSh ^= m_PeRlHaSh; \
231 SIPROUND; \
232 SIPROUND; \
233 v0_PeRlHaSh ^= m_PeRlHaSh; \
234 } \
235\
236 switch( left_PeRlHaSh ) \
237 { \
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; \
245 case 0: break; \
246 } \
247\
248 v3_PeRlHaSh ^= b_PeRlHaSh; \
249 SIPROUND; \
250 SIPROUND; \
251 v0_PeRlHaSh ^= b_PeRlHaSh; \
252\
253 v2_PeRlHaSh ^= 0xff; \
254 SIPROUND; \
255 SIPROUND; \
256 SIPROUND; \
257 SIPROUND; \
258 b_PeRlHaSh = v0_PeRlHaSh ^ v1_PeRlHaSh ^ v2_PeRlHaSh ^ v3_PeRlHaSh; \
259 (hash)= (U32)(b_PeRlHaSh & U32_MAX); \
260} STMT_END
261
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
270 */
271#undef get16bits
272#if (defined(__GNUC__) && defined(__i386__)) || defined(__WATCOMC__) \
273 || defined(_MSC_VER) || defined (__BORLANDC__) || defined (__TURBOC__)
274#define get16bits(d) (*((const U16 *) (d)))
f8d50d94
DM
275#endif
276
7dc86639
YO
277#if !defined (get16bits)
278#define get16bits(d) ((((const U8 *)(d))[1] << UINT32_C(8))\
279 +((const U8 *)(d))[0])
280#endif
281#define PERL_HASH(hash,str,len) \
282 STMT_START { \
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; \
290 \
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; \
297 } \
298 \
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; \
305 break; \
306 case 2: hash_PeRlHaSh += get16bits (str_PeRlHaSh); \
307 hash_PeRlHaSh ^= hash_PeRlHaSh << 11; \
308 hash_PeRlHaSh += hash_PeRlHaSh >> 17; \
309 break; \
310 case 1: hash_PeRlHaSh += *str_PeRlHaSh; \
311 hash_PeRlHaSh ^= hash_PeRlHaSh << 10; \
312 hash_PeRlHaSh += hash_PeRlHaSh >> 1; \
313 } \
314 \
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)); \
322 } STMT_END
323
324#elif defined(PERL_HASH_FUNC_MURMUR3)
325#define PERL_HASH_FUNC "MURMUR3"
326#define PERL_HASH_SEED_BYTES 4
327
328/*-----------------------------------------------------------------------------
329 * MurmurHash3 was written by Austin Appleby, and is placed in the public
330 * domain.
331 *
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
334 * Yves Orton.
335 *
336 * This is a portable ANSI C implementation of MurmurHash3_x86_32 (Murmur3A)
337 * with support for progressive processing.
338 *
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
342 *
343 * How does it work?
344 *
345 * We can only process entire 32 bit chunks of input, except for the very end
346 * that may be shorter.
347 *
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.
351 */
352
353
354/*-----------------------------------------------------------------------------
355 * Endianess, misalignment capabilities and util macros
356 *
357 * The following 3 macros are defined in this section. The other macros defined
358 * are only needed to help derive these 3.
359 *
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
363 */
f8d50d94 364
7dc86639 365/* Now find best way we can to READ_UINT32 */
b5a2311a 366#if (BYTEORDER == 0x1234 || BYTEORDER == 0x12345678) && U32SIZE == 4
7dc86639
YO
367 /* CPU endian matches murmurhash algorithm, so read 32-bit word directly */
368 #define MURMUR_READ_UINT32(ptr) (*((U32*)(ptr)))
b5a2311a 369#elif BYTEORDER == 0x4321 || BYTEORDER == 0x87654321
7dc86639
YO
370 /* TODO: Add additional cases below where a compiler provided bswap32 is available */
371 #if defined(__GNUC__) && (__GNUC__>4 || (__GNUC__==4 && __GNUC_MINOR__>=3))
372 #define MURMUR_READ_UINT32(ptr) (__builtin_bswap32(*((U32*)(ptr))))
373 #else
374 /* Without a known fast bswap32 we're just as well off doing this */
375 #define MURMUR_READ_UINT32(ptr) (ptr[0]|ptr[1]<<8|ptr[2]<<16|ptr[3]<<24)
376 #define MURMUR_UNALIGNED_SAFE
377 #endif
378#else
379 /* Unknown endianess so last resort is to read individual bytes */
380 #define MURMUR_READ_UINT32(ptr) (ptr[0]|ptr[1]<<8|ptr[2]<<16|ptr[3]<<24)
381
382 /* Since we're not doing word-reads we can skip the messing about with realignment */
383 #define MURMUR_UNALIGNED_SAFE
384#endif
385
386/* Find best way to ROTL32 */
387#if defined(_MSC_VER)
388 #include <stdlib.h> /* Microsoft put _rotl declaration in here */
389 #define MURMUR_ROTL32(x,r) _rotl(x,r)
390#else
391 /* gcc recognises this code and generates a rotate instruction for CPUs with one */
392 #define MURMUR_ROTL32(x,r) (((U32)x << r) | ((U32)x >> (32 - r)))
393#endif
394
395
396/*-----------------------------------------------------------------------------
397 * Core murmurhash algorithm macros */
398
399#define MURMUR_C1 (0xcc9e2d51)
400#define MURMUR_C2 (0x1b873593)
401#define MURMUR_C3 (0xe6546b64)
402#define MURMUR_C4 (0x85ebca6b)
403#define MURMUR_C5 (0xc2b2ae35)
404
405/* This is the main processing body of the algorithm. It operates
406 * on each full 32-bits of input. */
407#define MURMUR_DOBLOCK(h1, k1) STMT_START { \
408 k1 *= MURMUR_C1; \
409 k1 = MURMUR_ROTL32(k1,15); \
410 k1 *= MURMUR_C2; \
411 \
412 h1 ^= k1; \
413 h1 = MURMUR_ROTL32(h1,13); \
414 h1 = h1 * 5 + MURMUR_C3; \
415} STMT_END
416
417
418/* Append unaligned bytes to carry, forcing hash churn if we have 4 bytes */
419/* cnt=bytes to process, h1=name of h1 var, c=carry, n=bytes in c, ptr/len=payload */
420#define MURMUR_DOBYTES(cnt, h1, c, n, ptr, len) STMT_START { \
421 int MURMUR_DOBYTES_i = cnt; \
422 while(MURMUR_DOBYTES_i--) { \
423 c = c>>8 | *ptr++<<24; \
424 n++; len--; \
425 if(n==4) { \
426 MURMUR_DOBLOCK(h1, c); \
427 n = 0; \
428 } \
429 } \
430} STMT_END
431
432/* process the last 1..3 bytes and finalize */
433#define MURMUR_FINALIZE(hash, PeRlHaSh_len, PeRlHaSh_k1, PeRlHaSh_h1, PeRlHaSh_carry, PeRlHaSh_bytes_in_carry, PeRlHaSh_ptr, PeRlHaSh_total_length) STMT_START { \
434 /* Advance over whole 32-bit chunks, possibly leaving 1..3 bytes */\
435 PeRlHaSh_len -= PeRlHaSh_len/4*4; \
436 \
437 /* Append any remaining bytes into carry */ \
438 MURMUR_DOBYTES(PeRlHaSh_len, PeRlHaSh_h1, PeRlHaSh_carry, PeRlHaSh_bytes_in_carry, PeRlHaSh_ptr, PeRlHaSh_len); \
439 \
440 if (PeRlHaSh_bytes_in_carry) { \
441 PeRlHaSh_k1 = PeRlHaSh_carry >> ( 4 - PeRlHaSh_bytes_in_carry ) * 8; \
442 PeRlHaSh_k1 *= MURMUR_C1; \
443 PeRlHaSh_k1 = MURMUR_ROTL32(PeRlHaSh_k1,15); \
444 PeRlHaSh_k1 *= MURMUR_C2; \
445 PeRlHaSh_h1 ^= PeRlHaSh_k1; \
446 } \
447 PeRlHaSh_h1 ^= PeRlHaSh_total_length; \
448 \
449 /* fmix */ \
450 PeRlHaSh_h1 ^= PeRlHaSh_h1 >> 16; \
451 PeRlHaSh_h1 *= MURMUR_C4; \
452 PeRlHaSh_h1 ^= PeRlHaSh_h1 >> 13; \
453 PeRlHaSh_h1 *= MURMUR_C5; \
454 PeRlHaSh_h1 ^= PeRlHaSh_h1 >> 16; \
455 (hash)= PeRlHaSh_h1; \
456} STMT_END
457
458/* now we create the hash function */
459
460#if defined(UNALIGNED_SAFE)
461#define PERL_HASH(hash,str,len) STMT_START { \
462 register const char * const s_PeRlHaSh_tmp = (str); \
463 register const unsigned char *PeRlHaSh_ptr = (const unsigned char *)s_PeRlHaSh_tmp; \
464 register I32 PeRlHaSh_len = len; \
465 \
466 U32 PeRlHaSh_h1 = PERL_HASH_SEED_U32; \
467 U32 PeRlHaSh_k1; \
468 U32 PeRlHaSh_carry = 0; \
469 \
470 const unsigned char *PeRlHaSh_end; \
471 \
472 int PeRlHaSh_bytes_in_carry = 0; /* bytes in carry */ \
473 I32 PeRlHaSh_total_length= PeRlHaSh_len; \
474 \
475 /* This CPU handles unaligned word access */ \
476 /* Process 32-bit chunks */ \
477 PeRlHaSh_end = PeRlHaSh_ptr + PeRlHaSh_len/4*4; \
478 for( ; PeRlHaSh_ptr < PeRlHaSh_end ; PeRlHaSh_ptr+=4) { \
479 PeRlHaSh_k1 = MURMUR_READ_UINT32(PeRlHaSh_ptr); \
480 MURMUR_DOBLOCK(PeRlHaSh_h1, PeRlHaSh_k1); \
481 } \
482 \
483 MURMUR_FINALIZE(hash, PeRlHaSh_len, PeRlHaSh_k1, PeRlHaSh_h1, PeRlHaSh_carry, PeRlHaSh_bytes_in_carry, PeRlHaSh_ptr, PeRlHaSh_total_length);\
484 } STMT_END
485#else
486#define PERL_HASH(hash,str,len) STMT_START { \
487 register const char * const s_PeRlHaSh_tmp = (str); \
488 register const unsigned char *PeRlHaSh_ptr = (const unsigned char *)s_PeRlHaSh_tmp; \
489 register I32 PeRlHaSh_len = len; \
490 \
491 U32 PeRlHaSh_h1 = PERL_HASH_SEED_U32; \
492 U32 PeRlHaSh_k1; \
493 U32 PeRlHaSh_carry = 0; \
494 \
495 const unsigned char *PeRlHaSh_end; \
496 \
497 int PeRlHaSh_bytes_in_carry = 0; /* bytes in carry */ \
498 I32 PeRlHaSh_total_length= PeRlHaSh_len; \
499 \
500 /* This CPU does not handle unaligned word access */ \
501 \
502 /* Consume enough so that the next data byte is word aligned */ \
503 int PeRlHaSh_i = -(long)PeRlHaSh_ptr & 3; \
504 if(PeRlHaSh_i && PeRlHaSh_i <= PeRlHaSh_len) { \
505 MURMUR_DOBYTES(PeRlHaSh_i, PeRlHaSh_h1, PeRlHaSh_carry, PeRlHaSh_bytes_in_carry, PeRlHaSh_ptr, PeRlHaSh_len);\
506 } \
507 \
508 /* We're now aligned. Process in aligned blocks. Specialise for each possible carry count */ \
509 PeRlHaSh_end = PeRlHaSh_ptr + PeRlHaSh_len/4*4; \
510 switch(PeRlHaSh_bytes_in_carry) { /* how many bytes in carry */ \
511 case 0: /* c=[----] w=[3210] b=[3210]=w c'=[----] */ \
512 for( ; PeRlHaSh_ptr < PeRlHaSh_end ; PeRlHaSh_ptr+=4) { \
513 PeRlHaSh_k1 = MURMUR_READ_UINT32(PeRlHaSh_ptr); \
514 MURMUR_DOBLOCK(PeRlHaSh_h1, PeRlHaSh_k1); \
515 } \
516 break; \
517 case 1: /* c=[0---] w=[4321] b=[3210]=c>>24|w<<8 c'=[4---] */ \
518 for( ; PeRlHaSh_ptr < PeRlHaSh_end ; PeRlHaSh_ptr+=4) { \
519 PeRlHaSh_k1 = PeRlHaSh_carry>>24; \
520 PeRlHaSh_carry = MURMUR_READ_UINT32(PeRlHaSh_ptr); \
521 PeRlHaSh_k1 |= PeRlHaSh_carry<<8; \
522 MURMUR_DOBLOCK(PeRlHaSh_h1, PeRlHaSh_k1); \
523 } \
524 break; \
525 case 2: /* c=[10--] w=[5432] b=[3210]=c>>16|w<<16 c'=[54--] */ \
526 for( ; PeRlHaSh_ptr < PeRlHaSh_end ; PeRlHaSh_ptr+=4) { \
527 PeRlHaSh_k1 = PeRlHaSh_carry>>16; \
528 PeRlHaSh_carry = MURMUR_READ_UINT32(PeRlHaSh_ptr); \
529 PeRlHaSh_k1 |= PeRlHaSh_carry<<16; \
530 MURMUR_DOBLOCK(PeRlHaSh_h1, PeRlHaSh_k1); \
531 } \
532 break; \
533 case 3: /* c=[210-] w=[6543] b=[3210]=c>>8|w<<24 c'=[654-] */ \
534 for( ; PeRlHaSh_ptr < PeRlHaSh_end ; PeRlHaSh_ptr+=4) { \
535 PeRlHaSh_k1 = PeRlHaSh_carry>>8; \
536 PeRlHaSh_carry = MURMUR_READ_UINT32(PeRlHaSh_ptr); \
537 PeRlHaSh_k1 |= PeRlHaSh_carry<<24; \
538 MURMUR_DOBLOCK(PeRlHaSh_h1, PeRlHaSh_k1); \
539 } \
540 } \
541 \
542 MURMUR_FINALIZE(hash, PeRlHaSh_len, PeRlHaSh_k1, PeRlHaSh_h1, PeRlHaSh_carry, PeRlHaSh_bytes_in_carry, PeRlHaSh_ptr, PeRlHaSh_total_length);\
543 } STMT_END
544#endif
545
546#elif defined(PERL_HASH_FUNC_DJB2)
547#define PERL_HASH_FUNC "DJB2"
548#define PERL_HASH_SEED_BYTES 4
549#define PERL_HASH(hash,str,len) \
550 STMT_START { \
551 register const char * const s_PeRlHaSh_tmp = (str); \
552 register const unsigned char *s_PeRlHaSh = (const unsigned char *)s_PeRlHaSh_tmp; \
553 register I32 i_PeRlHaSh = len; \
554 register U32 hash_PeRlHaSh = PERL_HASH_SEED_U32 ^ len; \
555 while (i_PeRlHaSh--) { \
556 hash_PeRlHaSh = ((hash_PeRlHaSh << 5) + hash_PeRlHaSh) + *s_PeRlHaSh++; \
557 } \
558 (hash) = hash_PeRlHaSh;\
559 } STMT_END
560
561#elif defined(PERL_HASH_FUNC_SDBM)
562#define PERL_HASH_FUNC "SDBM"
563#define PERL_HASH_SEED_BYTES 4
564#define PERL_HASH(hash,str,len) \
565 STMT_START { \
566 register const char * const s_PeRlHaSh_tmp = (str); \
567 register const unsigned char *s_PeRlHaSh = (const unsigned char *)s_PeRlHaSh_tmp; \
568 register I32 i_PeRlHaSh = len; \
569 register U32 hash_PeRlHaSh = PERL_HASH_SEED_U32 ^ len; \
570 while (i_PeRlHaSh--) { \
571 hash_PeRlHaSh = (hash_PeRlHaSh << 6) + (hash_PeRlHaSh << 16) - hash_PeRlHaSh + *s_PeRlHaSh++; \
572 } \
573 (hash) = hash_PeRlHaSh;\
574 } STMT_END
575
576#elif defined(PERL_HASH_FUNC_ONE_AT_A_TIME)
577/* DEFAULT/HISTORIC HASH FUNCTION */
578#define PERL_HASH_FUNC "ONE_AT_A_TIME"
579#define PERL_HASH_SEED_BYTES 4
580
581/* FYI: This is the "One-at-a-Time" algorithm by Bob Jenkins
582 * from requirements by Colin Plumb.
583 * (http://burtleburtle.net/bob/hash/doobs.html) */
584#define PERL_HASH(hash,str,len) \
4b5190b5 585 STMT_START { \
7dc86639
YO
586 register const char * const s_PeRlHaSh_tmp = (str); \
587 register const unsigned char *s_PeRlHaSh = (const unsigned char *)s_PeRlHaSh_tmp; \
588 register I32 i_PeRlHaSh = len; \
589 register U32 hash_PeRlHaSh = PERL_HASH_SEED_U32 ^ len; \
4b5190b5 590 while (i_PeRlHaSh--) { \
7dc86639 591 hash_PeRlHaSh += (U8)*s_PeRlHaSh++; \
4b5190b5
NC
592 hash_PeRlHaSh += (hash_PeRlHaSh << 10); \
593 hash_PeRlHaSh ^= (hash_PeRlHaSh >> 6); \
594 } \
595 hash_PeRlHaSh += (hash_PeRlHaSh << 3); \
596 hash_PeRlHaSh ^= (hash_PeRlHaSh >> 11); \
597 (hash) = (hash_PeRlHaSh + (hash_PeRlHaSh << 15)); \
598 } STMT_END
7dc86639
YO
599#endif
600#ifndef PERL_HASH
601#error "No hash function defined!"
602#endif
954c1994 603/*
ccfc67b7
JH
604=head1 Hash Manipulation Functions
605
954c1994
GS
606=for apidoc AmU||HEf_SVKEY
607This flag, used in the length slot of hash entries and magic structures,
d1be9408 608specifies the structure contains an C<SV*> pointer where a C<char*> pointer
954c1994
GS
609is to be expected. (For information only--not to be used).
610
ccfc67b7
JH
611=head1 Handy Values
612
954c1994
GS
613=for apidoc AmU||Nullhv
614Null HV pointer.
615
3ae1b226
NC
616(deprecated - use C<(HV *)NULL> instead)
617
ccfc67b7
JH
618=head1 Hash Manipulation Functions
619
954c1994 620=for apidoc Am|char*|HvNAME|HV* stash
9282b5fd
SH
621Returns the package name of a stash, or NULL if C<stash> isn't a stash.
622See C<SvSTASH>, C<CvSTASH>.
954c1994 623
d9021235
FC
624=for apidoc Am|STRLEN|HvNAMELEN|HV *stash
625Returns the length of the stash's name.
626
627=for apidoc Am|unsigned char|HvNAMEUTF8|HV *stash
628Returns true if the name is in UTF8 encoding.
629
bc56db2a
FC
630=for apidoc Am|char*|HvENAME|HV* stash
631Returns the effective name of a stash, or NULL if there is none. The
632effective name represents a location in the symbol table where this stash
633resides. It is updated automatically when packages are aliased or deleted.
634A stash that is no longer in the symbol table has no effective name. This
635name is preferable to C<HvNAME> for use in MRO linearisations and isa
636caches.
637
d9021235
FC
638=for apidoc Am|STRLEN|HvENAMELEN|HV *stash
639Returns the length of the stash's effective name.
640
641=for apidoc Am|unsigned char|HvENAMEUTF8|HV *stash
642Returns true if the effective name is in UTF8 encoding.
643
954c1994
GS
644=for apidoc Am|void*|HeKEY|HE* he
645Returns the actual pointer stored in the key slot of the hash entry. The
646pointer may be either C<char*> or C<SV*>, depending on the value of
647C<HeKLEN()>. Can be assigned to. The C<HePV()> or C<HeSVKEY()> macros are
648usually preferable for finding the value of a key.
649
650=for apidoc Am|STRLEN|HeKLEN|HE* he
651If this is negative, and amounts to C<HEf_SVKEY>, it indicates the entry
652holds an C<SV*> key. Otherwise, holds the actual length of the key. Can
653be assigned to. The C<HePV()> macro is usually preferable for finding key
654lengths.
655
656=for apidoc Am|SV*|HeVAL|HE* he
566a4718
YO
657Returns the value slot (type C<SV*>) stored in the hash entry. Can be assigned
658to.
659
660 SV *foo= HeVAL(hv);
661 HeVAL(hv)= sv;
662
954c1994
GS
663
664=for apidoc Am|U32|HeHASH|HE* he
665Returns the computed hash stored in the hash entry.
666
667=for apidoc Am|char*|HePV|HE* he|STRLEN len
668Returns the key slot of the hash entry as a C<char*> value, doing any
669necessary dereferencing of possibly C<SV*> keys. The length of the string
670is placed in C<len> (this is a macro, so do I<not> use C<&len>). If you do
671not care about what the length of the key is, you may use the global
672variable C<PL_na>, though this is rather less efficient than using a local
673variable. Remember though, that hash keys in perl are free to contain
674embedded nulls, so using C<strlen()> or similar is not a good way to find
675the length of hash keys. This is very similar to the C<SvPV()> macro
289d3c6a
NC
676described elsewhere in this document. See also C<HeUTF8>.
677
678If you are using C<HePV> to get values to pass to C<newSVpvn()> to create a
679new SV, you should consider using C<newSVhek(HeKEY_hek(he))> as it is more
680efficient.
681
cca4e9fa 682=for apidoc Am|char*|HeUTF8|HE* he
289d3c6a
NC
683Returns whether the C<char *> value returned by C<HePV> is encoded in UTF-8,
684doing any necessary dereferencing of possibly C<SV*> keys. The value returned
62a1a1ef 685will be 0 or non-0, not necessarily 1 (or even a value with any low bits set),
289d3c6a
NC
686so B<do not> blindly assign this to a C<bool> variable, as C<bool> may be a
687typedef for C<char>.
954c1994
GS
688
689=for apidoc Am|SV*|HeSVKEY|HE* he
a0714e2c 690Returns the key as an C<SV*>, or C<NULL> if the hash entry does not
954c1994
GS
691contain an C<SV*> key.
692
693=for apidoc Am|SV*|HeSVKEY_force|HE* he
694Returns the key as an C<SV*>. Will create and return a temporary mortal
695C<SV*> if the hash entry contains only a C<char*> key.
696
697=for apidoc Am|SV*|HeSVKEY_set|HE* he|SV* sv
698Sets the key to a given C<SV*>, taking care to set the appropriate flags to
699indicate the presence of an C<SV*> key, and returns the same
700C<SV*>.
701
702=cut
703*/
bf6bd887 704
bf5b86ae 705/* these hash entry flags ride on hent_klen (for use only in magic/tied HVs) */
d1be9408 706#define HEf_SVKEY -2 /* hent_key is an SV* */
bf6bd887 707
3ae1b226
NC
708#ifndef PERL_CORE
709# define Nullhv Null(HV*)
710#endif
43e6e717 711#define HvARRAY(hv) ((hv)->sv_u.svu_hash)
4d0fbddd 712#define HvFILL(hv) Perl_hv_fill(aTHX_ (const HV *)(hv))
463ee0b2 713#define HvMAX(hv) ((XPVHV*) SvANY(hv))->xhv_max
b79f7545
NC
714/* This quite intentionally does no flag checking first. That's your
715 responsibility. */
716#define HvAUX(hv) ((struct xpvhv_aux*)&(HvARRAY(hv)[HvMAX(hv)+1]))
dbebbdb4
NC
717#define HvRITER(hv) (*Perl_hv_riter_p(aTHX_ MUTABLE_HV(hv)))
718#define HvEITER(hv) (*Perl_hv_eiter_p(aTHX_ MUTABLE_HV(hv)))
719#define HvRITER_set(hv,r) Perl_hv_riter_set(aTHX_ MUTABLE_HV(hv), r)
720#define HvEITER_set(hv,e) Perl_hv_eiter_set(aTHX_ MUTABLE_HV(hv), e)
b79f7545 721#define HvRITER_get(hv) (SvOOK(hv) ? HvAUX(hv)->xhv_riter : -1)
cef6ea9d 722#define HvEITER_get(hv) (SvOOK(hv) ? HvAUX(hv)->xhv_eiter : NULL)
7423f6db 723#define HvNAME(hv) HvNAME_get(hv)
f2462604 724#define HvNAMELEN(hv) HvNAMELEN_get(hv)
bc56db2a 725#define HvENAME(hv) HvENAME_get(hv)
f2462604 726#define HvENAMELEN(hv) HvENAMELEN_get(hv)
2c7f4b87
BB
727
728/* Checking that hv is a valid package stash is the
729 caller's responsibility */
730#define HvMROMETA(hv) (HvAUX(hv)->xhv_mro_meta \
731 ? HvAUX(hv)->xhv_mro_meta \
c60bad7b 732 : Perl_mro_meta_init(aTHX_ hv))
2c7f4b87 733
15d9236d
NC
734#define HvNAME_HEK_NN(hv) \
735 ( \
736 HvAUX(hv)->xhv_name_count \
737 ? *HvAUX(hv)->xhv_name_u.xhvnameu_names \
738 : HvAUX(hv)->xhv_name_u.xhvnameu_name \
b7247a80 739 )
9b9d0b15 740/* This macro may go away without notice. */
b7247a80 741#define HvNAME_HEK(hv) \
15d9236d 742 (SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name ? HvNAME_HEK_NN(hv) : NULL)
78b79c77 743#define HvNAME_get(hv) \
15d9236d 744 ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvNAME_HEK_NN(hv)) \
b7247a80 745 ? HEK_KEY(HvNAME_HEK_NN(hv)) : NULL)
78b79c77 746#define HvNAMELEN_get(hv) \
15d9236d 747 ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvNAME_HEK_NN(hv)) \
b7247a80 748 ? HEK_LEN(HvNAME_HEK_NN(hv)) : 0)
b2c03ebd 749#define HvNAMEUTF8(hv) \
f2462604
BF
750 ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvNAME_HEK_NN(hv)) \
751 ? HEK_UTF8(HvNAME_HEK_NN(hv)) : 0)
c4842d1d 752#define HvENAME_HEK_NN(hv) \
78b79c77 753 ( \
15d9236d
NC
754 HvAUX(hv)->xhv_name_count > 0 ? HvAUX(hv)->xhv_name_u.xhvnameu_names[0] : \
755 HvAUX(hv)->xhv_name_count < -1 ? HvAUX(hv)->xhv_name_u.xhvnameu_names[1] : \
78b79c77 756 HvAUX(hv)->xhv_name_count == -1 ? NULL : \
15d9236d 757 HvAUX(hv)->xhv_name_u.xhvnameu_name \
78b79c77 758 )
c4842d1d 759#define HvENAME_HEK(hv) \
15d9236d 760 (SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name ? HvENAME_HEK_NN(hv) : NULL)
c4842d1d 761#define HvENAME_get(hv) \
c49a809b 762 ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvAUX(hv)->xhv_name_count != -1) \
78b79c77 763 ? HEK_KEY(HvENAME_HEK_NN(hv)) : NULL)
c4842d1d 764#define HvENAMELEN_get(hv) \
c49a809b 765 ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvAUX(hv)->xhv_name_count != -1) \
78b79c77 766 ? HEK_LEN(HvENAME_HEK_NN(hv)) : 0)
b2c03ebd 767#define HvENAMEUTF8(hv) \
c49a809b 768 ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvAUX(hv)->xhv_name_count != -1) \
f2462604 769 ? HEK_UTF8(HvENAME_HEK_NN(hv)) : 0)
a0d0e21e 770
486ec47a 771/* the number of keys (including any placeholders) */
8aacddc1
NIS
772#define XHvTOTALKEYS(xhv) ((xhv)->xhv_keys)
773
8aacddc1
NIS
774/*
775 * HvKEYS gets the number of keys that actually exist(), and is provided
776 * for backwards compatibility with old XS code. The core uses HvUSEDKEYS
486ec47a 777 * (keys, excluding placeholders) and HvTOTALKEYS (including placeholders)
8aacddc1 778 */
ca732855
NC
779#define HvKEYS(hv) HvUSEDKEYS(hv)
780#define HvUSEDKEYS(hv) (HvTOTALKEYS(hv) - HvPLACEHOLDERS_get(hv))
8aacddc1 781#define HvTOTALKEYS(hv) XHvTOTALKEYS((XPVHV*) SvANY(hv))
dbebbdb4
NC
782#define HvPLACEHOLDERS(hv) (*Perl_hv_placeholders_p(aTHX_ MUTABLE_HV(hv)))
783#define HvPLACEHOLDERS_get(hv) (SvMAGIC(hv) ? Perl_hv_placeholders_get(aTHX_ (const HV *)hv) : 0)
784#define HvPLACEHOLDERS_set(hv,p) Perl_hv_placeholders_set(aTHX_ MUTABLE_HV(hv), p)
8aacddc1 785
bf6bd887 786#define HvSHAREKEYS(hv) (SvFLAGS(hv) & SVphv_SHAREKEYS)
787#define HvSHAREKEYS_on(hv) (SvFLAGS(hv) |= SVphv_SHAREKEYS)
788#define HvSHAREKEYS_off(hv) (SvFLAGS(hv) &= ~SVphv_SHAREKEYS)
789
19692e8d
NC
790/* This is an optimisation flag. It won't be set if all hash keys have a 0
791 * flag. Currently the only flags relate to utf8.
792 * Hence it won't be set if all keys are 8 bit only. It will be set if any key
793 * is utf8 (including 8 bit keys that were entered as utf8, and need upgrading
794 * when retrieved during iteration. It may still be set when there are no longer
795 * any utf8 keys.
fdcd69b6 796 * See HVhek_ENABLEHVKFLAGS for the trigger.
19692e8d
NC
797 */
798#define HvHASKFLAGS(hv) (SvFLAGS(hv) & SVphv_HASKFLAGS)
799#define HvHASKFLAGS_on(hv) (SvFLAGS(hv) |= SVphv_HASKFLAGS)
800#define HvHASKFLAGS_off(hv) (SvFLAGS(hv) &= ~SVphv_HASKFLAGS)
574c8022 801
bf5b86ae
GS
802#define HvLAZYDEL(hv) (SvFLAGS(hv) & SVphv_LAZYDEL)
803#define HvLAZYDEL_on(hv) (SvFLAGS(hv) |= SVphv_LAZYDEL)
804#define HvLAZYDEL_off(hv) (SvFLAGS(hv) &= ~SVphv_LAZYDEL)
805
3ae1b226
NC
806#ifndef PERL_CORE
807# define Nullhe Null(HE*)
808#endif
bf6bd887 809#define HeNEXT(he) (he)->hent_next
ff68c719 810#define HeKEY_hek(he) (he)->hent_hek
811#define HeKEY(he) HEK_KEY(HeKEY_hek(he))
bbce6d69 812#define HeKEY_sv(he) (*(SV**)HeKEY(he))
ff68c719 813#define HeKLEN(he) HEK_LEN(HeKEY_hek(he))
da58a35d 814#define HeKUTF8(he) HEK_UTF8(HeKEY_hek(he))
19692e8d 815#define HeKWASUTF8(he) HEK_WASUTF8(HeKEY_hek(he))
da58a35d 816#define HeKLEN_UTF8(he) (HeKUTF8(he) ? -HeKLEN(he) : HeKLEN(he))
19692e8d 817#define HeKFLAGS(he) HEK_FLAGS(HeKEY_hek(he))
de616631 818#define HeVAL(he) (he)->he_valu.hent_val
ff68c719 819#define HeHASH(he) HEK_HASH(HeKEY_hek(he))
1e422769 820#define HePV(he,lp) ((HeKLEN(he) == HEf_SVKEY) ? \
821 SvPV(HeKEY_sv(he),lp) : \
402f0539 822 ((lp = HeKLEN(he)), HeKEY(he)))
289d3c6a
NC
823#define HeUTF8(he) ((HeKLEN(he) == HEf_SVKEY) ? \
824 SvUTF8(HeKEY_sv(he)) : \
825 (U32)HeKUTF8(he))
1e422769 826
bbce6d69 827#define HeSVKEY(he) ((HeKEY(he) && \
828 HeKLEN(he) == HEf_SVKEY) ? \
a0714e2c 829 HeKEY_sv(he) : NULL)
bbce6d69 830
831#define HeSVKEY_force(he) (HeKEY(he) ? \
832 ((HeKLEN(he) == HEf_SVKEY) ? \
833 HeKEY_sv(he) : \
ad25789c
NC
834 newSVpvn_flags(HeKEY(he), \
835 HeKLEN(he), SVs_TEMP)) : \
3280af22 836 &PL_sv_undef)
1e422769 837#define HeSVKEY_set(he,sv) ((HeKLEN(he) = HEf_SVKEY), (HeKEY_sv(he) = sv))
bbce6d69 838
3ae1b226
NC
839#ifndef PERL_CORE
840# define Nullhek Null(HEK*)
841#endif
71be2cbc 842#define HEK_BASESIZE STRUCT_OFFSET(HEK, hek_key[0])
ff68c719 843#define HEK_HASH(hek) (hek)->hek_hash
844#define HEK_LEN(hek) (hek)->hek_len
845#define HEK_KEY(hek) (hek)->hek_key
19692e8d
NC
846#define HEK_FLAGS(hek) (*((unsigned char *)(HEK_KEY(hek))+HEK_LEN(hek)+1))
847
848#define HVhek_UTF8 0x01 /* Key is utf8 encoded. */
849#define HVhek_WASUTF8 0x02 /* Key is bytes here, but was supplied as utf8. */
45e34800 850#define HVhek_UNSHARED 0x08 /* This key isn't a shared hash key. */
19692e8d 851#define HVhek_FREEKEY 0x100 /* Internal flag to say key is malloc()ed. */
e16e2ff8
NC
852#define HVhek_PLACEHOLD 0x200 /* Internal flag to create placeholder.
853 * (may change, but Storable is a core module) */
44b87b50
NC
854#define HVhek_KEYCANONICAL 0x400 /* Internal flag - key is in canonical form.
855 If the string is UTF-8, it cannot be
856 converted to bytes. */
19692e8d
NC
857#define HVhek_MASK 0xFF
858
7dc86639 859#define HVhek_ENABLEHVKFLAGS (HVhek_MASK & ~(HVhek_UNSHARED))
fdcd69b6 860
19692e8d
NC
861#define HEK_UTF8(hek) (HEK_FLAGS(hek) & HVhek_UTF8)
862#define HEK_UTF8_on(hek) (HEK_FLAGS(hek) |= HVhek_UTF8)
863#define HEK_UTF8_off(hek) (HEK_FLAGS(hek) &= ~HVhek_UTF8)
864#define HEK_WASUTF8(hek) (HEK_FLAGS(hek) & HVhek_WASUTF8)
865#define HEK_WASUTF8_on(hek) (HEK_FLAGS(hek) |= HVhek_WASUTF8)
866#define HEK_WASUTF8_off(hek) (HEK_FLAGS(hek) &= ~HVhek_WASUTF8)
d18c6117 867
5cbe4eec 868/* calculate HV array allocation */
36768cf4
NC
869#ifndef PERL_USE_LARGE_HV_ALLOC
870/* Default to allocating the correct size - default to assuming that malloc()
871 is not broken and is efficient at allocating blocks sized at powers-of-two.
872*/
d18c6117
GS
873# define PERL_HV_ARRAY_ALLOC_BYTES(size) ((size) * sizeof(HE*))
874#else
875# define MALLOC_OVERHEAD 16
876# define PERL_HV_ARRAY_ALLOC_BYTES(size) \
877 (((size) < 64) \
878 ? (size) * sizeof(HE*) \
879 : (size) * sizeof(HE*) * 2 - MALLOC_OVERHEAD)
880#endif
37d85e3a 881
e16e2ff8
NC
882/* Flags for hv_iternext_flags. */
883#define HV_ITERNEXT_WANTPLACEHOLDERS 0x01 /* Don't skip placeholders. */
884
7a7b9979 885#define hv_iternext(hv) hv_iternext_flags(hv, 0)
b1bc3f34 886#define hv_magic(hv, gv, how) sv_magic(MUTABLE_SV(hv), MUTABLE_SV(gv), how, NULL, 0)
8581adba 887#define hv_undef(hv) Perl_hv_undef_flags(aTHX_ hv, 0)
7a7b9979 888
bbd42945
FC
889#define Perl_sharepvn(pv, len, hash) HEK_KEY(share_hek(pv, len, hash))
890#define sharepvn(pv, len, hash) Perl_sharepvn(pv, len, hash)
bfcb3514 891
d1db91c6
NC
892#define share_hek_hek(hek) \
893 (++(((struct shared_he *)(((char *)hek) \
894 - STRUCT_OFFSET(struct shared_he, \
895 shared_he_hek))) \
de616631 896 ->shared_he_he.he_valu.hent_refcount), \
d1db91c6
NC
897 hek)
898
99978bb4
NC
899#define hv_store_ent(hv, keysv, val, hash) \
900 ((HE *) hv_common((hv), (keysv), NULL, 0, 0, HV_FETCH_ISSTORE, \
901 (val), (hash)))
4c2df08c 902
99978bb4
NC
903#define hv_exists_ent(hv, keysv, hash) \
904 (hv_common((hv), (keysv), NULL, 0, 0, HV_FETCH_ISEXISTS, 0, (hash)) \
4c2df08c 905 ? TRUE : FALSE)
99978bb4
NC
906#define hv_fetch_ent(hv, keysv, lval, hash) \
907 ((HE *) hv_common((hv), (keysv), NULL, 0, 0, \
908 ((lval) ? HV_FETCH_LVALUE : 0), NULL, (hash)))
909#define hv_delete_ent(hv, key, flags, hash) \
b1bc3f34
NC
910 (MUTABLE_SV(hv_common((hv), (key), NULL, 0, 0, (flags) | HV_DELETE, \
911 NULL, (hash))))
99978bb4
NC
912
913#define hv_store_flags(hv, key, klen, val, hash, flags) \
914 ((SV**) hv_common((hv), NULL, (key), (klen), (flags), \
915 (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), (val), \
916 (hash)))
917
918#define hv_store(hv, key, klen, val, hash) \
919 ((SV**) hv_common_key_len((hv), (key), (klen), \
a038e571 920 (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), \
99978bb4 921 (val), (hash)))
a038e571 922
99978bb4
NC
923#define hv_exists(hv, key, klen) \
924 (hv_common_key_len((hv), (key), (klen), HV_FETCH_ISEXISTS, NULL, 0) \
a038e571
NC
925 ? TRUE : FALSE)
926
99978bb4
NC
927#define hv_fetch(hv, key, klen, lval) \
928 ((SV**) hv_common_key_len((hv), (key), (klen), (lval) \
a038e571
NC
929 ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) \
930 : HV_FETCH_JUST_SV, NULL, 0))
931
99978bb4 932#define hv_delete(hv, key, klen, flags) \
b1bc3f34
NC
933 (MUTABLE_SV(hv_common_key_len((hv), (key), (klen), \
934 (flags) | HV_DELETE, NULL, 0)))
a038e571 935
71ad1b0c
NC
936/* This refcounted he structure is used for storing the hints used for lexical
937 pragmas. Without threads, it's basically struct he + refcount.
938 With threads, life gets more complex as the structure needs to be shared
939 between threads (because it hangs from OPs, which are shared), hence the
940 alternate definition and mutex. */
941
44ebaf21
NC
942struct refcounted_he;
943
20439bc7
Z
944/* flags for the refcounted_he API */
945#define REFCOUNTED_HE_KEY_UTF8 0x00000001
94250aee
FC
946#ifdef PERL_CORE
947# define REFCOUNTED_HE_EXISTS 0x00000002
948#endif
20439bc7 949
71ad1b0c
NC
950#ifdef PERL_CORE
951
b6bbf3fa 952/* Gosh. This really isn't a good name any longer. */
71ad1b0c
NC
953struct refcounted_he {
954 struct refcounted_he *refcounted_he_next; /* next entry in chain */
cbb1fbea 955#ifdef USE_ITHREADS
b6bbf3fa
NC
956 U32 refcounted_he_hash;
957 U32 refcounted_he_keylen;
cbb1fbea 958#else
71ad1b0c 959 HEK *refcounted_he_hek; /* hint key */
cbb1fbea 960#endif
b6bbf3fa
NC
961 union {
962 IV refcounted_he_u_iv;
963 UV refcounted_he_u_uv;
964 STRLEN refcounted_he_u_len;
44ebaf21 965 void *refcounted_he_u_ptr; /* Might be useful in future */
b6bbf3fa 966 } refcounted_he_val;
9bd87817 967 U32 refcounted_he_refcnt; /* reference count */
b6bbf3fa
NC
968 /* First byte is flags. Then NUL-terminated value. Then for ithreads,
969 non-NUL terminated key. */
970 char refcounted_he_data[1];
71ad1b0c
NC
971};
972
20439bc7
Z
973/*
974=for apidoc m|SV *|refcounted_he_fetch_pvs|const struct refcounted_he *chain|const char *key|U32 flags
975
976Like L</refcounted_he_fetch_pvn>, but takes a literal string instead of
977a string/length pair, and no precomputed hash.
978
979=cut
980*/
981
982#define refcounted_he_fetch_pvs(chain, key, flags) \
983 Perl_refcounted_he_fetch_pvn(aTHX_ chain, STR_WITH_LEN(key), 0, flags)
984
985/*
986=for apidoc m|struct refcounted_he *|refcounted_he_new_pvs|struct refcounted_he *parent|const char *key|SV *value|U32 flags
987
988Like L</refcounted_he_new_pvn>, but takes a literal string instead of
989a string/length pair, and no precomputed hash.
990
991=cut
992*/
993
994#define refcounted_he_new_pvs(parent, key, value, flags) \
995 Perl_refcounted_he_new_pvn(aTHX_ parent, STR_WITH_LEN(key), 0, value, flags)
996
b6bbf3fa
NC
997/* Flag bits are HVhek_UTF8, HVhek_WASUTF8, then */
998#define HVrhek_undef 0x00 /* Value is undef. */
44ebaf21
NC
999#define HVrhek_delete 0x10 /* Value is placeholder - signifies delete. */
1000#define HVrhek_IV 0x20 /* Value is IV. */
1001#define HVrhek_UV 0x30 /* Value is UV. */
1002#define HVrhek_PV 0x40 /* Value is a (byte) string. */
1003#define HVrhek_PV_UTF8 0x50 /* Value is a (utf8) string. */
1004/* Two spare. As these have to live in the optree, you can't store anything
1005 interpreter specific, such as SVs. :-( */
1006#define HVrhek_typemask 0x70
1007
1008#ifdef USE_ITHREADS
1009/* A big expression to find the key offset */
1010#define REF_HE_KEY(chain) \
1011 ((((chain->refcounted_he_data[0] & 0x60) == 0x40) \
1012 ? chain->refcounted_he_val.refcounted_he_u_len + 1 : 0) \
1013 + 1 + chain->refcounted_he_data)
1014#endif
b6bbf3fa 1015
71ad1b0c
NC
1016# ifdef USE_ITHREADS
1017# define HINTS_REFCNT_LOCK MUTEX_LOCK(&PL_hints_mutex)
1018# define HINTS_REFCNT_UNLOCK MUTEX_UNLOCK(&PL_hints_mutex)
1019# else
1020# define HINTS_REFCNT_LOCK NOOP
1021# define HINTS_REFCNT_UNLOCK NOOP
1022# endif
1023#endif
1024
1025#ifdef USE_ITHREADS
1026# define HINTS_REFCNT_INIT MUTEX_INIT(&PL_hints_mutex)
1027# define HINTS_REFCNT_TERM MUTEX_DESTROY(&PL_hints_mutex)
1028#else
1029# define HINTS_REFCNT_INIT NOOP
1030# define HINTS_REFCNT_TERM NOOP
1031#endif
1032
324a0d18
JH
1033/* Hash actions
1034 * Passed in PERL_MAGIC_uvar calls
1035 */
b54b4831
NC
1036#define HV_DISABLE_UVAR_XKEY 0x01
1037/* We need to ensure that these don't clash with G_DISCARD, which is 2, as it
1038 is documented as being passed to hv_delete(). */
1039#define HV_FETCH_ISSTORE 0x04
1040#define HV_FETCH_ISEXISTS 0x08
1041#define HV_FETCH_LVALUE 0x10
1042#define HV_FETCH_JUST_SV 0x20
9dbc5603 1043#define HV_DELETE 0x40
df5f182b 1044#define HV_FETCH_EMPTY_HE 0x80 /* Leave HeVAL null. */
324a0d18 1045
745edda6
FC
1046/* Must not conflict with HVhek_UTF8 */
1047#define HV_NAME_SETALL 0x02
1048
bfcb3514 1049/*
78ac7dd9
NC
1050=for apidoc newHV
1051
1052Creates a new HV. The reference count is set to 1.
1053
1054=cut
1055*/
1056
dbebbdb4 1057#define newHV() MUTABLE_HV(newSV_type(SVt_PVHV))
78ac7dd9
NC
1058
1059/*
bfcb3514
NC
1060 * Local variables:
1061 * c-indentation-style: bsd
1062 * c-basic-offset: 4
14d04a33 1063 * indent-tabs-mode: nil
bfcb3514
NC
1064 * End:
1065 *
14d04a33 1066 * ex: set ts=8 sts=4 sw=4 et:
bfcb3514 1067 */