Rewrite to_string(real, digits) using grt.fcvt

6 files changed, 186 insertions, 22 deletions

diff --git a/src/grt/grt-cbinding.c b/src/grt/grt-cbinding.c
index 1083d5824..b3dceb39f 100644
--- a/src/grt/grt-cbinding.c
+++ b/src/grt/grt-cbinding.c
@@ -46,12 +46,6 @@ __ghdl_snprintf_g (char *buf, unsigned int len, double val)
 }
 
 void
-__ghdl_snprintf_nf (char *buf, unsigned int len, int ndigits, double val)
-{
-  snprintf (buf, len, "%.*f", ndigits, val);
-}
-
-void
 __ghdl_snprintf_fmtf (char *buf, unsigned int len,
 		      const char *format, double v)
 {
diff --git a/src/grt/grt-fcvt.adb b/src/grt/grt-fcvt.adb
index 1f8165b35..3f754a5d1 100644
--- a/src/grt/grt-fcvt.adb
+++ b/src/grt/grt-fcvt.adb
@@ -1102,4 +1102,167 @@ package body Grt.Fcvt is
       Last := P - 1;
    end Format_Image;
 
+   procedure Format_Precision (Str : in out String;
+                               Len : in out Natural;
+                               Exp : in out Integer;
+                               Prec : Positive)
+   is
+      pragma Assert (Str'First = 1);
+
+      --  LEN is the number of digits, so there are LEN - EXP digits after the
+      --  point.
+      Ndigits : constant Integer := Len - Exp;
+      Nlen : Integer;
+      Inc : Boolean;
+   begin
+      if Ndigits <= Prec then
+         --  Already precise enough.
+         return;
+      end if;
+
+      Nlen := Prec + Exp;
+      if Nlen < 0 then
+         --  Number is too small
+         Str (1) := '0';
+         Len := 1;
+         Exp := 0;
+         return;
+      end if;
+
+      if Nlen < Len then
+         --  Round.
+         if Str (Nlen + 1) < '5' then
+            Inc := False;
+         elsif Str (Nlen + 1) > '5' then
+            Inc := True;
+         else
+            Inc := False;
+            for I in Nlen + 2 .. Len loop
+               if Str (I) /= '0' then
+                  Inc := True;
+                  exit;
+               end if;
+            end loop;
+         end if;
+         if Inc then
+            --  Increment the last digit and handle carray propagation if any.
+            Inc := True;
+            for I in reverse 1 .. Nlen loop
+               if Str (I) < '9' then
+                  Str (I) := Character'Val (Character'Pos (Str (I)) + 1);
+                  Inc := False;
+                  exit;
+               else
+                  Str (I) := '0';
+               end if;
+            end loop;
+            if Inc then
+               --  The digits were 9999...  so becomes 10000...
+               --  Change the exponent so recompute the length.
+               Exp := Exp + 1;
+               Nlen := Prec + Exp;
+
+               Str (1) := '1';
+               Str (2 .. Nlen) := (others => '0');
+            end if;
+         end if;
+         Len := Nlen;
+      end if;
+   end Format_Precision;
+
+   procedure Format_Digits (Str : out String;
+                            Last : out Natural;
+                            N : IEEE_Float_64;
+                            Ndigits : Natural)
+   is
+      procedure Append (C : Character) is
+      begin
+         Last := Last + 1;
+         if Last <= Str'Last then
+            Str (Last) := C;
+         end if;
+      end Append;
+
+      S : String (1 .. 20);
+      Len : Natural;
+      Exp : Integer;
+      Is_Num, Is_Neg : Boolean;
+   begin
+      --  LRM08 5.2.6 Predefined operations on scalar types
+      --  If DIGITS is 0, then the string representation is the same as that
+      --  produced by the TO_STRING operation without the DIGITS or FORMAT
+      --  parameter.
+      if Ndigits = 0 then
+         Format_Image (Str, Last, N);
+         return;
+      end if;
+
+      --  Radix conversion.
+      Grt.Fcvt.To_String (S, Len, Is_Num, Is_Neg, Exp, N);
+
+      --  Sign.
+      Last := Str'First - 1;
+      if Is_Neg then
+         Append ('-');
+      end if;
+
+      --  Non finite numbers.  That shouldn't appear in VHDL, but let's handle
+      --  them.
+      if not Is_Num then
+         for I in 1 .. Len loop
+            Append (S (I));
+         end loop;
+         return;
+      end if;
+
+      --  Finite numbers.  Set precision.
+      Grt.Fcvt.Format_Precision (S, Len, Exp, Ndigits);
+
+      if Exp <= 0 then
+         --  Integer part is 0.
+         Append ('0');
+         Append ('.');
+         if Len - Exp <= Ndigits then
+            for I in 1 .. -Exp loop
+               Append ('0');
+            end loop;
+            for I in 1 .. Len loop
+               Append (S (I));
+            end loop;
+            for I in Len - Exp + 1 .. Ndigits loop
+               Append ('0');
+            end loop;
+         else
+            for I in 1 .. Ndigits loop
+               Append ('0');
+            end loop;
+         end if;
+      elsif Exp >= Len then
+         --  No fractional part.
+         for I in 1 .. Len loop
+            Append (S (I));
+         end loop;
+         for I in Len + 1 .. Exp loop
+            Append ('0');
+         end loop;
+         Append ('.');
+         for I in 1 .. Ndigits loop
+            Append ('0');
+         end loop;
+      else
+         for I in 1 .. Exp loop
+            Append (S (I));
+         end loop;
+         Append ('.');
+         for I in Exp + 1 .. Len loop
+            Append (S (I));
+         end loop;
+         --  Len - (Exp + 1) + 1 digits after the point have been added.
+         --  Complete with '0'.
+         for I in Len - (Exp + 1) + 1 + 1 .. Ndigits loop
+            Append ('0');
+         end loop;
+      end if;
+   end Format_Digits;
+
 end Grt.Fcvt;
diff --git a/src/grt/grt-fcvt.ads b/src/grt/grt-fcvt.ads
index 9fad63c06..6b278fe60 100644
--- a/src/grt/grt-fcvt.ads
+++ b/src/grt/grt-fcvt.ads
@@ -56,6 +56,21 @@ package Grt.Fcvt is
    procedure Format_Image
      (Str : out String; Last : out Natural; N : IEEE_Float_64);
 
+   --  For To_String (Value : Real; Digits : Natural)
+   procedure Format_Digits (Str : out String;
+                            Last : out Natural;
+                            N : IEEE_Float_64;
+                            Ndigits : Natural);
+
+   --  Reduce the precision of STR to PREC digits after the point.  If PREC is
+   --  too large, this is no-op.
+   --  STR, LEN, EXP are the output of To_String, that is:
+   --  0.STR * 10**EXP
+   procedure Format_Precision (Str : in out String;
+                               Len : in out Natural;
+                               Exp : in out Integer;
+                               Prec : Positive);
+
    --  Input format is [+-]int[.int][e[+-]int]
    --  where int is digit { _ digit }
    --    and [+-] means optional + or -.
diff --git a/src/grt/grt-images.adb b/src/grt/grt-images.adb
index 8e15d103a..b9ba82928 100644
--- a/src/grt/grt-images.adb
+++ b/src/grt/grt-images.adb
@@ -176,7 +176,7 @@ package body Grt.Images is
    procedure Ghdl_To_String_F64_Digits
      (Res : Std_String_Ptr; Val : Ghdl_F64; Nbr_Digits : Ghdl_I32)
    is
-      Str : String_Real_Digits;
+      Str : String (1 .. 128);
       P : Natural;
    begin
       To_String (Str, P, Val, Nbr_Digits);
diff --git a/src/grt/grt-vstrings.adb b/src/grt/grt-vstrings.adb
index 544626f46..b9fd0b8bb 100644
--- a/src/grt/grt-vstrings.adb
+++ b/src/grt/grt-vstrings.adb
@@ -268,22 +268,16 @@ package body Grt.Vstrings is
       Grt.Fcvt.Format_Image (Str, Last, Interfaces.IEEE_Float_64 (N));
    end To_String;
 
-   procedure To_String (Str : out String_Real_Digits;
+   procedure To_String (Str : out String;
                         Last : out Natural;
                         N : Ghdl_F64;
-                        Nbr_Digits : Ghdl_I32)
-   is
-      procedure Snprintf_Nf (Str : in out String;
-                             Len : Natural;
-                             Ndigits : Ghdl_I32;
-                             V : Ghdl_F64);
-      pragma Import (C, Snprintf_Nf, "__ghdl_snprintf_nf");
+                        Nbr_Digits : Ghdl_I32) is
    begin
-      Snprintf_Nf (Str, Str'Length, Nbr_Digits, N);
-      Last := strlen (To_Ghdl_C_String (Str'Address));
+      Grt.Fcvt.Format_Digits
+        (Str, Last, Interfaces.IEEE_Float_64 (N), Natural (Nbr_Digits));
    end To_String;
 
-   procedure To_String (Str : out String_Real_Digits;
+   procedure To_String (Str : out String_Real_Format;
                         Last : out Natural;
                         N : Ghdl_F64;
                         Format : Ghdl_C_String)
diff --git a/src/grt/grt-vstrings.ads b/src/grt/grt-vstrings.ads
index 80563e5a3..58d92ee64 100644
--- a/src/grt/grt-vstrings.ads
+++ b/src/grt/grt-vstrings.ads
@@ -100,11 +100,9 @@ package Grt.Vstrings is
    --  + exp_digits (4) -> 24.
    procedure To_String (Str : out String; Last : out Natural; N : Ghdl_F64);
 
-   subtype String_Real_Digits is String (1 .. 128);
-
    --  Write the image of N into STR using NBR_DIGITS digits after the decimal
    --  point.
-   procedure To_String (Str : out String_Real_Digits;
+   procedure To_String (Str : out String;
                         Last : out Natural;
                         N : Ghdl_F64;
                         Nbr_Digits : Ghdl_I32);
@@ -113,7 +111,7 @@ package Grt.Vstrings is
 
    --  Write the image of N into STR using NBR_DIGITS digits after the decimal
    --  point.
-   procedure To_String (Str : out String_Real_Digits;
+   procedure To_String (Str : out String_Real_Format;
                         Last : out Natural;
                         N : Ghdl_F64;
                         Format : Ghdl_C_String);