This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add epigraph for 5.17.10
[perl5.git] / hv_func.h
index fdb4ad8..28b07b9 100644 (file)
--- a/hv_func.h
+++ b/hv_func.h
@@ -11,6 +11,7 @@
 
 #ifndef PERL_SEEN_HV_FUNC_H /* compile once */
 #define PERL_SEEN_HV_FUNC_H
+#define PERL_HASH_FUNC_ONE_AT_A_TIME_HARD
 
 #if !( 0 \
         || defined(PERL_HASH_FUNC_SDBM) \
         || defined(PERL_HASH_FUNC_SUPERFAST) \
         || defined(PERL_HASH_FUNC_MURMUR3) \
         || defined(PERL_HASH_FUNC_ONE_AT_A_TIME) \
+        || defined(PERL_HASH_FUNC_ONE_AT_A_TIME_HARD) \
         || defined(PERL_HASH_FUNC_ONE_AT_A_TIME_OLD) \
     )
 #ifdef HAS_QUAD
 #define PERL_HASH_FUNC_SIPHASH
 #else
-#define PERL_HASH_FUNC_ONE_AT_A_TIME
+#define PERL_HASH_FUNC_ONE_AT_A_TIME_HARD
 #endif
 #endif
 
 #   define PERL_HASH_FUNC "SDBM"
 #   define PERL_HASH_SEED_BYTES 4
 #   define PERL_HASH(hash,str,len) (hash)= S_perl_hash_sdbm(PERL_HASH_SEED,(U8*)(str),(len))
+#elif defined(PERL_HASH_FUNC_ONE_AT_A_TIME_HARD)
+#   define PERL_HASH_FUNC "ONE_AT_A_TIME_HARD"
+#   define PERL_HASH_SEED_BYTES 8
+#   define PERL_HASH(hash,str,len) (hash)= S_perl_hash_one_at_a_time_hard(PERL_HASH_SEED,(U8*)(str),(len))
 #elif defined(PERL_HASH_FUNC_ONE_AT_A_TIME)
 #   define PERL_HASH_FUNC "ONE_AT_A_TIME"
 #   define PERL_HASH_SEED_BYTES 4
   #define UNALIGNED_SAFE
 #endif
 
-/* Find best way to ROTL32 */
+#ifdef HAS_QUAD
+#ifndef U64TYPE
+/* This probably isn't going to work, but failing with a compiler error due to
+   lack of uint64_t is no worse than failing right now with an #error.  */
+#define U64TYPE uint64_t
+#endif
+#endif
+
+/* Find best way to ROTL32/ROTL64 */
 #if defined(_MSC_VER)
   #include <stdlib.h>  /* Microsoft put _rotl declaration in here */
   #define ROTL32(x,r)  _rotl(x,r)
+  #ifdef HAS_QUAD
+    #define ROTL64(x,r)  _rotl64(x,r)
+  #endif
 #else
   /* gcc recognises this code and generates a rotate instruction for CPUs with one */
   #define ROTL32(x,r)  (((U32)x << r) | ((U32)x >> (32 - r)))
+  #ifdef HAS_QUAD
+    #define ROTL64(x,r)  (((U64TYPE)x << r) | ((U64TYPE)x >> (64 - r)))
+  #endif
 #endif
 
 
+#ifdef UV_IS_QUAD
+#define ROTL_UV(x,r) ROTL64(x,r)
+#else
+#define ROTL_UV(x,r) ROTL32(x,r)
+#endif
+
 /* This is SipHash by Jean-Philippe Aumasson and Daniel J. Bernstein.
  * The authors claim it is relatively secure compared to the alternatives
  * and that performance wise it is a suitable hash for languages like Perl.
 
 #ifdef HAS_QUAD
 
-#ifndef U64TYPE
-/* This probably isn't going to work, but failing with a compiler error due to
-   lack of uint64_t is no worse than failing right now with an #error.  */
-#define U64TYPE uint64_t
-#endif
-
-
-#define ROTL64(x,b) (U64TYPE)( ((x) << (b)) | ( (x) >> (64 - (b))) )
-
 #define U8TO64_LE(p) \
   (((U64TYPE)((p)[0])      ) | \
    ((U64TYPE)((p)[1]) <<  8) | \
@@ -376,7 +393,7 @@ S_perl_hash_murmur3(const unsigned char * const seed, const unsigned char *ptr,
 
     /* Consume enough so that the next data byte is word aligned */
     int i = -(long)ptr & 3;
-    if(i && i <= len) {
+    if(i && (STRLEN)i <= len) {
       MURMUR_DOBYTES(i, h1, carry, bytes_in_carry, ptr, len);
     }
 
@@ -460,9 +477,11 @@ S_perl_hash_sdbm(const unsigned char * const seed, const unsigned char *str, con
 }
 
 
-/* FYI: This is the "One-at-a-Time" algorithm by Bob Jenkins
+/* This is the "One-at-a-Time" algorithm by Bob Jenkins
  * from requirements by Colin Plumb.
- * (http://burtleburtle.net/bob/hash/doobs.html) */
+ * (http://burtleburtle.net/bob/hash/doobs.html)
+ * With seed/len tweak.
+ * */
 PERL_STATIC_INLINE U32
 S_perl_hash_one_at_a_time(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
     const unsigned char * const end = (const unsigned char *)str + len;
@@ -477,6 +496,42 @@ S_perl_hash_one_at_a_time(const unsigned char * const seed, const unsigned char
     return (hash + (hash << 15));
 }
 
+/* Derived from "One-at-a-Time" algorithm by Bob Jenkins */
+PERL_STATIC_INLINE U32
+S_perl_hash_one_at_a_time_hard(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
+    const unsigned char * const end = (const unsigned char *)str + len;
+    U32 hash = *((U32*)seed) + len;
+    
+    while (str < end) {
+        hash += (hash << 10);
+        hash ^= (hash >> 6);
+        hash += *str++;
+    }
+    
+    hash += (hash << 10);
+    hash ^= (hash >> 6);
+    hash += seed[4];
+    
+    hash += (hash << 10);
+    hash ^= (hash >> 6);
+    hash += seed[5];
+    
+    hash += (hash << 10);
+    hash ^= (hash >> 6);
+    hash += seed[6];
+    
+    hash += (hash << 10);
+    hash ^= (hash >> 6);
+    hash += seed[7];
+    
+    hash += (hash << 10);
+    hash ^= (hash >> 6);
+
+    hash += (hash << 3);
+    hash ^= (hash >> 11);
+    return (hash + (hash << 15));
+}
+
 PERL_STATIC_INLINE U32
 S_perl_hash_old_one_at_a_time(const unsigned char * const seed, const unsigned char *str, const STRLEN len) {
     const unsigned char * const end = (const unsigned char *)str + len;