{Copyright:      Hagen Reddmann  mailto:HaReddmann@AOL.COM
 Author:         Hagen Reddmann
 Remarks:        freeware, but this Copyright must be included
 known Problems: none
 Version:        3.0
                 Delphi 2-4, designed and testet under D3 and D4
 Description:    Linear Feedback Shift Register (LFSR)
                 Random Number Generator with variable Period
                 from 2^32 -1 to 2^2032 -1, Standard is 2^128 -1
                 with .Seed('', -1) absolutly random
                 The Period have theoretical no effect on the Speed.

 Speed:          ca. 40 Mb/sec of a PII MMX 266 MHz 64Mb RAM

 * THIS SOFTWARE IS PROVIDED BY THE AUTHORS ''AS IS'' AND ANY EXPRESS
 * OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE
 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
 * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
 * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
 * EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.


  Speed: all times for PII MMX 266Mhz 64Mb
         theoretical have the Period (Size of LFSR) no effect on the Speed,
         but a greater Period will run faster. (Cache, little Branches on Pentium, etc.)
         except the Period 2^128-1, this use a specially optimized method.

              >   14.5 Mb/sec
              >   40.5 Mb/sec with 128bit LFSR
Version 3.0

  TRandom is now a descend from TProtect, see Unit DECUtil.pas

 }
{$IFNDEF CLR}

{$I Dac.inc}

unit CRRNG;
{$ENDIF}

interface
{$A+,Q-,R-,Y-}
uses
{$IFDEF CLR}
  System.Text,
{$ELSE}
  CLRClasses,
{$ENDIF}
{$IFDEF MSWINDOWS}
  Windows,
{$ELSE}
  CRFunctions,
{$ENDIF}
  Classes, SyncObjs, SysUtils, CRDECUtil, CRTypes;

type
  TScRandom = class(TProtection)    // Basicly RNG, equal to Borland's Random()
  private
    FRegister: Integer;
  protected
// Count of Bytes that Int() or Buffer() has generated
    FCount: Integer;          // not as private Fields, easier access for descends
// the Size in Bits
    FSize: Integer;
    FBasicSeed: Integer;
    FLock: TCriticalSection;

    procedure SetSize(Value: Integer); virtual;
// override TProtect Methods
    procedure CodeInit(Action: TPAction); override;
    procedure CodeDone(Action: TPAction); override;
    procedure CodeBuf(const Buffer: TValueArr; const BufferSize: Integer; Action: TPAction); override;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Randomize(const Seed: TBytes; const Offset, Count: Integer); overload; virtual;
    procedure Randomize(const Seed: TBytes); overload;
    procedure Randomize(Seed: TStream); overload;
    procedure Randomize; overload;

    procedure Random(var buf: TBytes; const Offset, Count: integer); virtual;
  end;

  TScRandom_LFSR = class(TScRandom)   // Linear Feedback Shift Register
  private
    FPtr: Integer;                    // Current Position in FRegister
    FLast: Integer;                   // Highest Position in FRegister
    FTable: array[0..255] of Word;    // Lookup Table for FRegister
    FRegister: array[0..255] of Byte; // Linear Feedback Shift Register
    FFunc: procedure(Self: TObject;
      {$IFDEF UseASM}Buffer: PAnsiChar{$ELSE}var Buffer: TBytes{$ENDIF}; Size: Integer);
  protected
    procedure SetSize(Value: Integer); override;
  public
    procedure Randomize(const Seed: TBytes; const Offset, Count: Integer); override;
    procedure Random(var buf: TBytes; const Offset, Count: integer); override;
  end;

