diff --git a/rtl/inc/system.inc b/rtl/inc/system.inc index 7e967b549a..10b470b426 100644 --- a/rtl/inc/system.inc +++ b/rtl/inc/system.inc @@ -29,6 +29,13 @@ type FileFunc = Procedure(var t : TextRec); const +{ Random / Randomize constants } + OldRandSeed : Longint = 0; + InitialSeed : Boolean = TRUE; + Seed1 : Longint = 0; + Seed2 : Longint = 0; + Seed3 : Longint = 0; + { For Error Handling.} DoError : Boolean = FALSE; ErrorBase : Longint = 0; @@ -250,31 +257,77 @@ End; {$endif RTLLITE} +{**************************************************************************** + Random function routines + + This implements a very long cycle random number generator by combining + three independant generators. The technique was described in the March + 1987 issue of Byte. + Taken and modified with permission from the PCQ Pascal rtl code. +****************************************************************************} {$R-} +{$Q-} + +{ PLEASE DO NOT OPTIMIZE BECAUSE THEY ACTUALLY WORK CORRECTLY - unless } +{ you want me to go violent :) (CEC) } + +Procedure UseSeed(seed : Longint);Forward; + + +Function Random : Real; +var + ReturnValue : Real; +begin + if (InitialSeed) OR ((RandSeed <> OldRandSeed) AND NOT InitialSeed) then + Begin + OldRandSeed:=RandSeed; + { This is a pretty complicated affair } + { Initially we must call UseSeed when RandSeed is initalized } + { We must also call UseSeed each time RandSeed is reinitialized } + { DO NOT CHANGE THE ORDER OF DECLARATIONS IN THIS BLOCK } + { UNLESS YOU WANT RANDON TO CRASH OF COURSE (CEC) } + InitialSeed:=FALSE; + UseSeed(Randseed); + end; + Inc(Seed1); + Seed1 := (Seed1 * 706) mod 500009; + INC(Seed2); + Seed2 := (Seed2 * 774) MOD 600011; + INC(Seed3); + Seed3 := (Seed3 * 871) MOD 765241; + ReturnValue := Seed1/500009.0 + + Seed2/600011.0 + + Seed3/765241.0; + Random := frac(ReturnValue); +end; + Function Random(l : Longint) : Longint; -{ - the problem Wwth this Function is if l is maxLongint*3/4 then the - probability to obtain a number in the range maxlongint*1/4 to maxlongint*1/2 - is two times smaller than the probability for other numbers ! -} -Begin - Randseed:=Randseed*134775813+1; - Random:=abs(Randseed mod l); -End; +begin + if (InitialSeed) OR ((RandSeed <> OldRandSeed) AND NOT InitialSeed) then + Begin + OldRandSeed:=RandSeed; + { This is a pretty complicated affair } + { Initially we must call UseSeed when RandSeed is initalized } + { We must also call UseSeed each time RandSeed is reinitialized } + { DO NOT CHANGE THE ORDER OF DECLARATIONS IN THIS BLOCK } + { UNLESS YOU WANT RANDON TO CRASH OF COURSE (CEC) } + InitialSeed:=FALSE; + UseSeed(Randseed); + end; + Inc(Seed1); + Seed1 := (Seed1 * 998) mod 1000003; + Random := Seed1 mod Succ(l); +end; -Function Random : real; -{ - I am not sure about the accuracy of such a value (PM) -} -Begin - Random:=abs(Randseed); - Random:=Random/(maxLongint+1.0); - Randseed:=Randseed*134775813+1; - Random:=(abs(Randseed)+Random)/(maxLongint+2.0); -End; +Procedure UseSeed(seed : Longint); +begin + Seed1 := seed mod 1000003; + Seed2 := (Random(65000) * Random(65000)) mod 600011; + Seed3 := (Random(65000) * Random(65000)) mod 765241; +end; @@ -440,7 +493,10 @@ End; { $Log$ - Revision 1.18 1998-07-02 13:01:55 carl + Revision 1.19 1998-07-08 11:56:55 carl + * randon and Random(l) now work correctly - don't touch it works! + + Revision 1.18 1998/07/02 13:01:55 carl * hmmm... it is luck (BSS zeroed with GAS) that DoError and ErrorBase work. Now they are initilized instead.