This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
rework ROTL definitions (and add ROTL_UV)
[perl5.git] / hv_func.h
CommitLineData
4d3a042d
YO
1/* hash a key
2 *--------------------------------------------------------------------------------------
3 * The "hash seed" feature was added in Perl 5.8.1 to perturb the results
4 * to avoid "algorithmic complexity attacks".
5 *
6 * If USE_HASH_SEED is defined, hash randomisation is done by default
7 * If USE_HASH_SEED_EXPLICIT is defined, hash randomisation is done
8 * only if the environment variable PERL_HASH_SEED is set.
9 * (see also perl.c:perl_parse() and S_init_tls_and_interp() and util.c:get_hash_seed())
10 */
11
12#ifndef PERL_SEEN_HV_FUNC_H /* compile once */
13#define PERL_SEEN_HV_FUNC_H
8dafa723 14#define PERL_HASH_FUNC_ONE_AT_A_TIME_HARD
4d3a042d
YO
15
16#if !( 0 \
17 || defined(PERL_HASH_FUNC_SDBM) \
18 || defined(PERL_HASH_FUNC_DJB2) \
19 || defined(PERL_HASH_FUNC_SUPERFAST) \
20 || defined(PERL_HASH_FUNC_MURMUR3) \
21 || defined(PERL_HASH_FUNC_ONE_AT_A_TIME) \
b1300a73 22 || defined(PERL_HASH_FUNC_ONE_AT_A_TIME_HARD) \
4d3a042d
YO
23 || defined(PERL_HASH_FUNC_ONE_AT_A_TIME_OLD) \
24 )
25#ifdef HAS_QUAD
26#define PERL_HASH_FUNC_SIPHASH
27#else
b1300a73 28#define PERL_HASH_FUNC_ONE_AT_A_TIME_HARD
4d3a042d
YO
29#endif
30#endif
31
32#if defined(PERL_HASH_FUNC_SIPHASH)
33# define PERL_HASH_FUNC "SIPHASH_2_4"
34# define PERL_HASH_SEED_BYTES 16
35# define PERL_HASH(hash,str,len) (hash)= S_perl_hash_siphash_2_4(PERL_HASH_SEED,(U8*)(str),(len))
36#elif defined(PERL_HASH_FUNC_SUPERFAST)
37# define PERL_HASH_FUNC "SUPERFAST"
38# define PERL_HASH_SEED_BYTES 4
39# define PERL_HASH(hash,str,len) (hash)= S_perl_hash_superfast(PERL_HASH_SEED,(U8*)(str),(len))
40#elif defined(PERL_HASH_FUNC_MURMUR3)
41# define PERL_HASH_FUNC "MURMUR3"
42# define PERL_HASH_SEED_BYTES 4
43# define PERL_HASH(hash,str,len) (hash)= S_perl_hash_murmur3(PERL_HASH_SEED,(U8*)(str),(len))
44#elif defined(PERL_HASH_FUNC_DJB2)
45# define PERL_HASH_FUNC "DJB2"
46# define PERL_HASH_SEED_BYTES 4
47# define PERL_HASH(hash,str,len) (hash)= S_perl_hash_djb2(PERL_HASH_SEED,(U8*)(str),(len))
48#elif defined(PERL_HASH_FUNC_SDBM)
49# define PERL_HASH_FUNC "SDBM"
50# define PERL_HASH_SEED_BYTES 4
51# define PERL_HASH(hash,str,len) (hash)= S_perl_hash_sdbm(PERL_HASH_SEED,(U8*)(str),(len))
b1300a73
YO
52#elif defined(PERL_HASH_FUNC_ONE_AT_A_TIME_HARD)
53# define PERL_HASH_FUNC "ONE_AT_A_TIME_HARD"
54# define PERL_HASH_SEED_BYTES 8
55# define PERL_HASH(hash,str,len) (hash)= S_perl_hash_one_at_a_time_hard(PERL_HASH_SEED,(U8*)(str),(len))
4d3a042d
YO
56#elif defined(PERL_HASH_FUNC_ONE_AT_A_TIME)
57# define PERL_HASH_FUNC "ONE_AT_A_TIME"
58# define PERL_HASH_SEED_BYTES 4
59# define PERL_HASH(hash,str,len) (hash)= S_perl_hash_one_at_a_time(PERL_HASH_SEED,(U8*)(str),(len))
60#elif defined(PERL_HASH_FUNC_ONE_AT_A_TIME_OLD)
61# define PERL_HASH_FUNC "ONE_AT_A_TIME_OLD"
62# define PERL_HASH_SEED_BYTES 4
63# define PERL_HASH(hash,str,len) (hash)= S_perl_hash_old_one_at_a_time(PERL_HASH_SEED,(U8*)(str),(len))
64#endif
65
66#ifndef PERL_HASH
67#error "No hash function defined!"
68#endif
69#ifndef PERL_HASH_SEED_BYTES
70#error "PERL_HASH_SEED_BYTES not defined"
71#endif
72#ifndef PERL_HASH_FUNC
73#error "PERL_HASH_FUNC not defined"
74#endif
75
76#ifndef PERL_HASH_SEED
77# if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT)
78# define PERL_HASH_SEED PL_hash_seed
79# elif PERL_HASH_SEED_BYTES == 4
80# define PERL_HASH_SEED "PeRl"
81# elif PERL_HASH_SEED_BYTES == 16
82# define PERL_HASH_SEED "PeRlHaShhAcKpErl"
83# else
84# error "No PERL_HASH_SEED definition for " PERL_HASH_FUNC
85# endif
86#endif
87
88/*-----------------------------------------------------------------------------
89 * Endianess, misalignment capabilities and util macros
90 *
91 * The following 3 macros are defined in this section. The other macros defined
92 * are only needed to help derive these 3.
93 *
94 * U8TO32_LE(x) Read a little endian unsigned 32-bit int
95 * UNALIGNED_SAFE Defined if READ_UINT32 works on non-word boundaries
96 * ROTL32(x,r) Rotate x left by r bits
97 */
98
99#if (defined(__GNUC__) && defined(__i386__)) || defined(__WATCOMC__) \
100 || defined(_MSC_VER) || defined (__BORLANDC__) || defined (__TURBOC__)
101#define U8TO16_LE(d) (*((const U16 *) (d)))
102#endif
103
104#if !defined (U8TO16_LE)
105#define U8TO16_LE(d) ((((const U8 *)(d))[1] << 8)\
106 +((const U8 *)(d))[0])
107#endif
108
109
110/* Now find best way we can to READ_UINT32 */
111#if (BYTEORDER == 0x1234 || BYTEORDER == 0x12345678) && U32SIZE == 4
112 /* CPU endian matches murmurhash algorithm, so read 32-bit word directly */
113 #define U8TO32_LE(ptr) (*((U32*)(ptr)))
114#elif BYTEORDER == 0x4321 || BYTEORDER == 0x87654321
115 /* TODO: Add additional cases below where a compiler provided bswap32 is available */
116 #if defined(__GNUC__) && (__GNUC__>4 || (__GNUC__==4 && __GNUC_MINOR__>=3))
117 #define U8TO32_LE(ptr) (__builtin_bswap32(*((U32*)(ptr))))
118 #else
119 /* Without a known fast bswap32 we're just as well off doing this */
120 #define U8TO32_LE(ptr) (ptr[0]|ptr[1]<<8|ptr[2]<<16|ptr[3]<<24)
121 #define UNALIGNED_SAFE
122 #endif
123#else
124 /* Unknown endianess so last resort is to read individual bytes */
125 #define U8TO32_LE(ptr) (ptr[0]|ptr[1]<<8|ptr[2]<<16|ptr[3]<<24)
126 /* Since we're not doing word-reads we can skip the messing about with realignment */
127 #define UNALIGNED_SAFE
128#endif
129
b716320d
YO
130#ifdef HAS_QUAD
131#ifndef U64TYPE
132/* This probably isn't going to work, but failing with a compiler error due to
133 lack of uint64_t is no worse than failing right now with an #error. */
134#define U64TYPE uint64_t
135#endif
136#endif
137
138/* Find best way to ROTL32/ROTL64 */
4d3a042d
YO
139#if defined(_MSC_VER)
140 #include <stdlib.h> /* Microsoft put _rotl declaration in here */
141 #define ROTL32(x,r) _rotl(x,r)
b716320d
YO
142 #ifdef HAS_QUAD
143 #define ROTL64(x,r) _rotl64(x,r)
144 #endif
4d3a042d
YO
145#else
146 /* gcc recognises this code and generates a rotate instruction for CPUs with one */
147 #define ROTL32(x,r) (((U32)x << r) | ((U32)x >> (32 - r)))
b716320d
YO
148 #ifdef HAS_QUAD
149 #define ROTL64(x,r) (((U64TYPE)x << r) | ((U64TYPE)x >> (64 - r)))
150 #endif
4d3a042d
YO
151#endif
152
153
b716320d
YO
154#ifdef UV_IS_QUAD
155#define ROTL_UV(x,r) ROTL64(x,r)
156#else
157#define ROTL_UV(x,r) ROTL32(x,r)
158#endif
159
4d3a042d
YO
160/* This is SipHash by Jean-Philippe Aumasson and Daniel J. Bernstein.
161 * The authors claim it is relatively secure compared to the alternatives
162 * and that performance wise it is a suitable hash for languages like Perl.
163 * See:
164 *
165 * https://www.131002.net/siphash/
166 *
167 * This implementation seems to perform slightly slower than one-at-a-time for
168 * short keys, but degrades slower for longer keys. Murmur Hash outperforms it
169 * regardless of keys size.
170 *
171 * It is 64 bit only.
172 */
173
174#ifdef HAS_QUAD
175
4d3a042d
YO
176#define U8TO64_LE(p) \
177 (((U64TYPE)((p)[0]) ) | \
178 ((U64TYPE)((p)[1]) << 8) | \
179 ((U64TYPE)((p)[2]) << 16) | \
180 ((U64TYPE)((p)[3]) << 24) | \
181 ((U64TYPE)((p)[4]) << 32) | \
182 ((U64TYPE)((p)[5]) << 40) | \
183 ((U64TYPE)((p)[6]) << 48) | \
184 ((U64TYPE)((p)[7]) << 56))
185
186#define SIPROUND \
187 do { \
188 v0 += v1; v1=ROTL64(v1,13); v1 ^= v0; v0=ROTL64(v0,32); \
189 v2 += v3; v3=ROTL64(v3,16); v3 ^= v2; \
190 v0 += v3; v3=ROTL64(v3,21); v3 ^= v0; \
191 v2 += v1; v1=ROTL64(v1,17); v1 ^= v2; v2=ROTL64(v2,32); \
192 } while(0)
193
194/* SipHash-2-4 */
195
196PERL_STATIC_INLINE U32
197S_perl_hash_siphash_2_4(const unsigned char * const seed, const unsigned char *in, const STRLEN inlen) {
198 /* "somepseudorandomlygeneratedbytes" */
199 U64TYPE v0 = 0x736f6d6570736575ULL;
200 U64TYPE v1 = 0x646f72616e646f6dULL;
201 U64TYPE v2 = 0x6c7967656e657261ULL;
202 U64TYPE v3 = 0x7465646279746573ULL;
203
204 U64TYPE b;
205 U64TYPE k0 = ((U64TYPE*)seed)[0];
206 U64TYPE k1 = ((U64TYPE*)seed)[1];
207 U64TYPE m;
208 const int left = inlen & 7;
209 const U8 *end = in + inlen - left;
210
211 b = ( ( U64TYPE )(inlen) ) << 56;
212 v3 ^= k1;
213 v2 ^= k0;
214 v1 ^= k1;
215 v0 ^= k0;
216
217 for ( ; in != end; in += 8 )
218 {
219 m = U8TO64_LE( in );
220 v3 ^= m;
221 SIPROUND;
222 SIPROUND;
223 v0 ^= m;
224 }
225
226 switch( left )
227 {
228 case 7: b |= ( ( U64TYPE )in[ 6] ) << 48;
229 case 6: b |= ( ( U64TYPE )in[ 5] ) << 40;
230 case 5: b |= ( ( U64TYPE )in[ 4] ) << 32;
231 case 4: b |= ( ( U64TYPE )in[ 3] ) << 24;
232 case 3: b |= ( ( U64TYPE )in[ 2] ) << 16;
233 case 2: b |= ( ( U64TYPE )in[ 1] ) << 8;
234 case 1: b |= ( ( U64TYPE )in[ 0] ); break;
235 case 0: break;
236 }
237
238 v3 ^= b;
239 SIPROUND;
240 SIPROUND;
241 v0 ^= b;
242
243 v2 ^= 0xff;
244 SIPROUND;
245 SIPROUND;
246 SIPROUND;
247 SIPROUND;
248 b = v0 ^ v1 ^ v2 ^ v3;
249 return (U32)(b & U32_MAX);
250}
251#endif /* defined(HAS_QUAD) */
252
253/* FYI: This is the "Super-Fast" algorithm mentioned by Bob Jenkins in
254 * (http://burtleburtle.net/bob/hash/doobs.html)
255 * It is by Paul Hsieh (c) 2004 and is analysed here
256 * http://www.azillionmonkeys.com/qed/hash.html
257 * license terms are here:
258 * http://www.azillionmonkeys.com/qed/weblicense.html
259 */
260
261
262PERL_STATIC_INLINE U32
263S_perl_hash_superfast(const unsigned char * const seed, const unsigned char *str, STRLEN len) {
264 U32 hash = *((U32*)seed) + len;
265 U32 tmp;
266 int rem= len & 3;
267 len >>= 2;
268
269 for (;len > 0; len--) {
270 hash += U8TO16_LE (str);
271 tmp = (U8TO16_LE (str+2) << 11) ^ hash;
272 hash = (hash << 16) ^ tmp;
273 str += 2 * sizeof (U16);
274 hash += hash >> 11;
275 }
276
277 /* Handle end cases */
278 switch (rem) { \
279 case 3: hash += U8TO16_LE (str);
280 hash ^= hash << 16;
281 hash ^= str[sizeof (U16)] << 18;
282 hash += hash >> 11;
283 break;
284 case 2: hash += U8TO16_LE (str);
285 hash ^= hash << 11;
286 hash += hash >> 17;
287 break;
288 case 1: hash += *str;
289 hash ^= hash << 10;
290 hash += hash >> 1;
291 }
292 /* Force "avalanching" of final 127 bits */
293 hash ^= hash << 3;
294 hash += hash >> 5;
295 hash ^= hash << 4;
296 hash += hash >> 17;
297 hash ^= hash << 25;
298 return (hash + (hash >> 6));
299}
300
301
302/*-----------------------------------------------------------------------------
303 * MurmurHash3 was written by Austin Appleby, and is placed in the public
304 * domain.
305 *
306 * This implementation was originally written by Shane Day, and is also public domain,
307 * and was modified to function as a macro similar to other perl hash functions by
308 * Yves Orton.
309 *
310 * This is a portable ANSI C implementation of MurmurHash3_x86_32 (Murmur3A)
311 * with support for progressive processing.
312 *
313 * If you want to understand the MurmurHash algorithm you would be much better
314 * off reading the original source. Just point your browser at:
315 * http://code.google.com/p/smhasher/source/browse/trunk/MurmurHash3.cpp
316 *
317 * How does it work?
318 *
319 * We can only process entire 32 bit chunks of input, except for the very end
320 * that may be shorter.
321 *
322 * To handle endianess I simply use a macro that reads a U32 and define
323 * that macro to be a direct read on little endian machines, a read and swap
324 * on big endian machines, or a byte-by-byte read if the endianess is unknown.
325 */
326
327
328/*-----------------------------------------------------------------------------
329 * Core murmurhash algorithm macros */
330
331#define MURMUR_C1 (0xcc9e2d51)
332#define MURMUR_C2 (0x1b873593)
333#define MURMUR_C3 (0xe6546b64)
334#define MURMUR_C4 (0x85ebca6b)
335#define MURMUR_C5 (0xc2b2ae35)
336
337/* This is the main processing body of the algorithm. It operates
338 * on each full 32-bits of input. */
339#define MURMUR_DOBLOCK(h1, k1) STMT_START { \
340 k1 *= MURMUR_C1; \
341 k1 = ROTL32(k1,15); \
342 k1 *= MURMUR_C2; \
343 \
344 h1 ^= k1; \
345 h1 = ROTL32(h1,13); \
346 h1 = h1 * 5 + MURMUR_C3; \
347} STMT_END
348
349
350/* Append unaligned bytes to carry, forcing hash churn if we have 4 bytes */
351/* cnt=bytes to process, h1=name of h1 var, c=carry, n=bytes in c, ptr/len=payload */
352#define MURMUR_DOBYTES(cnt, h1, c, n, ptr, len) STMT_START { \
353 int MURMUR_DOBYTES_i = cnt; \
354 while(MURMUR_DOBYTES_i--) { \
355 c = c>>8 | *ptr++<<24; \
356 n++; len--; \
357 if(n==4) { \
358 MURMUR_DOBLOCK(h1, c); \
359 n = 0; \
360 } \
361 } \
362} STMT_END
363
364
365/* now we create the hash function */
366PERL_STATIC_INLINE U32
367S_perl_hash_murmur3(const unsigned char * const seed, const unsigned char *ptr, STRLEN len) {
368 U32 h1 = *((U32*)seed);
369 U32 k1;
370 U32 carry = 0;
371
372 const unsigned char *end;
373 int bytes_in_carry = 0; /* bytes in carry */
374 I32 total_length= len;
375
376#if defined(UNALIGNED_SAFE)
377 /* Handle carry: commented out as its only used in incremental mode - it never fires for us
378 int i = (4-n) & 3;
379 if(i && i <= len) {
380 MURMUR_DOBYTES(i, h1, carry, bytes_in_carry, ptr, len);
381 }
382 */
383
384 /* This CPU handles unaligned word access */
385 /* Process 32-bit chunks */
386 end = ptr + len/4*4;
387 for( ; ptr < end ; ptr+=4) {
388 k1 = U8TO32_LE(ptr);
389 MURMUR_DOBLOCK(h1, k1);
390 }
391#else
392 /* This CPU does not handle unaligned word access */
393
394 /* Consume enough so that the next data byte is word aligned */
395 int i = -(long)ptr & 3;
22e6de60 396 if(i && (STRLEN)i <= len) {
4d3a042d
YO
397 MURMUR_DOBYTES(i, h1, carry, bytes_in_carry, ptr, len);
398 }
399
400 /* We're now aligned. Process in aligned blocks. Specialise for each possible carry count */
401 end = ptr + len/4*4;
402 switch(bytes_in_carry) { /* how many bytes in carry */
403 case 0: /* c=[----] w=[3210] b=[3210]=w c'=[----] */
404 for( ; ptr < end ; ptr+=4) {
405 k1 = U8TO32_LE(ptr);
406 MURMUR_DOBLOCK(h1, k1);
407 }
408 break;
409 case 1: /* c=[0---] w=[4321] b=[3210]=c>>24|w<<8 c'=[4---] */
410 for( ; ptr < end ; ptr+=4) {
411 k1 = carry>>24;
412 carry = U8TO32_LE(ptr);
413 k1 |= carry<<8;
414 MURMUR_DOBLOCK(h1, k1);
415 }
416 break;
417 case 2: /* c=[10--] w=[5432] b=[3210]=c>>16|w<<16 c'=[54--] */
418 for( ; ptr < end ; ptr+=4) {
419 k1 = carry>>16;
420 carry = U8TO32_LE(ptr);
421 k1 |= carry<<16;
422 MURMUR_DOBLOCK(h1, k1);
423 }
424 break;
425 case 3: /* c=[210-] w=[6543] b=[3210]=c>>8|w<<24 c'=[654-] */
426 for( ; ptr < end ; ptr+=4) {
427 k1 = carry>>8;
428 carry = U8TO32_LE(ptr);
429 k1 |= carry<<24;
430 MURMUR_DOBLOCK(h1, k1);
431 }
432 }
433#endif
434 /* Advance over whole 32-bit chunks, possibly leaving 1..3 bytes */
435 len -= len/4*4;
436
437 /* Append any remaining bytes into carry */
438 MURMUR_DOBYTES(len, h1, carry, bytes_in_carry, ptr, len);
439
440 if (bytes_in_carry) {
441 k1 = carry >> ( 4 - bytes_in_carry ) * 8;
442 k1 *= MURMUR_C1;
443 k1 = ROTL32(k1,15);
444 k1 *= MURMUR_C2;
445 h1 ^= k1;
446 }
447 h1 ^= total_length;
448
449 /* fmix */
450 h1 ^= h1 >> 16;
451 h1 *= MURMUR_C4;
452 h1 ^= h1 >> 13;
453 h1 *= MURMUR_C5;
454 h1 ^= h1 >> 16;
455 return h1;
456}
457
458
459PERL_STATIC_INLINE U32
460S_perl_hash_djb2(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
461 const unsigned char * const end = (const unsigned char *)str + len;
462 U32 hash = *((U32*)seed + len);
463 while (str < end) {
464 hash = ((hash << 5) + hash) + *str++;
465 }
466 return hash;
467}
468
469PERL_STATIC_INLINE U32
470S_perl_hash_sdbm(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
471 const unsigned char * const end = (const unsigned char *)str + len;
472 U32 hash = *((U32*)seed + len);
473 while (str < end) {
474 hash = (hash << 6) + (hash << 16) - hash + *str++;
475 }
476 return hash;
477}
478
479
b1300a73 480/* This is the "One-at-a-Time" algorithm by Bob Jenkins
4d3a042d 481 * from requirements by Colin Plumb.
b1300a73
YO
482 * (http://burtleburtle.net/bob/hash/doobs.html)
483 * With seed/len tweak.
484 * */
4d3a042d
YO
485PERL_STATIC_INLINE U32
486S_perl_hash_one_at_a_time(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
487 const unsigned char * const end = (const unsigned char *)str + len;
488 U32 hash = *((U32*)seed) + len;
489 while (str < end) {
490 hash += *str++;
491 hash += (hash << 10);
492 hash ^= (hash >> 6);
493 }
494 hash += (hash << 3);
495 hash ^= (hash >> 11);
496 return (hash + (hash << 15));
497}
498
b1300a73
YO
499/* Derived from "One-at-a-Time" algorithm by Bob Jenkins */
500PERL_STATIC_INLINE U32
501S_perl_hash_one_at_a_time_hard(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
502 const unsigned char * const end = (const unsigned char *)str + len;
503 U32 hash = *((U32*)seed) + len;
504
505 while (str < end) {
506 hash += (hash << 10);
507 hash ^= (hash >> 6);
508 hash += *str++;
509 }
510
511 hash += (hash << 10);
512 hash ^= (hash >> 6);
513 hash += seed[4];
514
515 hash += (hash << 10);
516 hash ^= (hash >> 6);
517 hash += seed[5];
518
519 hash += (hash << 10);
520 hash ^= (hash >> 6);
521 hash += seed[6];
522
523 hash += (hash << 10);
524 hash ^= (hash >> 6);
525 hash += seed[7];
526
527 hash += (hash << 10);
528 hash ^= (hash >> 6);
529
530 hash += (hash << 3);
531 hash ^= (hash >> 11);
532 return (hash + (hash << 15));
533}
534
4d3a042d
YO
535PERL_STATIC_INLINE U32
536S_perl_hash_old_one_at_a_time(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
537 const unsigned char * const end = (const unsigned char *)str + len;
538 U32 hash = *((U32*)seed);
539 while (str < end) {
540 hash += *str++;
541 hash += (hash << 10);
542 hash ^= (hash >> 6);
543 }
544 hash += (hash << 3);
545 hash ^= (hash >> 11);
546 return (hash + (hash << 15));
547}
548
549/* legacy - only mod_perl should be doing this. */
550#ifdef PERL_HASH_INTERNAL_ACCESS
551#define PERL_HASH_INTERNAL(hash,str,len) PERL_HASH(hash,str,len)
552#endif
553
554#endif /*compile once*/
555
556/*
557 * Local variables:
558 * c-indentation-style: bsd
559 * c-basic-offset: 4
560 * indent-tabs-mode: nil
561 * End:
562 *
563 * ex: set ts=8 sts=4 sw=4 et:
564 */