[Back to STRINGS SWAG index]  [Back to Main SWAG index]  [Original]

  type
    long = array[0..3] of byte;   {defines the fake-longint type}
    string8 = string[8];

  {translate the significant portion of a real into a long var}
  procedure real2long(r:real; var l:long; var e:boolean);
  type
    string8   = string[8];
    string32  = string[32];
  var
    s : string32;

    function power(b:real; x:integer; var e:boolean): real;
    begin
      if b > 0 then 
        power:= exp(x * ln(b))
      else halt;
    end;

    {translate the significant portion of a real into a binary string32}
    procedure intreal2binstr(r:real; var s:string32; var e:boolean);
    var
      i : integer;
      m : real;
      p : real;
    begin
      e:= false;
      if (r > power(2,32,e)-1) then begin
        e:= true;
        exit;
      end;
      s:= '';
      for i:= 31 downto 1 do begin
        p:= power(2,i,e);
        m:= int(r/p);
        r:= r - (m * p);
        if (int(m) = 0)  then s:= s + '0'
                         else s:= s + '1';
      end;
      m:= int(r);
      r:= r - m;
      if (int(m) = 0) then s:= s + '0'
                      else s:= s + '1';
    end; 

    {translate a binary string32 into a long variable}
    procedure binstr2long(s: string32; var l:long; var e:boolean);
    var
      i : integer;
      w : string[8];
      b : byte;
  
      {translate a binary string8 into a byte}
      procedure binstr2byte(s:string8; var y:byte; var e:boolean);
      var
        i   : integer;
        v   : integer;
        c   : integer;
        b   : byte;
      begin
        y:= 0;
        for i:= 1 to 8 do begin
          val(s[i],v,c);
          e:= not(c = 0);
          if e then exit;
          b:= v * trunc(power(2,(8-i),e));
          y:= y or b;
        end;
      end;

    begin  {binstr2long}
      for i:= 0 to 3 do begin
        w:= copy(s,(i*8)+1,8);
        binstr2byte(w,b,e);
        l[3 - i]:= b;
      end;
    end;

  begin {real2long}
    intreal2binstr(r,s,e);
    if e then exit;
    binstr2long(s,l,e);
    if e then exit;
 end;

  {translate a string8 (a number in hex notation) into a long variable} 
  procedure str2long(s:string8; var l:long; var e: boolean);
  var
    i : integer;
    c : integer;
    v : integer;
    sb : array[0..3] of string[3];
  begin
    for i:= 0 to 3 do begin
      sb[i]:= '$' + copy(s,(7-(i*2)),2);
      val(sb[i],v,c);
      e:= not(c = 0);
      if e then exit;
      l[i]:= v;
    end;
  end;

  {translate an integer into a long variable}
  procedure int2long(i:integer; var l: long);
  begin
    fillchar(l,sizeof(l),0);
    move(i,l,2);
  end;

  {"shr 8" for long variables}
  procedure shr8(var a,b: long);
  var
    i : integer;
  begin
    for i:= 0 to 2 do
      b[i]:= a[(i+1)];
    b[3]:= 0;
  end;

  {"xor" for long variables}
  procedure xorl(var a,b,c : long);
  var
    i : integer;
  begin
    for i:= 0 to 3 do
      c[i]:= a[i] xor b[i];
  end;

  {"and" for long variables}
  procedure andl(var a,b,c : long);
  var
    i : integer;
  begin
    for i:= 0 to 3 do
      c[i]:= a[i] and b[i];
  end;

BEGIN
END.

[Back to STRINGS SWAG index]  [Back to Main SWAG index]  [Original]