[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]