paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-14 05:40:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Added a simple implementation of random. It is TP/Delphi compatible. Enabled it for 8/16 bit CPUs by default.

Browse Source 
git-svn-id: trunk@46266 -
This commit is contained in:
yury 2020-08-05 16:29:07 +00:00
parent eb21b39012
commit aa633544f1
2 changed files with 59 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
rtl/inc/system.inc
View File

@ -565,6 +565,7 @@ type
{$endif FPC_HAS_FEATURE_RTTI}
{$if defined(FPC_HAS_FEATURE_RANDOM)}
{$ifndef FPC_USE_SIMPLE_RANDOM}
{ Pascal translation of https://github.com/dajobe/libmtwist }
@ -749,6 +750,55 @@ begin
random := mtwist_u32rand * (extended(1.0)/(int64(1) shl 32));
end;
{$endif}
{$else FPC_USE_SIMPLE_RANDOM}
{ A simple implementation of random. TP/Delphi compatible. }
const
QRAN_A = 134775813;
QRAN_C = 1;
function rand_next: cardinal;
var
s: cardinal;
begin
s:=RandSeed*QRAN_A+QRAN_C;
RandSeed:=s;
rand_next:=s;
end;
function random(l: word): word;
var
s,ss: cardinal;
begin
s:=rand_next;
{ use 32-bit multiplications here }
ss:=(s shr 16)*l;
s:=(s and $FFFF)*l shr 16;
random:=(ss + s) shr 16;
end;
function random(l: longint): longint;
begin
random:=int64(rand_next)*l shr 32;
end;
function random(l:int64):int64;
begin
random:=random(longint(l));
end;
{$ifndef FPUNONE}
function random: extended;
const
c = 1.0/$10000/$10000;
begin
random:=rand_next*c;
end;
{$endif}
{$endif FPC_USE_SIMPLE_RANDOM}
{$endif FPC_HAS_FEATURE_RANDOM}

9
rtl/inc/systemh.inc
View File

@ -382,6 +382,12 @@ Type
{$endif CPUZ80}
{ By default enable a simple implementation of Random for 8/16 bit CPUs }
{$if (defined(CPU16) or defined(CPU8)) and not defined(FPC_NO_SIMPLE_RANDOM)}
{$define FPC_USE_SIMPLE_RANDOM}
{$endif}
{$if not declared(FarPointer)}
FarPointer = Pointer;
{$endif}
@ -906,6 +912,9 @@ Function Align (Addr : PtrUInt; Alignment : PtrUInt) : PtrUInt;{$ifdef SYSTEMINL
Function Align (Addr : Pointer; Alignment : PtrUInt) : Pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
{$ifdef FPC_HAS_FEATURE_RANDOM}
{$ifdef FPC_USE_SIMPLE_RANDOM}
Function Random(l:word):word;
{$endif FPC_USE_SIMPLE_RANDOM}
Function Random(l:longint):longint;
Function Random(l:int64):int64;
{$ifndef FPUNONE}