paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 17:49:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* randon and Random(l) now work correctly - don't touch it works!

Browse Source
This commit is contained in:
carl 1998-07-08 11:56:55 +00:00
parent df00344700
commit 4f8884b466
1 changed files with 76 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

96
rtl/inc/system.inc
View File

@ -29,6 +29,13 @@ type
FileFunc = Procedure(var t : TextRec); FileFunc = Procedure(var t : TextRec);
const const
{ Random / Randomize constants }
OldRandSeed : Longint = 0;
InitialSeed : Boolean = TRUE;
Seed1 : Longint = 0;
Seed2 : Longint = 0;
Seed3 : Longint = 0;
{ For Error Handling.} { For Error Handling.}
DoError : Boolean = FALSE; DoError : Boolean = FALSE;
ErrorBase : Longint = 0; ErrorBase : Longint = 0;
@ -250,31 +257,77 @@ End;
{$endif RTLLITE} {$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-} {$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; Function Random(l : Longint) : Longint;
{ begin
the problem Wwth this Function is if l is maxLongint*3/4 then the if (InitialSeed) OR ((RandSeed <> OldRandSeed) AND NOT InitialSeed) then
probability to obtain a number in the range maxlongint*1/4 to maxlongint*1/2 Begin
is two times smaller than the probability for other numbers ! OldRandSeed:=RandSeed;
} { This is a pretty complicated affair }
Begin { Initially we must call UseSeed when RandSeed is initalized }
Randseed:=Randseed*134775813+1; { We must also call UseSeed each time RandSeed is reinitialized }
Random:=abs(Randseed mod l); { DO NOT CHANGE THE ORDER OF DECLARATIONS IN THIS BLOCK }
End; { 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; Procedure UseSeed(seed : Longint);
{ begin
I am not sure about the accuracy of such a value (PM) Seed1 := seed mod 1000003;
} Seed2 := (Random(65000) * Random(65000)) mod 600011;
Begin Seed3 := (Random(65000) * Random(65000)) mod 765241;
Random:=abs(Randseed); end;
Random:=Random/(maxLongint+1.0);
Randseed:=Randseed*134775813+1;
Random:=(abs(Randseed)+Random)/(maxLongint+2.0);
End;
@ -440,7 +493,10 @@ End;
{ {
$Log$ $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. * hmmm... it is luck (BSS zeroed with GAS) that DoError and ErrorBase work.
Now they are initilized instead. Now they are initilized instead.