paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-08 08:28:09 +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);
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.