I've been trying to convert this randomizer to Forth, but somewhere I
seem to go wrong. Can somebody see anything I overlooked?
create Q 41790 cells allot
41790 value indx
362436 value carry
1236789 value xcng
521288629 value xs
: shift dup 0< if negate rshift else lshift then ;
: th cells + ;
: m ( k n ** m ) over swap shift xor ;
: cong xcng 69069 * 123 + dup to xcng ;
: shr3 xs 13 m -17 m -5 m dup to xs ;
: populate
41790 0 do
7010176 Q i th @ um* carry 0 d+
invert Q i th ! to carry
loop
1 to indx Q 0 th @
;
: supr indx 41790 < if Q indx th @ indx 1+ to indx else populate
then ;
: kiss supr cong shr3 + + ;
: main
41790 0 do cong shr3 + Q i th ! loop
0 1000000000 0 do drop kiss loop ." x = " . cr
;
#include <stdio.h>
static unsigned long Q
[41790],indx=41790,carry=362436,xcng=1236789,xs=521288629;
#define CNG ( xcng=69609*xcng+123 ) /*Congruential*/
#define XS ( xs^=xs<<13, xs^=(unsigned)xs>>17, xs^=xs>>5 ) /
*Xorshift*/
#define SUPR ( indx<41790 ? Q[indx++] : refill() )
#define KISS SUPR+CNG+XS
int refill( )
{ int i; unsigned long long t;
for(i=0;i<41790;i++) { t=7010176LL*Q[i]+carry; carry=(t>>32); Q[i]=~
(t);}
indx=1; return (Q[0]);
}
int main()
{unsigned long i,x;
for(i=0;i<41790;i++) Q[i]=CNG+XS;
for(i=0;i<1000000000;i++) x=KISS;
printf(" x=%d.\nDoes x=-872412446?\n",x);
}
For testing purposes, these are any intermediate results:
1 x= B754D5CD x=-1219177011 0.00 sec
10 x= 8DB4048B x=-1917582197 0.00 sec
100 x= 20FEE35D x= 553575261 0.00 sec
1000 x= C5BA67A7 x= -977639513 0.00 sec
10000 x= 2229E08A x= 573169802 0.00 sec
100000 x= C2856C21 x=-1031443423 0.00 sec
1000000 x= 16DA5756 x= 383407958 0.02 sec
10000000 x= 1C3F1FB8 x= 473898936 0.24 sec
100000000 x= 7C2EF719 x= 2083452697 2.43 sec
1000000000 x= CC000AE2 x= -872412446 24.77 sec
Tnx! I've been staring my eyes out at this thingy..
Hans Bezemer
-marcel
-- -----------------------------------------------------------------------------------------
ANEW -kissproblem
: ARRAY CREATE CELLS ALLOT DOES> SWAP CELLS + ;
#41790 CONSTANT ixmax
ixmax ARRAY Q
0 VALUE indx
0 VALUE carry
0 VALUE xcng
0 VALUE xs
: refill ( -- u )
ixmax 0 ?DO I Q @
7010176 UM* carry UM+ TO carry INVERT
I Q !
LOOP
1 TO indx 0 Q @ ;
: CNG S" xcng 69609 * 123 + DUP TO xcng " EVALUATE ; IMMEDIATE /* Congruential */
: XXS S" xs DUP 13 LSHIFT XOR TO xs " EVALUATE
S" xs DUP 17 RSHIFT XOR TO xs " EVALUATE
S" xs DUP 5 RSHIFT XOR DUP TO xs " EVALUATE ; IMMEDIATE /* Xorshift */
: SUPR S" indx ixmax < IF indx Q @ 1 +TO indx ELSE refill ENDIF " EVALUATE ; IMMEDIATE
: KISS ( -- u ) SUPR CNG + XXS + ;
: INITIALIZE ( -- )
TIMER-RESET
ixmax TO indx
362436 TO carry
1236789 TO xcng
521288629 TO xs
ixmax 0 ?DO CNG XXS + I Q ! LOOP ;
: EXITIALIZE ( iters x -- )
CR SWAP 11 .R 2 SPACES ." x = " DUP H. SPACE ." x = " DUP 11 .R 2 SPACES .ELAPSED
CR . CR ." Does x=-872412446?" ;
: main ( iters -- )
INITIALIZE
0 OVER 0 ?DO DROP KISS LOOP
( iters x) EXITIALIZE ;
DOC
(*
For testing purposes, these are any intermediate results:
1 x= B754D5CD x=-1219177011 0.00 sec
10 x= 8DB4048B x=-1917582197 0.00 sec
100 x= 20FEE35D x= 553575261 0.00 sec
1000 x= C5BA67A7 x= -977639513 0.00 sec
10000 x= 2229E08A x= 573169802 0.00 sec
100000 x= C2856C21 x=-1031443423 0.00 sec
1000000 x= 16DA5756 x= 383407958 0.02 sec
10000000 x= 1C3F1FB8 x= 473898936 0.24 sec
100000000 x= 7C2EF719 x= 2083452697 2.43 sec
1000000000 x= CC000AE2 x= -872412446 24.77 sec
*)
ENDDOC
(Maybe, if so I'm willing to learn ;-))
Hans
> The answer is yes. How could a real Forth have problems here?
Here it is in more condensed form. It is incorrect for 64-bit Forths.
-marcel
-- -----------------------------------------------------------------------------------------
ANEW -kissproblem2
#41790 CONSTANT ixmax CREATE Q ixmax CELLS ALLOT
0 VALUE indx 0 VALUE carry 0 VALUE xcng 0 VALUE xxs
: [] CELLS + ;
: reset ( -- u ) ixmax 0 ?DO Q I [] @ #7010176 UM* carry UM+ TO carry INVERT Q I [] ! LOOP 1 TO indx Q @ ;
: CNG xcng #69609 * #123 + DUP TO xcng ; /* Congruential */
: XS xxs DUP #13 LSHIFT XOR DUP #17 RSHIFT XOR DUP 5 RSHIFT XOR DUP TO xxs ; /* Xorshift */
: SUPR indx ixmax < IF Q indx [] @ 1 +TO indx ELSE reset ENDIF ;
: KISS ( -- u ) SUPR CNG + XS + ;
: INITIALIZE ( -- )
TIMER-RESET ixmax TO indx #362436 TO carry #1236789 TO xcng #521288629 TO xxs
ixmax 0 ?DO CNG XS + Q I [] ! LOOP ;
: EXITIALIZE ( iters x -- )
CR ." \ " SWAP #11 .R 2 SPACES ." x = " DUP H. ." , " DUP #11 .R 2 SPACES .ELAPSED
#-872412446 = IF ." .. matches! " ENDIF ;
: main ( iters -- ) INITIALIZE 0 OVER 0 ?DO DROP KISS LOOP ( iters x) EXITIALIZE ;
: TEST ( -- ) #10 0 DO I S>F FALOG F>S main LOOP ;
test
\ 1 x = $B754D5CD, -1219177011 0.001 seconds elapsed.
\ 10 x = $8DB4048B, -1917582197 0.001 seconds elapsed.
\ 100 x = $20FEE35D, 553575261 0.002 seconds elapsed.
\ 1000 x = $C5BA67A7, -977639513 0.001 seconds elapsed.
\ 10000 x = $2229E08A, 573169802 0.001 seconds elapsed.
\ 100000 x = $C2856C21, -1031443423 0.004 seconds elapsed.
\ 1000000 x = $16DA5756, 383407958 0.021 seconds elapsed.
\ 10000000 x = $1C3F1FB8, 473898936 0.209 seconds elapsed.
\ 100000000 x = $7C2EF719, 2083452697 2.078 seconds elapsed.
\ 1000000000 x = $CC000AE2, -872412446 20.741 seconds elapsed... matches! ok
---8<---
include lib/mixed.4th
41790 CONSTANT ixmax ixmax array Q
0 VALUE indx 0 VALUE carry 0 VALUE xcng 0 VALUE xxs
: [] CELLS + ;
: UM+ 0 D+ ;
: reset ( -- u ) ixmax 0 ?DO Q I [] @ 7010176 UM* carry UM+ TO
carry INVERT Q I [] ! LOOP 1 TO indx Q @ ;
: CNG xcng 69609 * 123 + DUP TO
xcng ;
: XS xxs DUP 13 LSHIFT XOR DUP 17 RSHIFT XOR DUP 5 RSHIFT XOR DUP
TO xxs ;
: SUPR indx ixmax < IF Q indx [] @ indx 1+ TO indx ELSE reset
THEN ;
: KISS ( -- u ) SUPR CNG + XS + ;
: INITIALIZE ( -- )
ixmax TO indx 362436 TO carry 1236789 TO xcng 521288629 TO
xxs
ixmax 0 ?DO CNG XS + Q I [] ! LOOP ;
: main ( iters -- ) INITIALIZE 0 OVER 0 ?DO DROP KISS LOOP ." x =
". cr ( iters x) ;
1000000 main
---8<---
Hans