{   Follow the used polynomial's for TScRandom_LFSR
     size in bytes of register, XORCode, Polynomial, Period

   4, $F5, x^32   + x^7 + x^5 + x^3 + x^2 + x + 1,   2^32   -1
   5, $9C, x^40   + x^5 + x^4 + x^3 + 1,             2^40   -1
   6, $ED, x^48   + x^7 + x^5 + x^4 + x^2 + x + 1,   2^48   -1
   7, $A9, x^56   + x^7 + x^4 + x^2 + 1,             2^56   -1
   8, $D8, x^64   + x^4 + x^3 + x + 1,               2^64   -1
   9, $FA, x^72   + x^6 + x^4 + x^3 + x^2 + x + 1,   2^72   -1
  10, $F5, x^80   + x^7 + x^5 + x^3 + x^2 + x + 1,   2^80   -1
  12, $BB, x^96   + x^7 + x^6 + x^4 + x^3 + x^2 + 1, 2^96   -1
  15, $E7, x^120  + x^7 + x^6 + x^5 + x^2 + x + 1,   2^120  -1
  16, $E1, x^128  + x^7 + x^2 + x + 1,               2^128  -1
  18, $A9, x^144  + x^7 + x^4 + x^2 + 1,             2^144  -1
  19, $B2, x^152  + x^6 + x^3 + x^2 + 1,             2^152  -1
  20, $B4, x^160  + x^5 + x^3 + x^2 + 1,             2^160  -1
  22, $BD, x^176  + x^7 + x^5 + x^4 + x^3 + x^2 + 1, 2^176  -1
  25, $B4, x^200  + x^5 + x^3 + x^2 + 1,             2^200  -1
  27, $D1, x^216  + x^7 + x^3 + x + 1,               2^216  -1
  38, $FC, x^304  + x^5 + x^4 + x^3 + x^2 + x + 1,   2^304  -1
  40, $D8, x^320  + x^4 + x^3 + x + 1,               2^320  -1
  42, $C9, x^336  + x^7 + x^4 + x + 1,               2^336  -1
  44, $BD, x^352  + x^7 + x^5 + x^4 + x^3 + x^2 + 1, 2^352  -1
  50, $B4, x^400  + x^5 + x^3 + x^2 + 1,             2^400  -1
  51, $FA, x^408  + x^6 + x^4 + x^3 + x^2 + x + 1,   2^408  -1
  55, $D8, x^440  + x^4 + x^3 + x + 1,               2^440  -1
  60, $BB, x^480  + x^7 + x^6 + x^4 + x^3 + x^2 + 1, 2^480  -1
  61, $D8, x^488  + x^4 + x^3 + x + 1,               2^488  -1
  63, $FA, x^504  + x^6 + x^4 + x^3 + x^2 + x + 1,   2^504  -1
  67, $95, x^536  + x^7 + x^5 + x^3 + 1,             2^536  -1
  84, $F6, x^672  + x^6 + x^5 + x^3 + x^2 + x + 1,   2^672  -1
  89, $9C, x^712  + x^5 + x^4 + x^3 + 1,             2^712  -1
  91, $B8, x^728  + x^4 + x^3 + x^2 + 1,             2^728  -1
 103, $FC, x^824  + x^5 + x^4 + x^3 + x^2 + x + 1,   2^824  -1
 141, $D1, x^1128 + x^7 + x^3 + x + 1,               2^1128 -1
 154, $F3, x^1232 + x^7 + x^6 + x^3 + x^2 + x + 1,   2^1232 -1
 254, $A3, x^2032 + x^7 + x^6 + x^2 + 1,             2^2032 -1

  follow various Periods
--------------------------------------------------------------------------------
  2^32-1   = 4294967295
  2^64-1   = 18446744073709551615
  2^128-1  = 340282366920938463463374607431768211455
  2^2032-1 = it's one Number
   49311837877366649323600580884811328064642490645928167773636391338386009428204
   17921935608125537553934278674005267623599165972833122328326583112816221076703
   35702985799671951234310153163915857728680359766210694390385082889078409114931
   66867209378778336289339669574030006474132653643098550122997363890264786354861
   31947843882498538312526670313197249581325688984118966381501107686008635362008
   71492771279798342546336760614070411100118371556871830774626226863061725361438
   46476937385117828689155818331492509954024778049592066494651864619855274961300
   9880449926596639031121858756000207590413184793166384097191709192063287295
--------------------------------------------------------------------------------
}

implementation

uses
  CRCipher;

const
// avaible Periods for the LFSR
  LFSRPeriod: array[0..33, 0..1] of Word =
   ((   32, $F5), (   40, $9C), (   48, $ED), (   56, $A9),
    (   64, $D8), (   72, $FA), (   80, $F5), (   96, $BB),
    (  120, $E7), (  128, $E1), (  144, $A9), (  152, $B2),
    (  160, $B4), (  176, $BD), (  200, $B4), (  216, $D1),
    (  304, $FC), (  320, $D8), (  336, $C9), (  352, $BD),
    (  400, $B4), (  408, $FA), (  440, $D8), (  480, $BB),
    (  488, $D8), (  504, $FA), (  536, $95), (  672, $F6),
    (  712, $9C), (  728, $B8), (  824, $FC), ( 1128, $D1),
    ( 1232, $F3), ( 2032, $A3));

