This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Revert "Move utility macros to their own file"
[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
3f023586
YO
7 * If USE_HASH_SEED_EXPLICIT is defined, hash randomisation is done
8 * only if the environment variable PERL_HASH_SEED is set.
4d3a042d
YO
9 * (see also perl.c:perl_parse() and S_init_tls_and_interp() and util.c:get_hash_seed())
10 */
3f023586 11
4d3a042d
YO
12#ifndef PERL_SEEN_HV_FUNC_H /* compile once */
13#define PERL_SEEN_HV_FUNC_H
3f023586
YO
14
15#if IVSIZE == 8
16#define CAN64BITHASH
17#endif
18
19/*-----------------------------------------------------------------------------
20 * Endianess, misalignment capabilities and util macros
21 *
22 * The following 3 macros are defined in this section. The other macros defined
23 * are only needed to help derive these 3.
24 *
25 * U8TO16_LE(x) Read a little endian unsigned 32-bit int
26 * U8TO32_LE(x) Read a little endian unsigned 32-bit int
27 * U8TO28_LE(x) Read a little endian unsigned 32-bit int
28 * ROTL32(x,r) Rotate x left by r bits
29 * ROTL64(x,r) Rotate x left by r bits
30 * ROTR32(x,r) Rotate x right by r bits
31 * ROTR64(x,r) Rotate x right by r bits
32 */
33
34#ifndef U32_ALIGNMENT_REQUIRED
35 #if (BYTEORDER == 0x1234 || BYTEORDER == 0x12345678)
36 #define U8TO16_LE(ptr) (*((const U16*)(ptr)))
37 #define U8TO32_LE(ptr) (*((const U32*)(ptr)))
38 #define U8TO64_LE(ptr) (*((const U64*)(ptr)))
39 #elif (BYTEORDER == 0x4321 || BYTEORDER == 0x87654321)
40 #if defined(__GNUC__) && (__GNUC__>4 || (__GNUC__==4 && __GNUC_MINOR__>=3))
41 #define U8TO16_LE(ptr) (__builtin_bswap16(*((U16*)(ptr))))
42 #define U8TO32_LE(ptr) (__builtin_bswap32(*((U32*)(ptr))))
43 #define U8TO64_LE(ptr) (__builtin_bswap64(*((U64*)(ptr))))
44 #endif
45 #endif
46#endif
47
48#ifndef U8TO16_LE
49 /* Without a known fast bswap32 we're just as well off doing this */
50 #define U8TO16_LE(ptr) ((U32)(ptr)[0]|(U32)(ptr)[1]<<8)
51 #define U8TO32_LE(ptr) ((U32)(ptr)[0]|(U32)(ptr)[1]<<8|(U32)(ptr)[2]<<16|(U32)(ptr)[3]<<24)
52 #define U8TO64_LE(ptr) ((U64)(ptr)[0]|(U64)(ptr)[1]<<8|(U64)(ptr)[2]<<16|(U64)(ptr)[3]<<24|\
53 (U64)(ptr)[4]<<32|(U64)(ptr)[5]<<40|\
54 (U64)(ptr)[6]<<48|(U64)(ptr)[7]<<56)
55#endif
56
57#ifdef CAN64BITHASH
58 #ifndef U64TYPE
59 /* This probably isn't going to work, but failing with a compiler error due to
60 lack of uint64_t is no worse than failing right now with an #error. */
61 #define U64 uint64_t
62 #endif
63#endif
64
65/* Find best way to ROTL32/ROTL64 */
66#if defined(_MSC_VER)
67 #include <stdlib.h> /* Microsoft put _rotl declaration in here */
68 #define ROTL32(x,r) _rotl(x,r)
69 #define ROTR32(x,r) _rotr(x,r)
70 #define ROTL64(x,r) _rotl64(x,r)
71 #define ROTR64(x,r) _rotr64(x,r)
72#else
73 /* gcc recognises this code and generates a rotate instruction for CPUs with one */
74 #define ROTL32(x,r) (((U32)(x) << (r)) | ((U32)(x) >> (32 - (r))))
75 #define ROTR32(x,r) (((U32)(x) << (32 - (r))) | ((U32)(x) >> (r)))
76 #define ROTL64(x,r) ( ( (U64)(x) << (r) ) | ( (U64)(x) >> ( 64 - (r) ) ) )
77 #define ROTR64(x,r) ( ( (U64)(x) << ( 64 - (r) ) ) | ( (U64)(x) >> (r) ) )
78#endif
79
80
81#ifdef UV_IS_QUAD
82#define ROTL_UV(x,r) ROTL64(x,r)
83#define ROTR_UV(x,r) ROTL64(x,r)
84#else
85#define ROTL_UV(x,r) ROTL32(x,r)
86#define ROTR_UV(x,r) ROTR32(x,r)
87#endif
88
89/*-----------------------------------------------------------------------------*
90 * And now set up the actual hashing macros
91 *-----------------------------------------------------------------------------*/
92#define PERL_HASH_FUNC_ZAPHOD32
a3bf60fb
YO
93
94#if !( 0 \
95 || defined(PERL_HASH_FUNC_SIPHASH) \
96 || defined(PERL_HASH_FUNC_SIPHASH13) \
97 || defined(PERL_HASH_FUNC_STADTX) \
98 || defined(PERL_HASH_FUNC_ZAPHOD32) \
99 )
100# ifdef CAN64BITHASH
101# define PERL_HASH_FUNC_STADTX
102# else
103# define PERL_HASH_FUNC_ZAPHOD32
104# endif
105#endif
106
107#ifndef PERL_HASH_USE_SBOX32_ALSO
108#define PERL_HASH_USE_SBOX32_ALSO 1
109#endif
110
111#ifndef SBOX32_MAX_LEN
112#define SBOX32_MAX_LEN 24
113#endif
114
115/* this must be after the SBOX32_MAX_LEN define */
116#include "sbox32_hash.h"
117
118#if defined(PERL_HASH_FUNC_SIPHASH)
119# define __PERL_HASH_FUNC "SIPHASH_2_4"
120# define __PERL_HASH_SEED_BYTES 16
121# define __PERL_HASH_STATE_BYTES 32
122# define __PERL_HASH_SEED_STATE(seed,state) S_perl_siphash_seed_state(seed,state)
123# define __PERL_HASH_WITH_STATE(state,str,len) S_perl_hash_siphash_2_4_with_state((state),(U8*)(str),(len))
124#elif defined(PERL_HASH_FUNC_SIPHASH13)
125# define __PERL_HASH_FUNC "SIPHASH_1_3"
126# define __PERL_HASH_SEED_BYTES 16
127# define __PERL_HASH_STATE_BYTES 32
128# define __PERL_HASH_SEED_STATE(seed,state) S_perl_siphash_seed_state(seed,state)
129# define __PERL_HASH_WITH_STATE(state,str,len) S_perl_hash_siphash_1_3_with_state((state),(U8*)(str),(len))
130#elif defined(PERL_HASH_FUNC_STADTX)
131# define __PERL_HASH_FUNC "STATDX"
132# define __PERL_HASH_SEED_BYTES 16
133# define __PERL_HASH_STATE_BYTES 32
134# define __PERL_HASH_SEED_STATE(seed,state) stadtx_seed_state(seed,state)
135# define __PERL_HASH_WITH_STATE(state,str,len) (U32)stadtx_hash_with_state((state),(U8*)(str),(len))
136# include "stadtx_hash.h"
137#elif defined(PERL_HASH_FUNC_ZAPHOD32)
138# define __PERL_HASH_FUNC "ZAPHOD32"
139# define __PERL_HASH_SEED_BYTES 12
140# define __PERL_HASH_STATE_BYTES 12
141# define __PERL_HASH_SEED_STATE(seed,state) zaphod32_seed_state(seed,state)
142# define __PERL_HASH_WITH_STATE(state,str,len) (U32)zaphod32_hash_with_state((state),(U8*)(str),(len))
143# include "zaphod32_hash.h"
144#endif
145
146#ifndef __PERL_HASH_WITH_STATE
147#error "No hash function defined!"
148#endif
149#ifndef __PERL_HASH_SEED_BYTES
150#error "__PERL_HASH_SEED_BYTES not defined"
151#endif
152#ifndef __PERL_HASH_FUNC
153#error "__PERL_HASH_FUNC not defined"
154#endif
155
156
157#if PERL_HASH_USE_SBOX32_ALSO == 1
158# define _PERL_HASH_FUNC __PERL_HASH_FUNC
159# define _PERL_HASH_SEED_BYTES __PERL_HASH_SEED_BYTES
160# define _PERL_HASH_STATE_BYTES __PERL_HASH_STATE_BYTES
161# define _PERL_HASH_SEED_STATE(seed,state) __PERL_HASH_SEED_STATE(seed,state)
162# define _PERL_HASH_WITH_STATE(state,str,len) __PERL_HASH_WITH_STATE(state,str,len)
163#else
164
165#define _PERL_HASH_FUNC "SBOX32_WITH_" __PERL_HASH_FUNC
166
167#define _PERL_HASH_SEED_BYTES ( __PERL_HASH_SEED_BYTES + ( 3 * sizeof(U32) ) )
168
169#define _PERL_HASH_STATE_BYTES \
170 ( __PERL_HASH_SEED_BYTES + ( ( 1 + ( 256 * SBOX32_MAX_LEN ) ) * sizeof(U32) ) )
171
172#define _PERL_HASH_SEED_STATE(seed,state) STMT_START { \
173 __PERL_HASH_SEED_STATE(seed,state); \
174 sbox32_seed_state96(seed + __PERL_HASH_SEED_BYTES , state + __PERL_HASH_STATE_BYTES); \
175} STMT_END
176
177#define _PERL_HASH_WITH_STATE(state,str,len) \
178 ((len <= SBOX32_MAX_LEN) \
179 ? sbox32_hash_with_state((state + __PERL_HASH_STATE_BYTES),(U8*)(str),(len)) \
180 : __PERL_HASH_WITH_STATE((state),(str),(len)))
181
182#endif
183
184PERL_STATIC_INLINE
185U32 S_perl_hash_with_seed(const U8 * const seed, const U8 * const str, const STRLEN len)
186{
187 U8 state[_PERL_HASH_STATE_BYTES];
188 _PERL_HASH_SEED_STATE(seed,state);
189 return _PERL_HASH_WITH_STATE(state,str,len);
190}
191
192#define PERL_HASH_WITH_SEED(seed,hash,str,len) \
193 (hash) = S_perl_hash_with_seed(seed,str,len)
194#define PERL_HASH_WITH_STATE(state,hash,str,len) \
195 (hash) = _PERL_HASH_WITH_STATE((state),(U8*)(str),(len))
196#define PERL_HASH_SEED_STATE(seed,state) _PERL_HASH_SEED_STATE(seed,state)
197#define PERL_HASH_SEED_BYTES _PERL_HASH_SEED_BYTES
198#define PERL_HASH_STATE_BYTES _PERL_HASH_STATE_BYTES
199#define PERL_HASH_FUNC _PERL_HASH_FUNC
200
201#ifdef PERL_USE_SINGLE_CHAR_HASH_CACHE
202#define PERL_HASH(state,str,len) \
203 (hash) = ((len) < 2 ? ( (len) == 0 ? PL_hash_chars[256] : PL_hash_chars[(U8)(str)[0]] ) \
204 : _PERL_HASH_WITH_STATE(PL_hash_state,(U8*)(str),(len)))
205#else
206#define PERL_HASH(hash,str,len) \
207 PERL_HASH_WITH_STATE(PL_hash_state,hash,(U8*)(str),(len))
208#endif
209
210/* Setup the hash seed, either we do things dynamically at start up,
211 * including reading from the environment, or we randomly setup the
212 * seed. The seed will be passed into the PERL_HASH_SEED_STATE() function
213 * defined for the configuration defined for this perl, which will then
214 * initialze whatever state it might need later in hashing. */
215
216#ifndef PERL_HASH_SEED
eba287cb 217# if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT)
a3bf60fb
YO
218# define PERL_HASH_SEED PL_hash_seed
219# else
220 /* this is a 512 bit seed, which should be more than enough for the
221 * configuration of any of our hash functions (with or without sbox).
222 * If you actually use a hard coded seed, you are strongly encouraged
223 * to replace this with something else of the correct length
224 * for the hash function you are using (24-32 bytes depending on build
225 * options). Repeat, you are *STRONGLY* encouraged not to use the value
226 * provided here.
227 */
228# define PERL_HASH_SEED \
229 ((const U8 *)"A long string of pseudorandomly " \
230 "chosen bytes for hashing in Perl")
231# endif
232#endif
233
234/* legacy - only mod_perl should be doing this. */
235#ifdef PERL_HASH_INTERNAL_ACCESS
236#define PERL_HASH_INTERNAL(hash,str,len) PERL_HASH(hash,str,len)
b716320d
YO
237#endif
238
4d3a042d
YO
239/* This is SipHash by Jean-Philippe Aumasson and Daniel J. Bernstein.
240 * The authors claim it is relatively secure compared to the alternatives
241 * and that performance wise it is a suitable hash for languages like Perl.
242 * See:
243 *
244 * https://www.131002.net/siphash/
245 *
246 * This implementation seems to perform slightly slower than one-at-a-time for
247 * short keys, but degrades slower for longer keys. Murmur Hash outperforms it
248 * regardless of keys size.
249 *
250 * It is 64 bit only.
251 */
252
a4283faf 253#ifdef CAN64BITHASH
4d3a042d 254
4d3a042d 255#define SIPROUND \
6b026047 256 STMT_START { \
4d3a042d
YO
257 v0 += v1; v1=ROTL64(v1,13); v1 ^= v0; v0=ROTL64(v0,32); \
258 v2 += v3; v3=ROTL64(v3,16); v3 ^= v2; \
259 v0 += v3; v3=ROTL64(v3,21); v3 ^= v0; \
260 v2 += v1; v1=ROTL64(v1,17); v1 ^= v2; v2=ROTL64(v2,32); \
6b026047 261 } STMT_END
4d3a042d 262
a3bf60fb
YO
263#define SIPHASH_SEED_STATE(key,v0,v1,v2,v3) \
264do { \
265 v0 = v2 = U8TO64_LE(key + 0); \
266 v1 = v3 = U8TO64_LE(key + 8); \
267 /* "somepseudorandomlygeneratedbytes" */ \
268 v0 ^= 0x736f6d6570736575ull; \
269 v1 ^= 0x646f72616e646f6dull; \
270 v2 ^= 0x6c7967656e657261ull; \
271 v3 ^= 0x7465646279746573ull; \
272} while (0)
273
274PERL_STATIC_INLINE
275void S_perl_siphash_seed_state(const unsigned char * const seed_buf, unsigned char * state_buf) {
276 U64 *v= (U64*) state_buf;
277 SIPHASH_SEED_STATE(seed_buf, v[0],v[1],v[2],v[3]);
278}
6b026047
YO
279
280#define PERL_SIPHASH_FNC(FNC,SIP_ROUNDS,SIP_FINAL_ROUNDS) \
281PERL_STATIC_INLINE U32 \
a3bf60fb
YO
282FNC ## _with_state \
283 (const unsigned char * const state, const unsigned char *in, const STRLEN inlen) \
284{ \
6b026047
YO
285 const int left = inlen & 7; \
286 const U8 *end = in + inlen - left; \
287 \
a3bf60fb
YO
288 U64 b = ( ( U64 )(inlen) ) << 56; \
289 U64 m; \
290 U64 v0 = U8TO64_LE(state); \
291 U64 v1 = U8TO64_LE(state+8); \
292 U64 v2 = U8TO64_LE(state+16); \
293 U64 v3 = U8TO64_LE(state+24); \
6b026047
YO
294 \
295 for ( ; in != end; in += 8 ) \
296 { \
297 m = U8TO64_LE( in ); \
298 v3 ^= m; \
299 \
300 SIP_ROUNDS; \
301 \
302 v0 ^= m; \
303 } \
304 \
305 switch( left ) \
306 { \
307 case 7: b |= ( ( U64 )in[ 6] ) << 48; \
308 case 6: b |= ( ( U64 )in[ 5] ) << 40; \
309 case 5: b |= ( ( U64 )in[ 4] ) << 32; \
310 case 4: b |= ( ( U64 )in[ 3] ) << 24; \
311 case 3: b |= ( ( U64 )in[ 2] ) << 16; \
312 case 2: b |= ( ( U64 )in[ 1] ) << 8; \
313 case 1: b |= ( ( U64 )in[ 0] ); break; \
314 case 0: break; \
315 } \
316 \
317 v3 ^= b; \
318 \
319 SIP_ROUNDS; \
320 \
321 v0 ^= b; \
322 \
323 v2 ^= 0xff; \
324 \
325 SIP_FINAL_ROUNDS \
326 \
327 b = v0 ^ v1 ^ v2 ^ v3; \
328 return (U32)(b & U32_MAX); \
a3bf60fb
YO
329} \
330 \
331PERL_STATIC_INLINE U32 \
332FNC (const unsigned char * const seed, const unsigned char *in, const STRLEN inlen) \
333{ \
334 U64 state[4]; \
335 SIPHASH_SEED_STATE(seed,state[0],state[1],state[2],state[3]); \
336 return FNC ## _with_state((U8*)state,in,inlen); \
4d3a042d 337}
6b026047 338
a3bf60fb 339
6b026047
YO
340PERL_SIPHASH_FNC(
341 S_perl_hash_siphash_1_3
342 ,SIPROUND;
343 ,SIPROUND;SIPROUND;SIPROUND;
344)
345
346PERL_SIPHASH_FNC(
347 S_perl_hash_siphash_2_4
348 ,SIPROUND;SIPROUND;
349 ,SIPROUND;SIPROUND;SIPROUND;SIPROUND;
350)
a4283faf 351#endif /* defined(CAN64BITHASH) */
4d3a042d 352
6b026047 353
eba287cb
YO
354
355
356
4d3a042d
YO
357#endif /*compile once*/
358
359/*
4d3a042d
YO
360 * ex: set ts=8 sts=4 sw=4 et:
361 */