This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove ExtUtils-Command, it is merged in EUMM now
[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
14
15#if !( 0 \
e6b54db6 16 || defined(PERL_HASH_FUNC_SIPHASH) \
4d3a042d
YO
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 23 || defined(PERL_HASH_FUNC_ONE_AT_A_TIME_OLD) \
7e0dd61b
YO
24 || defined(PERL_HASH_FUNC_MURMUR_HASH_64A) \
25 || defined(PERL_HASH_FUNC_MURMUR_HASH_64B) \
4d3a042d 26 )
b1300a73 27#define PERL_HASH_FUNC_ONE_AT_A_TIME_HARD
4d3a042d 28#endif
4d3a042d
YO
29
30#if defined(PERL_HASH_FUNC_SIPHASH)
31# define PERL_HASH_FUNC "SIPHASH_2_4"
32# define PERL_HASH_SEED_BYTES 16
3d53a8ea 33# define PERL_HASH_WITH_SEED(seed,hash,str,len) (hash)= S_perl_hash_siphash_2_4((seed),(U8*)(str),(len))
4d3a042d
YO
34#elif defined(PERL_HASH_FUNC_SUPERFAST)
35# define PERL_HASH_FUNC "SUPERFAST"
36# define PERL_HASH_SEED_BYTES 4
3d53a8ea 37# define PERL_HASH_WITH_SEED(seed,hash,str,len) (hash)= S_perl_hash_superfast((seed),(U8*)(str),(len))
4d3a042d
YO
38#elif defined(PERL_HASH_FUNC_MURMUR3)
39# define PERL_HASH_FUNC "MURMUR3"
40# define PERL_HASH_SEED_BYTES 4
3d53a8ea 41# define PERL_HASH_WITH_SEED(seed,hash,str,len) (hash)= S_perl_hash_murmur3((seed),(U8*)(str),(len))
4d3a042d
YO
42#elif defined(PERL_HASH_FUNC_DJB2)
43# define PERL_HASH_FUNC "DJB2"
44# define PERL_HASH_SEED_BYTES 4
3d53a8ea 45# define PERL_HASH_WITH_SEED(seed,hash,str,len) (hash)= S_perl_hash_djb2((seed),(U8*)(str),(len))
4d3a042d
YO
46#elif defined(PERL_HASH_FUNC_SDBM)
47# define PERL_HASH_FUNC "SDBM"
48# define PERL_HASH_SEED_BYTES 4
3d53a8ea 49# define PERL_HASH_WITH_SEED(seed,hash,str,len) (hash)= S_perl_hash_sdbm((seed),(U8*)(str),(len))
b1300a73
YO
50#elif defined(PERL_HASH_FUNC_ONE_AT_A_TIME_HARD)
51# define PERL_HASH_FUNC "ONE_AT_A_TIME_HARD"
52# define PERL_HASH_SEED_BYTES 8
3d53a8ea 53# define PERL_HASH_WITH_SEED(seed,hash,str,len) (hash)= S_perl_hash_one_at_a_time_hard((seed),(U8*)(str),(len))
4d3a042d
YO
54#elif defined(PERL_HASH_FUNC_ONE_AT_A_TIME)
55# define PERL_HASH_FUNC "ONE_AT_A_TIME"
56# define PERL_HASH_SEED_BYTES 4
3d53a8ea 57# define PERL_HASH_WITH_SEED(seed,hash,str,len) (hash)= S_perl_hash_one_at_a_time((seed),(U8*)(str),(len))
4d3a042d
YO
58#elif defined(PERL_HASH_FUNC_ONE_AT_A_TIME_OLD)
59# define PERL_HASH_FUNC "ONE_AT_A_TIME_OLD"
60# define PERL_HASH_SEED_BYTES 4
3d53a8ea 61# define PERL_HASH_WITH_SEED(seed,hash,str,len) (hash)= S_perl_hash_old_one_at_a_time((seed),(U8*)(str),(len))
7e0dd61b
YO
62#elif defined(PERL_HASH_FUNC_MURMUR_HASH_64A)
63# define PERL_HASH_FUNC "MURMUR_HASH_64A"
64# define PERL_HASH_SEED_BYTES 8
65# define PERL_HASH_WITH_SEED(seed,hash,str,len) (hash)= S_perl_hash_murmur_hash_64a((seed),(U8*)(str),(len))
66#elif defined(PERL_HASH_FUNC_MURMUR_HASH_64B)
67# define PERL_HASH_FUNC "MURMUR_HASH_64B"
68# define PERL_HASH_SEED_BYTES 8
69# define PERL_HASH_WITH_SEED(seed,hash,str,len) (hash)= S_perl_hash_murmur_hash_64b((seed),(U8*)(str),(len))
4d3a042d
YO
70#endif
71
3d53a8ea 72#ifndef PERL_HASH_WITH_SEED
4d3a042d
YO
73#error "No hash function defined!"
74#endif
75#ifndef PERL_HASH_SEED_BYTES
76#error "PERL_HASH_SEED_BYTES not defined"
77#endif
78#ifndef PERL_HASH_FUNC
79#error "PERL_HASH_FUNC not defined"
80#endif
81
82#ifndef PERL_HASH_SEED
83# if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT)
84# define PERL_HASH_SEED PL_hash_seed
85# elif PERL_HASH_SEED_BYTES == 4
86# define PERL_HASH_SEED "PeRl"
87# elif PERL_HASH_SEED_BYTES == 16
88# define PERL_HASH_SEED "PeRlHaShhAcKpErl"
89# else
90# error "No PERL_HASH_SEED definition for " PERL_HASH_FUNC
91# endif
92#endif
93
3d53a8ea
YO
94#define PERL_HASH(hash,str,len) PERL_HASH_WITH_SEED(PERL_HASH_SEED,hash,str,len)
95
4d3a042d
YO
96/*-----------------------------------------------------------------------------
97 * Endianess, misalignment capabilities and util macros
98 *
99 * The following 3 macros are defined in this section. The other macros defined
100 * are only needed to help derive these 3.
101 *
102 * U8TO32_LE(x) Read a little endian unsigned 32-bit int
8757ed9b 103 * UNALIGNED_SAFE Defined if unaligned access is safe
4d3a042d
YO
104 * ROTL32(x,r) Rotate x left by r bits
105 */
106
107#if (defined(__GNUC__) && defined(__i386__)) || defined(__WATCOMC__) \
0a35fd8a 108 || defined(_MSC_VER) || defined (__TURBOC__)
4d3a042d
YO
109#define U8TO16_LE(d) (*((const U16 *) (d)))
110#endif
111
112#if !defined (U8TO16_LE)
113#define U8TO16_LE(d) ((((const U8 *)(d))[1] << 8)\
114 +((const U8 *)(d))[0])
115#endif
116
4d3a042d
YO
117#if (BYTEORDER == 0x1234 || BYTEORDER == 0x12345678) && U32SIZE == 4
118 /* CPU endian matches murmurhash algorithm, so read 32-bit word directly */
119 #define U8TO32_LE(ptr) (*((U32*)(ptr)))
120#elif BYTEORDER == 0x4321 || BYTEORDER == 0x87654321
121 /* TODO: Add additional cases below where a compiler provided bswap32 is available */
122 #if defined(__GNUC__) && (__GNUC__>4 || (__GNUC__==4 && __GNUC_MINOR__>=3))
123 #define U8TO32_LE(ptr) (__builtin_bswap32(*((U32*)(ptr))))
124 #else
125 /* Without a known fast bswap32 we're just as well off doing this */
126 #define U8TO32_LE(ptr) (ptr[0]|ptr[1]<<8|ptr[2]<<16|ptr[3]<<24)
127 #define UNALIGNED_SAFE
128 #endif
129#else
130 /* Unknown endianess so last resort is to read individual bytes */
131 #define U8TO32_LE(ptr) (ptr[0]|ptr[1]<<8|ptr[2]<<16|ptr[3]<<24)
132 /* Since we're not doing word-reads we can skip the messing about with realignment */
133 #define UNALIGNED_SAFE
134#endif
135
b716320d
YO
136#ifdef HAS_QUAD
137#ifndef U64TYPE
138/* This probably isn't going to work, but failing with a compiler error due to
139 lack of uint64_t is no worse than failing right now with an #error. */
702c92eb 140#define U64 uint64_t
b716320d
YO
141#endif
142#endif
143
144/* Find best way to ROTL32/ROTL64 */
4d3a042d
YO
145#if defined(_MSC_VER)
146 #include <stdlib.h> /* Microsoft put _rotl declaration in here */
147 #define ROTL32(x,r) _rotl(x,r)
b716320d
YO
148 #ifdef HAS_QUAD
149 #define ROTL64(x,r) _rotl64(x,r)
150 #endif
4d3a042d
YO
151#else
152 /* gcc recognises this code and generates a rotate instruction for CPUs with one */
153 #define ROTL32(x,r) (((U32)x << r) | ((U32)x >> (32 - r)))
b716320d 154 #ifdef HAS_QUAD
702c92eb 155 #define ROTL64(x,r) (((U64)x << r) | ((U64)x >> (64 - r)))
b716320d 156 #endif
4d3a042d
YO
157#endif
158
159
b716320d
YO
160#ifdef UV_IS_QUAD
161#define ROTL_UV(x,r) ROTL64(x,r)
162#else
163#define ROTL_UV(x,r) ROTL32(x,r)
164#endif
165
4d3a042d
YO
166/* This is SipHash by Jean-Philippe Aumasson and Daniel J. Bernstein.
167 * The authors claim it is relatively secure compared to the alternatives
168 * and that performance wise it is a suitable hash for languages like Perl.
169 * See:
170 *
171 * https://www.131002.net/siphash/
172 *
173 * This implementation seems to perform slightly slower than one-at-a-time for
174 * short keys, but degrades slower for longer keys. Murmur Hash outperforms it
175 * regardless of keys size.
176 *
177 * It is 64 bit only.
178 */
179
180#ifdef HAS_QUAD
181
4d3a042d 182#define U8TO64_LE(p) \
702c92eb
JH
183 (((U64)((p)[0]) ) | \
184 ((U64)((p)[1]) << 8) | \
185 ((U64)((p)[2]) << 16) | \
186 ((U64)((p)[3]) << 24) | \
187 ((U64)((p)[4]) << 32) | \
188 ((U64)((p)[5]) << 40) | \
189 ((U64)((p)[6]) << 48) | \
190 ((U64)((p)[7]) << 56))
4d3a042d
YO
191
192#define SIPROUND \
193 do { \
194 v0 += v1; v1=ROTL64(v1,13); v1 ^= v0; v0=ROTL64(v0,32); \
195 v2 += v3; v3=ROTL64(v3,16); v3 ^= v2; \
196 v0 += v3; v3=ROTL64(v3,21); v3 ^= v0; \
197 v2 += v1; v1=ROTL64(v1,17); v1 ^= v2; v2=ROTL64(v2,32); \
198 } while(0)
199
200/* SipHash-2-4 */
201
202PERL_STATIC_INLINE U32
203S_perl_hash_siphash_2_4(const unsigned char * const seed, const unsigned char *in, const STRLEN inlen) {
204 /* "somepseudorandomlygeneratedbytes" */
702c92eb
JH
205 U64 v0 = UINT64_C(0x736f6d6570736575);
206 U64 v1 = UINT64_C(0x646f72616e646f6d);
207 U64 v2 = UINT64_C(0x6c7967656e657261);
208 U64 v3 = UINT64_C(0x7465646279746573);
209
210 U64 b;
211 U64 k0 = ((U64*)seed)[0];
212 U64 k1 = ((U64*)seed)[1];
213 U64 m;
4d3a042d
YO
214 const int left = inlen & 7;
215 const U8 *end = in + inlen - left;
216
702c92eb 217 b = ( ( U64 )(inlen) ) << 56;
4d3a042d
YO
218 v3 ^= k1;
219 v2 ^= k0;
220 v1 ^= k1;
221 v0 ^= k0;
222
223 for ( ; in != end; in += 8 )
224 {
225 m = U8TO64_LE( in );
226 v3 ^= m;
227 SIPROUND;
228 SIPROUND;
229 v0 ^= m;
230 }
231
232 switch( left )
233 {
702c92eb
JH
234 case 7: b |= ( ( U64 )in[ 6] ) << 48;
235 case 6: b |= ( ( U64 )in[ 5] ) << 40;
236 case 5: b |= ( ( U64 )in[ 4] ) << 32;
237 case 4: b |= ( ( U64 )in[ 3] ) << 24;
238 case 3: b |= ( ( U64 )in[ 2] ) << 16;
239 case 2: b |= ( ( U64 )in[ 1] ) << 8;
240 case 1: b |= ( ( U64 )in[ 0] ); break;
4d3a042d
YO
241 case 0: break;
242 }
243
244 v3 ^= b;
245 SIPROUND;
246 SIPROUND;
247 v0 ^= b;
248
249 v2 ^= 0xff;
250 SIPROUND;
251 SIPROUND;
252 SIPROUND;
253 SIPROUND;
254 b = v0 ^ v1 ^ v2 ^ v3;
255 return (U32)(b & U32_MAX);
256}
257#endif /* defined(HAS_QUAD) */
258
259/* FYI: This is the "Super-Fast" algorithm mentioned by Bob Jenkins in
260 * (http://burtleburtle.net/bob/hash/doobs.html)
261 * It is by Paul Hsieh (c) 2004 and is analysed here
262 * http://www.azillionmonkeys.com/qed/hash.html
263 * license terms are here:
264 * http://www.azillionmonkeys.com/qed/weblicense.html
265 */
266
3efdcc9c 267
4d3a042d
YO
268PERL_STATIC_INLINE U32
269S_perl_hash_superfast(const unsigned char * const seed, const unsigned char *str, STRLEN len) {
b4045391 270 U32 hash = *((U32*)seed) + (U32)len;
4d3a042d
YO
271 U32 tmp;
272 int rem= len & 3;
273 len >>= 2;
274
275 for (;len > 0; len--) {
276 hash += U8TO16_LE (str);
277 tmp = (U8TO16_LE (str+2) << 11) ^ hash;
278 hash = (hash << 16) ^ tmp;
279 str += 2 * sizeof (U16);
280 hash += hash >> 11;
281 }
282
283 /* Handle end cases */
284 switch (rem) { \
285 case 3: hash += U8TO16_LE (str);
286 hash ^= hash << 16;
287 hash ^= str[sizeof (U16)] << 18;
288 hash += hash >> 11;
289 break;
290 case 2: hash += U8TO16_LE (str);
291 hash ^= hash << 11;
292 hash += hash >> 17;
293 break;
294 case 1: hash += *str;
295 hash ^= hash << 10;
296 hash += hash >> 1;
297 }
298 /* Force "avalanching" of final 127 bits */
299 hash ^= hash << 3;
300 hash += hash >> 5;
301 hash ^= hash << 4;
302 hash += hash >> 17;
303 hash ^= hash << 25;
304 return (hash + (hash >> 6));
305}
3efdcc9c 306
4d3a042d
YO
307
308/*-----------------------------------------------------------------------------
309 * MurmurHash3 was written by Austin Appleby, and is placed in the public
310 * domain.
311 *
312 * This implementation was originally written by Shane Day, and is also public domain,
313 * and was modified to function as a macro similar to other perl hash functions by
314 * Yves Orton.
315 *
316 * This is a portable ANSI C implementation of MurmurHash3_x86_32 (Murmur3A)
317 * with support for progressive processing.
318 *
319 * If you want to understand the MurmurHash algorithm you would be much better
320 * off reading the original source. Just point your browser at:
321 * http://code.google.com/p/smhasher/source/browse/trunk/MurmurHash3.cpp
322 *
323 * How does it work?
324 *
325 * We can only process entire 32 bit chunks of input, except for the very end
326 * that may be shorter.
327 *
328 * To handle endianess I simply use a macro that reads a U32 and define
329 * that macro to be a direct read on little endian machines, a read and swap
330 * on big endian machines, or a byte-by-byte read if the endianess is unknown.
331 */
332
3efdcc9c 333
4d3a042d
YO
334/*-----------------------------------------------------------------------------
335 * Core murmurhash algorithm macros */
336
337#define MURMUR_C1 (0xcc9e2d51)
338#define MURMUR_C2 (0x1b873593)
339#define MURMUR_C3 (0xe6546b64)
340#define MURMUR_C4 (0x85ebca6b)
341#define MURMUR_C5 (0xc2b2ae35)
342
343/* This is the main processing body of the algorithm. It operates
344 * on each full 32-bits of input. */
345#define MURMUR_DOBLOCK(h1, k1) STMT_START { \
346 k1 *= MURMUR_C1; \
347 k1 = ROTL32(k1,15); \
348 k1 *= MURMUR_C2; \
349 \
350 h1 ^= k1; \
351 h1 = ROTL32(h1,13); \
352 h1 = h1 * 5 + MURMUR_C3; \
353} STMT_END
354
355
356/* Append unaligned bytes to carry, forcing hash churn if we have 4 bytes */
357/* cnt=bytes to process, h1=name of h1 var, c=carry, n=bytes in c, ptr/len=payload */
358#define MURMUR_DOBYTES(cnt, h1, c, n, ptr, len) STMT_START { \
359 int MURMUR_DOBYTES_i = cnt; \
360 while(MURMUR_DOBYTES_i--) { \
361 c = c>>8 | *ptr++<<24; \
362 n++; len--; \
363 if(n==4) { \
364 MURMUR_DOBLOCK(h1, c); \
365 n = 0; \
366 } \
367 } \
368} STMT_END
369
370
371/* now we create the hash function */
372PERL_STATIC_INLINE U32
373S_perl_hash_murmur3(const unsigned char * const seed, const unsigned char *ptr, STRLEN len) {
374 U32 h1 = *((U32*)seed);
375 U32 k1;
376 U32 carry = 0;
377
378 const unsigned char *end;
379 int bytes_in_carry = 0; /* bytes in carry */
b4045391 380 I32 total_length= (I32)len;
4d3a042d
YO
381
382#if defined(UNALIGNED_SAFE)
383 /* Handle carry: commented out as its only used in incremental mode - it never fires for us
384 int i = (4-n) & 3;
385 if(i && i <= len) {
386 MURMUR_DOBYTES(i, h1, carry, bytes_in_carry, ptr, len);
387 }
388 */
389
390 /* This CPU handles unaligned word access */
391 /* Process 32-bit chunks */
392 end = ptr + len/4*4;
393 for( ; ptr < end ; ptr+=4) {
394 k1 = U8TO32_LE(ptr);
395 MURMUR_DOBLOCK(h1, k1);
396 }
397#else
398 /* This CPU does not handle unaligned word access */
399
400 /* Consume enough so that the next data byte is word aligned */
c8523631
RB
401 STRLEN i = -PTR2IV(ptr) & 3;
402 if(i && i <= len) {
b4045391 403 MURMUR_DOBYTES((int)i, h1, carry, bytes_in_carry, ptr, len);
4d3a042d
YO
404 }
405
406 /* We're now aligned. Process in aligned blocks. Specialise for each possible carry count */
407 end = ptr + len/4*4;
408 switch(bytes_in_carry) { /* how many bytes in carry */
409 case 0: /* c=[----] w=[3210] b=[3210]=w c'=[----] */
410 for( ; ptr < end ; ptr+=4) {
411 k1 = U8TO32_LE(ptr);
412 MURMUR_DOBLOCK(h1, k1);
413 }
414 break;
415 case 1: /* c=[0---] w=[4321] b=[3210]=c>>24|w<<8 c'=[4---] */
416 for( ; ptr < end ; ptr+=4) {
417 k1 = carry>>24;
418 carry = U8TO32_LE(ptr);
419 k1 |= carry<<8;
420 MURMUR_DOBLOCK(h1, k1);
421 }
422 break;
423 case 2: /* c=[10--] w=[5432] b=[3210]=c>>16|w<<16 c'=[54--] */
424 for( ; ptr < end ; ptr+=4) {
425 k1 = carry>>16;
426 carry = U8TO32_LE(ptr);
427 k1 |= carry<<16;
428 MURMUR_DOBLOCK(h1, k1);
429 }
430 break;
431 case 3: /* c=[210-] w=[6543] b=[3210]=c>>8|w<<24 c'=[654-] */
432 for( ; ptr < end ; ptr+=4) {
433 k1 = carry>>8;
434 carry = U8TO32_LE(ptr);
435 k1 |= carry<<24;
436 MURMUR_DOBLOCK(h1, k1);
437 }
438 }
439#endif
440 /* Advance over whole 32-bit chunks, possibly leaving 1..3 bytes */
441 len -= len/4*4;
442
443 /* Append any remaining bytes into carry */
b4045391 444 MURMUR_DOBYTES((int)len, h1, carry, bytes_in_carry, ptr, len);
4d3a042d
YO
445
446 if (bytes_in_carry) {
447 k1 = carry >> ( 4 - bytes_in_carry ) * 8;
448 k1 *= MURMUR_C1;
449 k1 = ROTL32(k1,15);
450 k1 *= MURMUR_C2;
451 h1 ^= k1;
452 }
453 h1 ^= total_length;
454
455 /* fmix */
456 h1 ^= h1 >> 16;
457 h1 *= MURMUR_C4;
458 h1 ^= h1 >> 13;
459 h1 *= MURMUR_C5;
460 h1 ^= h1 >> 16;
461 return h1;
462}
463
3efdcc9c 464
4d3a042d
YO
465PERL_STATIC_INLINE U32
466S_perl_hash_djb2(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
467 const unsigned char * const end = (const unsigned char *)str + len;
b4045391 468 U32 hash = *((U32*)seed) + (U32)len;
4d3a042d
YO
469 while (str < end) {
470 hash = ((hash << 5) + hash) + *str++;
471 }
472 return hash;
473}
474
475PERL_STATIC_INLINE U32
476S_perl_hash_sdbm(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
477 const unsigned char * const end = (const unsigned char *)str + len;
b4045391 478 U32 hash = *((U32*)seed) + (U32)len;
4d3a042d
YO
479 while (str < end) {
480 hash = (hash << 6) + (hash << 16) - hash + *str++;
481 }
482 return hash;
483}
484
fab3d107
DD
485/* - ONE_AT_A_TIME_HARD is the 5.17+ recommend ONE_AT_A_TIME algorithm
486 * - ONE_AT_A_TIME_OLD is the unmodified 5.16 and older algorithm
487 * - ONE_AT_A_TIME is a 5.17+ tweak of ONE_AT_A_TIME_OLD to
488 * prevent strings of only \0 but different lengths from colliding
489 *
490 * Security-wise, from best to worst,
491 * ONE_AT_A_TIME_HARD > ONE_AT_A_TIME > ONE_AT_A_TIME_OLD
492 * There is a big drop-off in security between ONE_AT_A_TIME_HARD and
493 * ONE_AT_A_TIME
494 * */
4d3a042d 495
b1300a73 496/* This is the "One-at-a-Time" algorithm by Bob Jenkins
4d3a042d 497 * from requirements by Colin Plumb.
b1300a73
YO
498 * (http://burtleburtle.net/bob/hash/doobs.html)
499 * With seed/len tweak.
500 * */
4d3a042d
YO
501PERL_STATIC_INLINE U32
502S_perl_hash_one_at_a_time(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
503 const unsigned char * const end = (const unsigned char *)str + len;
b4045391 504 U32 hash = *((U32*)seed) + (U32)len;
4d3a042d
YO
505 while (str < end) {
506 hash += *str++;
507 hash += (hash << 10);
508 hash ^= (hash >> 6);
509 }
510 hash += (hash << 3);
511 hash ^= (hash >> 11);
512 return (hash + (hash << 15));
513}
514
b1300a73
YO
515/* Derived from "One-at-a-Time" algorithm by Bob Jenkins */
516PERL_STATIC_INLINE U32
517S_perl_hash_one_at_a_time_hard(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
518 const unsigned char * const end = (const unsigned char *)str + len;
b4045391 519 U32 hash = *((U32*)seed) + (U32)len;
b1300a73
YO
520
521 while (str < end) {
522 hash += (hash << 10);
523 hash ^= (hash >> 6);
524 hash += *str++;
525 }
526
527 hash += (hash << 10);
528 hash ^= (hash >> 6);
529 hash += seed[4];
530
531 hash += (hash << 10);
532 hash ^= (hash >> 6);
533 hash += seed[5];
534
535 hash += (hash << 10);
536 hash ^= (hash >> 6);
537 hash += seed[6];
538
539 hash += (hash << 10);
540 hash ^= (hash >> 6);
541 hash += seed[7];
542
543 hash += (hash << 10);
544 hash ^= (hash >> 6);
545
546 hash += (hash << 3);
547 hash ^= (hash >> 11);
548 return (hash + (hash << 15));
549}
550
4d3a042d
YO
551PERL_STATIC_INLINE U32
552S_perl_hash_old_one_at_a_time(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
553 const unsigned char * const end = (const unsigned char *)str + len;
554 U32 hash = *((U32*)seed);
555 while (str < end) {
556 hash += *str++;
557 hash += (hash << 10);
558 hash ^= (hash >> 6);
559 }
560 hash += (hash << 3);
561 hash ^= (hash >> 11);
562 return (hash + (hash << 15));
563}
564
7e0dd61b
YO
565#ifdef PERL_HASH_FUNC_MURMUR_HASH_64A
566/* This code is from Austin Appleby and is in the public domain.
567 Altered by Yves Orton to match Perl's hash interface, and to
568 return a 32 bit hash.
569
570 Note uses unaligned 64 bit loads - will NOT work on machines with
21ac16fe 571 strict alignment requirements.
7e0dd61b
YO
572
573 Also this code may not be suitable for big-endian machines.
574*/
575
576/* a 64 bit hash where we only use the low 32 bits */
577PERL_STATIC_INLINE U32
578S_perl_hash_murmur_hash_64a (const unsigned char * const seed, const unsigned char *str, const STRLEN len)
579{
702c92eb 580 const U64 m = UINT64_C(0xc6a4a7935bd1e995);
7e0dd61b 581 const int r = 47;
702c92eb
JH
582 U64 h = *((U64*)seed) ^ len;
583 const U64 * data = (const U64 *)str;
584 const U64 * end = data + (len/8);
7e0dd61b
YO
585 const unsigned char * data2;
586
587 while(data != end)
588 {
702c92eb 589 U64 k = *data++;
7e0dd61b
YO
590
591 k *= m;
592 k ^= k >> r;
593 k *= m;
594
595 h ^= k;
596 h *= m;
597 }
598
599 data2 = (const unsigned char *)data;
600
601 switch(len & 7)
602 {
702c92eb
JH
603 case 7: h ^= (U64)(data2[6]) << 48; /* fallthrough */
604 case 6: h ^= (U64)(data2[5]) << 40; /* fallthrough */
605 case 5: h ^= (U64)(data2[4]) << 32; /* fallthrough */
606 case 4: h ^= (U64)(data2[3]) << 24; /* fallthrough */
607 case 3: h ^= (U64)(data2[2]) << 16; /* fallthrough */
608 case 2: h ^= (U64)(data2[1]) << 8; /* fallthrough */
609 case 1: h ^= (U64)(data2[0]); /* fallthrough */
7e0dd61b
YO
610 h *= m;
611 };
612
613 h ^= h >> r;
614 h *= m;
615 h ^= h >> r;
616
617 /* was: return h; */
618 return h & 0xFFFFFFFF;
619}
620
621#endif
622
623#ifdef PERL_HASH_FUNC_MURMUR_HASH_64B
624/* This code is from Austin Appleby and is in the public domain.
625 Altered by Yves Orton to match Perl's hash interface and return
626 a 32 bit value
627
628 Note uses unaligned 32 bit loads - will NOT work on machines with
21ac16fe 629 strict alignment requirements.
7e0dd61b
YO
630
631 Also this code may not be suitable for big-endian machines.
632*/
633
634/* a 64-bit hash for 32-bit platforms where we only use the low 32 bits */
635PERL_STATIC_INLINE U32
636S_perl_hash_murmur_hash_64b (const unsigned char * const seed, const unsigned char *str, STRLEN len)
637{
638 const U32 m = 0x5bd1e995;
639 const int r = 24;
640
641 U32 h1 = ((U32 *)seed)[0] ^ len;
642 U32 h2 = ((U32 *)seed)[1];
643
644 const U32 * data = (const U32 *)str;
645
646 while(len >= 8)
647 {
648 U32 k1, k2;
649 k1 = *data++;
650 k1 *= m; k1 ^= k1 >> r; k1 *= m;
651 h1 *= m; h1 ^= k1;
652 len -= 4;
653
654 k2 = *data++;
655 k2 *= m; k2 ^= k2 >> r; k2 *= m;
656 h2 *= m; h2 ^= k2;
657 len -= 4;
658 }
659
660 if(len >= 4)
661 {
662 U32 k1 = *data++;
663 k1 *= m; k1 ^= k1 >> r; k1 *= m;
664 h1 *= m; h1 ^= k1;
665 len -= 4;
666 }
667
668 switch(len)
669 {
670 case 3: h2 ^= ((unsigned char*)data)[2] << 16; /* fallthrough */
671 case 2: h2 ^= ((unsigned char*)data)[1] << 8; /* fallthrough */
672 case 1: h2 ^= ((unsigned char*)data)[0]; /* fallthrough */
673 h2 *= m;
674 };
675
676 h1 ^= h2 >> 18; h1 *= m;
677 h2 ^= h1 >> 22; h2 *= m;
678 /*
679 The following code has been removed as it is unused
680 when only the low 32 bits are used. -- Yves
681
682 h1 ^= h2 >> 17; h1 *= m;
683
702c92eb 684 U64 h = h1;
7e0dd61b
YO
685
686 h = (h << 32) | h2;
687 */
688
689 return h2;
690}
691#endif
692
4d3a042d
YO
693/* legacy - only mod_perl should be doing this. */
694#ifdef PERL_HASH_INTERNAL_ACCESS
695#define PERL_HASH_INTERNAL(hash,str,len) PERL_HASH(hash,str,len)
696#endif
697
698#endif /*compile once*/
699
700/*
4d3a042d
YO
701 * ex: set ts=8 sts=4 sw=4 et:
702 */