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