mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-05 15:47:54 +02:00
* revert r47598: implement TRandomGenerator
git-svn-id: trunk@47605 -
This commit is contained in:
parent
9c77e4a899
commit
1a0ba60de6
@ -89,7 +89,7 @@ function paramstr(l: longint) : string;
|
||||
paramstr:='';
|
||||
end;
|
||||
|
||||
Procedure Randomize(var randseed: cardinal);
|
||||
Procedure Randomize;
|
||||
Begin
|
||||
randseed:=longint(Fptime(nil));
|
||||
End;
|
||||
|
@ -256,7 +256,7 @@ end;
|
||||
*****************************************************************************}
|
||||
|
||||
{ set randseed to a new pseudo random value }
|
||||
Procedure randomize(var randseed: cardinal);
|
||||
procedure randomize;
|
||||
var tmpTime: TDateStamp;
|
||||
begin
|
||||
DateStamp(@tmpTime);
|
||||
|
@ -175,7 +175,7 @@ end;
|
||||
*****************************************************************************}
|
||||
|
||||
{ set randseed to a new pseudo random value }
|
||||
Procedure Randomize(var randseed: cardinal);
|
||||
procedure Randomize;
|
||||
var
|
||||
tmpTime: TDateStamp;
|
||||
begin
|
||||
|
@ -123,7 +123,7 @@ var
|
||||
end;
|
||||
|
||||
|
||||
procedure randomize(var randseed: cardinal);
|
||||
procedure randomize;
|
||||
begin
|
||||
{$WARNING: randseed initial value is 24bit}
|
||||
randseed:=xbios_random;
|
||||
|
@ -280,7 +280,7 @@ begin
|
||||
paramstr := '';
|
||||
end;
|
||||
|
||||
Procedure Randomize(var randseed: cardinal);
|
||||
Procedure Randomize;
|
||||
Begin
|
||||
randseed:=longint(Fptime(nil));
|
||||
End;
|
||||
|
@ -165,7 +165,7 @@ function paramstr(l: longint) : string;
|
||||
paramstr:='';
|
||||
end;
|
||||
|
||||
Procedure Randomize(var randseed: cardinal);
|
||||
Procedure Randomize;
|
||||
Begin
|
||||
randseed:=longint(Fptime(nil));
|
||||
End;
|
||||
|
@ -244,7 +244,7 @@ function paramstr(l: longint) : string;
|
||||
{$endif FPC_HAS_FEATURE_COMMANDARGS}
|
||||
|
||||
{$ifdef FPC_HAS_FEATURE_RANDOM}
|
||||
procedure randomize(var randseed: cardinal);
|
||||
procedure randomize();
|
||||
begin
|
||||
RandSeed := 63458;
|
||||
end;
|
||||
|
@ -242,7 +242,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure randomize(var randseed: cardinal); assembler; // ToDo
|
||||
procedure randomize; assembler;
|
||||
asm
|
||||
mov ah, 2Ch
|
||||
call syscall
|
||||
|
@ -249,7 +249,7 @@ function paramstr(l: longint) : string;
|
||||
|
||||
|
||||
{$ifdef FPC_HAS_FEATURE_RANDOM}
|
||||
procedure randomize(var randseed: cardinal);
|
||||
procedure randomize();
|
||||
begin
|
||||
RandSeed := 63458;
|
||||
end;
|
||||
|
@ -63,6 +63,8 @@ var
|
||||
fake_heap_end: ^byte; cvar; external;
|
||||
|
||||
|
||||
procedure randomize(value: integer);
|
||||
|
||||
implementation
|
||||
|
||||
{$linklib sysbase}
|
||||
@ -108,11 +110,16 @@ end;
|
||||
ParamStr/Randomize
|
||||
*****************************************************************************}
|
||||
|
||||
procedure randomize(var randseed: cardinal);
|
||||
procedure randomize();
|
||||
begin
|
||||
RandSeed := 63458;
|
||||
end;
|
||||
|
||||
procedure randomize(value: integer);
|
||||
begin
|
||||
RandSeed := value;
|
||||
end;
|
||||
|
||||
{$ifdef FPC_HAS_FEATURE_COMMANDARGS}
|
||||
{ number of args }
|
||||
function paramcount : longint;
|
||||
|
@ -581,7 +581,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure randomize(var randseed: cardinal);
|
||||
procedure randomize;
|
||||
var
|
||||
hl : longint;
|
||||
regs : trealregs;
|
||||
|
@ -154,7 +154,7 @@ begin
|
||||
paramstr := '';
|
||||
end;
|
||||
|
||||
Procedure Randomize(var randseed: cardinal);
|
||||
Procedure Randomize;
|
||||
Begin
|
||||
randseed:=longint(Fptime(nil));
|
||||
End;
|
||||
|
@ -51,6 +51,8 @@ const
|
||||
{$else}
|
||||
STACK_MARGIN = 16384; { Stack size margin for stack checking }
|
||||
{$endif}
|
||||
{ Random / Randomize constants }
|
||||
OldRandSeed : Cardinal = 0;
|
||||
|
||||
{ For Error Handling.}
|
||||
ErrorBase : Pointer = nil;public name 'FPC_ERRORBASE';
|
||||
@ -601,12 +603,29 @@ type
|
||||
{$R-} {range checking off}
|
||||
{$Q-} {overflow checking off}
|
||||
|
||||
function TRandomGenerator.MTWIST_MIXBITS(u, v: cardinal): cardinal; inline;
|
||||
const
|
||||
MTWIST_N = 624;
|
||||
MTWIST_M = 397;
|
||||
|
||||
MT_STATIC_SEED = 5489;
|
||||
|
||||
MTWIST_UPPER_MASK = cardinal($80000000);
|
||||
MTWIST_LOWER_MASK = cardinal($7FFFFFFF);
|
||||
|
||||
MTWIST_MATRIX_A = cardinal($9908B0DF);
|
||||
|
||||
var
|
||||
mt_state: array[0..MTWIST_N-1] of cardinal;
|
||||
|
||||
const
|
||||
mt_index: cardinal = MTWIST_N+1;
|
||||
|
||||
function MTWIST_MIXBITS(u, v: cardinal): cardinal; inline;
|
||||
begin
|
||||
result:=(u and MTWIST_UPPER_MASK) or (v and MTWIST_LOWER_MASK);
|
||||
end;
|
||||
|
||||
function TRandomGenerator.MTWIST_TWIST(u, v: cardinal): cardinal; inline;
|
||||
function MTWIST_TWIST(u, v: cardinal): cardinal; inline;
|
||||
begin
|
||||
{ the construct at the end is equivalent to
|
||||
if odd(v) then
|
||||
@ -617,7 +636,7 @@ begin
|
||||
result:=(MTWIST_MIXBITS(u,v) shr 1) xor (cardinal(-(v and 1)) and MTWIST_MATRIX_A);
|
||||
end;
|
||||
|
||||
procedure TRandomGenerator.mtwist_init(seed: cardinal);
|
||||
procedure mtwist_init(seed: cardinal);
|
||||
var
|
||||
i: longint;
|
||||
begin
|
||||
@ -628,7 +647,7 @@ begin
|
||||
mt_index:=MTWIST_N;
|
||||
end;
|
||||
|
||||
procedure TRandomGenerator.mtwist_update_state;
|
||||
procedure mtwist_update_state;
|
||||
var
|
||||
count: longint;
|
||||
begin
|
||||
@ -649,7 +668,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function TRandomGenerator.mtwist_u32rand: cardinal;
|
||||
function mtwist_u32rand: cardinal;
|
||||
var
|
||||
l_index :cardinal;
|
||||
begin
|
||||
@ -683,7 +702,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function TRandomGenerator.Random(l:longint): longint;
|
||||
function random(l:longint): longint;
|
||||
begin
|
||||
{ otherwise we can return values = l (JM) }
|
||||
if (l < 0) then
|
||||
@ -691,7 +710,7 @@ begin
|
||||
random := longint((int64(mtwist_u32rand)*l) shr 32);
|
||||
end;
|
||||
|
||||
function TRandomGenerator.Random(l:int64): int64;
|
||||
function random(l:int64): int64;
|
||||
var
|
||||
a, b, c, d: cardinal;
|
||||
q, bd, ad, bc, ac: qword;
|
||||
@ -726,49 +745,12 @@ begin
|
||||
end;
|
||||
|
||||
{$ifndef FPUNONE}
|
||||
function TRandomGenerator.Random: extended;
|
||||
function random: extended;
|
||||
begin
|
||||
random := mtwist_u32rand * (extended(1.0)/(int64(1) shl 32));
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
procedure TRandomGenerator.Randomize(ARandSeed: cardinal);
|
||||
begin
|
||||
mt_index:=MTWIST_N+1;
|
||||
OldRandSeed:=0;
|
||||
Self.RandSeed:=ARandSeed;
|
||||
end;
|
||||
|
||||
procedure TRandomGenerator.Randomize;
|
||||
begin
|
||||
mt_index:=MTWIST_N+1;
|
||||
OldRandSeed:=0;
|
||||
System.Randomize(Self.RandSeed);
|
||||
end;
|
||||
|
||||
|
||||
function random(l:longint): longint;
|
||||
begin
|
||||
Result:=RandGenerator.Random(l);
|
||||
end;
|
||||
|
||||
function random(l:int64): int64;
|
||||
begin
|
||||
Result:=RandGenerator.Random(l);
|
||||
end;
|
||||
|
||||
{$ifndef FPUNONE}
|
||||
function random: extended;
|
||||
begin
|
||||
Result:=RandGenerator.Random;
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
Procedure Randomize;
|
||||
begin
|
||||
RandGenerator.Randomize;
|
||||
end;
|
||||
|
||||
{$else FPC_USE_SIMPLE_RANDOM}
|
||||
|
||||
{ A simple implementation of random. TP/Delphi compatible. }
|
||||
|
@ -786,51 +786,7 @@ const
|
||||
|
||||
var
|
||||
ExitCode : TExitCode; public name 'operatingsystem_result';
|
||||
|
||||
{ Random / Randomize definitions and variables }
|
||||
{$if defined(FPC_HAS_FEATURE_RANDOM)}
|
||||
{$ifndef FPC_USE_SIMPLE_RANDOM}
|
||||
type
|
||||
TRandomGenerator = record
|
||||
private const
|
||||
MTWIST_N = 624;
|
||||
MTWIST_M = 397;
|
||||
|
||||
MTWIST_UPPER_MASK = cardinal($80000000);
|
||||
MTWIST_LOWER_MASK = cardinal($7FFFFFFF);
|
||||
|
||||
MTWIST_MATRIX_A = cardinal($9908B0DF);
|
||||
|
||||
private
|
||||
mt_index: cardinal;
|
||||
RandSeed: cardinal;
|
||||
OldRandSeed: cardinal;
|
||||
mt_state: array[0..MTWIST_N-1] of cardinal;
|
||||
|
||||
function MTWIST_MIXBITS(u, v: cardinal): cardinal; inline;
|
||||
function MTWIST_TWIST(u, v: cardinal): cardinal; inline;
|
||||
procedure mtwist_init(seed: cardinal);
|
||||
procedure mtwist_update_state;
|
||||
function mtwist_u32rand: cardinal;
|
||||
public
|
||||
procedure Randomize;
|
||||
procedure Randomize(ARandSeed: cardinal);
|
||||
|
||||
function Random(l:longint): longint;
|
||||
function Random(l: int64): int64;
|
||||
{$ifndef FPUNONE}
|
||||
function Random: extended;
|
||||
{$endif}
|
||||
end;
|
||||
var
|
||||
RandGenerator: TRandomGenerator = (mt_index:TRandomGenerator.MTWIST_N+1; RandSeed:0; OldRandSeed:0);
|
||||
RandSeed: Cardinal absolute RandGenerator.RandSeed;
|
||||
{$else FPC_USE_SIMPLE_RANDOM}
|
||||
var
|
||||
RandSeed : Cardinal;
|
||||
{$endif FPC_USE_SIMPLE_RANDOM}
|
||||
{$endif FPC_HAS_FEATURE_RANDOM}
|
||||
|
||||
{ Delphi compatibility }
|
||||
|
||||
{$ifdef FPC_HAS_FEATURE_DYNLIBS}
|
||||
@ -976,7 +932,6 @@ Function Random(l:int64):int64;
|
||||
Function Random: extended;
|
||||
{$endif}
|
||||
Procedure Randomize;
|
||||
Procedure Randomize(var RandSeed: cardinal);
|
||||
{$endif FPC_HAS_FEATURE_RANDOM}
|
||||
|
||||
{$if defined(CPUINT8)}
|
||||
|
@ -453,7 +453,7 @@ function paramstr(l: longint) : string;
|
||||
paramstr:='';
|
||||
end;
|
||||
|
||||
Procedure Randomize(var randseed: cardinal);
|
||||
Procedure Randomize;
|
||||
Begin
|
||||
randseed:=longint(Fptime(nil));
|
||||
End;
|
||||
|
@ -239,7 +239,7 @@ begin
|
||||
end;
|
||||
|
||||
{ set randseed to a new pseudo random value }
|
||||
procedure randomize(var randseed: cardinal);
|
||||
procedure randomize;
|
||||
begin
|
||||
randseed:= Cardinal(TickCount);
|
||||
end;
|
||||
|
@ -179,7 +179,7 @@ end;
|
||||
*****************************************************************************}
|
||||
|
||||
{ set randseed to a new pseudo random value }
|
||||
procedure randomize(var randseed: cardinal);
|
||||
procedure randomize;
|
||||
var tmpTime: TDateStamp;
|
||||
begin
|
||||
DateStamp(@tmpTime);
|
||||
|
@ -578,7 +578,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure randomize(var randseed: cardinal);
|
||||
procedure randomize;
|
||||
var
|
||||
hl : longint;
|
||||
regs : Registers;
|
||||
|
@ -591,7 +591,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure randomize(var randseed: cardinal);
|
||||
procedure randomize;
|
||||
{$ifdef todo}
|
||||
var
|
||||
hl : longint;
|
||||
|
@ -263,7 +263,7 @@ end;
|
||||
|
||||
procedure KeQueryTickCount(TickCount: PLargeInteger); stdcall; external ntdll name 'KeQueryTickCount';
|
||||
|
||||
procedure randomize(var randseed: cardinal);
|
||||
procedure randomize;
|
||||
var
|
||||
tc: PLargeInteger;
|
||||
begin
|
||||
|
@ -133,7 +133,7 @@ end;
|
||||
*****************************************************************************}
|
||||
|
||||
{ set randseed to a new pseudo random value }
|
||||
procedure randomize(var randseed: cardinal);
|
||||
procedure randomize;
|
||||
var
|
||||
IPC_Timer: array [0..2] of byte absolute $27FF01B;
|
||||
begin
|
||||
|
@ -225,7 +225,7 @@ begin
|
||||
end;
|
||||
|
||||
{ set randseed to a new pseudo random value }
|
||||
procedure randomize(var randseed: cardinal);
|
||||
procedure randomize;
|
||||
begin
|
||||
randseed := _time (NIL);
|
||||
end;
|
||||
|
@ -212,7 +212,7 @@ begin
|
||||
end;
|
||||
|
||||
{ set randseed to a new pseudo random value }
|
||||
procedure randomize(var randseed: cardinal);
|
||||
procedure randomize;
|
||||
begin
|
||||
randseed := time (NIL);
|
||||
end;
|
||||
|
@ -823,7 +823,7 @@ begin
|
||||
else paramstr:='';
|
||||
end;
|
||||
|
||||
procedure randomize(var randseed: cardinal);
|
||||
procedure randomize;
|
||||
var
|
||||
dt: TSysDateTime;
|
||||
begin
|
||||
|
@ -102,7 +102,7 @@ var
|
||||
GenerateArgs;
|
||||
end;
|
||||
|
||||
procedure randomize(var randseed: cardinal);
|
||||
procedure randomize;
|
||||
begin
|
||||
{$WARNING: randseed initial value is zero!}
|
||||
randseed:=0;
|
||||
|
@ -113,7 +113,7 @@ procedure SysInitParamsAndEnv;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure randomize(var randseed: cardinal);
|
||||
procedure randomize;
|
||||
begin
|
||||
{$WARNING: randseed is uninitialized}
|
||||
randseed:=0;
|
||||
|
@ -121,7 +121,7 @@ function paramstr(l: longint) : string;
|
||||
paramstr:='';
|
||||
end;
|
||||
|
||||
Procedure Randomize(var randseed: cardinal);
|
||||
Procedure Randomize;
|
||||
Begin
|
||||
randseed:=longint(Fptime(nil));
|
||||
End;
|
||||
|
@ -153,7 +153,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure randomize(var randseed: cardinal);
|
||||
procedure randomize;
|
||||
begin
|
||||
// randseed:=GetTickCount;
|
||||
end;
|
||||
|
@ -651,7 +651,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure randomize(var randseed: cardinal);
|
||||
procedure randomize;
|
||||
var
|
||||
hl : longint;
|
||||
regs : trealregs;
|
||||
|
@ -103,7 +103,7 @@ end;
|
||||
*****************************************************************************}
|
||||
|
||||
{ set randseed to a new pseudo random value }
|
||||
procedure randomize(var randseed: cardinal);
|
||||
procedure randomize;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
@ -359,7 +359,7 @@ end;
|
||||
|
||||
{*****************************************************************************}
|
||||
|
||||
procedure randomize(var randseed: cardinal);
|
||||
procedure randomize;
|
||||
begin
|
||||
randseed:=GetTickCount;
|
||||
end;
|
||||
|
@ -445,7 +445,7 @@ begin
|
||||
paramstr:='';
|
||||
end;
|
||||
|
||||
procedure randomize(var randseed: cardinal);
|
||||
procedure randomize;
|
||||
begin
|
||||
randseed:=GetTickCount;
|
||||
end;
|
||||
|
@ -755,7 +755,7 @@ begin
|
||||
paramstr:='';
|
||||
end;
|
||||
|
||||
procedure randomize(var randseed: cardinal);
|
||||
procedure randomize;
|
||||
begin
|
||||
randseed:=GetTickCount;
|
||||
end;
|
||||
|
@ -111,7 +111,7 @@ var
|
||||
{$endif FPC_HAS_FEATURE_SOFTFPU}
|
||||
{$endif FPUNONE}
|
||||
|
||||
procedure randomize(var randseed: cardinal);
|
||||
procedure randomize;
|
||||
begin
|
||||
end;
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user