mirror of
https://github.com/doublecmd/doublecmd.git
synced 2026-06-21 09:58:13 +00:00
423 lines
13 KiB
ObjectPascal
423 lines
13 KiB
ObjectPascal
unit ISAAC;
|
|
|
|
{Bob Jenkins' public domain random number generator ISAAC}
|
|
|
|
interface
|
|
|
|
{$i std.inc}
|
|
|
|
(*************************************************************************
|
|
|
|
DESCRIPTION : Bob Jenkins' public domain random number generator ISAAC
|
|
(Indirection, Shift, Accumulate, Add, and Count)
|
|
Period at least 2^40, average 2^8295
|
|
|
|
REQUIREMENTS : TP5-7, D1-D7/D9-D10/D12, FPC, VP, WDOSX
|
|
|
|
EXTERNAL DATA : ---
|
|
|
|
MEMORY USAGE : ---
|
|
|
|
DISPLAY MODE : ---
|
|
|
|
REFERENCES : http://burtleburtle.net/bob/rand/isaacafa.html
|
|
(ISAAC: a fast cryptographic random number generator)
|
|
|
|
Version Date Author Modification
|
|
------- -------- ------- ------------------------------------------
|
|
0.10 23.07.05 W.Ehrhardt Initial BP7 port of rand.c with RANDSIZ=256
|
|
0.11 23.07.05 we Some tweaking in isaac_generate
|
|
0.12 23.07.05 we non crypt option (RANDSIZ=16), much slower
|
|
0.13 23.07.05 we use RANDSIZ=256 only, procedure Mix
|
|
0.14 23.07.05 we use mix array m, use inc where possible
|
|
0.15 23.07.05 we BASM16 in isaac_generate
|
|
0.16 24.07.05 we routines for word, long, double etc.
|
|
0.17 01.09.05 we byte typecast in init0
|
|
0.18 05.11.08 we isaac_dword function
|
|
0.19 02.12.08 we BTypes/Ptr2Inc
|
|
0.20 06.01.09 we Uses BTypes moved to implementation
|
|
0.21 14.06.12 we Fix bug in _read for trailing max 3 bytes
|
|
**************************************************************************)
|
|
|
|
|
|
(*-------------------------------------------------------------------------
|
|
(C) Copyright 2005-2012 Wolfgang Ehrhardt
|
|
|
|
This software is provided 'as-is', without any express or implied warranty.
|
|
In no event will the authors be held liable for any damages arising from
|
|
the use of this software.
|
|
|
|
Permission is granted to anyone to use this software for any purpose,
|
|
including commercial applications, and to alter it and redistribute it
|
|
freely, subject to the following restrictions:
|
|
|
|
1. The origin of this software must not be misrepresented; you must not
|
|
claim that you wrote the original software. If you use this software in
|
|
a product, an acknowledgment in the product documentation would be
|
|
appreciated but is not required.
|
|
|
|
2. Altered source versions must be plainly marked as such, and must not be
|
|
misrepresented as being the original software.
|
|
|
|
3. This notice may not be removed or altered from any source distribution.
|
|
----------------------------------------------------------------------------*)
|
|
|
|
|
|
|
|
{$ifdef BIT16}
|
|
{$N+}
|
|
{$endif}
|
|
|
|
type
|
|
isaac_ctx = record {context of random number generator}
|
|
randmem: array[0..255] of longint; {the internal state}
|
|
randrsl: array[0..255] of longint; {the results given to the user}
|
|
randa : longint; {accumulator}
|
|
randb : longint; {the last result}
|
|
randc : longint; {counter, guarantees cycle >= 2^40 }
|
|
nextres: longint; {the next result }
|
|
randidx: word; {the index in randrsl[] }
|
|
end;
|
|
|
|
|
|
procedure isaac_init (var ctx: isaac_ctx; seed: longint);
|
|
{-Init context from randrsl[0]=seed, randrsl[i]=0 otherwise}
|
|
|
|
procedure isaac_init0(var ctx: isaac_ctx);
|
|
{-Init context from randseed}
|
|
|
|
{$ifdef CONST}
|
|
procedure isaac_inita(var ctx: isaac_ctx; const key: array of longint; klen: integer);
|
|
{-Init all context variables with separate seeds, klen: number of seeds}
|
|
{$else}
|
|
procedure isaac_inita(var ctx: isaac_ctx; var KArr; klen: integer);
|
|
{-Init all context variables with separate seeds, klen: number of seeds}
|
|
{$endif}
|
|
|
|
procedure isaac_next(var ctx: isaac_ctx);
|
|
{-Next step of PRNG}
|
|
|
|
procedure isaac_read(var ctx: isaac_ctx; dest: pointer; len: longint);
|
|
{-Read len bytes from the PRNG to dest}
|
|
|
|
function isaac_long(var ctx: isaac_ctx): longint;
|
|
{-Next random positive longint}
|
|
|
|
function isaac_dword(var ctx: isaac_ctx): {$ifdef HAS_CARD32}cardinal{$else}longint{$endif};
|
|
{-Next 32 bit random dword (cardinal or longint)}
|
|
|
|
function isaac_word(var ctx: isaac_ctx): word;
|
|
{-Next random word}
|
|
|
|
function isaac_double(var ctx: isaac_ctx): double;
|
|
{-Next random double [0..1) with 32 bit precision}
|
|
|
|
function isaac_double53(var ctx: isaac_ctx): double;
|
|
{-Next random double in [0..1) with full double 53 bit precision}
|
|
|
|
function isaac_selftest: boolean;
|
|
{-Simple self-test of ISAAC PRNG}
|
|
|
|
|
|
{$ifdef testing}
|
|
{interfaced for cycle testing without overhead, do not use for normal use}
|
|
procedure isaac_generate(var ctx: isaac_ctx);
|
|
{-generate next 256 result values, ie refill randrsl}
|
|
{$endif}
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
BTypes;
|
|
|
|
{---------------------------------------------------------------------------}
|
|
procedure isaac_generate(var ctx: isaac_ctx);
|
|
{-generate next 256 result values, ie refill randrsl}
|
|
var
|
|
x,y: longint;
|
|
xi : integer absolute x; {better performance for BIT16}
|
|
i : integer;
|
|
{$ifdef BASM16}
|
|
pra: pointer; {pointer to cxt.randa for faster BASM16 access}
|
|
{$endif}
|
|
begin
|
|
{$ifdef BASM16}
|
|
pra := @ctx.randa;
|
|
{$endif}
|
|
with ctx do begin
|
|
inc(randc);
|
|
inc(randb, randc);
|
|
for i:=0 to 255 do begin
|
|
{$ifdef BASM16}
|
|
case i and 3 of
|
|
0: asm
|
|
les di,[pra]
|
|
db $66; mov ax,es:[di]
|
|
db $66; shl ax,13
|
|
db $66; xor es:[di],ax
|
|
end;
|
|
1: asm
|
|
les di,[pra]
|
|
db $66; mov ax,es:[di]
|
|
db $66; shr ax,6
|
|
db $66; xor es:[di],ax
|
|
end;
|
|
2: asm
|
|
les di,[pra]
|
|
db $66; mov ax,es:[di]
|
|
db $66; shl ax,2
|
|
db $66; xor es:[di],ax
|
|
end;
|
|
3: asm
|
|
{shr 16 is special, use word [pra+2]}
|
|
les di,[pra]
|
|
mov ax, es:[di+2]
|
|
xor es:[di],ax
|
|
end;
|
|
end;
|
|
{$else}
|
|
case i and 3 of
|
|
0: randa := randa xor (randa shl 13);
|
|
1: randa := randa xor (randa shr 6);
|
|
2: randa := randa xor (randa shl 2);
|
|
3: randa := randa xor (randa shr 16);
|
|
end;
|
|
{$endif}
|
|
x := randmem[i];
|
|
inc(randa,randmem[(i+128) and 255]);
|
|
y := randmem[(xi shr 2) and 255] + randa + randb;
|
|
randmem[i] := y;
|
|
randb := randmem[(y shr 10) and 255] + x;
|
|
randrsl[i] := randb;
|
|
end;
|
|
{reset result index}
|
|
randidx:=0;
|
|
end;
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------------------}
|
|
procedure internal_init(var ctx: isaac_ctx; flag: boolean);
|
|
{-Init state, use randrsl if flag=true}
|
|
var
|
|
i,j: integer;
|
|
m: array[0..7] of longint;
|
|
|
|
procedure Mix;
|
|
{-mix the array}
|
|
begin
|
|
m[0] := m[0] xor (m[1] shl 11); inc(m[3], m[0]); inc(m[1], m[2]);
|
|
m[1] := m[1] xor (m[2] shr 2); inc(m[4], m[1]); inc(m[2], m[3]);
|
|
m[2] := m[2] xor (m[3] shl 8); inc(m[5], m[2]); inc(m[3], m[4]);
|
|
m[3] := m[3] xor (m[4] shr 16); inc(m[6], m[3]); inc(m[4], m[5]);
|
|
m[4] := m[4] xor (m[5] shl 10); inc(m[7], m[4]); inc(m[5], m[6]);
|
|
m[5] := m[5] xor (m[6] shr 4); inc(m[0], m[5]); inc(m[6], m[7]);
|
|
m[6] := m[6] xor (m[7] shl 8); inc(m[1], m[6]); inc(m[7], m[0]);
|
|
m[7] := m[7] xor (m[0] shr 9); inc(m[2], m[7]); inc(m[0], m[1]);
|
|
end;
|
|
|
|
begin
|
|
with ctx do begin
|
|
randa := 0;
|
|
randb := 0;
|
|
randc := 0;
|
|
|
|
for i:=0 to 7 do m[i] := longint($9e3779b9); {the golden ratio}
|
|
for i:=0 to 3 do Mix;
|
|
|
|
i := 0;
|
|
while i<256 do begin
|
|
{fill in randmem[] with messy stuff}
|
|
if flag then begin
|
|
{use all the information in the seed}
|
|
for j:=0 to 7 do inc(m[j], randrsl[i+j]);
|
|
end;
|
|
Mix;
|
|
move(m, randmem[i], sizeof(m));
|
|
inc(i,8);
|
|
end;
|
|
|
|
if flag then begin
|
|
{do a second pass to make all of the seed affect all of randmem}
|
|
i := 0;
|
|
while i<256 do begin
|
|
for j:=0 to 7 do inc(m[j], randmem[i+j]);
|
|
Mix;
|
|
move(m, randmem[i], sizeof(m));
|
|
inc(i,8);
|
|
end;
|
|
end;
|
|
|
|
{generate first set of results}
|
|
isaac_generate(ctx);
|
|
{prepare to use the first set of results }
|
|
randidx := 0;
|
|
end;
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------------------}
|
|
procedure isaac_init(var ctx: isaac_ctx; seed: longint);
|
|
{-Init context from randrsl[0]=seed, randrsl[i]=0 otherwise}
|
|
begin
|
|
with ctx do begin
|
|
fillchar(randrsl, sizeof(randrsl),0);
|
|
randrsl[0] := seed;
|
|
end;
|
|
internal_init(ctx, true);
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------------------}
|
|
procedure isaac_init0(var ctx: isaac_ctx);
|
|
{-Init context from randseed and randrsl[i]:=random}
|
|
var
|
|
i,j: integer;
|
|
tl: longint;
|
|
ta: packed array[0..3] of byte absolute tl;
|
|
begin
|
|
with ctx do begin
|
|
for i:=0 to 255 do begin
|
|
for j:=0 to 3 do ta[j] := byte(random(256));
|
|
randrsl[i] := tl;
|
|
end;
|
|
end;
|
|
internal_init(ctx, true);
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------------------}
|
|
{$ifdef CONST}
|
|
procedure isaac_inita(var ctx: isaac_ctx; const key: array of longint; klen: integer);
|
|
{-Init all context variables with separate seeds, klen: number of seeds}
|
|
{$else}
|
|
procedure isaac_inita(var ctx: isaac_ctx; var KArr; klen: integer);
|
|
{-Init all context variables with separate seeds, klen: number of seeds}
|
|
var
|
|
key: packed array[0..255] of longint absolute KArr; {T5-6 do not have open arrrays}
|
|
{$endif}
|
|
var
|
|
i: integer;
|
|
begin
|
|
{$ifdef CONST}
|
|
if klen>high(key)+1 then klen := high(key)+1;
|
|
{$endif}
|
|
with ctx do begin
|
|
for i:=0 to 255 do begin
|
|
if i<klen then randrsl[i]:=key[i] else randrsl[i]:=0;
|
|
end;
|
|
end;
|
|
internal_init(ctx, true);
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------------------}
|
|
procedure isaac_next(var ctx: isaac_ctx);
|
|
{-Next step of PRNG}
|
|
begin
|
|
with ctx do begin
|
|
if randidx>255 then isaac_generate(ctx);
|
|
nextres := randrsl[randidx];
|
|
inc(randidx);
|
|
end;
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------------------}
|
|
procedure isaac_read(var ctx: isaac_ctx; dest: pointer; len: longint);
|
|
{-Read len bytes from the PRNG to dest}
|
|
type
|
|
plong = ^longint;
|
|
begin
|
|
{not optimized}
|
|
while len>3 do begin
|
|
isaac_next(ctx);
|
|
plong(dest)^ := ctx.nextres;
|
|
inc(Ptr2Inc(dest),4);
|
|
dec(len, 4);
|
|
end;
|
|
if len>0 then begin
|
|
isaac_next(ctx);
|
|
move(ctx.nextres, dest^, len and 3);
|
|
end;
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------------------}
|
|
function isaac_long(var ctx: isaac_ctx): longint;
|
|
{-Next random positive longint}
|
|
begin
|
|
isaac_next(ctx);
|
|
isaac_long := ctx.nextres shr 1;
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------------------}
|
|
function isaac_dword(var ctx: isaac_ctx): {$ifdef HAS_CARD32}cardinal{$else}longint{$endif};
|
|
{-Next 32 bit random dword (cardinal or longint)}
|
|
begin
|
|
isaac_next(ctx);
|
|
{$ifdef HAS_CARD32}
|
|
isaac_dword := cardinal(ctx.nextres);
|
|
{$else}
|
|
isaac_dword := ctx.nextres;
|
|
{$endif}
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------------------}
|
|
function isaac_word(var ctx: isaac_ctx): word;
|
|
{-Next random word}
|
|
type
|
|
TwoWords = packed record
|
|
L,H: word
|
|
end;
|
|
begin
|
|
isaac_next(ctx);
|
|
isaac_word := TwoWords(ctx.nextres).H;
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------------------}
|
|
function isaac_double(var ctx: isaac_ctx): double;
|
|
{-Next random double [0..1) with 32 bit precision}
|
|
begin
|
|
isaac_next(ctx);
|
|
isaac_double := (ctx.nextres + 2147483648.0) / 4294967296.0;
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------------------}
|
|
function isaac_double53(var ctx: isaac_ctx): double;
|
|
{-Next random double in [0..1) with full double 53 bit precision}
|
|
var
|
|
hb,lb: longint;
|
|
begin
|
|
isaac_next(ctx);
|
|
hb := ctx.nextres shr 5;
|
|
isaac_next(ctx);
|
|
lb := ctx.nextres shr 6;
|
|
isaac_double53 := (hb*67108864.0+lb)/9007199254740992.0;
|
|
end;
|
|
|
|
|
|
{---------------------------------------------------------------------------}
|
|
function isaac_selftest: boolean;
|
|
{-Simple self-test of ISAAC PRNG}
|
|
var
|
|
ctx: isaac_ctx;
|
|
begin
|
|
fillchar(ctx, sizeof(ctx),0);
|
|
internal_init(ctx, true);
|
|
isaac_generate(ctx);
|
|
{check first and last longint of randvec.txt}
|
|
if ctx.randrsl[0]<>longint($f650e4c8) then begin
|
|
isaac_selftest := false;
|
|
exit;
|
|
end;
|
|
isaac_generate(ctx);
|
|
isaac_selftest := ctx.randrsl[255] = longint($4bb5af29);
|
|
end;
|
|
|
|
end.
|