paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-30 15:40:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

* replaced pure LGPL Mersenne Twister implementation with a public domain

Browse Source 
version

git-svn-id: trunk@33029 -
This commit is contained in:
Jonas Maebe 2016-01-29 18:03:14 +00:00
parent e3060130a4
commit 9c3cab8224
1 changed files with 113 additions and 135 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

248
rtl/inc/system.inc
View File

@ -499,155 +499,130 @@ function aligntoptr(p : pointer) : pointer;inline;
{$if defined(FPC_HAS_FEATURE_RANDOM)} {$if defined(FPC_HAS_FEATURE_RANDOM)}
{---------------------------------------------------------------------- { Pascal translation of https://github.com/dajobe/libmtwist }
Mersenne Twister: A 623-Dimensionally Equidistributed Uniform
Pseudo-Random Number Generator.
What is Mersenne Twister? {* -*- Mode: c; c-basic-offset: 2 -*-
Mersenne Twister(MT) is a pseudorandom number generator developped by *
Makoto Matsumoto and Takuji Nishimura (alphabetical order) during * mt.c - Mersenne Twister functions
1996-1997. MT has the following merits: *
It is designed with consideration on the flaws of various existing * This is free and unencumbered software released into the public domain.
generators. *
Far longer period and far higher order of equidistribution than any * Anyone is free to copy, modify, publish, use, compile, sell, or
other implemented generators. (It is proved that the period is 2^19937-1, * distribute this software, either in source code form or as a compiled
and 623-dimensional equidistribution property is assured.) * binary, for any purpose, commercial or non-commercial, and by any
Fast generation. (Although it depends on the system, it is reported that * means.
MT is sometimes faster than the standard ANSI-C library in a system *
with pipeline and cache memory.) * In jurisdictions that recognize copyright laws, the author or authors
Efficient use of the memory. (The implemented C-code mt19937.c * of this software dedicate any and all copyright interest in the
consumes only 624 words of working area.) * software to the public domain. We make this dedication for the benefit
* of the public at large and to the detriment of our heirs and
home page * successors. We intend this dedication to be an overt act of
http://www.math.keio.ac.jp/~matumoto/emt.html * relinquishment in perpetuity of all present and future rights to this
original c source * software under copyright law.
http://www.math.keio.ac.jp/~nisimura/random/int/mt19937int.c *
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
Coded by Takuji Nishimura, considering the suggestions by * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
Topher Cooper and Marc Rieffel in July-Aug. 1997. * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
* IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
This library is free software; you can redistribute it and/or * OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
modify it under the terms of the GNU Library General Public * ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
License as published by the Free Software Foundation; either * OTHER DEALINGS IN THE SOFTWARE.
version 2 of the License, or (at your option) any later *
version. * For more information, please refer to <http://unlicense.org/>
This library is distributed in the hope that it will be useful, *
but WITHOUT ANY WARRANTY; without even the implied warranty of *}
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
See the GNU Library General Public License for more details.
You should have received a copy of the GNU Library General
Public License along with this library; if not, write to the
Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
02111-1307 USA
Copyright (C) 1997, 1999 Makoto Matsumoto and Takuji Nishimura.
When you use this, send an email to: matumoto@math.keio.ac.jp
with an appropriate reference to your work.
REFERENCE
M. Matsumoto and T. Nishimura,
"Mersenne Twister: A 623-Dimensionally Equidistributed Uniform
Pseudo-Random Number Generator",
ACM Transactions on Modeling and Computer Simulation,
Vol. 8, No. 1, January 1998, pp 3--30.
Translated to OP and Delphi interface added by Roman Krejci (6.12.1999)
http://www.rksolution.cz/delphi/tips.htm
Revised 21.6.2000: Bug in the function RandInt_MT19937 fixed
2003/10/26: adapted to use the improved intialisation mentioned at
<http://www.math.keio.ac.jp/~matumoto/MT2002/emt19937ar.html> and
removed the assembler code
----------------------------------------------------------------------}
{$R-} {range checking off} {$R-} {range checking off}
{$Q-} {overflow checking off} {$Q-} {overflow checking off}
{ Period parameter }
Const
MT19937N=624;
Type
tMT19937StateArray = array [0..MT19937N-1] of longint; // the array for the state vector
{ Period parameters }
const const
MT19937M=397; MTWIST_N = 624;
MT19937MATRIX_A =$9908b0df; // constant vector a MTWIST_M = 397;
MT19937UPPER_MASK=longint($80000000); // most significant w-r bits
MT19937LOWER_MASK=longint($7fffffff); // least significant r bits
{ Tempering parameters } MT_STATIC_SEED = 5489;
TEMPERING_MASK_B=longint($9d2c5680);
TEMPERING_MASK_C=longint($efc60000);
MTWIST_UPPER_MASK = cardinal($80000000);
MTWIST_LOWER_MASK = cardinal($7FFFFFFF);
VAR MTWIST_MATRIX_A = cardinal($9908B0DF);
mt : tMT19937StateArray;
mti: longint=MT19937N+1; // mti=MT19937N+1 means mt[] is not initialized
{ Initializing the array with a seed } var
procedure sgenrand_MT19937(seed: longint); 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 MTWIST_TWIST(u, v: cardinal): cardinal; inline;
begin
{ the construct at the end is equivalent to
if odd(v) then
MTWIST_MATRIX_A
else
0
}
result:=(MTWIST_MIXBITS(u,v) shr 1) xor (cardinal(-(v and 1)) and MTWIST_MATRIX_A);
end;
procedure mtwist_init(seed: cardinal);
var var
i: longint; i: longint;
begin begin
mt[0] := seed; mt_state[0]:=seed;
for i := 1 to MT19937N-1 do for i:=1 to MTWIST_N-1 do
begin mt_state[i]:=cardinal(1812433253) * (mt_state[i-1] xor (mt_state[i-1] shr 30)) + i;
mt[i] := 1812433253 * (mt[i-1] xor (mt[i-1] shr 30)) + i; { still need to update the state }
{ See Knuth TAOCP Vol2. 3rd Ed. P.106 for multiplier. } mt_index:=MTWIST_N;
{ In the previous versions, MSBs of the seed affect } end;
{ only MSBs of the array mt[]. }
{ 2002/01/09 modified by Makoto Matsumoto } procedure mtwist_update_state;
end; var
mti := MT19937N; count: longint;
begin
{ The original C code uses pointers, doesn't play nice with JVM backend;
it counts from N-M+1 downto 0 (0 not included) for the first loop, which
should initialise the first N-M+1 elements -- doing so gives the wrong
results though (different from the old generator, and it also doesn't
match the algorithm description), so we use only N-M iterations. They don't
seem to test this one element and its value does not impact subsequent
numbers, so it's probably a bug in their implementation.
}
for count:=0 to MTWIST_N-MTWIST_M-1 do
mt_state[count]:=mt_state[count+MTWIST_M] xor MTWIST_TWIST(mt_state[count],mt_state[count+1]);
for count:=MTWIST_N-MTWIST_M to MTWIST_N-2 do
mt_state[count]:=mt_state[count+(MTWIST_M-MTWIST_N)] xor MTWIST_TWIST(mt_state[count],mt_state[count+1]);
mt_state[MTWIST_N-1]:=mt_state[MTWIST_M-1] xor MTWIST_TWIST(mt_state[MTWIST_N-1],mt_state[0]);
mt_index:=0;
end; end;
function genrand_MT19937: longint; function mtwist_u32rand: cardinal;
const
mag01 : array [0..1] of longint =(0, longint(MT19937MATRIX_A));
var
y: longint;
kk: longint;
begin begin
if RandSeed<>OldRandSeed then if (RandSeed<>OldRandSeed) or
mti:=MT19937N+1; (mt_index=MTWIST_N+1) then
if (mti >= MT19937N) { generate MT19937N longints at one time } begin
then begin mtwist_init(RandSeed);
if mti = (MT19937N+1) then // if sgenrand_MT19937() has not been called, { Detect resets of randseed
begin
sgenrand_MT19937(randseed); // default initial seed is used This will break if someone coincidentally uses not(randseed) as the
{ hack: randseed is not used more than once in this algorithm. Most } next randseed, but it's much more common that you will reset randseed
{ user changes are re-initialising reandseed with the value it had } to the same value as before to regenerate the same sequence of numbers
{ at the start -> with the "not", we will detect this change. } }
{ Detecting other changes is not useful, since the generated } RandSeed:=not(RandSeed);
{ numbers will be different anyway. } OldRandSeed:=RandSeed;
randseed := not(randseed); end;
oldrandseed := randseed; if mt_index=MTWIST_N then
end; mtwist_update_state;
for kk:=0 to MT19937N-MT19937M-1 do begin result:=mt_state[mt_index];
y := (mt[kk] and MT19937UPPER_MASK) or (mt[kk+1] and MT19937LOWER_MASK); inc(mt_index);
mt[kk] := mt[kk+MT19937M] xor (y shr 1) xor mag01[y and $00000001]; result:=result xor (result shr 11);
end; result:=result xor ((result shl 7) and cardinal($9D2C5680));
for kk:= MT19937N-MT19937M to MT19937N-2 do begin result:=result xor ((result shl 15) and cardinal($EFC60000));
y := (mt[kk] and MT19937UPPER_MASK) or (mt[kk+1] and MT19937LOWER_MASK); result:=result xor (result shr 18);
mt[kk] := mt[kk+(MT19937M-MT19937N)] xor (y shr 1) xor mag01[y and $00000001];
end;
y := (mt[MT19937N-1] and MT19937UPPER_MASK) or (mt[0] and MT19937LOWER_MASK);
mt[MT19937N-1] := mt[MT19937M-1] xor (y shr 1) xor mag01[y and $00000001];
mti := 0;
end;
y := mt[mti]; inc(mti);
y := y xor (y shr 11);
y := y xor (y shl 7) and TEMPERING_MASK_B;
y := y xor (y shl 15) and TEMPERING_MASK_C;
y := y xor (y shr 18);
Result := y;
end; end;
@ -656,13 +631,16 @@ begin
{ otherwise we can return values = l (JM) } { otherwise we can return values = l (JM) }
if (l < 0) then if (l < 0) then
inc(l); inc(l);
random := longint((int64(cardinal(genrand_MT19937))*l) shr 32); random := longint((int64(mtwist_u32rand)*l) shr 32);
end; end;
function random(l:int64): int64; function random(l:int64): int64;
begin begin
{ always call random, so the random generator cycles (TP-compatible) (JM) } { always call random, so the random generator cycles (TP-compatible) (JM) }
random := int64((qword(cardinal(genrand_MT19937)) or ((qword(cardinal(genrand_MT19937)) shl 32))) and $7fffffffffffffff); { also do it in two separate steps, so the order in which the two calls
are performed is predictable (JM) }
random:=mtwist_u32rand;
random:=random or ((qword(mtwist_u32rand) shl 32) and high(int64));
if (l<>0) then if (l<>0) then
random := random mod l random := random mod l
else else
@ -672,7 +650,7 @@ end;
{$ifndef FPUNONE} {$ifndef FPUNONE}
function random: extended; function random: extended;
begin begin
random := cardinal(genrand_MT19937) * (extended(1.0)/(int64(1) shl 32)); random := mtwist_u32rand * (extended(1.0)/(int64(1) shl 32));
end; end;
{$endif} {$endif}
{$endif FPC_HAS_FEATURE_RANDOM} {$endif FPC_HAS_FEATURE_RANDOM}