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

Removed (internal) words with no corresponding non-internal 

Removed SYMBOL: init
minor cleanups
cvs
Doug Coleman 2005-10-05 05:21:14 +00:00
parent fa122fd1c0
commit 7192167304
1 changed files with 20 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
contrib/crypto/mt.factor
View File

@ -15,7 +15,6 @@ USING: kernel math namespaces sequences ;
: HI-MASK HEX: 80000000 ; inline : HI-MASK HEX: 80000000 ; inline
: LO-MASK HEX: 7fffffff ; inline : LO-MASK HEX: 7fffffff ; inline
SYMBOL: init
SYMBOL: mt SYMBOL: mt
SYMBOL: mti SYMBOL: mti
@ -25,42 +24,42 @@ SYMBOL: mti
: mt-nth ( n -- nth ) : mt-nth ( n -- nth )
mt get nth ; inline mt get nth ; inline
: (formula) ( mt mti magic -- mt[mti] ) : formula ( mt mti -- mt[mti] )
-rot dup rot nth dup -30 shift bitxor rot * + HEX: ffffffff bitand ; inline dup rot nth dup -30 shift bitxor 1812433253 * + HEX: ffffffff bitand ; inline
: (y) ( index -- y ) : y ( index -- y )
dup 1+ mt-nth LO-MASK bitand >r mt-nth HI-MASK bitand r> bitor ; inline dup 1+ mt-nth LO-MASK bitand >r mt-nth HI-MASK bitand r> bitor ; inline
: (set-mt-ith) ( y index index1 -- ) : set-mt-ith ( y index index1 -- )
mt-nth rot dup odd? [ A ] [ 0 ] if swap -1 shift bitxor bitxor swap mt get set-nth ; inline 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
dup 7 shift HEX: 9d2c5680 bitand bitxor dup 7 shift HEX: 9d2c5680 bitand bitxor
dup 15 shift HEX: efc60000 bitand bitxor dup 15 shift HEX: efc60000 bitand bitxor
dup -18 shift bitxor ; inline dup -18 shift bitxor ; inline
: (generate-new-mt) : generate-new-mt
N M - [ dup (y) over dup M + (set-mt-ith) ] repeat N M - [ dup y over dup M + set-mt-ith ] repeat
M 1 - [ dup 227 + dup (y) over dup M N - + (set-mt-ith) drop ] repeat M 1 - [ dup 227 + dup y over dup M N - + set-mt-ith drop ] repeat
0 mti set ; 0 mti set ;
: init-genrand ( seed -- ) : init ( seed -- )
init on
[ N 1- [ drop 0 , ] each ] { } make swap [ N 1- [ drop 0 , ] each ] { } make swap
HEX: ffffffff bitand 0 pick set-nth HEX: ffffffff bitand 0 pick set-nth
N 1- [ 2dup 1812433253 (formula) 1+ pick pick 1+ swap set-nth ] repeat N 1- [ 2dup formula 1+ pick pick 1+ swap set-nth ] repeat
mt set 0 mti set mt set 0 mti set
(generate-new-mt) ; generate-new-mt ;
: genrand ( -- rand ) : genrand ( -- rand )
init get [ 5489 init-genrand ] unless mti get
mti get N >= [ { ! leave mti
(generate-new-mt) { [ dup not ] [ drop 5489 init 0 ] }
] when { [ dup N < ] [ ] }
mti get mt get nth { [ t ] [ drop generate-new-mt 0 ] }
mti [ 1+ ] change } cond
(temper) ; mt get nth temper
mti [ 1+ ] change ;
USE: compiler USE: compiler
USE: test USE: test