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