Use grt.fcvt for 'image.

4 files changed, 171 insertions, 200 deletions

diff --git a/src/grt/grt-fcvt.adb b/src/grt/grt-fcvt.adb
index 2e3cd0d23..0757886a2 100644
--- a/src/grt/grt-fcvt.adb
+++ b/src/grt/grt-fcvt.adb
@@ -574,6 +574,26 @@ package body Grt.Fcvt is
       Len := Len + 1;
    end Append;
 
+   procedure Insert (Str : in out String;
+                     Len : in out Natural;
+                     Pos : Positive;
+                     C : Character)
+   is
+      Prev_C, C1 : Character;
+   begin
+      if Pos > Str'Length then
+         return;
+      end if;
+
+      C1 := C;
+      for I in Pos .. Positive'Min (Str'Length, Len) loop
+         Prev_C := Str (I);
+         Str (I) := C1;
+         C1 := Prev_C;
+      end loop;
+      Append (Str, Len, C1);
+   end Insert;
+
    procedure Append_Digit (Str : in out String;
                            Len : in out Natural;
                            D : Natural) is
@@ -764,19 +784,11 @@ package body Grt.Fcvt is
    end Dragon4;
 
    procedure Output_Nan_Inf (Str : out String;
-                             Len : out Natural;
-                             Is_Inf : Boolean;
-                             S : Boolean) is
+                             Len : in out Natural;
+                             Is_Inf : Boolean) is
    begin
-      Len := 0;
-
       if Is_Inf then
          --  Infinite
-         if S then
-            Append (Str, Len, '-');
-         else
-            Append (Str, Len, '+');
-         end if;
          Append (Str, Len, 'i');
          Append (Str, Len, 'n');
          Append (Str, Len, 'f');
