This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
7932fcd226aa2bdd83d139d01845d328e0e1f27e
[perl5.git] / hv_func.h
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
14 #define PERL_HASH_FUNC_ONE_AT_A_TIME_HARD
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) \
22         || defined(PERL_HASH_FUNC_ONE_AT_A_TIME_HARD) \
23         || defined(PERL_HASH_FUNC_ONE_AT_A_TIME_OLD) \
24     )
25 #ifdef HAS_QUAD
26 #define PERL_HASH_FUNC_SIPHASH
27 #else
28 #define PERL_HASH_FUNC_ONE_AT_A_TIME_HARD
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))
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))
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
130 /* Find best way to ROTL32 */
131 #if defined(_MSC_VER)
132   #include <stdlib.h>  /* Microsoft put _rotl declaration in here */
133   #define ROTL32(x,r)  _rotl(x,r)
134 #else
135   /* gcc recognises this code and generates a rotate instruction for CPUs with one */
136   #define ROTL32(x,r)  (((U32)x << r) | ((U32)x >> (32 - r)))
137 #endif
138
139
140 /* This is SipHash by Jean-Philippe Aumasson and Daniel J. Bernstein.
141  * The authors claim it is relatively secure compared to the alternatives
142  * and that performance wise it is a suitable hash for languages like Perl.
143  * See:
144  *
145  * https://www.131002.net/siphash/
146  *
147  * This implementation seems to perform slightly slower than one-at-a-time for
148  * short keys, but degrades slower for longer keys. Murmur Hash outperforms it
149  * regardless of keys size.
150  *
151  * It is 64 bit only.
152  */
153
154 #ifdef HAS_QUAD
155
156 #ifndef U64TYPE
157 /* This probably isn't going to work, but failing with a compiler error due to
158    lack of uint64_t is no worse than failing right now with an #error.  */
159 #define U64TYPE uint64_t
160 #endif
161
162
163 #define ROTL64(x,b) (U64TYPE)( ((x) << (b)) | ( (x) >> (64 - (b))) )
164
165 #define U8TO64_LE(p) \
166   (((U64TYPE)((p)[0])      ) | \
167    ((U64TYPE)((p)[1]) <<  8) | \
168    ((U64TYPE)((p)[2]) << 16) | \
169    ((U64TYPE)((p)[3]) << 24) | \
170    ((U64TYPE)((p)[4]) << 32) | \
171    ((U64TYPE)((p)[5]) << 40) | \
172    ((U64TYPE)((p)[6]) << 48) | \
173    ((U64TYPE)((p)[7]) << 56))
174
175 #define SIPROUND            \
176   do {              \
177     v0 += v1; v1=ROTL64(v1,13); v1 ^= v0; v0=ROTL64(v0,32); \
178     v2 += v3; v3=ROTL64(v3,16); v3 ^= v2;     \
179     v0 += v3; v3=ROTL64(v3,21); v3 ^= v0;     \
180     v2 += v1; v1=ROTL64(v1,17); v1 ^= v2; v2=ROTL64(v2,32); \
181   } while(0)
182
183 /* SipHash-2-4 */
184
185 PERL_STATIC_INLINE U32
186 S_perl_hash_siphash_2_4(const unsigned char * const seed, const unsigned char *in, const STRLEN inlen) {
187   /* "somepseudorandomlygeneratedbytes" */
188   U64TYPE v0 = 0x736f6d6570736575ULL;
189   U64TYPE v1 = 0x646f72616e646f6dULL;
190   U64TYPE v2 = 0x6c7967656e657261ULL;
191   U64TYPE v3 = 0x7465646279746573ULL;
192
193   U64TYPE b;
194   U64TYPE k0 = ((U64TYPE*)seed)[0];
195   U64TYPE k1 = ((U64TYPE*)seed)[1];
196   U64TYPE m;
197   const int left = inlen & 7;
198   const U8 *end = in + inlen - left;
199
200   b = ( ( U64TYPE )(inlen) ) << 56;
201   v3 ^= k1;
202   v2 ^= k0;
203   v1 ^= k1;
204   v0 ^= k0;
205
206   for ( ; in != end; in += 8 )
207   {
208     m = U8TO64_LE( in );
209     v3 ^= m;
210     SIPROUND;
211     SIPROUND;
212     v0 ^= m;
213   }
214
215   switch( left )
216   {
217   case 7: b |= ( ( U64TYPE )in[ 6] )  << 48;
218   case 6: b |= ( ( U64TYPE )in[ 5] )  << 40;
219   case 5: b |= ( ( U64TYPE )in[ 4] )  << 32;
220   case 4: b |= ( ( U64TYPE )in[ 3] )  << 24;
221   case 3: b |= ( ( U64TYPE )in[ 2] )  << 16;
222   case 2: b |= ( ( U64TYPE )in[ 1] )  <<  8;
223   case 1: b |= ( ( U64TYPE )in[ 0] ); break;
224   case 0: break;
225   }
226
227   v3 ^= b;
228   SIPROUND;
229   SIPROUND;
230   v0 ^= b;
231
232   v2 ^= 0xff;
233   SIPROUND;
234   SIPROUND;
235   SIPROUND;
236   SIPROUND;
237   b = v0 ^ v1 ^ v2  ^ v3;
238   return (U32)(b & U32_MAX);
239 }
240 #endif /* defined(HAS_QUAD) */
241
242 /* FYI: This is the "Super-Fast" algorithm mentioned by Bob Jenkins in
243  * (http://burtleburtle.net/bob/hash/doobs.html)
244  * It is by Paul Hsieh (c) 2004 and is analysed here
245  * http://www.azillionmonkeys.com/qed/hash.html
246  * license terms are here:
247  * http://www.azillionmonkeys.com/qed/weblicense.html
248  */
249
250
251 PERL_STATIC_INLINE U32
252 S_perl_hash_superfast(const unsigned char * const seed, const unsigned char *str, STRLEN len) {
253     U32 hash = *((U32*)seed) + len;
254     U32 tmp;
255     int rem= len & 3;
256     len >>= 2;
257
258     for (;len > 0; len--) {
259         hash  += U8TO16_LE (str);
260         tmp    = (U8TO16_LE (str+2) << 11) ^ hash;
261         hash   = (hash << 16) ^ tmp;
262         str   += 2 * sizeof (U16);
263         hash  += hash >> 11;
264     }
265
266     /* Handle end cases */
267     switch (rem) { \
268         case 3: hash += U8TO16_LE (str);
269                 hash ^= hash << 16;
270                 hash ^= str[sizeof (U16)] << 18;
271                 hash += hash >> 11;
272                 break;
273         case 2: hash += U8TO16_LE (str);
274                 hash ^= hash << 11;
275                 hash += hash >> 17;
276                 break;
277         case 1: hash += *str;
278                 hash ^= hash << 10;
279                 hash += hash >> 1;
280     }
281     /* Force "avalanching" of final 127 bits */
282     hash ^= hash << 3;
283     hash += hash >> 5;
284     hash ^= hash << 4;
285     hash += hash >> 17;
286     hash ^= hash << 25;
287     return (hash + (hash >> 6));
288 }
289
290
291 /*-----------------------------------------------------------------------------
292  * MurmurHash3 was written by Austin Appleby, and is placed in the public
293  * domain.
294  *
295  * This implementation was originally written by Shane Day, and is also public domain,
296  * and was modified to function as a macro similar to other perl hash functions by
297  * Yves Orton.
298  *
299  * This is a portable ANSI C implementation of MurmurHash3_x86_32 (Murmur3A)
300  * with support for progressive processing.
301  *
302  * If you want to understand the MurmurHash algorithm you would be much better
303  * off reading the original source. Just point your browser at:
304  * http://code.google.com/p/smhasher/source/browse/trunk/MurmurHash3.cpp
305  *
306  * How does it work?
307  *
308  * We can only process entire 32 bit chunks of input, except for the very end
309  * that may be shorter.
310  *
311  * To handle endianess I simply use a macro that reads a U32 and define
312  * that macro to be a direct read on little endian machines, a read and swap
313  * on big endian machines, or a byte-by-byte read if the endianess is unknown.
314  */
315
316
317 /*-----------------------------------------------------------------------------
318  * Core murmurhash algorithm macros */
319
320 #define MURMUR_C1  (0xcc9e2d51)
321 #define MURMUR_C2  (0x1b873593)
322 #define MURMUR_C3  (0xe6546b64)
323 #define MURMUR_C4  (0x85ebca6b)
324 #define MURMUR_C5  (0xc2b2ae35)
325
326 /* This is the main processing body of the algorithm. It operates
327  * on each full 32-bits of input. */
328 #define MURMUR_DOBLOCK(h1, k1) STMT_START { \
329     k1 *= MURMUR_C1; \
330     k1 = ROTL32(k1,15); \
331     k1 *= MURMUR_C2; \
332     \
333     h1 ^= k1; \
334     h1 = ROTL32(h1,13); \
335     h1 = h1 * 5 + MURMUR_C3; \
336 } STMT_END
337
338
339 /* Append unaligned bytes to carry, forcing hash churn if we have 4 bytes */
340 /* cnt=bytes to process, h1=name of h1 var, c=carry, n=bytes in c, ptr/len=payload */
341 #define MURMUR_DOBYTES(cnt, h1, c, n, ptr, len) STMT_START { \
342     int MURMUR_DOBYTES_i = cnt; \
343     while(MURMUR_DOBYTES_i--) { \
344         c = c>>8 | *ptr++<<24; \
345         n++; len--; \
346         if(n==4) { \
347             MURMUR_DOBLOCK(h1, c); \
348             n = 0; \
349         } \
350     } \
351 } STMT_END
352
353
354 /* now we create the hash function */
355 PERL_STATIC_INLINE U32
356 S_perl_hash_murmur3(const unsigned char * const seed, const unsigned char *ptr, STRLEN len) {
357     U32 h1 = *((U32*)seed);
358     U32 k1;
359     U32 carry = 0;
360
361     const unsigned char *end;
362     int bytes_in_carry = 0; /* bytes in carry */
363     I32 total_length= len;
364
365 #if defined(UNALIGNED_SAFE)
366     /* Handle carry: commented out as its only used in incremental mode - it never fires for us
367     int i = (4-n) & 3;
368     if(i && i <= len) {
369       MURMUR_DOBYTES(i, h1, carry, bytes_in_carry, ptr, len);
370     }
371     */
372
373     /* This CPU handles unaligned word access */
374     /* Process 32-bit chunks */
375     end = ptr + len/4*4;
376     for( ; ptr < end ; ptr+=4) {
377         k1 = U8TO32_LE(ptr);
378         MURMUR_DOBLOCK(h1, k1);
379     }
380 #else
381     /* This CPU does not handle unaligned word access */
382
383     /* Consume enough so that the next data byte is word aligned */
384     int i = -(long)ptr & 3;
385     if(i && (STRLEN)i <= len) {
386       MURMUR_DOBYTES(i, h1, carry, bytes_in_carry, ptr, len);
387     }
388
389     /* We're now aligned. Process in aligned blocks. Specialise for each possible carry count */
390     end = ptr + len/4*4;
391     switch(bytes_in_carry) { /* how many bytes in carry */
392         case 0: /* c=[----]  w=[3210]  b=[3210]=w            c'=[----] */
393         for( ; ptr < end ; ptr+=4) {
394             k1 = U8TO32_LE(ptr);
395             MURMUR_DOBLOCK(h1, k1);
396         }
397         break;
398         case 1: /* c=[0---]  w=[4321]  b=[3210]=c>>24|w<<8   c'=[4---] */
399         for( ; ptr < end ; ptr+=4) {
400             k1 = carry>>24;
401             carry = U8TO32_LE(ptr);
402             k1 |= carry<<8;
403             MURMUR_DOBLOCK(h1, k1);
404         }
405         break;
406         case 2: /* c=[10--]  w=[5432]  b=[3210]=c>>16|w<<16  c'=[54--] */
407         for( ; ptr < end ; ptr+=4) {
408             k1 = carry>>16;
409             carry = U8TO32_LE(ptr);
410             k1 |= carry<<16;
411             MURMUR_DOBLOCK(h1, k1);
412         }
413         break;
414         case 3: /* c=[210-]  w=[6543]  b=[3210]=c>>8|w<<24   c'=[654-] */
415         for( ; ptr < end ; ptr+=4) {
416             k1 = carry>>8;
417             carry = U8TO32_LE(ptr);
418             k1 |= carry<<24;
419             MURMUR_DOBLOCK(h1, k1);
420         }
421     }
422 #endif
423     /* Advance over whole 32-bit chunks, possibly leaving 1..3 bytes */
424     len -= len/4*4;
425
426     /* Append any remaining bytes into carry */
427     MURMUR_DOBYTES(len, h1, carry, bytes_in_carry, ptr, len);
428
429     if (bytes_in_carry) {
430         k1 = carry >> ( 4 - bytes_in_carry ) * 8;
431         k1 *= MURMUR_C1;
432         k1 = ROTL32(k1,15);
433         k1 *= MURMUR_C2;
434         h1 ^= k1;
435     }
436     h1 ^= total_length;
437
438     /* fmix */
439     h1 ^= h1 >> 16;
440     h1 *= MURMUR_C4;
441     h1 ^= h1 >> 13;
442     h1 *= MURMUR_C5;
443     h1 ^= h1 >> 16;
444     return h1;
445 }
446
447
448 PERL_STATIC_INLINE U32
449 S_perl_hash_djb2(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
450     const unsigned char * const end = (const unsigned char *)str + len;
451     U32 hash = *((U32*)seed + len);
452     while (str < end) {
453         hash = ((hash << 5) + hash) + *str++;
454     }
455     return hash;
456 }
457
458 PERL_STATIC_INLINE U32
459 S_perl_hash_sdbm(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
460     const unsigned char * const end = (const unsigned char *)str + len;
461     U32 hash = *((U32*)seed + len);
462     while (str < end) {
463         hash = (hash << 6) + (hash << 16) - hash + *str++;
464     }
465     return hash;
466 }
467
468
469 /* This is the "One-at-a-Time" algorithm by Bob Jenkins
470  * from requirements by Colin Plumb.
471  * (http://burtleburtle.net/bob/hash/doobs.html)
472  * With seed/len tweak.
473  * */
474 PERL_STATIC_INLINE U32
475 S_perl_hash_one_at_a_time(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
476     const unsigned char * const end = (const unsigned char *)str + len;
477     U32 hash = *((U32*)seed) + len;
478     while (str < end) {
479         hash += *str++;
480         hash += (hash << 10);
481         hash ^= (hash >> 6);
482     }
483     hash += (hash << 3);
484     hash ^= (hash >> 11);
485     return (hash + (hash << 15));
486 }
487
488 /* Derived from "One-at-a-Time" algorithm by Bob Jenkins */
489 PERL_STATIC_INLINE U32
490 S_perl_hash_one_at_a_time_hard(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
491     const unsigned char * const end = (const unsigned char *)str + len;
492     U32 hash = *((U32*)seed) + len;
493     
494     while (str < end) {
495         hash += (hash << 10);
496         hash ^= (hash >> 6);
497         hash += *str++;
498     }
499     
500     hash += (hash << 10);
501     hash ^= (hash >> 6);
502     hash += seed[4];
503     
504     hash += (hash << 10);
505     hash ^= (hash >> 6);
506     hash += seed[5];
507     
508     hash += (hash << 10);
509     hash ^= (hash >> 6);
510     hash += seed[6];
511     
512     hash += (hash << 10);
513     hash ^= (hash >> 6);
514     hash += seed[7];
515     
516     hash += (hash << 10);
517     hash ^= (hash >> 6);
518
519     hash += (hash << 3);
520     hash ^= (hash >> 11);
521     return (hash + (hash << 15));
522 }
523
524 PERL_STATIC_INLINE U32
525 S_perl_hash_old_one_at_a_time(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
526     const unsigned char * const end = (const unsigned char *)str + len;
527     U32 hash = *((U32*)seed);
528     while (str < end) {
529         hash += *str++;
530         hash += (hash << 10);
531         hash ^= (hash >> 6);
532     }
533     hash += (hash << 3);
534     hash ^= (hash >> 11);
535     return (hash + (hash << 15));
536 }
537
538 /* legacy - only mod_perl should be doing this.  */
539 #ifdef PERL_HASH_INTERNAL_ACCESS
540 #define PERL_HASH_INTERNAL(hash,str,len) PERL_HASH(hash,str,len)
541 #endif
542
543 #endif /*compile once*/
544
545 /*
546  * Local variables:
547  * c-indentation-style: bsd
548  * c-basic-offset: 4
549  * indent-tabs-mode: nil
550  * End:
551  *
552  * ex: set ts=8 sts=4 sw=4 et:
553  */