Changeset 8148 in project


Ignore:
Timestamp:
02/04/08 23:26:52 (12 years ago)
Author:
Kon Lovett
Message:

Added hash procs.

Location:
release/3/hashes/trunk
Files:
5 added
30 edited

Legend:

Unmodified
Added
Removed
  • release/3/hashes/trunk/APHash.scm

    r8129 r8148  
    77  (usual-integrations)
    88  (inline)
     9  (disable-interrupts)
    910  (no-procedure-checks)
    1011  (no-bound-checks)
     
    1718#include "hashes.h"
    1819
    19 /* An algorithm produced by me Arash Partow. I took ideas from all of
    20 the above hash functions making a hybrid rotative and additive hash
    21 function algorithm based around four primes 3,5,7 and 11. There isn't
    22 any real mathematical analysis explaining why one should use this hash
    23 function instead of the others described above other than the fact that
    24 I tired to resemble the design as close as possible to a simple LFSR.
    25 An empirical result which demonstrated the distributive abilities of
    26 the hash algorithm was obtained using a hash-table with 100003 buckets,
    27 hashing The Project Gutenberg E-text of Webster's Unabridged Dictionary,
    28 the longest encountered chain length was 7, the average chain length
    29 was 2, the number of empty buckets was 4579. */
     20/*
     21 * An algorithm produced by me Arash Partow.
     22 *
     23 * I took ideas from all of the above hash functions making a hybrid rotative and
     24 * additive hash function algorithm based around four primes 3,5,7 and 11. There
     25 * isn't any real mathematical analysis explaining why one should use this hash
     26 * function instead of the others described above other than the fact that I tired
     27 * to resemble the design as close as possible to a simple LFSR. An empirical
     28 * result which demonstrated the distributive abilities of the hash algorithm was
     29 * obtained using a hash-table with 100003 buckets, hashing The Project Gutenberg
     30 * E-text of Webster's Unabridged Dictionary, the longest encountered chain length
     31 * was 7, the average chain length was 2, the number of empty buckets was 4579.
     32*/
    3033
    3134static uint32_t
    32 APHash(uint8_t *data, uint32_t len, uint32_t initval)
     35APHash (uint8_t *data, uint32_t len, uint32_t initval)
    3336{
    3437   uint32_t hash = initval;
     
    4649
    4750#undef bitsizeof
    48 #ifdef HASHES_BIG_ENDIAN
    49 # undef HASHES_BIG_ENDIAN
    50 #endif
    5151<#
    5252
  • release/3/hashes/trunk/BKDRHash.scm

    r8129 r8148  
    77  (usual-integrations)
    88  (inline)
     9  (disable-interrupts)
    910  (no-procedure-checks)
    1011  (no-bound-checks)
     
    1718#include "hashes.h"
    1819
    19 /* This hash function comes from Brian Kernighan and Dennis Ritchie's
    20 book "The C Programming Language". It is a simple hash function using a
    21 strange set of possible seeds which all constitute a pattern of
    22 31....31...31 etc, it seems to be very similar to the DJB hash
    23 function. */
     20/*
     21 * This hash function comes from Brian Kernighan and Dennis Ritchie's book "The C
     22 * Programming Language". It is a simple hash function using a strange set of
     23 * possible seeds which all constitute a pattern of 31....31...31 etc, it seems to
     24 * be very similar to the DJB hash function.
     25 */
    2426
    2527static uint32_t
    26 BKDRHash(uint8_t *data, uint32_t len, uint32_t initval)
     28BKDRHash (uint8_t *data, uint32_t len, uint32_t initval)
    2729{
    2830   uint32_t seed = 131; /* 31 131 1313 13131 131313 etc.. */
     
    4042
    4143#undef bitsizeof
    42 #ifdef HASHES_BIG_ENDIAN
    43 # undef HASHES_BIG_ENDIAN
    44 #endif
    4544<#
    4645
  • release/3/hashes/trunk/BRPHash.scm

    r8129 r8148  
    77  (usual-integrations)
    88  (inline)
     9  (disable-interrupts)
    910  (no-procedure-checks)
    1011  (no-bound-checks)
     
    2021
    2122static uint32_t
    22 BRPHash(uint8_t *data, uint32_t len, uint32_t initval)
     23BRPHash (uint8_t *data, uint32_t len, uint32_t initval)
    2324{
    2425#  define SHIFT 6
     
    4142
    4243#undef bitsizeof
    43 #ifdef HASHES_BIG_ENDIAN
    44 # undef HASHES_BIG_ENDIAN
    45 #endif
    4644<#
    4745
  • release/3/hashes/trunk/CRCHash.scm

    r8129 r8148  
    1111  (usual-integrations)
    1212  (inline)
     13  (disable-interrupts)
    1314  (no-procedure-checks)
    1415  (no-bound-checks)
  • release/3/hashes/trunk/DEKHash.scm

    r8129 r8148  
    77  (usual-integrations)
    88  (inline)
     9  (disable-interrupts)
    910  (no-procedure-checks)
    1011  (no-bound-checks)
     
    1718#include "hashes.h"
    1819
    19 /* An algorithm proposed by Donald E. Knuth in The Art Of Computer
    20 Programming Volume 3, under the topic of sorting and search chapter
    21 6.4. */
     20/*
     21 * An algorithm proposed by Donald E. Knuth in The Art Of Computer
     22 * Programming Volume 3, under the topic of sorting and search chapter
     23 * 6.4.
     24 */
    2225
    23 static
    24 uint32_t DEKHash(uint8_t *data, uint32_t len, uint32_t initval)
     26static uint32_t
     27DEKHash (uint8_t *data, uint32_t len, uint32_t initval)
    2528{
    2629   uint32_t hash = initval ? initval : len;
     
    2932   if (data == NULL) return 0;
    3033
    31    for (i = 0; i < len; data++, i++)
    32    {
     34   for (i = 0; i < len; data++, i++) {
    3335      hash = ((hash << 5) ^ (hash >> 27)) ^ (*data);
    3436   }
     37
    3538   return hash;
    3639}
    3740
    3841#undef bitsizeof
    39 #ifdef HASHES_BIG_ENDIAN
    40 # undef HASHES_BIG_ENDIAN
    41 #endif
    4242<#
    4343
  • release/3/hashes/trunk/DJBHash.scm

    r8129 r8148  
    77  (usual-integrations)
    88  (inline)
     9  (disable-interrupts)
    910  (no-procedure-checks)
    1011  (no-bound-checks)
     
    1718#include "hashes.h"
    1819
    19 /* An algorithm produced by Professor Daniel J. Bernstein and shown
    20 first to the world on the usenet newsgroup comp.lang.c. It is one of
    21 the most efficient hash functions ever published. */
     20/*
     21 * An algorithm produced by Professor Daniel J. Bernstein and shown
     22 * first to the world on the usenet newsgroup comp.lang.c. It is one of
     23 * the most efficient hash functions ever published.
     24 */
    2225
    23 static
    24 uint32_t DJBHash(uint8_t *data, uint32_t len, uint32_t initval)
     26static uint32_t
     27DJBHash (uint8_t *data, uint32_t len, uint32_t initval)
    2528{
    2629   uint32_t hash = initval ? initval : 5381;
     
    2932   if (data == NULL) return 0;
    3033
    31    for (i = 0; i < len; data++, i++)
    32    {
     34   for (i = 0; i < len; data++, i++) {
    3335      hash = ((hash << 5) + hash) + (*data);
    3436   }
     
    3840
    3941#undef bitsizeof
    40 #ifdef HASHES_BIG_ENDIAN
    41 #       undef HASHES_BIG_ENDIAN
    42 #endif
    4342<#
    4443
  • release/3/hashes/trunk/ELFHash.scm

    r8129 r8148  
    77  (usual-integrations)
    88  (inline)
     9  (disable-interrupts)
    910  (no-procedure-checks)
    1011  (no-bound-checks)
     
    1718#include "hashes.h"
    1819
    19 /* Similar to the PJW Hash function, but tweaked for 32-bit processors.
    20 Its the hash function widely used on most UNIX systems. */
     20/*
     21 * Similar to the PJW Hash function, but tweaked for 32-bit processors.
     22 * It's the hash function widely used on most UNIX systems.
     23 */
    2124
    22 static
    23 uint32_t ELFHash(uint8_t *data, uint32_t len, uint32_t initval)
     25static uint32_t
     26ELFHash (uint8_t *data, uint32_t len, uint32_t initval)
    2427{
    2528   uint32_t hash = initval;
     
    2932   if (data == NULL) return 0;
    3033
    31    for (i = 0; i < len; data++, i++)
    32    {
     34   for (i = 0; i < len; data++, i++) {
    3335      hash = (hash << 4) + (*data);
    34 
    35       if((x = hash & 0xF0000000L) != 0)
    36       {
     36      if ((x = (hash & 0xF0000000L)) != 0) {
    3737         hash ^= (x >> 24);
    3838         hash &= ~x;
     
    4444
    4545#undef bitsizeof
    46 #ifdef HASHES_BIG_ENDIAN
    47 #       undef HASHES_BIG_ENDIAN
    48 #endif
    4946<#
    5047
  • release/3/hashes/trunk/FNVAHash.scm

    r8129 r8148  
    77  (usual-integrations)
    88  (inline)
     9  (disable-interrupts)
    910  (no-procedure-checks)
    1011  (no-bound-checks)
     
    8182#define NO_FNV_GCC_OPTIMIZATION
    8283
    83 static
    84 uint32_t FNVAHash(uint8_t *data, uint32_t len, uint32_t initval)
     84static uint32_t
     85FNVAHash (uint8_t *data, uint32_t len, uint32_t initval)
    8586{
    8687        uint32_t hval = initval ? initval : FNV1_32A_INIT;
     
    116117
    117118#undef bitsizeof
    118 #ifdef HASHES_BIG_ENDIAN
    119 #       undef HASHES_BIG_ENDIAN
    120 #endif
    121119<#
    122120
  • release/3/hashes/trunk/FNVHash.scm

    r8129 r8148  
    77  (usual-integrations)
    88  (inline)
     9  (disable-interrupts)
    910  (no-procedure-checks)
    1011  (no-bound-checks)
     
    8182#define NO_FNV_GCC_OPTIMIZATION
    8283
    83 static
    84 uint32_t FNVHash(uint8_t *data, uint32_t len, uint32_t initval)
     84static uint32_t
     85FNVHash (uint8_t *data, uint32_t len, uint32_t initval)
    8586{
    8687        uint32_t hval = initval ? initval : FNV1_32_INIT;
     
    103104
    104105                /* xor the bottom with the current octet */
    105                 hval ^= (uint32_t)*bp++;
     106                hval ^= ((uint32_t) *bp++);
    106107        }
    107108
     
    116117
    117118#undef bitsizeof
    118 #ifdef HASHES_BIG_ENDIAN
    119 #       undef HASHES_BIG_ENDIAN
    120 #endif
    121119<#
    122120
  • release/3/hashes/trunk/ISPLHash.scm

    r8129 r8148  
    77  (usual-integrations)
    88  (inline)
     9  (disable-interrupts)
    910  (no-procedure-checks)
    1011  (no-bound-checks)
     
    5758 */
    5859
    59 static
    60 uint32_t ISPLHash(uint8_t *data, uint32_t len, uint32_t initval)
     60static uint32_t
     61ISPLHash (uint8_t *data, uint32_t len, uint32_t initval)
    6162{
    6263#  define SHIFT 5
     
    6970   if (data == NULL) return 0;
    7071 
    71    for (i = 0; i < lim; data++, i++)
    72    {
     72   for (i = 0; i < lim; data++, i++) {
    7373      hash = (hash << 8) | (*data);
    7474   }
    7575
    76    for (; i < len; data++, i++)
    77    {
     76   for (; i < len; data++, i++) {
    7877      hash = (hash << SHIFT) | ((hash >> (BITS - SHIFT)) & ((1 << SHIFT) - 1));
    7978      hash ^= (*data);
     
    8786
    8887#undef bitsizeof
    89 #ifdef HASHES_BIG_ENDIAN
    90 #       undef HASHES_BIG_ENDIAN
    91 #endif
    9288<#
    9389
  • release/3/hashes/trunk/JSHash.scm

    r8129 r8148  
    77  (usual-integrations)
    88  (inline)
     9  (disable-interrupts)
    910  (no-procedure-checks)
    1011  (no-bound-checks)
     
    1920/* A bitwise hash function written by Justin Sobel */
    2021
    21 static
    22 uint32_t JSHash(uint8_t *data, uint32_t len, uint32_t initval)
     22static uint32_t
     23JSHash (uint8_t *data, uint32_t len, uint32_t initval)
    2324{
    2425   uint32_t hash = initval ? initval : 1315423911;
     
    2728   if (data == NULL) return 0;
    2829
    29    for (i = 0; i < len; data++, i++)
    30    {
     30   for (i = 0; i < len; data++, i++) {
    3131      hash ^= ((hash << 5) + (*data) + (hash >> 2));
    3232   }
     
    3636
    3737#undef bitsizeof
    38 #ifdef HASHES_BIG_ENDIAN
    39 # undef HASHES_BIG_ENDIAN
    40 #endif
    4138<#
    4239
  • release/3/hashes/trunk/NDJBHash.scm

    r8129 r8148  
    77  (usual-integrations)
    88  (inline)
     9  (disable-interrupts)
    910  (no-procedure-checks)
    1011  (no-bound-checks)
     
    1718#include "hashes.h"
    1819
    19 /* Now favored by Bernstein; the magic of number 33 (why it works better
    20 than many other constants, prime or not) has never been adequately
    21 explained. */
     20/*
     21 * Now favored by Bernstein; the magic of number 33 (why it works better
     22 * than many other constants, prime or not) has never been adequately
     23 * explained.
     24 */
    2225
    23 static
    24 uint32_t NDJBHash(uint8_t *data, uint32_t len, uint32_t initval)
     26static uint32_t
     27NDJBHash (uint8_t *data, uint32_t len, uint32_t initval)
    2528{
    2629   uint32_t hash = initval ? initval : 5381;
     
    2932   if (data == NULL) return 0;
    3033
    31    for (i = 0; i < len; data++, i++)
    32    {
     34   for (i = 0; i < len; data++, i++) {
    3335      hash = hash * 33 ^ (*data);
    3436   }
     
    3840
    3941#undef bitsizeof
    40 #ifdef HASHES_BIG_ENDIAN
    41 # undef HASHES_BIG_ENDIAN
    42 #endif
    4342<#
    4443
  • release/3/hashes/trunk/PHSFHash.scm

    r8129 r8148  
    77  (usual-integrations)
    88  (inline)
     9  (disable-interrupts)
    910  (no-procedure-checks)
    1011  (no-bound-checks)
     
    1920/* Paul Hsieh's SuperFast */
    2021
    21 static
    22 uint32_t PHSFHash(uint8_t *data, uint32_t len, uint32_t initval)
     22static uint32_t
     23PHSFHash (uint8_t *data, uint32_t len, uint32_t initval)
    2324{
    2425#   define get16bits(d) (*((uint16_t *)(d)))
     
    7172
    7273#undef bitsizeof
    73 #ifdef HASHES_BIG_ENDIAN
    74 # undef HASHES_BIG_ENDIAN
    75 #endif
    7674<#
    7775
  • release/3/hashes/trunk/PJWHash.scm

    r8129 r8148  
    77  (usual-integrations)
    88  (inline)
     9  (disable-interrupts)
    910  (no-procedure-checks)
    1011  (no-bound-checks)
     
    2021Bell Labs. */
    2122
    22 static
    23 uint32_t PJWHash(uint8_t *data, uint32_t len, uint32_t initval)
     23#if 0
     24static uint32_t
     25PJWHash (uint8_t *data, uint32_t len, uint32_t initval)
    2426{
    25 #if 1
    26 #  define BitsInUnsignedInt (uint32_t)bitsizeof(uint32_t)
    27 #  define ThreeQuarters     (uint32_t)((BitsInUnsignedInt * 3) / 4)
    28 #  define OneEighth         (uint32_t)(BitsInUnsignedInt / 8)
    29 #  define HighBits          (uint32_t)(~0) << (BitsInUnsignedInt - OneEighth)
     27   uint32_t hash = initval;
     28   uint32_t test;
     29   uint32_t i;
     30
     31   if (data == NULL) return 0;
     32
     33   for (i = 0; i < len; data++, i++) {
     34      hash = (hash << 2) + (*data);
     35      if ((test = (hash & 0xC000)) != 0) {
     36         hash = ((hash ^ (test >> 12)) & 0x3FFF);
     37      }
     38   }
     39
     40   return hash;
     41}
     42#else
     43static uint32_t
     44PJWHash (uint8_t *data, uint32_t len, uint32_t initval)
     45{
     46#  define BitsInUnsignedInt ((uint32_t) bitsizeof (uint32_t))
     47#  define ThreeQuarters     ((uint32_t) ((BitsInUnsignedInt * 3) / 4))
     48#  define OneEighth         ((uint32_t) (BitsInUnsignedInt / 8))
     49#  define HighBits          (((uint32_t) (~0)) << (BitsInUnsignedInt - OneEighth))
    3050
    3151   uint32_t hash = initval;
     
    3555   if (data == NULL) return 0;
    3656
    37    for (i = 0; i < len; data++, i++)
    38    {
     57   for (i = 0; i < len; data++, i++) {
    3958      hash = (hash << OneEighth) + (*data);
    40 
    41       if ((test = hash & HighBits) != 0)
    42       {
     59      if ((test = (hash & HighBits)) != 0) {
    4360         hash = ((hash ^ (test >> ThreeQuarters)) & (~HighBits));
    4461      }
     
    5168#  undef ThreeQuarters
    5269#  undef BitsInUnsignedInt
    53 #else
    54 
    55    uint32_t hash = initval;
    56    uint32_t test;
    57    uint32_t i;
    58 
    59    if (data == NULL) return 0;
    60 
    61    for (i = 0; i < len; data++, i++)
    62    {
    63       hash = (hash << 2) + (*data);
    64 
    65       if ((test = hash & 0xC000) != 0)
    66       {
    67          hash = ((hash ^ (test >> 12)) & 0x3FFF);
    68       }
    69    }
    70 
    71    return hash;
    72    
     70}
    7371#endif
    74 }
    7572
    7673#undef bitsizeof
    77 #ifdef HASHES_BIG_ENDIAN
    78 # undef HASHES_BIG_ENDIAN
    79 #endif
    8074<#
    8175
  • release/3/hashes/trunk/PYHash.scm

    r8129 r8148  
    77  (usual-integrations)
    88  (inline)
     9  (disable-interrupts)
    910  (no-procedure-checks)
    1011  (no-bound-checks)
     
    1920/* Python */
    2021
    21 static
    22 uint32_t PYHash(uint8_t *data, uint32_t len, uint32_t initval)
     22static uint32_t
     23PYHash (uint8_t *data, uint32_t len, uint32_t initval)
    2324{
    2425   uint32_t hash;
     
    2930   hash = initval ? initval : (*data) << 7;
    3031
    31    for (i = 0; i < len; data++, i++)
    32    {
     32   for (i = 0; i < len; data++, i++) {
    3333      hash = (1000003 * hash) ^ (*data);
    3434   }
     
    4040
    4141#undef bitsizeof
    42 #ifdef HASHES_BIG_ENDIAN
    43 # undef HASHES_BIG_ENDIAN
    44 #endif
    4542<#
    4643
  • release/3/hashes/trunk/RJL3Hash.scm

    r8129 r8148  
    77  (usual-integrations)
    88  (inline)
     9  (disable-interrupts)
    910  (no-procedure-checks)
    1011  (no-bound-checks)
     
    105106*/
    106107
    107 #define mix(a, b, c) \
    108 { \
     108#define mix(a, b, c) { \
    109109  a -= c;  a ^= rot(c, 4);  c += b; \
    110110  b -= a;  b ^= rot(a, 6);  a += c; \
     
    141141*/
    142142
    143 #define final(a, b, c) \
    144 { \
     143#define final(a, b, c) { \
    145144  c ^= b; c -= rot(b,14); \
    146145  a ^= c; a -= rot(c,11); \
     
    152151}
    153152
    154 #ifdef HASHES_BIG_ENDIAN
     153#ifdef C_BIG_ENDIAN
    155154static uint32_t
    156 RJL3Hash(uint8_t *data, uint32_t length, uint32_t initval)
     155RJL3Hash (uint8_t *data, uint32_t length, uint32_t initval)
    157156{
    158157  uint32_t a, b, c;
     
    211210      /* all the case statements fall through */
    212211    case 12: c += k[2]; b += k[1]; a += k[0]; break;
    213     case 11: c += ((uint32_t)k8[10]) << 8;  /* fall through */
    214     case 10: c += ((uint32_t)k8[9]) << 16;  /* fall through */
    215     case 9 : c += ((uint32_t)k8[8]) << 24;  /* fall through */
     212    case 11: c += ((uint32_t) k8[10]) << 8;  /* fall through */
     213    case 10: c += ((uint32_t) k8[9]) << 16;  /* fall through */
     214    case 9 : c += ((uint32_t) k8[8]) << 24;  /* fall through */
    216215    case 8 : b += k[1]; a += k[0]; break;
    217     case 7 : b += ((uint32_t)k8[6]) << 8;   /* fall through */
    218     case 6 : b += ((uint32_t)k8[5]) << 16;  /* fall through */
    219     case 5 : b += ((uint32_t)k8[4]) << 24;  /* fall through */
     216    case 7 : b += ((uint32_t) k8[6]) << 8;   /* fall through */
     217    case 6 : b += ((uint32_t) k8[5]) << 16;  /* fall through */
     218    case 5 : b += ((uint32_t) k8[4]) << 24;  /* fall through */
    220219    case 4 : a += k[0]; break;
    221     case 3 : a += ((uint32_t)k8[2]) << 8;   /* fall through */
    222     case 2 : a += ((uint32_t)k8[1]) << 16;  /* fall through */
    223     case 1 : a += ((uint32_t)k8[0]) << 24; break;
     220    case 3 : a += ((uint32_t) k8[2]) << 8;   /* fall through */
     221    case 2 : a += ((uint32_t) k8[1]) << 16;  /* fall through */
     222    case 1 : a += ((uint32_t) k8[0]) << 24; break;
    224223    case 0 : return c;
    225224    }
     
    274273#else
    275274static uint32_t
    276 RJL3Hash(uint8_t *data, uint32_t length, uint32_t initval)
     275RJL3Hash (uint8_t *data, uint32_t length, uint32_t initval)
    277276{
    278277  uint32_t a,b,c;                                          /* internal state */
     
    327326#else /* make valgrind happy */
    328327
    329     k8 = (const uint8_t *)k;
     328    k8 = ((const uint8_t *) k);
    330329    switch (length) {
    331330    case 12: c += k[2]; b += k[1]; a += k[0]; break;
    332     case 11: c += ((uint32_t)k8[10]) << 16;  /* fall through */
    333     case 10: c += ((uint32_t)k8[9]) << 8;    /* fall through */
     331    case 11: c += ((uint32_t) k8[10]) << 16;  /* fall through */
     332    case 10: c += ((uint32_t) k8[9]) << 8;    /* fall through */
    334333    case 9 : c += k8[8];                   /* fall through */
    335334    case 8 : b += k[1]; a += k[0]; break;
    336     case 7 : b += ((uint32_t)k8[6]) << 16;   /* fall through */
    337     case 6 : b += ((uint32_t)k8[5]) << 8;    /* fall through */
     335    case 7 : b += ((uint32_t) k8[6]) << 16;   /* fall through */
     336    case 6 : b += ((uint32_t) k8[5]) << 8;    /* fall through */
    338337    case 5 : b += k8[4];                   /* fall through */
    339338    case 4 : a += k[0]; break;
    340     case 3 : a += ((uint32_t)k8[2]) << 16;   /* fall through */
    341     case 2 : a += ((uint32_t)k8[1]) << 8;    /* fall through */
     339    case 3 : a += ((uint32_t) k8[2]) << 16;   /* fall through */
     340    case 2 : a += ((uint32_t) k8[1]) << 8;    /* fall through */
    342341    case 1 : a += k8[0]; break;
    343342    case 0 : return c;
     
    361360
    362361    /*----------------------------- handle the last (probably partial) block */
    363     k8 = (const uint8_t *)k;
     362    k8 = ((const uint8_t *) k);
    364363    switch (length) {
    365364    case 12: c += k[4]+(((uint32_t) k[5]) << 16);
     
    367366             a += k[0]+(((uint32_t) k[1]) << 16);
    368367             break;
    369     case 11: c += ((uint32_t)k8[10]) << 16;     /* fall through */
     368    case 11: c += ((uint32_t) k8[10]) << 16;     /* fall through */
    370369    case 10: c += k[4];
    371370             b += k[2]+(((uint32_t) k[3]) << 16);
     
    376375             a += k[0]+(((uint32_t) k[1]) << 16);
    377376             break;
    378     case 7 : b += ((uint32_t)k8[6]) << 16;      /* fall through */
     377    case 7 : b += ((uint32_t) k8[6]) << 16;      /* fall through */
    379378    case 6 : b += k[2];
    380379             a += k[0]+(((uint32_t) k[1]) << 16);
     
    383382    case 4 : a += k[0]+(((uint32_t) k[1]) << 16);
    384383             break;
    385     case 3 : a += ((uint32_t)k8[2]) << 16;      /* fall through */
     384    case 3 : a += ((uint32_t) k8[2]) << 16;      /* fall through */
    386385    case 2 : a += k[0];
    387386             break;
     
    445444
    446445#undef bitsizeof
    447 
    448 #ifdef HASHES_BIG_ENDIAN
    449 # undef HASHES_BIG_ENDIAN
    450 #endif
    451446<#
    452447
  • release/3/hashes/trunk/RJMXHash.scm

    r8129 r8148  
    77  (usual-integrations)
    88  (inline)
     9  (disable-interrupts)
    910  (no-procedure-checks)
    1011  (no-bound-checks)
     
    1314    RJMXHash
    1415    RJMXHash:binary-digest RJMXHash:digest RJMXHash:primitive ) )
     16
    1517#>
    1618#include "hashes.h"
     
    9092*/
    9193
    92 #ifdef HASHES_BIG_ENDIAN
     94#ifdef C_BIG_ENDIAN
    9395static uint32_t
    94 RJMXHash(uint8_t *data, uint32_t length, uint32_t initval)
     96RJMXHash (uint8_t *data, uint32_t length, uint32_t initval)
    9597{
    9698   /* Set up the internal state */
     
    138140#else
    139141static uint32_t
    140 RJMXHash(uint8_t *data, uint32_t length, uint32_t initval)
     142RJMXHash (uint8_t *data, uint32_t length, uint32_t initval)
    141143{
    142144   /* Set up the internal state */
     
    198200
    199201#undef bitsizeof
    200 #ifdef HASHES_BIG_ENDIAN
    201 # undef HASHES_BIG_ENDIAN
    202 #endif
    203202<#
    204203
  • release/3/hashes/trunk/RSHash.scm

    r8129 r8148  
    77  (usual-integrations)
    88  (inline)
     9  (disable-interrupts)
    910  (no-procedure-checks)
    1011  (no-bound-checks)
     
    3940up its hashing process. */
    4041
    41 static
    42 uint32_t RSHash(uint8_t *data, uint32_t len, uint32_t initval)
     42static uint32_t
     43RSHash (uint8_t *data, uint32_t len, uint32_t initval)
    4344{
    4445   uint32_t b    = 378551;
     
    4950   if (data == NULL) return 0;
    5051
    51    for (i = 0; i < len; data++, i++)
    52    {
     52   for (i = 0; i < len; data++, i++) {
    5353      hash = hash * a + (*data);
    5454      a *= b;
     
    5959
    6060#undef bitsizeof
    61 #ifdef HASHES_BIG_ENDIAN
    62 # undef HASHES_BIG_ENDIAN
    63 #endif
    6461<#
    6562
  • release/3/hashes/trunk/SDBMHash.scm

    r8129 r8148  
    77  (usual-integrations)
    88  (inline)
     9  (disable-interrupts)
    910  (no-procedure-checks)
    1011  (no-bound-checks)
     
    2223there is a high variance in the MSBs of the elements in a data set. */
    2324
    24 static
    25 uint32_t SDBMHash(uint8_t *data, uint32_t len, uint32_t initval)
     25static uint32_t
     26SDBMHash (uint8_t *data, uint32_t len, uint32_t initval)
    2627{
    2728   uint32_t hash = initval;
     
    3031   if (data == NULL) return 0;
    3132
    32    for (i = 0; i < len; data++, i++)
    33    {
     33   for (i = 0; i < len; data++, i++) {
    3434      hash = (*data) + (hash << 6) + (hash << 16) - hash;
    3535   }
     
    3939
    4040#undef bitsizeof
    41 #ifdef HASHES_BIG_ENDIAN
    42 # undef HASHES_BIG_ENDIAN
    43 #endif
    4441<#
    4542
  • release/3/hashes/trunk/TWMXHash.scm

    r8129 r8148  
    77  (usual-integrations)
    88  (inline)
     9  (disable-interrupts)
    910  (no-procedure-checks)
    1011  (no-bound-checks)
     
    2627  key += ~(key << 11); \
    2728  key ^= ((key & 0x7FFFFFFF) >> 16); \
    28 }
    29 
    30 #define mix32shift(key) { \
    31   key = ~key + (key << 15); \
    32   key = key ^ (key >> 12); \
    33   key = key + (key << 2); \
    34   key = key ^ (key >> 4); \
    35   key = key * 2057; \
    36   key = key ^ (key >> 16); \
    37 }
    38 
    39 #define mix32shiftmult(key) { \
    40   key = (key ^ 61) ^ (key >> 16); \
    41   key = key + (key << 3); \
    42   key = key ^ (key >> 4); \
    43   key = key * 0x27D4EB2D; \
    44   key = key ^ (key >> 15); \
    45 }
    46 
    47 #define mix32magic(a, b, c) { \
    48    a = (a + 0x7ED55D16) + (a << 12); \
    49    a = (a ^ 0xC761C23C) ^ (a >> 19); \
    50    a = (a + 0x165667B1) + (a << 5); \
    51    a = (a + 0xD3A2646C) ^ (a << 9); \
    52    a = (a + 0xFD7046C5) + (a << 3); \
    53    a = (a ^ 0xB55A4F09) ^ (a >> 16); \
    5429}
    5530
     
    7752#endif
    7853
    79 #ifdef HASHES_BIG_ENDIAN
     54#ifdef C_BIG_ENDIAN
    8055static uint32_t
    8156TWMXHash (uint8_t *data, uint32_t length, uint32_t initval)
     
    145120
    146121#undef mix
    147 #undef mix32shift
    148 #undef mix32shiftmult
    149 #undef mix32magic
    150122
    151123#if 0
     
    157129
    158130#undef bitsizeof
    159 #ifdef HASHES_BIG_ENDIAN
    160 # undef HASHES_BIG_ENDIAN
    161 #endif
    162131<#
    163132
  • release/3/hashes/trunk/hash-utils.scm

    r8129 r8148  
    1515(declare
    1616  (usual-integrations)
    17   (number-type generic)
     17  (number-type generic) ; "core" - fixnum & flonum only
    1818  (inline)
    1919  (no-procedure-checks)
     
    4444
    4545#undef bitsizeof
    46 #ifdef HASHES_BIG_ENDIAN
    47 # undef HASHES_BIG_ENDIAN
    48 #endif
    4946<#
    5047
     
    5249
    5350(define-inline (check-number loc obj)
    54   (##sys#check-number obj loc)
    55   #;
    56         (unless (number? obj)
    57                 (error loc "not a number" obj) ) )
     51  (##sys#check-number obj loc) )
    5852
    5953(define-inline (check-fixnum loc obj)
    60   (##sys#check-exact obj loc)
    61   #;
    62         (unless (fixnum? obj)
    63                 (error loc "not a fixnum" obj) ) )
    64 
    65 (define (check-procedure loc obj)
    66   (##sys#check-closure obj loc)
    67   #;
    68         (unless (procedure? obj)
    69                 (error loc "not a procedure" obj) ) )
     54  (##sys#check-exact obj loc) )
     55
     56(define-inline (check-procedure loc obj)
     57  (##sys#check-closure obj loc) )
    7058
    7159(define-inline (check-unsigned-integer32 loc obj)
    72         (unless (and (integer? obj) (<= 0 obj maximum-unsigned-integer32))
    73                 (error loc "not a positive integer or zero" obj) ) )
    74 
    75 ;; Only flonum & fixnum, not full-numeric-tower.
    76 
    77 (define-inline (number->fixnum n)
     60        (unless (and (integer? obj)
     61                     (<= 0 obj maximum-unsigned-integer32))
     62                (error loc "not an integer in [0 maximum-unsigned-integer32)" obj) ) )
     63
     64;;
     65
     66(define-inline (force-exact num)
     67  (if (flonum? num)
     68      (##core#inline "C_quickflonumtruncate" num)
     69      num) )
     70
     71(define-inline (number->exact n)
    7872        (if (inexact? n)
    7973      (let ([i (if (integer? n) n (round n))])
     
    8377                [else                       i])) )
    8478      n ) )
     79
     80(define-inline (number->fixnum n)
     81  (force-exact (number->exact n)) )
    8582
    8683;; Common hash seed
     
    113110    "*((uint32_t *) dat) = (uint32_t) w32;"))
    114111
    115 (define-inline (ptr-prc-for-obj obj a b)
     112(define-inline (ptr-prc-for-obj obj cptr-proc sptr-proc)
    116113    (if (or (pointer? obj) (locative? obj))
    117         a
    118         b ) )
    119 
    120 (define (unsigned-integer32-set! obj val)
    121   ((ptr-prc-for-obj obj uint32-cptr-set! uint32-sptr-set!) obj val) )
     114        cptr-proc
     115        sptr-proc ) )
     116
     117(define (unsigned-integer32-set! obj num)
     118  ((ptr-prc-for-obj obj uint32-cptr-set! uint32-sptr-set!) obj num) )
    122119
    123120(define (unsigned-integer32-ref obj)
    124121  ((ptr-prc-for-obj obj uint32-cptr-ref uint32-sptr-ref) obj) )
    125122
    126 ;;;
     123;;; Range restrictions
    127124
    128125(define (make-range-restriction upper . args)
     
    147144
    148145;;; SRFI-69 hash function signatures
    149 
    150 (define-inline (force-exact val)
    151   (if (flonum? val) (##core#inline "C_quickflonumtruncate" val) val) )
    152146
    153147(define (make-fixnum-bounded-hash hash-proc . args)
  • release/3/hashes/trunk/hashes-eggdoc.scm

    r8129 r8148  
    7272
    7373                                        (describe TWMXHash
    74                                                 (p "Thomas Wang's MIX hash function."))
     74                                                (p "Thomas Wang's hash function with original MIX."))
     75
     76                                        (describe TWSHMXHash
     77                                                (p "Thomas Wang's hash function with shift MIX."))
     78
     79                                        (describe TWSHMLMXHash
     80                                                (p "Thomas Wang's hash function with shift-multiply MIX."))
     81
     82                                        (describe TWMGMXHash
     83                                                (p "Thomas Wang's hash function with Magic MIX."))
    7584
    7685                                        (describe FNVHash
     
    153162                        )
    154163
    155                         (subsection "Hash Auxillary Procedures"
    156                        
    157                                 (p "Note: The domain 'number' below means '(or flonum fixnum)', "
    158                                 "not the full Scheme 'number' domain.")
    159 
    160                                 (parameter "(current-hash-seed [NEW-SEED])"
    161                                         (p "Returns or sets the current default hash seed. The initial "
    162                                         "value is 0."))
    163 
    164                                 (procedure "(make-fixnum-bounded-hash {HASH}-PROC [GETLEN string-length] [GETINT (constantly 0)])"
    165                                         (p "Returns a hash function with a SRFI-69 signature, but with a fixnum domain; "
    166                                         "i.e. (object #!optional (positive fixnum) -> fixnum). The "
    167                                         (tt "GETLEN") " will be used to aquire the " (tt "OBJECT") " length for the "
    168                                         (tt "{HASH}-PROC") ". The " (tt "GETINT") " will supply the initial hash value."))
    169 
    170                                 (procedure "(make-bounded-hash {HASH}-PROC [GETLEN string-length] [GETINT (constantly 0)])"
    171                                         (p "Returns a hash function with a SRFI-69 signature, but with a real domain; "
    172                                         "i.e. (object #!optional (positive number) -> number). The "
    173                                         (tt "GETLEN") " will be used to aquire the " (tt "OBJECT") " length for the "
    174                                         (tt "{HASH}-PROC") ". The " (tt "GETINT") " will supply the initial hash value."))
    175 
    176                                 (procedure "(make-seeded-hash {HASH}-PROC [SEED])"
    177                                         (p "Returns a curried " (tt "{HASH}-PROC") " of 1 or 2 arguments "
    178                                         "with the supplied " (tt "SEED") ". When the seed is missing "
    179                                         "the " (tt "(current-hash-seed)") " is assumed."))
    180 
    181                                 (procedure "(make-mask-hash {HASH}-PROC MASK)"
    182                                         (p "Returns a " (tt "{HASH}-PROC") " with the hash value "
    183                                         "bitwise and'ed with the supplied " (tt "MASK") "."))
    184 
    185                                 (procedure "(make-range-hash {HASH}-PROC UPPER [LOWER])"
    186                                         (p "Returns a " (tt "{HASH}-PROC") " with the hash value "
    187                                         "restricted to the supplied exact interval, [" (tt "LOWER") " "
    188                                         (tt "UPPER") "]. When " (tt "LOWER") " is missing 0 is assumed. "
    189                                         "The signature is that of the " (tt "{HASH}-PROC") "."))
    190 
    191                                 (procedure "(make-real-hash {HASH}-PROC)"
    192                                         (p "Returns a " (tt "{HASH}-PROC") " with the hash value "
    193                                         "restricted to the interval, [0.0 1.0]. The signature is that "
    194                                         "of the " (tt "{HASH}-PROC") "."))
    195                         )
     164      #; ;TWUserMixHash DOESN'T WORK
     165                        (subsection "TWUserMixHash Procedures"
     166
     167        (p "Thomas Wang's hash function with a user supplied MIX.")
     168
     169        (procedure "(make-TWUserMixHash-primitive-procedure MIXER)"
     170          (p "Returns a hash primitive procedure, "
     171          (code "(scheme-object unsigned-integer32 unsigned-integer32 -> unsigned-integer32)") ", "
     172          "for the procedure " (tt "MIX") ", "
     173          (code "(unsigned-integer32 -> unsigned-integer32)") ".") )
     174
     175        (procedure "(make-TWUserMixHash-procedure HASH-PRIM [BYTE-LENGTH string-length])"
     176          (p "Returns a hash procedure, "
     177          (code "(scheme-object #!optional unsigned-integer32 unsigned-integer32 -> unsigned-integer32)") ", "
     178          "for the hash primitive procedure " (tt "HASH-PRIM") ".") )
     179
     180        (procedure "(make-TWUserMixHash-message-digest-procedures HASH-PRIM)"
     181          (p "Returns a list of " (code ":binary-digest") ", " (code ":digest") ", and "
     182          (code ":primitive") "for the hash primitive procedure " (tt "HASH-PRIM") ".") )
     183
     184        (procedure "(make-TWUserMixHash MIXER)"
     185          (p "Returns 5 values: " (tt "HASH-PRIM") ", " (tt "HASH") ", "
     186          (code ":binary-digest") ", " (code ":digest") ", and " (code ":primitive") ".") )
     187      )
    196188
    197189                        (subsection "Digest Procedures"
     
    212204                        )
    213205
    214                         (subsection "Miscellaneous Procedures"
     206                        (subsection "Hash Auxillary Procedures"
     207
     208                                (p "Note: The domain 'number' below means '(or flonum fixnum)', "
     209                                "not the full Scheme 'number' domain.")
     210
     211                                (parameter "(current-hash-seed [NEW-SEED])"
     212                                        (p "Returns or sets the current default hash seed. The initial "
     213                                        "value is 0."))
     214
     215                                (procedure "(make-fixnum-bounded-hash {HASH} [GETLEN string-length] [GETINT (constantly 0)])"
     216                                        (p "Returns a hash function with a SRFI-69 signature, but with a fixnum domain; "
     217                                        "i.e. (object #!optional (positive fixnum) -> fixnum). The "
     218                                        (tt "GETLEN") " will be used to aquire the " (tt "OBJECT") " length for the "
     219                                        (tt "{HASH}") ". The " (tt "GETINT") " will supply the initial hash value."))
     220
     221                                (procedure "(make-bounded-hash {HASH} [GETLEN string-length] [GETINT (constantly 0)])"
     222                                        (p "Returns a hash function with a SRFI-69 signature, but with a real domain; "
     223                                        "i.e. (object #!optional (positive number) -> number). The "
     224                                        (tt "GETLEN") " will be used to aquire the " (tt "OBJECT") " length for the "
     225                                        (tt "{HASH}") ". The " (tt "GETINT") " will supply the initial hash value."))
     226
     227                                (procedure "(make-seeded-hash {HASH} [SEED])"
     228                                        (p "Returns a curried " (tt "{HASH}") " of 1 or 2 arguments "
     229                                        "with the supplied " (tt "SEED") ". When the seed is missing "
     230                                        "the " (tt "(current-hash-seed)") " is assumed."))
     231
     232                                (procedure "(make-mask-hash {HASH} MASK)"
     233                                        (p "Returns a " (tt "{HASH}") " with the hash value "
     234                                        "bitwise and'ed with the supplied " (tt "MASK") "."))
     235
     236                                (procedure "(make-range-hash {HASH} UPPER [LOWER])"
     237                                        (p "Returns a " (tt "{HASH}") " with the hash value "
     238                                        "restricted to the supplied exact interval, [" (tt "LOWER") " "
     239                                        (tt "UPPER") "]. When " (tt "LOWER") " is missing 0 is assumed. "
     240                                        "The signature is that of the " (tt "{HASH}") "."))
     241
     242                                (procedure "(make-real-hash {HASH})"
     243                                        (p "Returns a " (tt "{HASH}") " with the hash value "
     244                                        "restricted to the interval, [0.0 1.0]. The signature is that "
     245                                        "of the " (tt "{HASH}") "."))
     246                        )
     247
     248                        (subsection "Range Procedures"
    215249
    216250                                (procedure "(make-range-restriction UPPER [LOWER])"
     
    225259                                        " (tt "UPPER") "]. When " (tt "LOWER") " missing 0 is "
    226260                                        "assumed.")
    227                                        
     261
    228262                                        (p (tt "LOWER") " & " (tt "UPPER") " must be fixnums."))
     263                        )
     264
     265                        (subsection "unsigned-integer32 Procedures"
    229266
    230267                                (procedure "(unsigned-integer32-ref OBJECT)"
     
    237274
    238275  (history
     276    (version "2.105" "Added TWSHMXHash, TWSHMLMXHash, TWMGMXHash.")
    239277    (version "2.104" "Added make-fixnum-bounded-hash.")
    240278    (version "2.103" "Bugfix for make-bounded-hash, assumed fixnum.")
  • release/3/hashes/trunk/hashes-macros.scm

    r5592 r8148  
    2020       (foreign-lambda unsigned-integer32 ,(symbol->string NAME) scheme-pointer unsigned-integer32 unsigned-integer32) )
    2121     (define ,NAME
    22        (let ([byte-string-length string-length])
    23          (lambda (str . args)
    24            (let-optionals args ([len (byte-string-length str)] [initval 0])
    25              (,(gen-prim-proc-sym NAME) str len initval)) ) ) ) ) )
     22       (let ([byte-length string-length])
     23         (lambda (dat . args)
     24           (let-optionals args ([len (byte-length dat)] [initval 0])
     25             (,(gen-prim-proc-sym NAME) dat len initval)) ) ) ) ) )
    2626
    2727(define-macro (gen-update-proc NAME)
    2828  `(define ,(gen-update-proc-sym NAME)
    29      (foreign-lambda* void ((c-pointer ctx) (scheme-pointer str) (unsigned-int len))
    30        ,(conc "((hashctx *)ctx)->hash = " NAME "((uint8_t *)str, (uint32_t)len, ((hashctx *)ctx)->hash);")) ) )
     29     (foreign-lambda* void ((c-pointer ctx) (scheme-pointer dat) (unsigned-integer32 len))
     30       ,(conc "((hashctx *) ctx)->hash = " NAME " ((uint8_t *) dat, (uint32_t) len, ((hashctx *) ctx)->hash);")) ) )
    3131
    3232(define-macro (gen-md-api NAME)
  • release/3/hashes/trunk/hashes-support.scm

    r8129 r8148  
    1010;; TBD
    1111;;
    12 ;; - LITTLE/BIG-ENDIAN specific versions of all hash functions are not
    13 ;; provided. So performance on Intel, etc. not optimal.
     12;; - LITTLE/BIG-ENDIAN versions of all hash functions are not provided.
     13;;
     14;; - 64-bit versions of alll hash functions are not provided.
    1415;;
    1516;; - 64-bit optimization: Chicken object data is 64-bit aligned so
     
    2324  (usual-integrations)
    2425  (inline)
     26  (disable-interrupts)
    2527  (no-procedure-checks)
    2628  (no-argc-checks)
     
    2830  (export
    2931    hashes:hash-context-size
     32    hashes:ctx-hash-ref
     33    hashes:ctx-hash-set!
    3034    hashes:generic-init
    3135    hashes:generic-final ) )
     
    3539
    3640#undef bitsizeof
    37 #ifdef HASHES_BIG_ENDIAN
    38 #       undef HASHES_BIG_ENDIAN
    39 #endif
    4041<#
     42
     43;;;
    4144
    4245(define hashes:hash-context-size (foreign-value "sizeof (hashctx)" int))
    4346
     47;;
     48
     49(define hashes:ctx-hash-ref
     50  (foreign-lambda* unsigned-integer32 ((c-pointer ctx))
     51   "return (((hashctx *) ctx)->hash);") )
     52
     53;;
     54
     55(define hashes:ctx-hash-set!
     56  (foreign-lambda* void ((c-pointer ctx) (unsigned-integer32 val))
     57   "((hashctx *) ctx)->hash = val;"))
     58
     59;;
     60
    4461(define (hashes:generic-init ctx)
    45         ((foreign-lambda* void ((c-pointer ctx) (unsigned-integer32 seed))
    46             "((hashctx *) ctx)->hash = seed;")
    47                 ctx (current-hash-seed)) )
     62        (hashes:ctx-hash-set! ctx (current-hash-seed)) )
     63
     64;;
    4865
    4966(define (hashes:generic-final ctx result)
    50         (unsigned-integer32-set! result
    51                 ((foreign-lambda* unsigned-integer32 ((c-pointer ctx))
    52                     "return (((hashctx *) ctx)->hash);")
    53                         ctx)) )
     67        (unsigned-integer32-set! result (hashes:ctx-hash-ref ctx)) )
  • release/3/hashes/trunk/hashes.h

    r8129 r8148  
    11/* hashes.h */
    2 
    3 #ifdef C_BIG_ENDIAN
    4 # define HASHES_BIG_ENDIAN
    5 #endif
    62
    73/* bitsizeof is C++, sigh */
  • release/3/hashes/trunk/hashes.html

    r8129 r8148  
    192192<td class="symbol">TWMXHash</td>
    193193<td>
    194 <p>Thomas Wang's MIX hash function.</p></td></tr>
     194<p>Thomas Wang's hash function with original MIX.</p></td></tr>
     195<tr>
     196<td class="symbol">TWSHMXHash</td>
     197<td>
     198<p>Thomas Wang's hash function with shift MIX.</p></td></tr>
     199<tr>
     200<td class="symbol">TWSHMLMXHash</td>
     201<td>
     202<p>Thomas Wang's hash function with shift-multiply MIX.</p></td></tr>
     203<tr>
     204<td class="symbol">TWMGMXHash</td>
     205<td>
     206<p>Thomas Wang's hash function with Magic MIX.</p></td></tr>
    195207<tr>
    196208<td class="symbol">FNVHash</td>
     
    261273<td>
    262274<p>The ISpell hash function.</p></td></tr></table></div>
     275<div class="subsection">
     276<h4>Digest Procedures</h4>
     277<p>An acceptable input object for the digest procedures is a string, input-port, blob, vector, list, or homogeneous-vector. See <a href="http://www.call-with-current-continuation.org/eggs/message-digest.html">message-digest</a> for more information.</p>
     278<dt class="definition"><strong>procedure:</strong> ({HASH}:digest OBJECT)</dt>
     279<dd>
     280<p>Returns the hash of <tt>OBJECT</tt> as a hexadecimal text string.</p></dd>
     281<dt class="definition"><strong>procedure:</strong> ({HASH}:binary-digest OBJECT)</dt>
     282<dd>
     283<p>Returns the hash of <tt>OBJECT</tt> as a byte-string.</p></dd>
     284<dt class="definition"><strong>procedure:</strong> ({HASH}:primitive)</dt>
     285<dd>
     286<p>Returns the hash primitive object.</p></dd></div>
    263287<div class="subsection">
    264288<h4>Hash Auxillary Procedures</h4>
     
    267291<dd>
    268292<p>Returns or sets the current default hash seed. The initial value is 0.</p></dd>
    269 <dt class="definition"><strong>procedure:</strong> (make-fixnum-bounded-hash {HASH}-PROC [GETLEN string-length] [GETINT (constantly 0)])</dt>
    270 <dd>
    271 <p>Returns a hash function with a SRFI-69 signature, but with a fixnum domain; i.e. (object #!optional (positive fixnum) -&gt; fixnum). The <tt>GETLEN</tt> will be used to aquire the <tt>OBJECT</tt> length for the <tt>{HASH}-PROC</tt>. The <tt>GETINT</tt> will supply the initial hash value.</p></dd>
    272 <dt class="definition"><strong>procedure:</strong> (make-bounded-hash {HASH}-PROC [GETLEN string-length] [GETINT (constantly 0)])</dt>
    273 <dd>
    274 <p>Returns a hash function with a SRFI-69 signature, but with a real domain; i.e. (object #!optional (positive number) -&gt; number). The <tt>GETLEN</tt> will be used to aquire the <tt>OBJECT</tt> length for the <tt>{HASH}-PROC</tt>. The <tt>GETINT</tt> will supply the initial hash value.</p></dd>
    275 <dt class="definition"><strong>procedure:</strong> (make-seeded-hash {HASH}-PROC [SEED])</dt>
    276 <dd>
    277 <p>Returns a curried <tt>{HASH}-PROC</tt> of 1 or 2 arguments with the supplied <tt>SEED</tt>. When the seed is missing the <tt>(current-hash-seed)</tt> is assumed.</p></dd>
    278 <dt class="definition"><strong>procedure:</strong> (make-mask-hash {HASH}-PROC MASK)</dt>
    279 <dd>
    280 <p>Returns a <tt>{HASH}-PROC</tt> with the hash value bitwise and'ed with the supplied <tt>MASK</tt>.</p></dd>
    281 <dt class="definition"><strong>procedure:</strong> (make-range-hash {HASH}-PROC UPPER [LOWER])</dt>
    282 <dd>
    283 <p>Returns a <tt>{HASH}-PROC</tt> with the hash value restricted to the supplied exact interval, [<tt>LOWER</tt> <tt>UPPER</tt>]. When <tt>LOWER</tt> is missing 0 is assumed. The signature is that of the <tt>{HASH}-PROC</tt>.</p></dd>
    284 <dt class="definition"><strong>procedure:</strong> (make-real-hash {HASH}-PROC)</dt>
    285 <dd>
    286 <p>Returns a <tt>{HASH}-PROC</tt> with the hash value restricted to the interval, [0.0 1.0]. The signature is that of the <tt>{HASH}-PROC</tt>.</p></dd></div>
    287 <div class="subsection">
    288 <h4>Digest Procedures</h4>
    289 <p>An acceptable input object for the digest procedures is a string, input-port, blob, vector, list, or homogeneous-vector. See <a href="http://www.call-with-current-continuation.org/eggs/message-digest.html">message-digest</a> for more information.</p>
    290 <dt class="definition"><strong>procedure:</strong> ({HASH}:digest OBJECT)</dt>
    291 <dd>
    292 <p>Returns the hash of <tt>OBJECT</tt> as a hexadecimal text string.</p></dd>
    293 <dt class="definition"><strong>procedure:</strong> ({HASH}:binary-digest OBJECT)</dt>
    294 <dd>
    295 <p>Returns the hash of <tt>OBJECT</tt> as a byte-string.</p></dd>
    296 <dt class="definition"><strong>procedure:</strong> ({HASH}:primitive)</dt>
    297 <dd>
    298 <p>Returns the hash primitive object.</p></dd></div>
    299 <div class="subsection">
    300 <h4>Miscellaneous Procedures</h4>
     293<dt class="definition"><strong>procedure:</strong> (make-fixnum-bounded-hash {HASH} [GETLEN string-length] [GETINT (constantly 0)])</dt>
     294<dd>
     295<p>Returns a hash function with a SRFI-69 signature, but with a fixnum domain; i.e. (object #!optional (positive fixnum) -&gt; fixnum). The <tt>GETLEN</tt> will be used to aquire the <tt>OBJECT</tt> length for the <tt>{HASH}</tt>. The <tt>GETINT</tt> will supply the initial hash value.</p></dd>
     296<dt class="definition"><strong>procedure:</strong> (make-bounded-hash {HASH} [GETLEN string-length] [GETINT (constantly 0)])</dt>
     297<dd>
     298<p>Returns a hash function with a SRFI-69 signature, but with a real domain; i.e. (object #!optional (positive number) -&gt; number). The <tt>GETLEN</tt> will be used to aquire the <tt>OBJECT</tt> length for the <tt>{HASH}</tt>. The <tt>GETINT</tt> will supply the initial hash value.</p></dd>
     299<dt class="definition"><strong>procedure:</strong> (make-seeded-hash {HASH} [SEED])</dt>
     300<dd>
     301<p>Returns a curried <tt>{HASH}</tt> of 1 or 2 arguments with the supplied <tt>SEED</tt>. When the seed is missing the <tt>(current-hash-seed)</tt> is assumed.</p></dd>
     302<dt class="definition"><strong>procedure:</strong> (make-mask-hash {HASH} MASK)</dt>
     303<dd>
     304<p>Returns a <tt>{HASH}</tt> with the hash value bitwise and'ed with the supplied <tt>MASK</tt>.</p></dd>
     305<dt class="definition"><strong>procedure:</strong> (make-range-hash {HASH} UPPER [LOWER])</dt>
     306<dd>
     307<p>Returns a <tt>{HASH}</tt> with the hash value restricted to the supplied exact interval, [<tt>LOWER</tt> <tt>UPPER</tt>]. When <tt>LOWER</tt> is missing 0 is assumed. The signature is that of the <tt>{HASH}</tt>.</p></dd>
     308<dt class="definition"><strong>procedure:</strong> (make-real-hash {HASH})</dt>
     309<dd>
     310<p>Returns a <tt>{HASH}</tt> with the hash value restricted to the interval, [0.0 1.0]. The signature is that of the <tt>{HASH}</tt>.</p></dd></div>
     311<div class="subsection">
     312<h4>Range Procedures</h4>
    301313<dt class="definition"><strong>procedure:</strong> (make-range-restriction UPPER [LOWER])</dt>
    302314<dd>
     
    307319<p>Returns a procedure of 1 argument, (-&gt; number fixnum). The arguments will be swapped if necessary so the range is [<tt>LOWER</tt>
    308320                                        <tt>UPPER</tt>]. When <tt>LOWER</tt> missing 0 is assumed.</p>
    309 <p><tt>LOWER</tt> &amp; <tt>UPPER</tt> must be fixnums.</p></dd>
     321<p><tt>LOWER</tt> &amp; <tt>UPPER</tt> must be fixnums.</p></dd></div>
     322<div class="subsection">
     323<h4>unsigned-integer32 Procedures</h4>
    310324<dt class="definition"><strong>procedure:</strong> (unsigned-integer32-ref OBJECT)</dt>
    311325<dd>
     
    317331<h3>Version</h3>
    318332<ul>
     333<li>2.105 Added TWSHMXHash, TWSHMLMXHash, TWMGMXHash.</li>
    319334<li>2.104 Added make-fixnum-bounded-hash.</li>
    320335<li>2.103 Bugfix for make-bounded-hash, assumed fixnum.</li>
  • release/3/hashes/trunk/hashes.meta

    r5588 r8148  
    1313        "RJMXHash.scm"
    1414        "TWMXHash.scm"
     15        "TWMGMXHash.scm"
     16        "TWSHMXHash.scm"
     17        "TWSHMLMXHash.scm"
     18        "TWUserMixHash.scm" "TWUserMixHash-support.scm"
    1519        "FNVHash.scm"
    1620        "FNVAHash.scm"
  • release/3/hashes/trunk/hashes.scm

    r5588 r8148  
    22;;;; Kon Lovett, Jan '06
    33
     4(use hash-utils)
    45(use
    56        RJMXHash
    6         TWMXHash
    7         FNVHash
    8         FNVAHash
     7        TWMXHash TWSHMXHash TWSHMLMXHash TWMGMXHash
     8        #; ;TWUserMixHash DOESN'T WORK
     9        TWUserMixHash
     10        FNVHash FNVAHash
    911        PHSFHash
    1012        RSHash
  • release/3/hashes/trunk/hashes.setup

    r5705 r8148  
    1212(install-dynld hashes-support *version* -O3 -d0)
    1313
     14#| TWUserMixHash DOESN'T WORK
     15(install-dynld TWUserMixHash-support *version*)
     16(install-dynld TWUserMixHash *version*)
     17|#
     18
    1419(install-dynld RJMXHash *version*)
    1520(install-dynld TWMXHash *version*)
     21(install-dynld TWMGMXHash *version*)
     22(install-dynld TWSHMXHash *version*)
     23(install-dynld TWSHMLMXHash *version*)
    1624(install-dynld FNVHash *version*)
    1725(install-dynld FNVAHash *version*)
  • release/3/hashes/trunk/tests/hashes-test.scm

    r8129 r8148  
    22
    33(use testbase testbase-output-human)
    4 (use hashes hash-utils)
     4(use hashes)
    55
    66;;;
     
    1919;;;
    2020
    21 (define-test hashes-test "Hashes"
     21(define-test hashes-test "Hash Functions"
    2222
    2323        (test/case "Hash-prim"
     
    2525                (expect-success "RJMXHash" (RJMXHash-prim TSTSTR TSTSTR-HALF-LEN 0))
    2626                (expect-success "TWMXHash" (TWMXHash-prim TSTSTR TSTSTR-HALF-LEN 0))
     27                (expect-success "TWSHMXHash" (TWSHMXHash-prim TSTSTR TSTSTR-HALF-LEN 0))
     28                (expect-success "TWSHMLMXHash" (TWSHMLMXHash-prim TSTSTR TSTSTR-HALF-LEN 0))
     29                (expect-success "TWMGMXHash" (TWMGMXHash-prim TSTSTR TSTSTR-HALF-LEN 0))
    2730                (expect-success "RSHash" (RSHash-prim TSTSTR TSTSTR-HALF-LEN 0))
    2831                (expect-success "JSHash" (JSHash-prim TSTSTR TSTSTR-HALF-LEN 0))
     
    4952                (expect-eqv "RJMXHash" (RJMXHash-prim TSTSTR TSTSTR-LEN 0) (RJMXHash TSTSTR))
    5053                (expect-eqv "TWMXHash" (TWMXHash-prim TSTSTR TSTSTR-LEN 0) (TWMXHash TSTSTR))
     54                (expect-eqv "TWSHMXHash" (TWSHMXHash-prim TSTSTR TSTSTR-LEN 0) (TWSHMXHash TSTSTR))
     55                (expect-eqv "TWSHMLMXHash" (TWSHMLMXHash-prim TSTSTR TSTSTR-LEN 0) (TWSHMLMXHash TSTSTR))
     56                (expect-eqv "TWMGMXHash" (TWMGMXHash-prim TSTSTR TSTSTR-LEN 0) (TWMGMXHash TSTSTR))
    5157                (expect-eqv "RSHash" (RSHash-prim TSTSTR TSTSTR-LEN 0) (RSHash TSTSTR))
    5258                (expect-eqv "JSHash" (JSHash-prim TSTSTR TSTSTR-LEN 0) (JSHash TSTSTR))
     
    7379                (expect-eqv "RJMXHash" (RJMXHash-prim TSTSTR TSTSTR-HALF-LEN 0) (RJMXHash TSTSTR TSTSTR-HALF-LEN))
    7480                (expect-eqv "TWMXHash" (TWMXHash-prim TSTSTR TSTSTR-HALF-LEN 0) (TWMXHash TSTSTR TSTSTR-HALF-LEN))
     81                (expect-eqv "TWSHMXHash" (TWSHMXHash-prim TSTSTR TSTSTR-HALF-LEN 0) (TWSHMXHash TSTSTR TSTSTR-HALF-LEN))
     82                (expect-eqv "TWSHMLMXHash" (TWSHMLMXHash-prim TSTSTR TSTSTR-HALF-LEN 0) (TWSHMLMXHash TSTSTR TSTSTR-HALF-LEN))
     83                (expect-eqv "TWMGMXHash" (TWMGMXHash-prim TSTSTR TSTSTR-HALF-LEN 0) (TWMGMXHash TSTSTR TSTSTR-HALF-LEN))
    7584                (expect-eqv "RSHash" (RSHash-prim TSTSTR TSTSTR-HALF-LEN 0) (RSHash TSTSTR TSTSTR-HALF-LEN))
    7685                (expect-eqv "JSHash" (JSHash-prim TSTSTR TSTSTR-HALF-LEN 0) (JSHash TSTSTR TSTSTR-HALF-LEN))
     
    97106                (expect-success "RJMXHash" (RJMXHash:digest TSTSTR))
    98107                (expect-success "TWMXHash" (TWMXHash:digest TSTSTR))
     108                (expect-success "TWSHMXHash" (TWSHMXHash:digest TSTSTR))
     109                (expect-success "TWSHMLMXHash" (TWSHMLMXHash:digest TSTSTR))
     110                (expect-success "TWMGMXHash" (TWMGMXHash:digest TSTSTR))
    99111                (expect-success "RSHash" (RSHash:digest TSTSTR))
    100112                (expect-success "JSHash" (JSHash:digest TSTSTR))
     
    116128                (expect-success "ISPLHash" (ISPLHash:digest TSTSTR))
    117129        )
     130)
    118131
    119         (test/case "Utils" (
    120                         [tstr (make-string 4)]
    121                         [bnd-hsh #f]
    122                         [str TSTSTR] )
     132(define-test hashes-utils-test "Utilities"
     133  (initial
     134    (define tstr (make-string 4))
     135    (define bnd-hsh #f)
     136    (define str TSTSTR) )
    123137
    124                 (expect-success "string" (unsigned-integer32-set! tstr (arithmetic-shift 1 31)))
    125                 (test/eqv (unsigned-integer32-ref tstr) (arithmetic-shift 1 31))
     138  (expect-success "string" (unsigned-integer32-set! tstr (arithmetic-shift 1 31)))
     139  (test/eqv (unsigned-integer32-ref tstr) (arithmetic-shift 1 31))
    126140
    127                 (expect-set! bnd-hsh (make-bounded-hash RJMXHash-prim))
    128                 (expect-procedure bnd-hsh)
    129                 (expect-number "number bound override" (bnd-hsh str 12345678901234567890))
    130                 (expect-> "within bounds" 1456 (bnd-hsh str 1456))
     141  (expect-set! bnd-hsh (make-bounded-hash RJMXHash-prim))
     142  (expect-procedure bnd-hsh)
     143  (expect-number "number bound override" (bnd-hsh str 12345678901234567890))
     144  (expect-> "within bounds" 1456 (bnd-hsh str 1456))
    131145
    132                 (expect-set! bnd-hsh (make-fixnum-bounded-hash RJMXHash-prim))
    133                 (expect-procedure bnd-hsh)
    134                 (expect-fixnum "fixnum bound override" (bnd-hsh str 1456))
    135                 (expect-> "within bounds" 1456 (bnd-hsh str 1456))
    136         )
     146  (expect-set! bnd-hsh (make-fixnum-bounded-hash RJMXHash-prim))
     147  (expect-procedure bnd-hsh)
     148  (expect-fixnum "fixnum bound override" (bnd-hsh str 1456))
     149  (expect-> "within bounds" 1456 (bnd-hsh str 1456))
     150)
    137151
    138         (test/suite "RJL3Hash random?" (
    139             [val (RJL3Hash-prim "abc" 3 0)] )
     152(define-test hashes-random-test "RJL3Hash Idempotent?"
     153        (initial
     154          (define val (RJL3Hash-prim TSTSTR TSTSTR-LEN 0)) )
    140155
    141                 (expect-eqv "1" val (RJL3Hash "abc"))
    142                 (expect-eqv "2" val (RJL3Hash "abc"))
    143                 (expect-eqv "3" val (RJL3Hash "abc"))
    144                 (expect-eqv "4" val (RJL3Hash "abc"))
    145                 (expect-eqv "5" val (RJL3Hash "abc"))
    146                 (expect-eqv "6" val (RJL3Hash "abc"))
    147                 (expect-eqv "7" val (RJL3Hash "abc"))
    148                 (expect-eqv "8" val (RJL3Hash "abc"))
    149                 (expect-eqv "9" val (RJL3Hash "abc"))
    150         )
     156  (expect-eqv "1" val (RJL3Hash TSTSTR))
     157  (expect-eqv "2" val (RJL3Hash TSTSTR))
     158  (expect-eqv "3" val (RJL3Hash TSTSTR))
     159  (expect-eqv "4" val (RJL3Hash TSTSTR))
     160  (expect-eqv "5" val (RJL3Hash TSTSTR))
     161  (expect-eqv "6" val (RJL3Hash TSTSTR))
     162  (expect-eqv "7" val (RJL3Hash TSTSTR))
     163  (expect-eqv "8" val (RJL3Hash TSTSTR))
     164  (expect-eqv "9" val (RJL3Hash TSTSTR))
     165)
     166
     167#; ;TWUserMixHash DOESN'T WORK
     168(define-test hashes-utils-test "TWUserMixHash"
     169  (initial
     170    (define (mix key)
     171      key)
     172    (define usrmixhsh)
     173    (define hash-prim)
     174                (define hash)
     175                (define binary:digest)
     176                (define text:digest)
     177                (define prim:digest) )
     178
     179    (expect-set! "TWUserMixHash Make" usrmixhsh (receive (make-TWUserMixHash mix)))
     180    (side-effect
     181      (set! hash-prim (car usrmixhsh))
     182      (set! hash (cadr usrmixhsh))
     183      (set! binary:digest (caddr usrmixhsh))
     184      (set! text:digest (cadddr usrmixhsh))
     185      (set! prim:digest (car (cddddr usrmixhsh))) )
     186
     187  (expect-success "TWUserMixHash-prim" (hash-prim TSTSTR TSTSTR-HALF-LEN 0))
     188  (expect-eqv "TWUserMixHash Hash" (hash-prim TSTSTR TSTSTR-LEN 0) (hash TSTSTR))
     189  (expect-eqv "TWUserMixHash Length Arg" (hash-prim TSTSTR TSTSTR-HALF-LEN 0) (hash TSTSTR TSTSTR-HALF-LEN))
     190  (expect-success "TWUserMixHash Digest" (text:digest TSTSTR))
    151191)
    152192
    153193;;;
    154194
    155 (test::styler-set! hashes-test test::output-style-human)
    156 (run-test "Hashes Test")
     195(test::for-each (cut test::styler-set! <> test::output-style-human))
     196(run-test "Hashes Tests")
    157197
    158198(test::forget!)
Note: See TracChangeset for help on using the changeset viewer.