* rtl: implement TRandomGenerator for thread-safe random

git-svn-id: trunk@47598 -

rtl/aix/system.pp

@@ -89,7 +89,7 @@ function paramstr(l: longint) : string;
        paramstr:='';
  end;
 
-Procedure Randomize;
+Procedure Randomize(var randseed: cardinal);
 Begin
   randseed:=longint(Fptime(nil));
 End;

rtl/amiga/system.pp

@@ -256,7 +256,7 @@ end;
 *****************************************************************************}
 
 { set randseed to a new pseudo random value }
-procedure randomize;
+Procedure randomize(var randseed: cardinal);
 var tmpTime: TDateStamp;
 begin
   DateStamp(@tmpTime);

rtl/aros/system.pp

@@ -175,7 +175,7 @@ end;
 *****************************************************************************}
 
 { set randseed to a new pseudo random value }
-procedure Randomize;
+Procedure Randomize(var randseed: cardinal);
 var
   tmpTime: TDateStamp;
 begin

rtl/atari/system.pp

@@ -123,7 +123,7 @@ var
   end;
 
 
-  procedure randomize;
+  procedure randomize(var randseed: cardinal);
   begin
     {$WARNING: randseed initial value is 24bit}
     randseed:=xbios_random;

rtl/beos/system.pp

@@ -280,7 +280,7 @@ begin
     paramstr := '';
 end;
 
-Procedure Randomize;
+Procedure Randomize(var randseed: cardinal);
 Begin
   randseed:=longint(Fptime(nil));
 End;

rtl/bsd/system.pp

@@ -165,7 +165,7 @@ function paramstr(l: longint) : string;
        paramstr:='';
  end;
 
-Procedure Randomize;
+Procedure Randomize(var randseed: cardinal);
 Begin
   randseed:=longint(Fptime(nil));
 End;

rtl/embedded/system.pp

@@ -244,7 +244,7 @@ function paramstr(l: longint) : string;
 {$endif FPC_HAS_FEATURE_COMMANDARGS}
 
 {$ifdef FPC_HAS_FEATURE_RANDOM}
-procedure randomize();
+procedure randomize(var randseed: cardinal);
 begin
   RandSeed := 63458;
 end;

rtl/emx/system.pas

@@ -242,7 +242,7 @@ begin
 end;
 
 
-procedure randomize; assembler;
+procedure randomize(var randseed: cardinal); assembler; // ToDo
 asm
     mov ah, 2Ch
     call syscall

rtl/freertos/system.pp

@@ -249,7 +249,7 @@ function paramstr(l: longint) : string;
 
 
 {$ifdef FPC_HAS_FEATURE_RANDOM}
-procedure randomize();
+procedure randomize(var randseed: cardinal);
 begin
   RandSeed := 63458;
 end;

rtl/gba/system.pp

@@ -63,8 +63,6 @@ var
   fake_heap_end: ^byte; cvar; external;
 
 
-procedure randomize(value: integer);
-
 implementation
 
 {$linklib sysbase}
@@ -110,16 +108,11 @@ end;
                              ParamStr/Randomize
 *****************************************************************************}
 
-procedure randomize();
+procedure randomize(var randseed: cardinal);
 begin
   RandSeed := 63458;
 end;
 
-procedure randomize(value: integer);
-begin
-  RandSeed := value;
-end;
-
 {$ifdef FPC_HAS_FEATURE_COMMANDARGS}
 { number of args }
 function paramcount : longint;

rtl/go32v2/system.pp

@@ -581,7 +581,7 @@ begin
 end;
 
 
-procedure randomize;
+procedure randomize(var randseed: cardinal);
 var
   hl   : longint;
   regs : trealregs;

rtl/haiku/system.pp

@@ -154,7 +154,7 @@ begin
     paramstr := '';
 end;
 
-Procedure Randomize;
+Procedure Randomize(var randseed: cardinal);
 Begin
   randseed:=longint(Fptime(nil));
 End;

