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