1 ! Copyright (C) 2021 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
4 USING: accessors alien.c-types alien.data byte-arrays checksums
5 grouping io.binary kernel literals math math.bitwise math.order
6 sequences sequences.generalizations sequences.private
8 SPECIALIZED-ARRAY: uint64_t
13 :: wymum ( a b -- a' b' )
14 a -32 shift 32 bits :> Ha
15 b -32 shift 32 bits :> Hb
23 RL RM0 32 shift W+ :> T
24 T RM1 32 shift W+ :> LO
25 T RL < 1 0 ? LO T < 1 0 ? W+ :> C
26 RH RM0 -32 shift W+ RM1 -32 shift W+ C W+ :> HI
33 CONSTANT: P0 0xa0761d6478bd642f
34 CONSTANT: P1 0xe7037ed1a0b428db
35 CONSTANT: P2 0x8ebc6af09c88c6e3
36 CONSTANT: P3 0x589965cc75374cc3
38 : wyrand ( seed -- seed' rand )
39 P0 W+ dup dup P1 bitxor wymix ;
41 : wyhash64 ( a b -- c )
42 [ P0 bitxor ] [ P1 bitxor ] bi* wymum
43 [ P0 bitxor ] [ P1 bitxor ] bi* wymix ;
45 : wy2u01 ( r -- [0,1) )
46 -12 shift 0x1.0p-52 * ;
48 : wy2gau ( r -- gaussian )
49 [ ] [ -21 shift ] [ -42 shift ] tri
50 [ 0x1fffff bitand ] tri@ + + 0x1.0p-20 * 3.0 - ;
52 :: native-mapper ( from to bytes c-type -- seq )
54 bytes byte-array? little-endian? and
56 [ c-type heap-size <groups> [ le> ] map ] if ; inline
64 M:: wyhash checksum-bytes ( bytes checksum -- value )
66 checksum seed>> P0 bitxor :> seed!
72 bytes [ 4 head-slice ] [ 4 tail-slice* ] bi [ le> ] bi@
76 len 2/ bytes nth 8 shift bitor
77 len 1 - bytes nth bitor
84 bytes [ 8 head-slice ] [ 8 tail-slice* ] bi [ le> ] bi@
88 len 1 - dup 48 mod - :> len/48
89 len 1 - dup 16 mod - :> len/16
91 0 len/48 bytes uint64_t native-mapper [
95 6 firstn-unsafe :> ( n0 n1 n2 n3 n4 n5 )
96 n0 P1 bitxor n1 seed bitxor wymix seed!
97 n2 P2 bitxor n3 see1 bitxor wymix see1!
98 n4 P3 bitxor n5 see2 bitxor wymix see2!
100 see1 see2 bitxor seed bitxor seed!
103 len/48 len/16 bytes uint64_t native-mapper [
105 first2-unsafe :> ( n0 n1 )
106 n0 P1 bitxor n1 seed bitxor wymix seed!
110 len 16 - len bytes uint64_t native-mapper first2
114 len P1 bitxor a P1 bitxor b seed bitxor wymix wymix ;