steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

random.sfmt: make it endian-agnostic

db4
Slava Pestov 2009-10-19 05:22:43 -05:00
parent b2592e01c1
commit 2b868bd1c3
1 changed files with 14 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
basis/random/sfmt/sfmt.factor
View File

@ -4,7 +4,7 @@ USING: accessors alien.c-types kernel locals math math.ranges
math.bitwise math.vectors math.vectors.simd random math.bitwise math.vectors math.vectors.simd random
sequences specialized-arrays sequences.private classes.struct sequences specialized-arrays sequences.private classes.struct
combinators.short-circuit fry ; combinators.short-circuit fry ;
SIMD: uint SIMDS: uchar uint ;
SPECIALIZED-ARRAY: uint SPECIALIZED-ARRAY: uint
SPECIALIZED-ARRAY: uint-4 SPECIALIZED-ARRAY: uint-4
IN: random.sfmt IN: random.sfmt
@ -28,14 +28,25 @@ TUPLE: sfmt
{ uint-array uint-array } { uint-array uint-array }
{ uint-4-array uint-4-array } ; { uint-4-array uint-4-array } ;
: endian-shuffle ( v -- w )
little-endian? [
B{ 3 2 1 0 7 6 5 4 11 10 9 8 15 14 13 12 } uint-4 boa vshuffle
] unless ; inline
: hlshift* ( v n -- w )
[ endian-shuffle ] dip hlshift endian-shuffle ; inline
: hrshift* ( v n -- w )
[ endian-shuffle ] dip hrshift endian-shuffle ; inline
: wA ( w -- wA ) : wA ( w -- wA )
dup 1 hlshift vbitxor ; inline dup 1 hlshift* vbitxor ; inline
: wB ( w mask -- wB ) : wB ( w mask -- wB )
[ 11 vrshift ] dip vbitand ; inline [ 11 vrshift ] dip vbitand ; inline
: wC ( w -- wC ) : wC ( w -- wC )
1 hrshift ; inline 1 hrshift* ; inline
: wD ( w -- wD ) : wD ( w -- wD )
18 vlshift ; inline 18 vlshift ; inline