unit tsrandom;

inteface

type

{ A threadsafe implementation of Free Pascal's random number generator.

The Free Pascal default Random is not thread safe.

This algorithm is fully compatible will Free Pascal's Random.

It is an implementation of a Mersenne Twister.

See:https://en.wikipedia.org/wiki/Mersenne_Twister

This class only guarantees a repeatable series of random values

within the same thread. Every thread has it's own Random and Randseed.

Exported data, however, can be repeated provided the Randseed is known.

Every Randseed needs to be initialized on a per thread basis.}

{ TThreadSafeRandom }

TThreadSafeRandom = class sealed

strict private

class function GetSeed: Cardinal; inline;static;

class procedure SetSeed(AValue: Cardinal);inline; static;

class procedure Initialize(const ASeed:Cardinal);inline;static;

class procedure Twist;inline;static;

class function IM:Cardinal;inline;static;

class constructor create;

public

class procedure Randomize;inline;static;

class function Random: extended; overload;static;inline;

class function Random(range:longint):longint;overload;static;inline;

class function Random(range:int64):int64;overload;static;inline;

class property RandSeed:Cardinal Read GetSeed write SetSeed;

end;

TsRand = type TThreadSafeRandom;

implementation

const

// Define MT19937 constants (32-bit RNG)

N = 624;M = 397;R = 31;A = $9908B0DF;F = 1812433253;

U = 11;S = 7;B = $9D2C5680;T = 15;C = $EFC60000;L = 18;

MASK_LOWER = QWORD(1) << R - 1;

MASK_UPPER = QWORD(1) << R;

// conversion constants. Converts IM output from Cardinal to Float.

CONVERT_UNSIGNED = Extended (1.0/int64(1 shl 32)); // 0..1

CONVERT_SIGNED = Extended (2.0/int64(1 shl 32)); // -1..1

Threadvar

MtRandSeed:Cardinal;

MtOldRandSeed:Cardinal;

Index:Cardinal;

mt:array[0..N-1] of dword;

{ TThreadSafeRandom }

class function TThreadSafeRandom.GetSeed: Cardinal;

begin

Result := mtRandSeed;

end;

class procedure TThreadSafeRandom.SetSeed(AValue: Cardinal);

begin

mtRandSeed := AValue;

Initialize(mtRandseed);

end;

class procedure TThreadSafeRandom.Initialize(const ASeed: Cardinal);

var

i:dword;

begin

mt[0] := Aseed;

for i := 1 to pred(N) do

mt[i] := F * (mt[i - 1] xor (mt[i - 1] >> 30)) + i;

index := N;

end;

class procedure TThreadSafeRandom.Twist;inline;static;

var

i:integer;

begin

for i:=0 to N-M-1 do

mt[i]:=mt[i+M] xor {twist} (((mt[i] and MASK_UPPER) or

(mt[i+1] and MASK_LOWER)) shr 1)xor(dword(-(mt[i+1] and 1)) and A);

for i:=N-M to N-2 do

mt[i]:=mt[i+(M-N)]xor{twist}(((mt[i] and MASK_UPPER) or

(mt[i+1] and MASK_LOWER)) shr 1)xor(dword(-(mt[i+1] and 1)) and A);

mt[N-1]:=mt[M-1] xor {twist} (((mt[n-1] and MASK_UPPER) or (mt[0] and

MASK_LOWER)) shr 1)xor(dword(-(mt[0] and 1)) and A);

index:=0;

end;

class constructor TThreadSafeRandom.create;

begin

initialize(0);

mtOldRandSeed := 0;

end;

class procedure TThreadSafeRandom.Randomize;

begin

// Hm. Not ideal...

system.Randomize;

// assumes the Randseed is atomic for read

mtrandseed := RandSeed;

end;

class function TThreadSafeRandom.Random: extended;overload;inline;static;

begin

Result := IM * CONVERT_UNSIGNED

end;

class function TThreadSafeRandom.Random(range: longint): longint;

begin

if Range < 0 then inc(Range);

Result := IM * Range shr 32;

end;

class function TThreadSafeRandom.Random(range: int64): int64;

begin

Result:=IM;

Result:=Result or ((qword(IM) shl 32) and high(int64));

if Range<>0 then

Result := Result mod range

else

Result := 0;

end;

class function TThreadSafeRandom.IM: Cardinal;inline;static;

var

i:integer;

begin

i := index;

if (index >= N) or (mtRandSeed<>mtOldRandSeed) then

begin

Twist;

mtRandSeed:=not(mtRandSeed);

mtOldRandSeed:=mtRandSeed;

i := index;

end;

Result := mt[i];

index := i + 1;

Result := Result xor (mt[i] >> U);

Result := Result xor (Result << S) and B;

Result := Result xor (Result << T) and C;

Result := Result xor (Result >> L);

end;

end.