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

major bugfix, was not wrapping around the mt array so the last element stayed the same 

fixed a refactoring error.
added a unit test for the 10,000th random of seed 5489
cvs
Doug Coleman 2005-10-05 07:19:29 +00:00
parent 47da70e5a8
commit 3409f887e1
1 changed files with 10 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
contrib/crypto/mt.factor
View File

@ -27,11 +27,11 @@ SYMBOL: mti
: formula ( mt mti -- mt[mti] ) : formula ( mt mti -- mt[mti] )
dup rot nth dup -30 shift bitxor 1812433253 * + HEX: ffffffff bitand ; inline dup rot nth dup -30 shift bitxor 1812433253 * + HEX: ffffffff bitand ; inline
: y ( index -- y ) : y ( i0 i1 -- y )
dup 1+ mt-nth LO-MASK bitand >r mt-nth HI-MASK bitand r> bitor ; inline mt-nth LO-MASK bitand >r mt-nth HI-MASK bitand r> bitor ; inline
: set-mt-ith ( index index1 -- ) : set-mt-ith ( yi0 yi1 mt-set mt-get -- )
>r dup >r y r> r> mt-nth rot dup odd? A 0 ? swap -1 shift bitxor bitxor swap mt get set-nth ; inline >r >r y r> r> mt-nth rot dup odd? A 0 ? swap -1 shift bitxor bitxor swap mt get set-nth ; inline
: temper ( y -- yt ) : temper ( y -- yt )
dup -11 shift bitxor dup -11 shift bitxor
@ -39,9 +39,11 @@ SYMBOL: mti
dup 15 shift HEX: efc60000 bitand bitxor dup 15 shift HEX: efc60000 bitand bitxor
dup -18 shift bitxor ; inline dup -18 shift bitxor ; inline
USE: io
: generate-new-mt : generate-new-mt
N M - [ dup 2dup M + set-mt-ith ] repeat N M - [ dup 2dup >r 1+ r> dup M + set-mt-ith ] repeat
M 1- [ dup 227 + dup 2dup M N - + set-mt-ith drop ] repeat M 1- [ dup 227 + dup 2dup >r 1+ r> dup M N - + set-mt-ith drop ] repeat
N 1- 0 N 1- M 1- set-mt-ith
0 mti set ; 0 mti set ;
: init-random ( seed -- ) : init-random ( seed -- )
@ -61,6 +63,8 @@ USE: test
: million-genrand 1000000 [ drop genrand drop ] each ; : million-genrand 1000000 [ drop genrand drop ] each ;
: test-genrand \ million-genrand compile [ million-genrand ] time ; : test-genrand \ million-genrand compile [ million-genrand ] time ;
[ 4123659995 ] [ 5489 init-random 9999 [ drop genrand drop ] each genrand millis init-random ] unit-test
! test-genrand ! test-genrand
! 5987 ms run / 56 ms GC time ! 5987 ms run / 56 ms GC time