File Coverage

/usr/local/lib/perl5/5.26.1/x86_64-linux/CORE/hv_func.h
Criterion Covered Total %
statement 70 70 100.0
branch 2 2 100.0
condition n/a
subroutine n/a
pod n/a
total 72 72 100.0


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