// internal used for the random initialization of the Seed Initial Value
// change this to produce Application dependent Randomness
  DefaultSeed: Integer = 693258280;

constructor TScRandom.Create;
var
  AProtection: TProtection;
begin
  inherited Create(nil);
  AProtection := TCipher_Blowfish.Create;
  TCipher_Blowfish(AProtection).GenerateKey;
  TCipher_Blowfish(AProtection).GenerateIV;
  Protection := AProtection;

  FLock := TCriticalSection.Create;
  FBasicSeed := DefaultSeed;
  SetSize(0);
  Randomize(nil, 0, -1);
end;

destructor TScRandom.Destroy;
begin
{$IFNDEF CLR}
  Randomize(nil, 0, 0);
{$ENDIF}
//  if Self = FRND then FRND := nil;

{$IFNDEF NEXTGEN}
  Protection.Free;
{$ENDIF}
  FLock.Free;
  inherited;
end;

procedure TScRandom.SetSize(Value: Integer);
begin
  FSize := 32; // allways 32
end;

procedure TScRandom.Randomize(const Seed: TBytes; const Offset, Count: Integer);
var
  buf: TValueArr;
  I: Integer;
begin
  FLock.Acquire;
  try
    if (Count > 0) and (Seed <> nil) then
    begin
      FRegister := 0;
      for I := 0 to Count -1 do
        FRegister := FRegister + Integer(Seed[Offset + I] shl ((I and 3) * 8));
    end else
      if Count < 0 then FRegister := Integer(GetTickCount) + (FCount +1)
        else FRegister := FBasicSeed;
    if Protection <> nil then begin
    {$IFDEF CLR}
      SetLength(buf, 4);
      buf[3] := byte(FRegister shr 24);
      buf[2] := byte(FRegister shr 16);
      buf[1] := byte(FRegister shr 8);
      buf[0] := byte(FRegister);
    {$ELSE}
      buf := @FRegister;
    {$ENDIF}

      Protection.CodeBuffer(buf, SizeOf(FRegister), paScramble);

    {$IFDEF CLR}
      FRegister := (buf[3] shl 24) or (buf[2] shl 16) or (buf[1] shl 8) or buf[0];
    {$ENDIF}
    end;
  finally
    FLock.Release;
  end;
end;

procedure TScRandom.Randomize(const Seed: TBytes);
begin
  Randomize(Seed, 0, Length(Seed));
end;

procedure TScRandom.Randomize(Seed: TStream);
var
  buf: TBytes;
  sz: integer;
begin
  Seed.Position := 0;
  sz := Seed.Size;
  SetLength(buf, sz);
  Seed.ReadBuffer(buf{$IFNDEF CLR}[0]{$ENDIF}, sz);
  Randomize(buf, 0, Length(buf));
end;

procedure TScRandom.Randomize;
var
  Ticks: Int64;
begin
{$IFDEF MSWINDOWS}
  Ticks := 0;
  if not QueryPerformanceCounter(Ticks) then
{$ENDIF}
    Ticks := GetTickCount;

  Randomize(BitConverter.GetBytes(Ticks), 0, SizeOf(Ticks));
end;

procedure TScRandom.Random(var buf: TBytes; const Offset, Count: integer);
var
  tmp: TValueArr;
begin
  if Count <= 0 then Exit;

  ArrayClear(buf, 0, Count);
{$IFDEF CLR}
  SetLength(tmp, Count);
{$ELSE}
  tmp := @buf[Offset];
{$ENDIF}

  FLock.Acquire;
  try
    FRegister := RndXORBuffer(FRegister, tmp, Count);
    Inc(FCount, Count);
    if Protection <> nil then
      Protection.CodeBuffer(tmp, Count, paScramble);
  finally
    FLock.Release;
  end;

{$IFDEF CLR}
  Buffer.BlockCopy(tmp, 0, buf, Offset, Count);
{$ENDIF}
end;

procedure TScRandom.CodeInit(Action: TPAction);
begin
  Randomize(nil, 0, -1);
  inherited CodeInit(Action);
end;