rtl/inc/system.inc

@@ -51,8 +51,6 @@ 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';
@@ -603,29 +601,12 @@ type
 {$R-} {range checking off}
 {$Q-} {overflow checking off}
 
-const
+function TRandomGenerator.MTWIST_MIXBITS(u, v: cardinal): cardinal; inline;
-  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 MTWIST_TWIST(u, v: cardinal): cardinal; inline;
+function TRandomGenerator.MTWIST_TWIST(u, v: cardinal): cardinal; inline;
 begin
   { the construct at the end is equivalent to
     if odd(v) then
@@ -636,7 +617,7 @@ begin
   result:=(MTWIST_MIXBITS(u,v) shr 1) xor (cardinal(-(v and 1)) and MTWIST_MATRIX_A);
 end;
 
-procedure mtwist_init(seed: cardinal);
+procedure TRandomGenerator.mtwist_init(seed: cardinal);
 var
   i: longint;
 begin
@@ -647,7 +628,7 @@ begin
   mt_index:=MTWIST_N;
 end;
 
-procedure mtwist_update_state;
+procedure TRandomGenerator.mtwist_update_state;
 var
   count: longint;
 begin
@@ -668,7 +649,7 @@ begin
 end;
 
 
-function mtwist_u32rand: cardinal;
+function TRandomGenerator.mtwist_u32rand: cardinal;
 var
   l_index :cardinal;
 begin
@@ -702,7 +683,7 @@ begin
 end;
 
 
-function random(l:longint): longint;
+function TRandomGenerator.Random(l:longint): longint;
 begin
   { otherwise we can return values = l (JM) }
   if (l < 0) then
@@ -710,7 +691,7 @@ begin
   random := longint((int64(mtwist_u32rand)*l) shr 32);
 end;
 
-function random(l:int64): int64;
+function TRandomGenerator.Random(l:int64): int64;
 var
  a, b, c, d: cardinal;
  q, bd, ad, bc, ac: qword;
@@ -745,12 +726,49 @@ begin
 end;
 
 {$ifndef FPUNONE}
-function random: extended;
+function TRandomGenerator.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. }

rtl/inc/systemh.inc

@@ -786,7 +786,51 @@ 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}
@@ -932,6 +976,7 @@ Function  Random(l:int64):int64;
 Function  Random: extended;
 {$endif}
 Procedure Randomize;
+Procedure Randomize(var RandSeed: cardinal);
 {$endif FPC_HAS_FEATURE_RANDOM}
 
 {$if defined(CPUINT8)}

rtl/linux/system.pp

@@ -453,7 +453,7 @@ function paramstr(l: longint) : string;
      paramstr:='';
  end;
 
-Procedure Randomize;
+Procedure Randomize(var randseed: cardinal);
 Begin
   randseed:=longint(Fptime(nil));
 End;

rtl/macos/system.pp

@@ -239,7 +239,7 @@ begin
 end;
 
 { set randseed to a new pseudo random value }
-procedure randomize;
+procedure randomize(var randseed: cardinal);
 begin
   randseed:= Cardinal(TickCount);
 end;

rtl/morphos/system.pp

@@ -179,7 +179,7 @@ end;
 *****************************************************************************}
 
 { set randseed to a new pseudo random value }
-procedure randomize;
+procedure randomize(var randseed: cardinal);
 var tmpTime: TDateStamp;
 begin
   DateStamp(@tmpTime);

rtl/msdos/system.pp

@@ -578,7 +578,7 @@ begin
 end;
 
 
-procedure randomize;
+procedure randomize(var randseed: cardinal);
 var
   hl   : longint;
   regs : Registers;

rtl/msxdos/system.pp

@@ -591,7 +591,7 @@ begin
 end;
 
 
-procedure randomize;
+procedure randomize(var randseed: cardinal);
 {$ifdef todo}
 var
   hl   : longint;

rtl/nativent/system.pp

