ezrndstm.pas

来自「Delphi数据结构分析源码」· PAS 代码 · 共 589 行 · 第 1/2 页

    rcl si, 1
    xor ax, si
    and ax, 1           {isolate the new random bit}
    shl bx, 1           {shift seed left by one}
    rcl dx, 1
    or bx, ax           {add in the new bit to the seed as bit 0}
    loop @@NextBit      {go get next random bit, until we've got them all}
    mov ax, bx          {return random bits as a word}
  end;
{$ENDIF}

{=InitTable===========================================================
Uses Random16Bit/Random32Bit to seed the random number generator
table.
13Mar96 JMB
======================================================================}
{$IFDEF Win32}
procedure InitTable(RS : PRandStream; Seed : longint);
  register;
  asm
    push edi
    push ebx
    mov edi, eax
    mov ecx, rsTableEntries
    mov ebx, edx
  @@NextEntry:
    push ecx
    call Random32Bit
    pop ecx
    stosd
    dec ecx
    jnz @@NextEntry
    and eax, $1F
    shl eax, 2
    stosd
    pop ebx
    pop edi
  end;
{$ELSE}
procedure InitTable(RS : PRandStream; Seed : longint);
  near; assembler;
  asm
    push ds
    lds di, RS
    mov ax, ds
    mov es, ax
    mov cx, rsTableEntries * 2
    cld
    mov dx, Seed.Word[2]
    mov bx, Seed.Word[0]
  @@NextWord:
    push di
    push cx
    call Random16Bit
    pop cx
    pop di
    stosw
    loop @@NextWord
    and ax, $1F
    shl ax, 1
    shl ax, 1
    stosw
    pop ds
  end;
{$ENDIF}

function  CreateRandStream(Seed : longint) : PRandStream;
  var
    RS : PRandStream;
  begin
    GetMem(RS, sizeof(TRandStream));
    if Assigned(RS) then
      begin
        if (Seed = 0) then
          {$IFDEF Win32}
          Seed := GetTickCount;
          {$ELSE}
          asm
            mov ah, $2C
            int $21
            mov Seed.Word[0], cx
            mov Seed.Word[2], dx
          end;
          {$ENDIF}
        InitTable(RS, Seed);
        if not IsUnitInitialised then
          InitRSUnit;
      end;
    CreateRandStream := RS;
  end;

procedure DestroyRandStream(var RS : PRandStream);
  begin
    if Assigned(RS) then
      begin
        FreeMem(RS, sizeof(TRandStream));
        RS := nil;
      end;
  end;

{$IFDEF Win32}
function GetNextRandomLong(RS : PRandStream) : longint;
  {Input:  eax = RS
   Output: eax = random long word
           ecx, edx trashed}
  register;
  asm
    mov ecx, eax
    mov edx, [ecx].TRandStream.&Offset
    mov eax, [ecx+edx]
    sub edx, 4
    jge @@1
    mov edx, rsTableEntries * 4 - 4
  @@1:
    push edx
    sub edx, TableMagic * 4
    jge @@2
    add edx, rsTableEntries * 4
  @@2:
    add eax, [ecx+edx]
    pop edx
    mov [ecx+edx], eax
    mov [ecx].TRandStream.&Offset, edx
  end;

function rsRandom(RS : PRandStream; UpperLimit : word) : Cardinal;
  {Input:  eax = RS
           edx = UpperLimit
   Output: ax = random value}
  register;
  asm
    movzx edx, dx
    push edx
    call GetNextRandomLong
    pop edx
    mul edx
    mov eax, edx
  end;

function rsRandomWord(RS : PRandStream) : word;
  {Input:  eax = RS
   Output: ax = random value}
  register;
  asm
    call GetNextRandomLong
    shr eax, 16
  end;

function rsRandomLongint(RS : PRandStream) : longint; assembler;
  {Input:  eax = RS
   Output: eax = random value}
  register;
  asm
    call GetNextRandomLong
    shr eax, 1
  end;

function  rsRandomFloat(RS : PRandStream) : TrsFloat; assembler;
  {Input:  eax = RS
   Output: random value on floating point stack}
  register;
  const
    Scale : integer = -31;
  asm
    call GetNextRandomLong
    shr eax, 1
    fild Scale
    push eax
    fild dword ptr [esp]
    add esp, 4
    fscale
    fstp st(1)
  end;
{$ELSE}
procedure GetNextRandomLong;
  {-Input:  ds:si   => TRandStream
    Output: dx:ax   new random longint
            ds, si  unchanged
            bx, di  trashed
            cx      not touched}
  near; assembler;
  asm
    mov bx, [si].TRandStream.&Offset
    mov ax, [si+bx]
    mov dx, [si+bx+2]
    sub bx, 4
    jge @@1
    mov bx, rsTableEntries * 4 - 4
  @@1:
    mov di, bx
    sub bx, TableMagic * 4
    jge @@2
    add bx, rsTableEntries * 4
  @@2:
    add ax, [si+bx]
    adc dx, [si+bx+2]
    mov bx, di
    mov [si+bx], ax
    mov [si+bx+2], dx
    mov [si].TRandStream.&Offset, bx
  end;

function rsRandom(RS : PRandStream; UpperLimit : word) : word;
  assembler;
  asm
    mov cx, ds
    lds si, RS
    call GetNextRandomLong
    xchg ax, dx
    mul UpperLimit
    xchg ax, dx
    mov ds, cx
  end;

function rsRandomWord(RS : PRandStream) : word;
  assembler;
  asm
    mov cx, ds
    lds si, RS
    call GetNextRandomLong
    xchg ax, dx
    mov ds, cx
  end;

function rsRandomLongint(RS : PRandStream) : longint;
  assembler;
  asm
    mov cx, ds
    lds si, RS
    call GetNextRandomLong
    shr dx, 1
    rcr ax, 1
    mov ds, cx
  end;

function  rsRandomFloat(RS : PRandStream) : TrsFloat;
  assembler;
{$IFOPT N+}
  var
    R : longint;
    Scale : integer;
  asm
    mov cx, ds
    lds si, RS
    call GetNextRandomLong
    shr dx, 1
    rcr ax, 1
    mov R.Word[0], ax
    mov R.Word[2], dx
    mov Scale, -31
    fild Scale
    fild R
    fscale
    fstp st(1)
    fwait
    mov ds, cx
  end;
{$ELSE} {N-}
  asm
    mov cx, ds
    lds si, RS
    call GetNextRandomLong
    mov bx, ax
    or ax, dx
    jz @@Exit
    mov ax, $80
    jmp @@StartNormalize
  @@MultBy2:
    shl bx, 1
    rcl dx, 1
    dec al
  @@StartNormalize:
    test dh, $80
    jz @@MultBy2
    and dh, $7F
  @@Exit:
    mov ds, cx
  end;
{$ENDIF}
{$ENDIF}

function rsdRandomUniform(RS : PRandStream; Lower, Upper : TrsFloat) : TrsFloat;
  begin
    if (Upper <= Lower) then
      begin
        rsErrorHandler(rsErrBadRange);
        rsdRandomUniform := 0.0;
      end
    else
      rsdRandomUniform := (rsRandomFloat(RS) * (Upper - Lower)) + Lower;
  end;

end.