\ Copyright 1997 Pierre Henri Michel Abbat as a derivative work. \ Translated from Bob Jenkins' C code. \ See R. Jenkins, "ISAAC", LNCS 1039 (Fast Software Encryption), pp 41-49, February 1996. \ Anyone may use this code freely, as long as credit is given. ( isaac.f translated from Bob Jenkins' rand.c ) ( This version works in Win32Forth ) ( The code will work with or without optimization; it is significantly faster optimized. There is a bug in the optimizer: If you load the optimizer, then load any file using anew three times without clearing the name cache, Forth will complain that the marker is in the protected dictionary. ) \ needs optimize \ hidden >name-cache-init forth in-application anew isaac-random-number-generator hex : range over + swap ; 100 constant randsiz 8 constant randsizl ( base 2 log of randsiz ) create randrsl randsiz cells allot variable randptr ( like randcnt in C ) create mm randsiz cells allot ( internal state of isaac ) variable aa aa off variable bb bb off variable cc cc off code 5roll ( n1 n2 n3 n4 n5 n6 -- n2 n3 n4 n5 n6 n1 ) ( This occurs three times in rngstep, and the "optimizer" turns it into a long code sequence. ) xchg ebx, 0 [esp] xchg ebx, 4 [esp] xchg ebx, 8 [esp] xchg ebx, c [esp] xchg ebx, 10 [esp] next c; \ opt-on : ind ( u - u' ) ( Given u, produces one of the elements of mm. ) [ randsiz 1- cells ] literal and mm + @ ; : rngstep ( a b m m2 r mix - a' b' m+4 m2+4 r+4 ) 5roll xor 2 pick @ + ( b m m2 r a' ) 3 pick @ swap 5roll ( m m2 r x a' b ) 2dup 4 pick ind + + dup 7 pick ! nip ( m m2 r x a' y ) randsizl rshift ind rot + dup ( m m2 r a' b' b' ) 2rot cell+ swap cell+ swap ( r a' b' b' m+4 m2+4 ) rot 5roll tuck ! cell+ ( a' b' m+4 m2+4 r+4 ) ; \ opt-off : isaac aa @ 1 cc +! cc @ bb @ + mm dup randsiz cells 2/ + randrsl randsiz 2/ 0 do 4 pick 0d lshift rngstep 4 pick 06 rshift rngstep 4 pick 02 lshift rngstep 4 pick 10 rshift rngstep 4 +loop nip mm swap randsiz 2/ 0 do 4 pick 0d lshift rngstep 4 pick 06 rshift rngstep 4 pick 02 lshift rngstep 4 pick 10 rshift rngstep 4 +loop 3drop bb ! aa ! ; : reset-isaac aa off bb off cc off randptr off mm randsiz cells erase ; : test reset-isaac 0a 0 do isaac loop aa @ u. bb @ u. cc @ u. ; randptr off : rand randptr @ randrsl < if isaac randrsl randsiz 1- cells + randptr ! then randptr @ @ -cell randptr +! ; : isaac256 ( every 256th result of isaac, to be tested for bias ) isaac mm @ ; : test256 ( n - ) 0 ?do isaac256 ( 10 u.r ) drop loop ; ( Initialization of the random number generator with or without a seed ) : -roll ( This is slow code, but it's used only in the initialization! ) dup 1+ swap 0 ?do dup roll swap loop drop ; : 8@ 8 cells + 8 0 do cell- dup @ swap loop drop ; : 8! 8 cells range do i ! cell +loop ; : 8+! 8 cells range do i +! cell +loop ; : (nextnum) -rot over + 2swap tuck + swap 2swap rot 7 -roll ; : mix ( h g f e d c b a - h' g' f' e' d' c' b' a' ) over 0b lshift xor (nextnum) over 02 rshift xor (nextnum) over 08 lshift xor (nextnum) over 10 rshift xor (nextnum) over 0a lshift xor (nextnum) over 04 rshift xor (nextnum) over 08 lshift xor (nextnum) over 09 rshift xor (nextnum) ; : randinit ( ? ) ( Initializes isaac. If the argument is 0, use a default initialization; otherwise, use the contents of randrsl to compute the seed. ) reset-isaac >r ( save flag ) 9e3779b9 dup 2dup 2dup 2dup mix mix mix mix r@ not if randrsl randsiz cells erase then randrsl randsiz cells range do i 8+! i 8@ mix i mm + randrsl - dup>r 8! r> 8@ 8 cells +loop r> if mm randsiz cells range do i 8+! i 8@ mix i 8! i 8@ 8 cells +loop then 2drop 2drop 2drop 2drop ; : test768 ( Outputs the first 768 numbers generated by isaac initialized with randrsl zeroed. The second and third 256 are the numbers in randvect.txt backward in two groups. ) randrsl randsiz cells erase true randinit base @ hex 300 0 do i 8 mod 0= if cr then rand 9 u.r loop base ! ; create randsave randsiz cells allot : test-change false randinit isaac randrsl randsave randsiz cells move false randinit 400 mm +! isaac randrsl randsave randsiz 0 do i 0f and 0= if cr then over @ over @ = if ascii . else ascii * then emit cell+ swap cell+ swap loop 2drop ; decimal