@@ -263,7 +263,7 @@ end;
 
 procedure KeQueryTickCount(TickCount: PLargeInteger); stdcall; external ntdll name 'KeQueryTickCount';
 
-procedure randomize;
+procedure randomize(var randseed: cardinal);
 var
   tc: PLargeInteger;
 begin

rtl/nds/system.pp

@@ -133,7 +133,7 @@ end;
 *****************************************************************************}
 
 { set randseed to a new pseudo random value }
-procedure randomize;
+procedure randomize(var randseed: cardinal);
 var
   IPC_Timer: array [0..2] of byte absolute $27FF01B;
 begin

rtl/netware/system.pp

@@ -225,7 +225,7 @@ begin
 end;
 
 { set randseed to a new pseudo random value }
-procedure randomize;
+procedure randomize(var randseed: cardinal);
 begin
   randseed := _time (NIL);
 end;

rtl/netwlibc/system.pp

@@ -212,7 +212,7 @@ begin
 end;
 
 { set randseed to a new pseudo random value }
-procedure randomize;
+procedure randomize(var randseed: cardinal);
 begin
   randseed := time (NIL);
 end;

rtl/os2/system.pas

@@ -823,7 +823,7 @@ begin
     else paramstr:='';
 end;
 
-procedure randomize;
+procedure randomize(var randseed: cardinal);
 var
   dt: TSysDateTime;
 begin

rtl/palmos/system.pp

@@ -102,7 +102,7 @@ var
     GenerateArgs;
   end;
 
-  procedure randomize;
+  procedure randomize(var randseed: cardinal);
   begin
     {$WARNING: randseed initial value is zero!}
     randseed:=0;

rtl/sinclairql/system.pp

@@ -113,7 +113,7 @@ procedure SysInitParamsAndEnv;
 begin
 end;
 
-procedure randomize;
+procedure randomize(var randseed: cardinal);
 begin
   {$WARNING: randseed is uninitialized}
   randseed:=0;

rtl/solaris/system.pp

@@ -121,7 +121,7 @@ function paramstr(l: longint) : string;
        paramstr:='';
  end;
 
-Procedure Randomize;
+Procedure Randomize(var randseed: cardinal);
 Begin
   randseed:=longint(Fptime(nil));
 End;

rtl/symbian/system.pp

@@ -153,7 +153,7 @@ begin
 end;
 
 
-procedure randomize;
+procedure randomize(var randseed: cardinal);
 begin
 //  randseed:=GetTickCount;
 end;

rtl/watcom/system.pp

@@ -651,7 +651,7 @@ begin
 end;
 
 
-procedure randomize;
+procedure randomize(var randseed: cardinal);
 var
   hl   : longint;
   regs : trealregs;

rtl/wii/system.pp

@@ -103,7 +103,7 @@ end;
 *****************************************************************************}
 
 { set randseed to a new pseudo random value }
-procedure randomize;
+procedure randomize(var randseed: cardinal);
 begin
 
 end;

rtl/win/syswin.inc

@@ -359,7 +359,7 @@ end;
 
 {*****************************************************************************}
 
-procedure randomize;
+procedure randomize(var randseed: cardinal);
 begin
   randseed:=GetTickCount;
 end;

rtl/win16/system.pp

@@ -445,7 +445,7 @@ begin
     paramstr:='';
 end;
 
-procedure randomize;
+procedure randomize(var randseed: cardinal);
 begin
   randseed:=GetTickCount;
 end;

rtl/wince/system.pp

@@ -755,7 +755,7 @@ begin
     paramstr:='';
 end;
 
-procedure randomize;
+procedure randomize(var randseed: cardinal);
 begin
   randseed:=GetTickCount;
 end;

rtl/zxspectrum/system.pp

@@ -111,7 +111,7 @@ var
 {$endif FPC_HAS_FEATURE_SOFTFPU}
 {$endif FPUNONE}
 
-procedure randomize;
+procedure randomize(var randseed: cardinal);
 begin
 end;