grt-vstrings: add to_string for ghdl_f64, use it in grt-images.

3 files changed, 94 insertions, 83 deletions

diff --git a/translate/grt/grt-images.adb b/translate/grt/grt-images.adb
index 25d7fcc1f..7d98940d3 100644
--- a/translate/grt/grt-images.adb
+++ b/translate/grt/grt-images.adb
@@ -143,91 +143,10 @@ package body Grt.Images is
 
    procedure Ghdl_Image_F64 (Res : Std_String_Ptr; Val : Ghdl_F64)
    is
-      function Trunc (V : Ghdl_F64) return Ghdl_F64;
-      pragma Import (C, Trunc);
-
-      --  Sign (1) + digit (1) + dot (1) + digits (15) + exp (1) + sign (1)
-      --  + exp_digits (4) -> 24.
-      Str : String (1 .. 25);
+      Str : String (1 .. 24);
       P : Natural;
-      V : Ghdl_F64;
-      Vmax : Ghdl_F64;
-      Vd : Ghdl_F64;
-      Exp : Integer;
-      D : Integer;
-      B : Boolean;
    begin
-      --  Handle sign.
-      if Val < 0.0 then
-         Str (1) := '-';
-         P := 1;
-         V := -Val;
-      else
-         P := 0;
-         V := Val;
-      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);
-         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 < 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.
-         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;
-
+      To_String (Str, P, Val);
       Return_String (Res, Str (1 .. P));
    end Ghdl_Image_F64;
 
diff --git a/translate/grt/grt-vstrings.adb b/translate/grt/grt-vstrings.adb
index 35a80327b..005bc89e2 100644
--- a/translate/grt/grt-vstrings.adb
+++ b/translate/grt/grt-vstrings.adb
@@ -251,4 +251,91 @@ 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;
+   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;
+   end To_String;
+
 end Grt.Vstrings;
diff --git a/translate/grt/grt-vstrings.ads b/translate/grt/grt-vstrings.ads
index d10bf445e..0f5938edc 100644
--- a/translate/grt/grt-vstrings.ads
+++ b/translate/grt/grt-vstrings.ads
@@ -84,6 +84,11 @@ package Grt.Vstrings is
    --  Requires at least 21 characters.
    procedure To_String (Str : out String; First : out Natural; N : Ghdl_I64);
 
+   --  Requires at least 24 characters.
+   --  Sign (1) + digit (1) + dot (1) + digits (15) + exp (1) + sign (1)
+   --  + exp_digits (4) -> 24.
+   procedure To_String (Str : out String; Last : out Natural; N : Ghdl_F64);
+
 private
    subtype Fat_String is String (Positive);
    type Fat_String_Acc is access Fat_String;