procedure TScRandom.CodeDone(Action: TPAction);
begin
  inherited CodeDone(Action);
  Randomize(nil, 0, 0);
end;

procedure TScRandom.CodeBuf(const Buffer: TValueArr; const BufferSize: Integer; Action: TPAction);
begin
  Assert(False);
end;

{$IFDEF UseASM}
// internal for TScRandom_LFSR
procedure LFSRBuf(Self: TObject; Buffer: TValueArr; Size: Integer); assembler;
asm
      AND     EDX,EDX    // Buffer = nil ?
      JZ      @@9
      AND     ECX,ECX    // BufferSize <= 0 ?
      JLE     @@9

      PUSH    EDI
      PUSH    ESI
      PUSH    EBX
      PUSH    EBP
      PUSH    EAX

      MOV     EDI,[EAX].TScRandom_LFSR.FPtr
      MOV     EBP,[EAX].TScRandom_LFSR.FLast
      LEA     ESI,[EAX].TScRandom_LFSR.FRegister
      LEA     EBX,[EAX].TScRandom_LFSR.FTable
      DEC     EDX

@@1:  MOVZX   EAX,Byte Ptr [ESI + EDI]
      MOV     [EDX + ECX],AL
      MOV     AX,[EBX + EAX * 2]
      MOV     [ESI + EDI],AL
      DEC     EDI
      JS      @@2
      XOR     [ESI + EDI],AH
      ADD     EDI,2
      CMP     EDI,EBP
      JLE     @@3
      XOR     EDI,EDI
      JMP     @@3
@@2:  MOV     EDI,EBP
      XOR     [ESI + EDI],AH
      MOV     EDI,1
@@3:  DEC     ECX
      JNZ     @@1

      POP     EAX
      MOV     [EAX].TScRandom_LFSR.FPtr,EDI

      POP     EBP
      POP     EBX
      POP     ESI
      POP     EDI
@@9:
end;
{$ENDIF}

procedure LFSRBuf128(Self: TObject;
  {$IFDEF UseASM}Buffer: PAnsiChar{$ELSE}var Buffer: TBytes{$ENDIF}; Size: Integer); {$IFDEF UseASM}assembler;{$ENDIF}
{$IFNDEF UseASM}
var
  Rnd: Word;
  Reg: Byte;
  Ptr: Integer;
  i: Integer;
begin
  if Buffer = nil then
    Exit;

  Ptr := TScRandom_LFSR(Self).FPtr;
  for i := Size - 1 downto 0 do begin
    Reg := TScRandom_LFSR(Self).FRegister[Ptr];
    Buffer[i] := Reg;
    Rnd := TScRandom_LFSR(Self).FTable[Reg];
    TScRandom_LFSR(Self).FRegister[Ptr] := Byte(Rnd);
    Dec(Ptr);
    Ptr := Ptr and $0f;
    TScRandom_LFSR(Self).FRegister[Ptr] := TScRandom_LFSR(Self).FRegister[Ptr] xor (Rnd shr 8);
    Ptr := (Ptr + 2) and $0f;
  end;
  TScRandom_LFSR(Self).FPtr := Ptr;

{$ELSE}
asm
      AND     EDX,EDX    // Buffer = nil ?
      JZ      @@9
      AND     ECX,ECX    // BufferSize <= 0 ?
      JLE     @@9

      PUSH    EDI
      PUSH    ESI
      PUSH    EBX
      PUSH    EBP
      PUSH    EAX

      MOV     EDI,[EAX].TScRandom_LFSR.FPtr
      LEA     EBP,[EAX].TScRandom_LFSR.FTable
      LEA     ESI,[EAX].TScRandom_LFSR.FRegister
      DEC     EDX
      XOR     EAX,EAX

@@1:  MOV     AL,[ESI + EDI]
      MOV     BX,[EBP + EAX * 2]
      MOV     [EDX + ECX],AL
      MOV     [ESI + EDI],BL
      DEC     EDI
      AND     EDI,0Fh
      XOR     [ESI + EDI],BH
      ADD     EDI,2
      AND     EDI,0Fh
      DEC     ECX
      JNZ     @@1

      POP     EAX
      MOV     [EAX].TScRandom_LFSR.FPtr,EDI

      POP     EBP
      POP     EBX
      POP     ESI
      POP     EDI
@@9:
{$ENDIF}
end;