@@ -789,6 +801,9 @@ package body Grt.Fcvt is
 
    procedure To_String (Str : out String;
                         Len : out Natural;
+                        Is_Num : out Boolean;
+                        Is_Neg : out Boolean;
+                        Exp : out Integer;
                         V : IEEE_Float_64)
    is
       pragma Assert (Str'First = 1);
@@ -800,16 +815,19 @@ package body Grt.Fcvt is
       E : constant Integer := Integer (Shift_Right (V_Bits, 52) and 16#7_ff#);
 
       Ctxt : Fcvt_Context;
-      First : Natural;
    begin
+      Is_Neg := S;
+      Len := 0;
+
       --  Handle NaN & Inf
       if E = 2047 then
-         Output_Nan_Inf (Str, Len, M = 0, S);
+         Output_Nan_Inf (Str, Len, M = 0);
+         Is_Num := False;
          return;
       end if;
 
       --  Normal or denormal float.
-      Len := 0;
+      Is_Num := True;
 
       Ctxt.F.N := 2;
       Ctxt.F.V (1) := Unsigned_32 (M and 16#ffff_ffff#);
@@ -821,11 +839,6 @@ package body Grt.Fcvt is
          --  Bignum digits may be 0.
          Bignum_Normalize (Ctxt.F);
 
-         --  Display sign.
-         if S then
-            Append (Str, Len, '-');
-         end if;
-
          Ctxt.Is_Emin := True;
          Ctxt.Is_Pow2 := False; --  Not needed.
 
@@ -845,11 +858,6 @@ package body Grt.Fcvt is
          --  Implicit leading 1.
          Ctxt.F.V (2) := Ctxt.F.V (2) or 16#10_00_00#;
 
-         --  Display sign.
-         if S then
-            Append (Str, Len, '-');
-         end if;
-
          Ctxt.Is_Emin := False;
          Ctxt.Is_Pow2 := M = 0;
          Ctxt.Log2v := E - 1023;
@@ -857,8 +865,6 @@ package body Grt.Fcvt is
 
       pragma Assert (Bignum_Is_Valid (Ctxt.F));
 
-      First := Len;
-
       --  At this point, the number is represented as:
       --  F * 2**K
       if Ctxt.F.N = 0 then
@@ -869,23 +875,39 @@ package body Grt.Fcvt is
          Dragon4 (Str, Len, Ctxt);
       end if;
 
+      Exp := Ctxt.K;
+   end To_String;
+
+   procedure To_String (Str : out String;
+                        Len : out Natural;
+                        V : IEEE_Float_64)
+   is
+      Is_Num : Boolean;
+      Is_Neg : Boolean;
+      Exp : Integer;
+      First : Positive;
+   begin
+      To_String (Str, Len, Is_Num, Is_Neg, Exp, V);
+
+      --  Handle sign.
+      if Is_Neg then
+         First := 2;
+         Insert (Str, Len, 1, '-');
+      else
+         First := 1;
+      end if;
+
+      if not Is_Num then
+         return;
+      end if;
+
+      --  At this point STR contains the minus sign (if any) and digits.
+      --  The value is 0.NNNN * 10**K
+
       --  Formatting.
       --  Insert the dot.
-      declare
-         C, Prev_C : Character;
-      begin
-         if Len > First + 1 then
-            C := '.';
-            for I in First + 2 .. Len loop
-               Prev_C := Str (I);
-               Str (I) := C;
-               C := Prev_C;
-            end loop;
-            Len := Len + 1;
-            Str (Len) := C;
-         end if;
-         Ctxt.K := Ctxt.K - 1;
-      end;
+      Insert (Str, Len, First + 1, '.');
+      Exp := Exp - 1;
 
       Append (Str, Len, 'e');
       declare
@@ -893,7 +915,7 @@ package body Grt.Fcvt is
          T : Integer;
          Den : Natural;
       begin
-         K := Ctxt.K;
+         K := Exp;
          if K < 0 then
             Append (Str, Len, '-');
             K := -K;
@@ -1087,4 +1109,76 @@ package body Grt.Fcvt is
       --  F * 10**EXP
       return To_Float_64 (Neg, F, 10, Exp);
    end From_String;
+
+   procedure Format_Image
+     (Str : out String; Last : out Natural; N : IEEE_Float_64)
+   is
+      P : Natural;
+      S : String (1 .. 20);
+      Len : Natural;
+      Is_Num : Boolean;
+      Is_Neg : Boolean;
+      Exp : Integer;
+   begin
+      To_String (S, Len, Is_Num, Is_Neg, Exp, N);
+
+      --  The sign.
+      P := Str'First;
+      if Is_Neg then
+         Str (P) := '-';
+         P := P + 1;
+      end if;
+
+      --  Non numbers
+      if not Is_Num then
+         Str (P .. P + Len - 1) := S (1 .. Len);
+         Last := P + Len - 1;
+         return;
+      end if;
+
+      --  Mantissa N.NNNNN
+      Str (P) := S (1);
+      Str (P + 1) := '.';
+      Exp := Exp - 1;
+      if Len = 1 then
+         Str (P + 2) := '0';
+         P := P + 3;
+      else
+         Str (P + 2 .. P + 2 + Len - 2) := S (2 .. Len);
+         P := P + 2 + Len - 2 + 1;
+      end if;
+
+      --  Exponent
+      if Exp /= 0 then
+         --  LRM93 14.3
+         --  if the exponent is present, the `e' is written as a lower case
+         --  character.
+         Str (P) := 'e';
+         P := P + 1;
+
+         if Exp < 0 then
+            Str (P) := '-';
+            P := P + 1;
+            Exp := -Exp;
+         end if;
+         declare
+            B : Boolean;
+            D : Natural;
+         begin
+            B := False;
+            for I in 0 .. 4 loop
+               D := (Exp / 10000) mod 10;
+               if D /= 0 or B or I = 4 then
+                  Str (P) := Character'Val (48 + D);
+                  P := P + 1;
+                  B := True;
+               end if;
+               Exp := (Exp - D * 10000) * 10;
+            end loop;
+         end;
+      end if;
+
+      Last := P - 1;
+   end Format_Image;
+
 end Grt.Fcvt;
diff --git a/src/grt/grt-fcvt.ads b/src/grt/grt-fcvt.ads
index e1e272850..2ec42fcfa 100644
--- a/src/grt/grt-fcvt.ads
+++ b/src/grt/grt-fcvt.ads
@@ -30,6 +30,32 @@
 with Interfaces; use Interfaces;
 
 package Grt.Fcvt is
+   pragma Preelaborate;
+
+   --  Convert (without formatting) number V.
+   --  The result is LEN characters stored to STR.  If STR is too short, then
+   --  the output is truncated but LEN contains the number of characters that
+   --  would be needed.  The procedure assumes STR'First = 1.
+   --  The digits are the digits after the point.  The output has to be read as
+   --   0.NNNNN * 10**EXP
+   --  IS_NUM is true if V is a number and false for NaN or Infinite.
+   --  IS_NEG is true if the number if negative.
+   procedure To_String (Str : out String;
+                        Len : out Natural;
+                        Is_Num : out Boolean;
+                        Is_Neg : out Boolean;
+                        Exp : out Integer;
+                        V : IEEE_Float_64);
+
+   --  Formatting.
+
+   --  For 'Image
+   --  STR must have at least 24 characters:
+   --  Sign (1) + digit (1) + dot (1) + digits (15) + 'e' (1) + sign (1)
+   --  + exp_digits (4) -> 24.
+   procedure Format_Image
+     (Str : out String; Last : out Natural; N : IEEE_Float_64);
+
    --  Convert V to 10-based number stored (in ASCII) in STR/LEN [using at most
    --  NDIGITS digits.]
    --  LEN is the number of characters needed (so it may be greater than
diff --git a/src/grt/grt-vstrings.adb b/src/grt/grt-vstrings.adb
index d5d14c856..544626f46 100644
--- a/src/grt/grt-vstrings.adb
+++ b/src/grt/grt-vstrings.adb
@@ -22,10 +22,11 @@
 --  covered by the GNU General Public License. This exception does not
 --  however invalidate any other reasons why the executable file might be
 --  covered by the GNU Public License.
-with System.Storage_Elements; --  Work around GNAT bug.
-pragma Unreferenced (System.Storage_Elements);
+
+with Interfaces;
 with Grt.Errors; use Grt.Errors;
 with Grt.C; use Grt.C;
+with Grt.Fcvt;
 
 package body Grt.Vstrings is
    procedure Free (Fs : Fat_String_Acc);
@@ -262,90 +263,9 @@ package body Grt.Vstrings is
    procedure To_String (Str : out String; First : out Natural; N : Ghdl_I64)
      renames To_String_I64;
 
-   procedure To_String (Str : out String; Last : out Natural; N : Ghdl_F64)
-   is
-      function Trunc (V : Ghdl_F64) return Ghdl_F64;
-      pragma Import (C, Trunc);
-
-      P : Natural := Str'First;
-      V : Ghdl_F64;
-      Vmax : Ghdl_F64;
-      Vd : Ghdl_F64;
-      Exp : Integer;
-      D : Integer;
-      B : Boolean;
+   procedure To_String (Str : out String; Last : out Natural; N : Ghdl_F64) is
    begin
-      --  Handle sign.
-      if N < 0.0 then
-         Str (P) := '-';
-         P := P + 1;
-         V := -N;
-      else
-         V := N;
-      end if;
-
-      --  Compute the mantissa.
-      --  and normalize V in [0 .. 10.0[
-      --  FIXME: should do a dichotomy.
-      if V  = 0.0 then
-         Exp := 0;
-      elsif V < 1.0 then
-         Exp := 0;
-         loop
-            exit when V >= 1.0;
-            Exp := Exp - 1;
-            V := V * 10.0;
-         end loop;
-      else
-         Exp := 0;
-         loop
-            exit when V < 10.0;
-            Exp := Exp + 1;
-            V := V / 10.0;
-         end loop;
-      end if;
-
-      Vmax := 10.0 ** (1 - 15);
-      for I in 0 .. 15 loop
-         --  Vd := Ghdl_F64'Truncation (V);
-         Vd := Trunc (V);
-         Str (P) := Character'Val (48 + Integer (Vd));
-         P := P + 1;
-         V := (V - Vd) * 10.0;
-
-         if I = 0 then
-            Str (P) := '.';
-            P := P + 1;
-         end if;
-         exit when I > 0 and V < Vmax;
-         Vmax := Vmax * 10.0;
-      end loop;
-
-      if Exp /= 0 then
-         --  LRM93 14.3
-         --  if the exponent is present, the `e' is written as a lower case
-         --  character.
-         Str (P) := 'e';
-         P := P + 1;
-
-         if Exp < 0 then
-            Str (P) := '-';
-            P := P + 1;
-            Exp := -Exp;
-         end if;
-         B := False;
-         for I in 0 .. 4 loop
-            D := (Exp / 10000) mod 10;
-            if D /= 0 or B or I = 4 then
-               Str (P) := Character'Val (48 + D);
-               P := P + 1;
-               B := True;
-            end if;
-            Exp := (Exp - D * 10000) * 10;
-         end loop;
-      end if;
-
-      Last := P - 1;
+      Grt.Fcvt.Format_Image (Str, Last, Interfaces.IEEE_Float_64 (N));
    end To_String;
 
    procedure To_String (Str : out String_Real_Digits;
diff --git a/src/vhdl/evaluation.adb b/src/vhdl/evaluation.adb
index 85c99209f..214deb5ca 100644
--- a/src/vhdl/evaluation.adb
+++ b/src/vhdl/evaluation.adb
@@ -16,6 +16,7 @@
 --  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 --  02111-1307, USA.
 with Ada.Unchecked_Deallocation;
+with Interfaces;
 with Scanner;
 with Errorout; use Errorout;
 with Name_Table; use Name_Table;
@@ -25,6 +26,7 @@ with Std_Package; use Std_Package;
 with Flags; use Flags;
 with Std_Names;
 with Ada.Characters.Handling;
+with Grt.Fcvt;
 
 package body Evaluation is
    --  If FORCE is true, always return a literal.
@@ -1763,87 +1765,16 @@ package body Evaluation is
       use Str_Table;
       Id : String8_Id;
 
-      --  Sign (1) + digit (1) + dot (1) + digits (15) + exp (1) + sign (1)
+      --  Sign (1) + digit (1) + dot (1) + digits (15) + 'e' (1) + sign (1)
       --  + exp_digits (4) -> 24.
       Str : String (1 .. 25);
       P : Natural;
-      V : Iir_Fp64;
-      Vd : Iir_Fp64;
-      Exp : Integer;
-      D : Integer;
-      B : Boolean;
 
       Res : Iir;
    begin
-      --  Handle sign.
-      if Val < 0.0 then
-         Str (1) := '-';
-         P := 1;
-         V := -Val;
-      else
-         P := 0;
-         V := Val;
-      end if;
-
-      --  Compute the mantissa.
-      --  FIXME: should do a dichotomy.
-      if V  = 0.0 then
-         Exp := 0;
-      elsif V < 1.0 then
-         Exp := -1;
-         while V * (10.0 ** (-Exp)) < 1.0 loop
-            Exp := Exp - 1;
-         end loop;
-      else
-         Exp := 0;
-         while V / (10.0 ** Exp) >= 10.0 loop
-            Exp := Exp + 1;
-         end loop;
-      end if;
-
-      --  Normalize VAL: in [0; 10[
-      if Exp >= 0 then
-         V := V / (10.0 ** Exp);
-      else
-         V := V * 10.0 ** (-Exp);
-      end if;
+      P := Str'First;
 
-      for I in 0 .. 15 loop
-         Vd := Iir_Fp64'Truncation (V);
-         P := P + 1;
-         Str (P) := Character'Val (48 + Integer (Vd));
-         V := (V - Vd) * 10.0;
-
-         if I = 0 then
-            P := P + 1;
-            Str (P) := '.';
-         end if;
-         exit when I > 0 and V < 10.0 ** (I + 1 - 15);
-      end loop;
-
-      if Exp /= 0 then
-         --  LRM93 14.3
-         --  if the exponent is present, the `e' is written as a lower case
-         --  character.
-         P := P + 1;
-         Str (P) := 'e';
-
-         if Exp < 0 then
-            P := P + 1;
-            Str (P) := '-';
-            Exp := -Exp;
-         end if;
-         B := False;
-         for I in 0 .. 4 loop
-            D := (Exp / 10000) mod 10;
-            if D /= 0 or B or I = 4 then
-               P := P + 1;
-               Str (P) := Character'Val (48 + D);
-               B := True;
-            end if;
-            Exp := (Exp - D * 10000) * 10;
-         end loop;
-      end if;
+      Grt.Fcvt.Format_Image (Str, P, Interfaces.IEEE_Float_64 (Val));
 
       Id := Create_String8;
       for I in 1 .. P loop