From c4dd3b661a6c7a91b75e4f6d834702092dad6a40 Mon Sep 17 00:00:00 2001 From: ondrej Date: Thu, 26 Nov 2020 05:59:00 +0000 Subject: [PATCH] * rtl: implement TRandomGenerator for thread-safe random git-svn-id: trunk@47598 - --- rtl/aix/system.pp | 2 +- rtl/amiga/system.pp | 2 +- rtl/aros/system.pp | 2 +- rtl/atari/system.pp | 2 +- rtl/beos/system.pp | 2 +- rtl/bsd/system.pp | 2 +- rtl/embedded/system.pp | 2 +- rtl/emx/system.pas | 2 +- rtl/freertos/system.pp | 2 +- rtl/gba/system.pp | 9 +---- rtl/go32v2/system.pp | 2 +- rtl/haiku/system.pp | 2 +- rtl/inc/system.inc | 72 +++++++++++++++++++++++++--------------- rtl/inc/systemh.inc | 45 +++++++++++++++++++++++++ rtl/linux/system.pp | 2 +- rtl/macos/system.pp | 2 +- rtl/morphos/system.pp | 2 +- rtl/msdos/system.pp | 2 +- rtl/msxdos/system.pp | 2 +- rtl/nativent/system.pp | 2 +- rtl/nds/system.pp | 2 +- rtl/netware/system.pp | 2 +- rtl/netwlibc/system.pp | 2 +- rtl/os2/system.pas | 2 +- rtl/palmos/system.pp | 2 +- rtl/sinclairql/system.pp | 2 +- rtl/solaris/system.pp | 2 +- rtl/symbian/system.pp | 2 +- rtl/watcom/system.pp | 2 +- rtl/wii/system.pp | 2 +- rtl/win/syswin.inc | 2 +- rtl/win16/system.pp | 2 +- rtl/wince/system.pp | 2 +- rtl/zxspectrum/system.pp | 2 +- 34 files changed, 122 insertions(+), 66 deletions(-) diff --git a/rtl/aix/system.pp b/rtl/aix/system.pp index d39523e2a2..a5c4f60e7c 100644 --- a/rtl/aix/system.pp +++ b/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; diff --git a/rtl/amiga/system.pp b/rtl/amiga/system.pp index f35a781cd3..6e014be8ea 100644 --- a/rtl/amiga/system.pp +++ b/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); diff --git a/rtl/aros/system.pp b/rtl/aros/system.pp index 7a4017417a..aedede0012 100644 --- a/rtl/aros/system.pp +++ b/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 diff --git a/rtl/atari/system.pp b/rtl/atari/system.pp index 83de56f7ef..81670df26b 100644 --- a/rtl/atari/system.pp +++ b/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; diff --git a/rtl/beos/system.pp b/rtl/beos/system.pp index abd89cebbe..2d04291d96 100644 --- a/rtl/beos/system.pp +++ b/rtl/beos/system.pp @@ -280,7 +280,7 @@ begin paramstr := ''; end; -Procedure Randomize; +Procedure Randomize(var randseed: cardinal); Begin randseed:=longint(Fptime(nil)); End; diff --git a/rtl/bsd/system.pp b/rtl/bsd/system.pp index de986f1cd6..3252ead104 100644 --- a/rtl/bsd/system.pp +++ b/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; diff --git a/rtl/embedded/system.pp b/rtl/embedded/system.pp index 1a06200b7c..382c511b4b 100644 --- a/rtl/embedded/system.pp +++ b/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; diff --git a/rtl/emx/system.pas b/rtl/emx/system.pas index 9d3a2c32b4..6bc72cf7c2 100644 --- a/rtl/emx/system.pas +++ b/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 diff --git a/rtl/freertos/system.pp b/rtl/freertos/system.pp index 297f4f4405..b4fdd64130 100644 --- a/rtl/freertos/system.pp +++ b/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; diff --git a/rtl/gba/system.pp b/rtl/gba/system.pp index 2656b362ab..b684a6312a 100644 --- a/rtl/gba/system.pp +++ b/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; diff --git a/rtl/go32v2/system.pp b/rtl/go32v2/system.pp index a78ca4107b..1450b0cdf2 100644 --- a/rtl/go32v2/system.pp +++ b/rtl/go32v2/system.pp @@ -581,7 +581,7 @@ begin end; -procedure randomize; +procedure randomize(var randseed: cardinal); var hl : longint; regs : trealregs; diff --git a/rtl/haiku/system.pp b/rtl/haiku/system.pp index 44c537ea97..5f4a3d854e 100644 --- a/rtl/haiku/system.pp +++ b/rtl/haiku/system.pp @@ -154,7 +154,7 @@ begin paramstr := ''; end; -Procedure Randomize; +Procedure Randomize(var randseed: cardinal); Begin randseed:=longint(Fptime(nil)); End; diff --git a/rtl/inc/system.inc b/rtl/inc/system.inc index 9b1f7932e1..0b5e2600be 100644 --- a/rtl/inc/system.inc +++ b/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 - 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; +function TRandomGenerator.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. } diff --git a/rtl/inc/systemh.inc b/rtl/inc/systemh.inc index 3898399f17..81f03fb97b 100644 --- a/rtl/inc/systemh.inc +++ b/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)} diff --git a/rtl/linux/system.pp b/rtl/linux/system.pp index e6cb6246f2..ca6e7d40dd 100644 --- a/rtl/linux/system.pp +++ b/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; diff --git a/rtl/macos/system.pp b/rtl/macos/system.pp index 232861a30d..ecdc67ac80 100644 --- a/rtl/macos/system.pp +++ b/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; diff --git a/rtl/morphos/system.pp b/rtl/morphos/system.pp index 1037a1727e..641eaa8b1b 100644 --- a/rtl/morphos/system.pp +++ b/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); diff --git a/rtl/msdos/system.pp b/rtl/msdos/system.pp index ca62df02ca..636e83b742 100644 --- a/rtl/msdos/system.pp +++ b/rtl/msdos/system.pp @@ -578,7 +578,7 @@ begin end; -procedure randomize; +procedure randomize(var randseed: cardinal); var hl : longint; regs : Registers; diff --git a/rtl/msxdos/system.pp b/rtl/msxdos/system.pp index 845c175b7d..f2263913cf 100644 --- a/rtl/msxdos/system.pp +++ b/rtl/msxdos/system.pp @@ -591,7 +591,7 @@ begin end; -procedure randomize; +procedure randomize(var randseed: cardinal); {$ifdef todo} var hl : longint; diff --git a/rtl/nativent/system.pp b/rtl/nativent/system.pp index 2addf19c3f..81afcc7dae 100644 --- a/rtl/nativent/system.pp +++ b/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 diff --git a/rtl/nds/system.pp b/rtl/nds/system.pp index 635f18ad6f..bb64ec33ac 100644 --- a/rtl/nds/system.pp +++ b/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 diff --git a/rtl/netware/system.pp b/rtl/netware/system.pp index 2203d5e5e2..701ad8ac45 100644 --- a/rtl/netware/system.pp +++ b/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; diff --git a/rtl/netwlibc/system.pp b/rtl/netwlibc/system.pp index a43ae063eb..09497abf68 100644 --- a/rtl/netwlibc/system.pp +++ b/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; diff --git a/rtl/os2/system.pas b/rtl/os2/system.pas index b78a4b1dc5..7f45bf84e8 100644 --- a/rtl/os2/system.pas +++ b/rtl/os2/system.pas @@ -823,7 +823,7 @@ begin else paramstr:=''; end; -procedure randomize; +procedure randomize(var randseed: cardinal); var dt: TSysDateTime; begin diff --git a/rtl/palmos/system.pp b/rtl/palmos/system.pp index 5a3073043a..6fcf1d2d1b 100644 --- a/rtl/palmos/system.pp +++ b/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; diff --git a/rtl/sinclairql/system.pp b/rtl/sinclairql/system.pp index 45d8d82548..ba5264d9c6 100644 --- a/rtl/sinclairql/system.pp +++ b/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; diff --git a/rtl/solaris/system.pp b/rtl/solaris/system.pp index 9149072161..be958771a9 100644 --- a/rtl/solaris/system.pp +++ b/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; diff --git a/rtl/symbian/system.pp b/rtl/symbian/system.pp index e5c9ce8bf3..d97fa52fb8 100644 --- a/rtl/symbian/system.pp +++ b/rtl/symbian/system.pp @@ -153,7 +153,7 @@ begin end; -procedure randomize; +procedure randomize(var randseed: cardinal); begin // randseed:=GetTickCount; end; diff --git a/rtl/watcom/system.pp b/rtl/watcom/system.pp index fe3625b7f6..568c0c18e3 100644 --- a/rtl/watcom/system.pp +++ b/rtl/watcom/system.pp @@ -651,7 +651,7 @@ begin end; -procedure randomize; +procedure randomize(var randseed: cardinal); var hl : longint; regs : trealregs; diff --git a/rtl/wii/system.pp b/rtl/wii/system.pp index a70860c347..ff2e7e867c 100644 --- a/rtl/wii/system.pp +++ b/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; diff --git a/rtl/win/syswin.inc b/rtl/win/syswin.inc index 63ee752569..1fd7174ecb 100644 --- a/rtl/win/syswin.inc +++ b/rtl/win/syswin.inc @@ -359,7 +359,7 @@ end; {*****************************************************************************} -procedure randomize; +procedure randomize(var randseed: cardinal); begin randseed:=GetTickCount; end; diff --git a/rtl/win16/system.pp b/rtl/win16/system.pp index 238f805385..9fa1dcb4a7 100644 --- a/rtl/win16/system.pp +++ b/rtl/win16/system.pp @@ -445,7 +445,7 @@ begin paramstr:=''; end; -procedure randomize; +procedure randomize(var randseed: cardinal); begin randseed:=GetTickCount; end; diff --git a/rtl/wince/system.pp b/rtl/wince/system.pp index f196b0230e..8434e37c29 100644 --- a/rtl/wince/system.pp +++ b/rtl/wince/system.pp @@ -755,7 +755,7 @@ begin paramstr:=''; end; -procedure randomize; +procedure randomize(var randseed: cardinal); begin randseed:=GetTickCount; end; diff --git a/rtl/zxspectrum/system.pp b/rtl/zxspectrum/system.pp index 0ad38059f5..e81e08201e 100644 --- a/rtl/zxspectrum/system.pp +++ b/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;