procedure TScRandom_LFSR.SetSize(Value: Integer);

  procedure CalcLFSRTable(XORCode: Byte);
  var
    I,J,Z: Integer;
    {$IFNDEF UseASM}n: Byte;{$ENDIF}
  begin
  {$IFDEF UseASM}
    asm // Reverse the bitorder
      XOR   AX,AX
      MOV   AL,XORCode
      MOV   CL,8
@@1:  RCR   AL,1
      RCL   AH,1
      DEC   CL
      JNZ   @@1
      MOV   XORCode,AH
    end;

  {$ELSE}
    n := 0;
    for I := 1 to 8 do begin
      n := n shl $1;
      n := n or (XORCode and $1);
      XORCode := XORCode shr $1;
    end;
    XORCode := n;
  {$ENDIF}

  {$IFNDEF CLR}
    FillChar(FTable, SizeOf(FTable), 0);
  {$ELSE}
    &Array.Clear(FTable, 0, Length(FTable));
  {$ENDIF}

    for I := 0 to 255 do
    begin
      Z := I;
      for J := 0 to 7 do
      begin
        FTable[I] := FTable[I] shl 1;
        if Z and $80 <> 0 then FTable[I] := FTable[I] xor XORCode;
        Z := Z shl 1;
      end;
    end;
  end;

  procedure DoSet(Index: Integer);
  begin
    FSize := LFSRPeriod[Index, 0];
    FLast := LFSRPeriod[Index, 0] div 8 -1;
{$IFDEF UseASM}
    if FSize = 128 then FFunc := LFSRBuf128 else FFunc := LFSRBuf;
{$ELSE}
    FFunc := LFSRBuf128;
{$ENDIF}

    CalcLFSRTable(LFSRPeriod[Index, 1]);
    Randomize(nil, 0, 0);
  end;

var
  I: Integer;
begin
//  if Value <= 0 then
  Value := 128;

  if Value <> FSize then
  begin
    for I := 33 downto 0 do
      if Value >= LFSRPeriod[I, 0] then
      begin
        DoSet(I);
        Exit;
      end;
    DoSet(9);  // The Standard fast 2^128-1 Period
  end;
end;

procedure TScRandom_LFSR.Randomize(const Seed: TBytes; const Offset, Count: Integer);
var
  I,S: Integer;
begin
  FLock.Acquire;
  try
    FPtr := 0;
    if (Count > 0) and (Seed <> nil) then
    begin
    {$IFNDEF CLR}
      FillChar(FRegister, SizeOf(FRegister), 0);
    {$ELSE}
      &Array.Clear(FRegister, 0, Length(FRegister));
    {$ENDIF}

      S := FSize div 8;
      for I := 0 to Count -1 do
        FRegister[I mod S] := FRegister[I mod S] + Seed[Offset + I];
    end
    else
      if Count < 0 then RndXORBuffer(Integer(GetTickCount) + (FCount +1), {$IFNDEF CLR}@{$ENDIF}FRegister, Length(FRegister))
        else
        {$IFNDEF CLR}
          FillChar(FRegister, SizeOf(FRegister), 0);
        {$ELSE}
          &Array.Clear(FRegister, 0, Length(FRegister));
        {$ENDIF}

    RndXORBuffer(FBasicSeed, {$IFNDEF CLR}@{$ENDIF}FRegister, Length(FRegister));
    if Protection <> nil then
      Protection.CodeBuffer({$IFNDEF CLR}@{$ENDIF}FRegister, Length(FRegister), paScramble);
  finally
    FLock.Release;
  end;
end;

procedure TScRandom_LFSR.Random(var buf: TBytes; const Offset, Count: integer);
var
  tmp: TBytes;
begin
  if Count <= 0 then
    Exit;

  SetLength(tmp, Count);
  FLock.Acquire;
  try
    FFunc(Self, {$IFDEF UseASM}TValueArr(tmp){$ELSE}tmp{$ENDIF}, Count);
    if Protection <> nil then
      Protection.CodeBuffer(TValueArr(tmp), Count, paScramble);
    Inc(FCount, Count);
  finally
    FLock.Release;
  end;

{$IFDEF CLR}
  Buffer.BlockCopy(tmp, 0, buf, Offset, Count);
{$ELSE}
  Move(tmp[0], buf[Offset], Count);
{$ENDIF}
end;

end.
