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

sfmt uses some simd now

db4
Doug Coleman 2009-10-02 00:40:55 -05:00
parent 926ed2d5e1
commit b8e5e84df3
1 changed files with 20 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types kernel locals math math.ranges 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 specialized-arrays sequences.private ;
IN: random.sfmt IN: random.sfmt
SIMD: uint SIMD: uint
@ -16,7 +16,8 @@ CONSTANT: state-multiplier 1812433253
TUPLE: sfmt TUPLE: sfmt
sl1 sl2 sr1 sr2 mask parity sl1 sl2 sr1 sr2 mask parity
{ seed integer } { n fixnum } { m fixnum } { r1 uint-4 } { r2 uint-4 }
{ seed fixnum } { n fixnum } { m fixnum }
{ m-n fixnum } { ix fixnum } { state uint-4-array } ; { m-n fixnum } { ix fixnum } { state uint-4-array } ;
: init-state ( sfmt -- sfmt' ) : init-state ( sfmt -- sfmt' )
@ -51,36 +52,32 @@ sl1 sl2 sr1 sr2 mask parity
GENERIC: generate ( sfmt -- sfmt' ) GENERIC: generate ( sfmt -- sfmt' )
M:: sfmt generate ( sfmt -- sfmt' ) M:: sfmt generate ( sfmt -- sfmt' )
sfmt n>> 2 - sfmt state>> nth :> r1! sfmt state>> :> state
sfmt n>> 1 - sfmt state>> nth :> r2! sfmt n>> 2 - state nth-unsafe sfmt (>>r1)
0 :> r! sfmt n>> 1 - state nth-unsafe sfmt (>>r2)
0 :> i!
sfmt m>> :> m sfmt m>> :> m
sfmt n>> :> n sfmt n>> :> n
sfmt m-n>> :> m-n sfmt m-n>> :> m-n
sfmt mask>> :> mask sfmt mask>> :> mask
sfmt state>> :> state
n m - iota [ n m - iota [| i |
i! i state nth-unsafe
i state nth i m + state nth-unsafe
i m + state nth mask sfmt r1>> sfmt r2>> formula :> r
mask r1 r2 formula r!
r i state set-nth r i state set-nth-unsafe
r2 r1! sfmt r2>> sfmt (>>r1)
r r2! r sfmt (>>r2)
] each ] each
n m - 1 + n [a,b) [ n m - 1 + n [a,b) [| i |
i! i state nth-unsafe
i state nth m-n i + state nth-unsafe
m-n i + state nth mask sfmt r1>> sfmt r2>> formula :> r
mask r1 r2 formula r!
r i state set-nth r i state set-nth-unsafe
r2 r1! sfmt r2>> sfmt (>>r1)
r r2! r sfmt (>>r2)
] each ] each
sfmt 0 >>ix ; sfmt 0 >>ix ;