textio: use grt.fcvt to write reals.

4 files changed, 30 insertions, 4 deletions

diff --git a/src/grt/grt-files.ads b/src/grt/grt-files.ads
index 3c6191f36..e5c797ec9 100644
--- a/src/grt/grt-files.ads
+++ b/src/grt/grt-files.ads
@@ -75,9 +75,6 @@ package Grt.Files is
    function Ghdl_Text_Read_Length
      (File : Ghdl_File_Index; Str : Std_String_Ptr) return Std_Integer;
 
-   type Std_Integer_Acc is access Std_Integer;
-   pragma Convention (C, Std_Integer_Acc);
-
    procedure Ghdl_Untruncated_Text_Read
      (File : Ghdl_File_Index; Str : Std_String_Ptr; Len : Std_Integer_Acc);
 
diff --git a/src/grt/grt-lib.adb b/src/grt/grt-lib.adb
index 3c16392be..9aa3558cc 100644
--- a/src/grt/grt-lib.adb
+++ b/src/grt/grt-lib.adb
@@ -22,6 +22,8 @@
 --  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 Interfaces;
 with Grt.Errors; use Grt.Errors;
 with Grt.Options;
 with Grt.Fcvt;
@@ -277,9 +279,26 @@ package body Grt.Lib is
       subtype Str1 is String (1 .. Natural (Str.Bounds.Dim_1.Length));
    begin
       return Ghdl_F64 (Grt.Fcvt.From_String
-                         (Str1 (Str.Base (0 .. Str.Bounds.Dim_1.Length))));
+                         (Str1 (Str.Base (0 .. Str.Bounds.Dim_1.Length - 1))));
    end Textio_Read_Real;
 
+   procedure Textio_Write_Real (Str : Std_String_Ptr;
+                                Len : Std_Integer_Acc;
+                                V : Ghdl_F64;
+                                Ndigits : Std_Integer)
+   is
+      --  FIXME: avoid that copy.
+      S : String (1 .. Natural (Str.Bounds.Dim_1.Length));
+      Last : Natural;
+   begin
+      Grt.Fcvt.Format_Digits
+        (S, Last, Interfaces.IEEE_Float_64 (V), Natural (Ndigits));
+      Len.all := Std_Integer (Last);
+      for I in 1 .. Last loop
+         Str.Base (Ghdl_Index_Type (I - 1)) := S (I);
+      end loop;
+   end Textio_Write_Real;
+
    function Ghdl_Get_Resolution_Limit return Std_Time is
    begin
       return 1;
diff --git a/src/grt/grt-lib.ads b/src/grt/grt-lib.ads
index 97ee669a8..6e01ea9de 100644
--- a/src/grt/grt-lib.ads
+++ b/src/grt/grt-lib.ads
@@ -94,6 +94,11 @@ package Grt.Lib is
 
    function Textio_Read_Real (Str : Std_String_Ptr) return Ghdl_F64;
 
+   procedure Textio_Write_Real (Str : Std_String_Ptr;
+                                Len : Std_Integer_Acc;
+                                V : Ghdl_F64;
+                                Ndigits : Std_Integer);
+
    function Ghdl_Get_Resolution_Limit return Std_Time;
 
    procedure Ghdl_Control_Simulation
@@ -124,6 +129,8 @@ private
 
    pragma Export (C, Textio_Read_Real,
                   "std__textio__textio_read_real");
+   pragma Export (C, Textio_Write_Real,
+                  "std__textio__textio_write_real");
 
    pragma Export (C, Ghdl_Get_Resolution_Limit,
                   "std__env__get_resolution_limit");
diff --git a/src/grt/grt-types.ads b/src/grt/grt-types.ads
index 5fb60f2d5..d9b17f67e 100644
--- a/src/grt/grt-types.ads
+++ b/src/grt/grt-types.ads
@@ -55,6 +55,9 @@ package Grt.Types is
 
    subtype Std_Integer is Ghdl_I32;
 
+   type Std_Integer_Acc is access Std_Integer;
+   pragma Convention (C, Std_Integer_Acc);
+
    type Std_Time is new Ghdl_I64;
    Bad_Time : constant Std_Time := Std_Time'First;