Browse Source

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

git-svn-id: trunk@46266 -
yury 5 years ago
parent
commit
aa633544f1
2 changed files with 59 additions and 0 deletions
  1. 50 0
      rtl/inc/system.inc
  2. 9 0
      rtl/inc/systemh.inc

+ 50 - 0
rtl/inc/system.inc

@@ -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 - 0
rtl/inc/systemh.inc

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