Quellcode durchsuchen

* revert r47598: implement TRandomGenerator

git-svn-id: trunk@47605 -
ondrej vor 4 Jahren
Ursprung
Commit
1a0ba60de6

+ 1 - 1
rtl/aix/system.pp

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

+ 1 - 1
rtl/amiga/system.pp

@@ -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);

+ 1 - 1
rtl/aros/system.pp

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

+ 1 - 1
rtl/atari/system.pp

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

+ 1 - 1
rtl/beos/system.pp

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

+ 1 - 1
rtl/bsd/system.pp

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

+ 1 - 1
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(var randseed: cardinal);
+procedure randomize();
 begin
   RandSeed := 63458;
 end;

+ 1 - 1
rtl/emx/system.pas

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

+ 1 - 1
rtl/freertos/system.pp

@@ -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;

+ 8 - 1
rtl/gba/system.pp

@@ -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;

+ 1 - 1
rtl/go32v2/system.pp

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

+ 1 - 1
rtl/haiku/system.pp

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

+ 27 - 45
rtl/inc/system.inc

@@ -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;
@@ -725,50 +744,13 @@ begin
     result:=-result;
 end;
 
-{$ifndef FPUNONE}
-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;
+  random := mtwist_u32rand * (extended(1.0)/(int64(1) shl 32));
 end;
 {$endif}
 
-Procedure Randomize;
-begin
-  RandGenerator.Randomize;
-end;
-
 {$else FPC_USE_SIMPLE_RANDOM}
 
 { A simple implementation of random. TP/Delphi compatible. }

+ 0 - 45
rtl/inc/systemh.inc

@@ -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)}

+ 1 - 1
rtl/linux/system.pp

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

+ 1 - 1
rtl/macos/system.pp

@@ -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;

+ 1 - 1
rtl/morphos/system.pp

@@ -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);

+ 1 - 1
rtl/msdos/system.pp

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

+ 1 - 1
rtl/msxdos/system.pp

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

+ 1 - 1
rtl/nativent/system.pp

@@ -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

+ 1 - 1
rtl/nds/system.pp

@@ -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

+ 1 - 1
rtl/netware/system.pp

@@ -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;

+ 1 - 1
rtl/netwlibc/system.pp

@@ -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;

+ 1 - 1
rtl/os2/system.pas

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

+ 1 - 1
rtl/palmos/system.pp

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

+ 1 - 1
rtl/sinclairql/system.pp

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

+ 1 - 1
rtl/solaris/system.pp

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

+ 1 - 1
rtl/symbian/system.pp

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

+ 1 - 1
rtl/watcom/system.pp

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

+ 1 - 1
rtl/wii/system.pp

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

+ 1 - 1
rtl/win/syswin.inc

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

+ 1 - 1
rtl/win16/system.pp

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

+ 1 - 1
rtl/wince/system.pp

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

+ 1 - 1
rtl/zxspectrum/system.pp

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