basis/checksums/metrohash/metrohash.factor

   1 ! Copyright (C) 2018 John Benediktsson.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien.c-types alien.data byte-arrays checksums
   4 combinators endian grouping kernel math math.bitwise sequences ;
   5
   6 IN: checksums.metrohash
   7
   8 TUPLE: metrohash-64 seed ;
   9
  10 C: <metrohash-64> metrohash-64
  11
  12 <PRIVATE
  13
  14 :: native-mapper ( from to bytes c-type -- seq )
  15     from to bytes <slice>
  16     bytes byte-array? alien.data:little-endian? and
  17     [ c-type cast-array ]
  18     [ c-type heap-size <groups> [ le> ] map ] if ; inline
  19
  20 PRIVATE>
  21
  22 M:: metrohash-64 checksum-bytes ( bytes checksum -- value )
  23     0xD6D018F5 :> k0
  24     0xA2AA033B :> k1
  25     0x62992FC1 :> k2
  26     0x30BC5B29 :> k3
  27
  28     checksum seed>> :> seed
  29     bytes length :> len
  30
  31     len dup 32 mod - :> len/32
  32     len dup 16 mod - :> len/16
  33     len dup 8 mod - :> len/8
  34     len dup 4 mod - :> len/4
  35     len dup 2 mod - :> len/2
  36
  37     seed k2 W+ k0 W* :> h
  38
  39     h h h h :> ( v0! v1! v2! v3! )
  40
  41     len 32 >= [
  42         0 len/32 bytes uint64_t native-mapper 4 <groups> [
  43             first4 {
  44                 [ k0 W* v0 W+ -29 bitroll-64 v2 W+ v0! ]
  45                 [ k1 W* v1 W+ -29 bitroll-64 v3 W+ v1! ]
  46                 [ k2 W* v2 W+ -29 bitroll-64 v0 W+ v2! ]
  47                 [ k3 W* v3 W+ -29 bitroll-64 v1 W+ v3! ]
  48             } spread
  49         ] each
  50
  51         v0 v3 W+ k0 W* v1 W+ -37 bitroll-64 k1 W* v2 bitxor v2!
  52         v1 v2 W+ k1 W* v0 W+ -37 bitroll-64 k0 W* v3 bitxor v3!
  53         v0 v2 W+ k0 W* v3 W+ -37 bitroll-64 k1 W* v0 bitxor v0!
  54         v1 v3 W+ k1 W* v2 W+ -37 bitroll-64 k0 W* v1 bitxor v1!
  55
  56         v0 v1 bitxor h W+ v0!
  57     ] when
  58
  59     len/32 len/16 bytes uint64_t native-mapper [
  60         first2
  61         [ k2 W* v0 W+ -29 bitroll-64 k3 W* v1! ]
  62         [ k2 W* v0 W+ -29 bitroll-64 k3 W* v2! ] bi*
  63         v1 k0 W* -21 bitroll-64 v2 W+ v1 bitxor v1!
  64         v2 k3 W* -21 bitroll-64 v1 W+ v2 bitxor v2!
  65         v2 v0 W+ v0!
  66     ] unless-empty
  67
  68     len/16 len/8 bytes uint64_t native-mapper [
  69         first k3 W* v0 W+ v0!
  70         v0 -55 bitroll-64 k1 W* v0 bitxor v0!
  71     ] unless-empty
  72
  73     len/8 len/4 bytes uint32_t native-mapper [
  74         first k3 W* v0 W+ v0!
  75         v0 -26 bitroll-64 k1 W* v0 bitxor v0!
  76     ] unless-empty
  77
  78     len/4 len/2 bytes uint16_t native-mapper [
  79         first k3 W* v0 W+ v0!
  80         v0 -48 bitroll-64 k1 W* v0 bitxor v0!
  81     ] unless-empty
  82
  83     bytes len/2 tail-slice [
  84         first k3 W* v0 W+ v0!
  85         v0 -37 bitroll-64 k1 W* v0 bitxor v0!
  86     ] unless-empty
  87
  88     v0 -28 bitroll-64 v0 bitxor v0!
  89     v0 k0 W* v0!
  90     v0 -29 bitroll-64 v0 bitxor v0!
  91     v0 ;
  92
  93 INSTANCE: metrohash-64 checksum
  94
  95 TUPLE: metrohash-128 seed ;
  96
  97 C: <metrohash-128> metrohash-128
  98
  99 M:: metrohash-128 checksum-bytes ( bytes checksum -- value )
 100     0xC83A91E1 :> k0
 101     0x8648DBDB :> k1
 102     0x7BDEC03B :> k2
 103     0x2F5870A5 :> k3
 104
 105     checksum seed>> :> seed
 106     bytes length :> len
 107
 108     len dup 32 mod - :> len/32
 109     len dup 16 mod - :> len/16
 110     len dup 8 mod - :> len/8
 111     len dup 4 mod - :> len/4
 112     len dup 2 mod - :> len/2
 113
 114     seed k0 W- k3 W* :> v0!
 115     seed k1 W+ k2 W* :> v1!
 116     seed k0 W+ k2 W* :> v2!
 117     seed k1 W- k3 W* :> v3!
 118
 119     len 32 >= [
 120         0 len/32 bytes uint64_t native-mapper 4 <groups> [
 121             first4 {
 122                 [ k0 W* v0 W+ -29 bitroll-64 v2 W+ v0! ]
 123                 [ k1 W* v1 W+ -29 bitroll-64 v3 W+ v1! ]
 124                 [ k2 W* v2 W+ -29 bitroll-64 v0 W+ v2! ]
 125                 [ k3 W* v3 W+ -29 bitroll-64 v1 W+ v3! ]
 126             } spread
 127         ] each
 128
 129         v0 v3 W+ k0 W* v1 W+ -21 bitroll-64 k1 W* v2 bitxor v2!
 130         v1 v2 W+ k1 W* v0 W+ -21 bitroll-64 k0 W* v3 bitxor v3!
 131         v0 v2 W+ k0 W* v3 W+ -21 bitroll-64 k1 W* v0 bitxor v0!
 132         v1 v3 W+ k1 W* v2 W+ -21 bitroll-64 k0 W* v1 bitxor v1!
 133     ] when
 134
 135     len/32 len/16 bytes uint64_t native-mapper [
 136         first2
 137         [ k2 W* v0 W+ -33 bitroll-64 k3 W* v0! ]
 138         [ k2 W* v1 W+ -33 bitroll-64 k3 W* v1! ] bi*
 139         v0 k2 W* v1 W+ -45 bitroll-64 k1 W* v0 bitxor v0!
 140         v1 k3 W* v0 W+ -45 bitroll-64 k0 W* v1 bitxor v1!
 141     ] unless-empty
 142
 143     len/16 len/8 bytes uint64_t native-mapper [
 144         first k2 W* v0 W+ -33 bitroll-64 k3 W* v0!
 145         v0 k2 W* v1 W+ -27 bitroll-64 k1 W* v0 bitxor v0!
 146     ] unless-empty
 147
 148     len/8 len/4 bytes uint32_t native-mapper [
 149         first k2 W* v1 W+ -33 bitroll-64 k3 W* v1!
 150         v1 k3 W* v0 W+ -46 bitroll-64 k0 W* v1 bitxor v1!
 151     ] unless-empty
 152
 153     len/4 len/2 bytes uint16_t native-mapper [
 154         first k2 W* v0 W+ -33 bitroll-64 k3 W* v0!
 155         v0 k2 W* v1 W+ -22 bitroll-64 k1 W* v0 bitxor v0!
 156     ] unless-empty
 157
 158     bytes len/2 tail-slice [
 159         first k2 W* v1 W+ -33 bitroll-64 k3 W* v1!
 160         v1 k3 W* v0 W+ -58 bitroll-64 k0 W* v1 bitxor v1!
 161     ] unless-empty
 162
 163     v0 k0 W* v1 W+ -13 bitroll-64 v0 W+ v0!
 164     v1 k1 W* v0 W+ -37 bitroll-64 v1 W+ v1!
 165     v0 k2 W* v1 W+ -13 bitroll-64 v0 W+ v0!
 166     v1 k3 W* v0 W+ -37 bitroll-64 v1 W+ v1!
 167
 168     v0 64 shift v1 + ;
 169
 170 INSTANCE: metrohash-128 checksum