File : reps-io.adb

package body Reps.IO is

  package Txt_Rep_IO is new Ada.Text_IO.Float_IO(Rep);

  HexDig: constant array(0 .. 15) of Character
          := ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');

  function Val(S: String) return Rep is

    function V(C: Character) return Integer is
    begin
      for K in 1 .. 15 loop
        if C=HexDig(K) then return K; end if;
      end loop;
      return 0;
    end V;

    E1,E2,Ed1,Es2,Ms: Integer := 0;
    R: Rep := Zero;
  begin
    for K in S'Range loop
      if S(K)=' ' then
        null;
      elsif S(K)='+' then
        if Ms=0 then Ms := 1; else Es2 := 1; end if;
      elsif S(K)='-' then
        if Ms=0 then Ms := -1; else Es2 := -1; end if;
      elsif Es2=0 then
        if Ms=0 then Ms := 1; end if;
        if S(K)='.' then
          Ed1 := -1;
        else
          R := Rep(16)*R+Rep(V(S(K)));
          E1 := E1+Ed1;
        end if;
      else
        E2 := 16*E2+V(S(K));
      end if;
    end loop;
    R := Rep(Ms)*Rep'Scaling(R,4*(E1+Es2*E2));
    return R;
  end Val;

  function HexStr(I: Integer) return String is
    Nhex: constant Integer := 1+Integer'Size/4;
    S: String(1 .. Nhex);
    J: Integer := Abs(I);
  begin
    for N in reverse 1 .. Nhex loop
      S(N) := HexDig(J mod 16);
      J := J/16;
      if J=0 then
        if I<0 then return "-" & S(N .. Nhex);
        else return "+" & S(N .. Nhex); end if;
      end if;
    end loop;
    raise Constraint_Error;
    return "+0";
  end HexStr;

  function HexStr(R: Rep) return String is
    Nhex: constant Integer := 1+Rep'Machine_Mantissa/4;
    E,F: Integer;
    M,L: Rep;
    S: String(1 .. Nhex+2);
  begin
    if R=0.0 then
      return " 0.0+0";
    end if;
    if R<0.0 then S(1) := '-'; else S(1) := '+'; end if;
    E := Rep'Exponent(R)-1;
    F := E mod 4;
    M := Rep'Compose(Abs(R),F+1);
    L := Rep'Leading_Part(M,F+1);
    S(2) := HexDig(Integer(Rep'Floor(L)));
    S(3) := '.';
    for N in 1 .. Nhex-1 loop
      L := M-Rep'Leading_Part(M,F-3+4*N);
      S(N+3) := HexDig(Integer(Rep'Floor(L*Rep(16)**N)));
    end loop;
    return S & HexStr((E-F)/4);
  end HexStr;

  procedure Txt_Get(F: in File_Type; R: out Rep; Decimal: in Boolean := True) is
    I: Integer;
    S: String(1..32);
  begin
    if Decimal then
      Txt_Rep_IO.Get(F,R);
    else
      I := 0;
      while I=0 loop
        Get_Line(File=>F, Item=>S, Last=>I);
      end loop;
      R := Val(S(1..I));
    end if;
  end Txt_Get;

  procedure Txt_Get(F: in File_Type; R1,R2: out Rep; Decimal: in Boolean := True) is
    I: Integer;
    S: String(1..64);
  begin
    if Decimal then
      Txt_Rep_IO.Get(F,R1);
      R2 := Zero;             --- no decimal pairs, according to Txt_Put
    else
      I := 0;
      while I=0 loop
        Get_Line(File=>F, Item=>S, Last=>I);
      end loop;
      for N in 2 .. I-1 loop
        if S(N)=',' then
          R1 := Val(S(1 .. N-1));
          R2 := Val(S(N+1 .. I));
          return;
        end if;
      end loop;
      R1 := Val(S(1..I));
      R2 := Zero;
    end if;
  end Txt_Get;

  procedure Txt_Put(F: in File_Type; R: in Rep; Decimal: in Boolean := True) is
--- Long_Float approx 16 decimal digits
--- Long_Long_Float only 17 decimal digits
  begin
    if Decimal then
      Txt_Rep_IO.Put(File=>F, Item=>R, Aft=>17, Exp=>4);  --- approximate
    else
      Put(F,HexStr(R));
    end if;
  end Txt_Put;

  procedure Txt_Put(F: in File_Type; R1,R2: in Rep; Decimal: in Boolean := True) is
  begin
    if Decimal then                                        --- ignore R2
      Txt_Rep_IO.Put(File=>F, Item=>R1, Aft=>17, Exp=>4);  --- approximate
    elsif R2=Zero then
      Put(F,HexStr(R1));
    else
      Put(F,HexStr(R1) & "," & HexStr(R2));
    end if;
  end Txt_Put;

end Reps.IO;