basis/checksums/metrohash/metrohash.factor

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