basis/checksums/xxhash/xxhash.factor

   1 ! Copyright (C) 2014 John Benediktsson.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3
   4 USING: accessors alien alien.c-types alien.data byte-arrays
   5 checksums combinators endian generalizations grouping kernel
   6 locals math math.bitwise math.ranges sequences
   7 specialized-arrays ;
   8 SPECIALIZED-ARRAY: uint64_t
   9
  10 IN: checksums.xxhash
  11
  12 CONSTANT: prime1 2654435761
  13 CONSTANT: prime2 2246822519
  14 CONSTANT: prime3 3266489917
  15 CONSTANT: prime4 668265263
  16 CONSTANT: prime5 374761393
  17
  18 TUPLE: xxhash seed ;
  19
  20 C: <xxhash> xxhash
  21
  22 <PRIVATE
  23
  24 :: native-mapper ( from to bytes c-type -- seq )
  25     from to bytes <slice>
  26     bytes byte-array? little-endian? and
  27     [ c-type cast-array ]
  28     [ c-type heap-size <groups> [ le> ] map ] if ; inline
  29
  30 PRIVATE>
  31
  32 M:: xxhash checksum-bytes ( bytes checksum -- value )
  33     checksum seed>> :> seed
  34     bytes length :> len
  35
  36     len dup 16 mod - :> len/16
  37     len dup 4 mod - :> len/4
  38
  39     len 16 >= [
  40
  41         seed prime1 w+ prime2 w+
  42         seed prime2 w+
  43         seed
  44         seed prime1 w-
  45
  46         0 len/16 bytes uint native-mapper
  47
  48         4 <groups> [
  49             first4
  50             [ prime2 w* w+ 13 bitroll-32 prime1 w* ]
  51             4 napply
  52         ] each
  53
  54         {
  55             [ 1 bitroll-32 ]
  56             [ 7 bitroll-32 ]
  57             [ 12 bitroll-32 ]
  58             [ 18 bitroll-32 ]
  59         } spread w+ w+ w+
  60     ] [
  61         seed prime5 w+
  62     ] if
  63
  64     len w+
  65
  66     len/16 len/4 bytes uint native-mapper
  67     [ prime3 w* w+ 17 bitroll-32 prime4 w* ] each
  68
  69     bytes len/4 tail-slice
  70     [ prime5 w* w+ 11 bitroll-32 prime1 w* ] each
  71
  72     [ -15 shift ] [ bitxor ] bi prime2 w*
  73     [ -13 shift ] [ bitxor ] bi prime3 w*
  74     [ -16 shift ] [ bitxor ] bi ;
  75
  76 INSTANCE: xxhash checksum