This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Revert "Tweak our hash bucket splitting rules"
[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
15 #if IVSZIE == 8
16 #define CAN64BITHASH
17 #endif
18
19 #if !( 0 \
20         || defined(PERL_HASH_FUNC_SIPHASH) \
21         || defined(PERL_HASH_FUNC_SIPHASH13) \
22         || defined(PERL_HASH_FUNC_HYBRID_OAATHU_SIPHASH13) \
23         || defined(PERL_HASH_FUNC_ONE_AT_A_TIME_HARD) \
24     )
25 #ifdef CAN64BITHASH
26 #define PERL_HASH_FUNC_HYBRID_OAATHU_SIPHASH13
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_WITH_SEED(seed,hash,str,len) (hash)= S_perl_hash_siphash_2_4((seed),(U8*)(str),(len))
36 #elif defined(PERL_HASH_FUNC_SIPHASH13)
37 #   define PERL_HASH_FUNC "SIPHASH_1_3"
38 #   define PERL_HASH_SEED_BYTES 16
39 #   define PERL_HASH_WITH_SEED(seed,hash,str,len) (hash)= S_perl_hash_siphash_1_3((seed),(U8*)(str),(len))
40 #elif defined(PERL_HASH_FUNC_HYBRID_OAATHU_SIPHASH13)
41 #   define PERL_HASH_FUNC "HYBRID_OAATHU_SIPHASH_1_3"
42 #   define PERL_HASH_SEED_BYTES 24
43 #   define PERL_HASH_WITH_SEED(seed,hash,str,len) (hash)= S_perl_hash_oaathu_siphash_1_3((seed),(U8*)(str),(len))
44 #elif defined(PERL_HASH_FUNC_ONE_AT_A_TIME_HARD)
45 #   define PERL_HASH_FUNC "ONE_AT_A_TIME_HARD"
46 #   define PERL_HASH_SEED_BYTES 8
47 #   define PERL_HASH_WITH_SEED(seed,hash,str,len) (hash)= S_perl_hash_one_at_a_time_hard((seed),(U8*)(str),(len))
48 #endif
49
50 #ifndef PERL_HASH_WITH_SEED
51 #error "No hash function defined!"
52 #endif
53 #ifndef PERL_HASH_SEED_BYTES
54 #error "PERL_HASH_SEED_BYTES not defined"
55 #endif
56 #ifndef PERL_HASH_FUNC
57 #error "PERL_HASH_FUNC not defined"
58 #endif
59
60 #ifndef PERL_HASH_SEED
61 #   if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT)
62 #       define PERL_HASH_SEED PL_hash_seed
63 #   elif PERL_HASH_SEED_BYTES == 4
64 #       define PERL_HASH_SEED ((const U8 *)"PeRl")
65 #   elif PERL_HASH_SEED_BYTES == 8
66 #       define PERL_HASH_SEED ((const U8 *)"PeRlHaSh")
67 #   elif PERL_HASH_SEED_BYTES == 16
68 #       define PERL_HASH_SEED ((const U8 *)"PeRlHaShhAcKpErl")
69 #   else
70 #       error "No PERL_HASH_SEED definition for " PERL_HASH_FUNC
71 #   endif
72 #endif
73
74 #define PERL_HASH(hash,str,len) PERL_HASH_WITH_SEED(PERL_HASH_SEED,hash,str,len)
75
76 /* legacy - only mod_perl should be doing this.  */
77 #ifdef PERL_HASH_INTERNAL_ACCESS
78 #define PERL_HASH_INTERNAL(hash,str,len) PERL_HASH(hash,str,len)
79 #endif
80
81 /*-----------------------------------------------------------------------------
82  * Endianess, misalignment capabilities and util macros
83  *
84  * The following 3 macros are defined in this section. The other macros defined
85  * are only needed to help derive these 3.
86  *
87  * U8TO32_LE(x)   Read a little endian unsigned 32-bit int
88  * UNALIGNED_SAFE   Defined if unaligned access is safe
89  * ROTL32(x,r)      Rotate x left by r bits
90  */
91
92 #if (defined(__GNUC__) && defined(__i386__)) || defined(__WATCOMC__) \
93   || defined(_MSC_VER) || defined (__TURBOC__)
94 #define U8TO16_LE(d) (*((const U16 *) (d)))
95 #endif
96
97 #if !defined (U8TO16_LE)
98 #define U8TO16_LE(d) ((((const U8 *)(d))[1] << 8)\
99                       +((const U8 *)(d))[0])
100 #endif
101
102 #if (BYTEORDER == 0x1234 || BYTEORDER == 0x12345678) && U32SIZE == 4
103   /* CPU endian matches murmurhash algorithm, so read 32-bit word directly */
104   #define U8TO32_LE(ptr)   (*((const U32*)(ptr)))
105 #elif BYTEORDER == 0x4321 || BYTEORDER == 0x87654321
106   /* TODO: Add additional cases below where a compiler provided bswap32 is available */
107   #if defined(__GNUC__) && (__GNUC__>4 || (__GNUC__==4 && __GNUC_MINOR__>=3))
108     #define U8TO32_LE(ptr)   (__builtin_bswap32(*((U32*)(ptr))))
109   #else
110     /* Without a known fast bswap32 we're just as well off doing this */
111     #define U8TO32_LE(ptr)   (ptr[0]|ptr[1]<<8|ptr[2]<<16|ptr[3]<<24)
112     #define UNALIGNED_SAFE
113   #endif
114 #else
115   /* Unknown endianess so last resort is to read individual bytes */
116   #define U8TO32_LE(ptr)   (ptr[0]|ptr[1]<<8|ptr[2]<<16|ptr[3]<<24)
117   /* Since we're not doing word-reads we can skip the messing about with realignment */
118   #define UNALIGNED_SAFE
119 #endif
120
121 #ifdef CAN64BITHASH
122 #ifndef U64TYPE
123 /* This probably isn't going to work, but failing with a compiler error due to
124    lack of uint64_t is no worse than failing right now with an #error.  */
125 #define U64 uint64_t
126 #endif
127 #endif
128
129 /* Find best way to ROTL32/ROTL64 */
130 #if defined(_MSC_VER)
131   #include <stdlib.h>  /* Microsoft put _rotl declaration in here */
132   #define ROTL32(x,r)  _rotl(x,r)
133   #ifdef CAN64BITHASH
134     #define ROTL64(x,r)  _rotl64(x,r)
135   #endif
136 #else
137   /* gcc recognises this code and generates a rotate instruction for CPUs with one */
138   #define ROTL32(x,r)  (((U32)x << r) | ((U32)x >> (32 - r)))
139   #ifdef CAN64BITHASH
140     #define ROTL64(x,r)  (((U64)x << r) | ((U64)x >> (64 - r)))
141   #endif
142 #endif
143
144
145 #ifdef UV_IS_QUAD
146 #define ROTL_UV(x,r) ROTL64(x,r)
147 #else
148 #define ROTL_UV(x,r) ROTL32(x,r)
149 #endif
150
151 /* This is SipHash by Jean-Philippe Aumasson and Daniel J. Bernstein.
152  * The authors claim it is relatively secure compared to the alternatives
153  * and that performance wise it is a suitable hash for languages like Perl.
154  * See:
155  *
156  * https://www.131002.net/siphash/
157  *
158  * This implementation seems to perform slightly slower than one-at-a-time for
159  * short keys, but degrades slower for longer keys. Murmur Hash outperforms it
160  * regardless of keys size.
161  *
162  * It is 64 bit only.
163  */
164
165 #ifdef CAN64BITHASH
166
167 #define U8TO64_LE(p) \
168   (((U64)((p)[0])      ) | \
169    ((U64)((p)[1]) <<  8) | \
170    ((U64)((p)[2]) << 16) | \
171    ((U64)((p)[3]) << 24) | \
172    ((U64)((p)[4]) << 32) | \
173    ((U64)((p)[5]) << 40) | \
174    ((U64)((p)[6]) << 48) | \
175    ((U64)((p)[7]) << 56))
176
177 #define SIPROUND            \
178   STMT_START {              \
179     v0 += v1; v1=ROTL64(v1,13); v1 ^= v0; v0=ROTL64(v0,32); \
180     v2 += v3; v3=ROTL64(v3,16); v3 ^= v2;     \
181     v0 += v3; v3=ROTL64(v3,21); v3 ^= v0;     \
182     v2 += v1; v1=ROTL64(v1,17); v1 ^= v2; v2=ROTL64(v2,32); \
183   } STMT_END
184
185 /* SipHash-2-4 */
186
187
188 #define PERL_SIPHASH_FNC(FNC,SIP_ROUNDS,SIP_FINAL_ROUNDS) \
189 PERL_STATIC_INLINE U32 \
190 FNC(const unsigned char * const seed, const unsigned char *in, const STRLEN inlen) { \
191   /* "somepseudorandomlygeneratedbytes" */  \
192   U64 v0 = UINT64_C(0x736f6d6570736575);    \
193   U64 v1 = UINT64_C(0x646f72616e646f6d);    \
194   U64 v2 = UINT64_C(0x6c7967656e657261);    \
195   U64 v3 = UINT64_C(0x7465646279746573);    \
196                                             \
197   U64 b;                                    \
198   U64 k0 = ((const U64*)seed)[0];           \
199   U64 k1 = ((const U64*)seed)[1];           \
200   U64 m;                                    \
201   const int left = inlen & 7;               \
202   const U8 *end = in + inlen - left;        \
203                                             \
204   b = ( ( U64 )(inlen) ) << 56;             \
205   v3 ^= k1;                                 \
206   v2 ^= k0;                                 \
207   v1 ^= k1;                                 \
208   v0 ^= k0;                                 \
209                                             \
210   for ( ; in != end; in += 8 )              \
211   {                                         \
212     m = U8TO64_LE( in );                    \
213     v3 ^= m;                                \
214                                             \
215     SIP_ROUNDS;                             \
216                                             \
217     v0 ^= m;                                \
218   }                                         \
219                                             \
220   switch( left )                            \
221   {                                         \
222   case 7: b |= ( ( U64 )in[ 6] )  << 48;    \
223   case 6: b |= ( ( U64 )in[ 5] )  << 40;    \
224   case 5: b |= ( ( U64 )in[ 4] )  << 32;    \
225   case 4: b |= ( ( U64 )in[ 3] )  << 24;    \
226   case 3: b |= ( ( U64 )in[ 2] )  << 16;    \
227   case 2: b |= ( ( U64 )in[ 1] )  <<  8;    \
228   case 1: b |= ( ( U64 )in[ 0] ); break;    \
229   case 0: break;                            \
230   }                                         \
231                                             \
232   v3 ^= b;                                  \
233                                             \
234   SIP_ROUNDS;                               \
235                                             \
236   v0 ^= b;                                  \
237                                             \
238   v2 ^= 0xff;                               \
239                                             \
240   SIP_FINAL_ROUNDS                          \
241                                             \
242   b = v0 ^ v1 ^ v2  ^ v3;                   \
243   return (U32)(b & U32_MAX);                \
244 }
245
246 PERL_SIPHASH_FNC(
247     S_perl_hash_siphash_1_3
248     ,SIPROUND;
249     ,SIPROUND;SIPROUND;SIPROUND;
250 )
251
252 PERL_SIPHASH_FNC(
253     S_perl_hash_siphash_2_4
254     ,SIPROUND;SIPROUND;
255     ,SIPROUND;SIPROUND;SIPROUND;SIPROUND;
256 )
257
258 #endif /* defined(CAN64BITHASH) */
259
260 /* - ONE_AT_A_TIME_HARD is the 5.17+ recommend ONE_AT_A_TIME variant */
261
262 /* This is derived from the "One-at-a-Time" algorithm by Bob Jenkins
263  * from requirements by Colin Plumb.
264  * (http://burtleburtle.net/bob/hash/doobs.html)
265  * Modified by Yves Orton to increase security for Perl 5.17 and later.
266  */
267 PERL_STATIC_INLINE U32
268 S_perl_hash_one_at_a_time_hard(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
269     const unsigned char * const end = (const unsigned char *)str + len;
270     U32 hash = *((const U32*)seed) + (U32)len;
271     
272     while (str < end) {
273         hash += (hash << 10);
274         hash ^= (hash >> 6);
275         hash += *str++;
276     }
277     
278     hash += (hash << 10);
279     hash ^= (hash >> 6);
280     hash += seed[4];
281     
282     hash += (hash << 10);
283     hash ^= (hash >> 6);
284     hash += seed[5];
285     
286     hash += (hash << 10);
287     hash ^= (hash >> 6);
288     hash += seed[6];
289     
290     hash += (hash << 10);
291     hash ^= (hash >> 6);
292     hash += seed[7];
293     
294     hash += (hash << 10);
295     hash ^= (hash >> 6);
296
297     hash += (hash << 3);
298     hash ^= (hash >> 11);
299     return (hash + (hash << 15));
300 }
301
302 #ifdef CAN64BITHASH
303
304 /* Hybrid hash function
305  *
306  * For short strings, 16 bytes or shorter, we use an optimised variant
307  * of One At A Time Hard, and for longer strings, we use siphash_1_3.
308  *
309  * The optimisation of One At A Time Hard means we read the key in
310  * reverse from normal, but by doing so we avoid the loop overhead.
311  */
312 PERL_STATIC_INLINE U32
313 S_perl_hash_oaathu_siphash_1_3(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
314     U32 hash = *((const U32*)seed) + (U32)len;
315     switch (len) {
316         case 16:
317             hash += (hash << 10);
318             hash ^= (hash >> 6);
319             hash += str[15];
320         case 15:
321             hash += (hash << 10);
322             hash ^= (hash >> 6);
323             hash += str[14];
324         case 14:
325             hash += (hash << 10);
326             hash ^= (hash >> 6);
327             hash += str[13];
328         case 13:
329             hash += (hash << 10);
330             hash ^= (hash >> 6);
331             hash += str[12];
332         case 12:
333             hash += (hash << 10);
334             hash ^= (hash >> 6);
335             hash += str[11];
336         case 11:
337             hash += (hash << 10);
338             hash ^= (hash >> 6);
339             hash += str[10];
340         case 10:
341             hash += (hash << 10);
342             hash ^= (hash >> 6);
343             hash += str[9];
344         case 9:
345             hash += (hash << 10);
346             hash ^= (hash >> 6);
347             hash += str[8];
348         case 8:
349             hash += (hash << 10);
350             hash ^= (hash >> 6);
351             hash += str[7];
352         case 7:
353             hash += (hash << 10);
354             hash ^= (hash >> 6);
355             hash += str[6];
356         case 6:
357             hash += (hash << 10);
358             hash ^= (hash >> 6);
359             hash += str[5];
360         case 5:
361             hash += (hash << 10);
362             hash ^= (hash >> 6);
363             hash += str[4];
364         case 4:
365             hash += (hash << 10);
366             hash ^= (hash >> 6);
367             hash += str[3];
368         case 3:
369             hash += (hash << 10);
370             hash ^= (hash >> 6);
371             hash += str[2];
372         case 2:
373             hash += (hash << 10);
374             hash ^= (hash >> 6);
375             hash += str[1];
376         case 1:
377             hash += (hash << 10);
378             hash ^= (hash >> 6);
379             hash += str[0];
380         case 0:
381             hash += (hash << 10);
382             hash ^= (hash >> 6);
383             hash += seed[4];
384             hash += (hash << 10);
385             hash ^= (hash >> 6);
386             hash += seed[5];
387             hash += (hash << 10);
388             hash ^= (hash >> 6);
389             hash += seed[6];
390             hash += (hash << 10);
391             hash ^= (hash >> 6);
392             hash += seed[7];
393             hash += (hash << 10);
394             hash ^= (hash >> 6);
395
396             hash += (hash << 3);
397             hash ^= (hash >> 11);
398             return (hash + (hash << 15));
399     }
400     return S_perl_hash_siphash_1_3(seed+8, str, len);
401 }
402 #endif /* defined(CAN64BITHASH) */
403
404
405 #endif /*compile once*/
406
407 /*
408  * ex: set ts=8 sts=4 sw=4 et:
409  */