textio: use grt.fcvt to write reals.

7 files changed, 36 insertions, 6 deletions

diff --git a/src/ghdldrv/ghdlrun.adb b/src/ghdldrv/ghdlrun.adb
index 6e2351343..55165fac4 100644
--- a/src/ghdldrv/ghdlrun.adb
+++ b/src/ghdldrv/ghdlrun.adb
@@ -189,6 +189,8 @@ package body Ghdlrun is
                   Def (Ortho, Grt.Files.Ghdl_Untruncated_Text_Read'Address);
                elsif Name = "textio_read_real" then
                   Def (Ortho, Grt.Lib.Textio_Read_Real'Address);
+               elsif Name = "textio_write_real" then
+                  Def (Ortho, Grt.Lib.Textio_Write_Real'Address);
                elsif Name = "control_simulation" then
                   Def (Ortho, Grt.Lib.Ghdl_Control_Simulation'Address);
                elsif Name = "get_resolution_limit" then
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;
 
diff --git a/src/std_names.adb b/src/std_names.adb
index 60d96d4f4..4e2f05f04 100644
--- a/src/std_names.adb
+++ b/src/std_names.adb
@@ -399,6 +399,7 @@ package body Std_Names is
       Def ("maximum",               Name_Maximum);
       Def ("untruncated_text_read", Name_Untruncated_Text_Read);
       Def ("textio_read_real",      Name_Textio_Read_Real);
+      Def ("textio_write_real",     Name_Textio_Write_Real);
       Def ("get_resolution_limit",  Name_Get_Resolution_Limit);
       Def ("control_simulation",    Name_Control_Simulation);
 
diff --git a/src/std_names.ads b/src/std_names.ads
index 0dc3143f3..2f75e8b0e 100644
--- a/src/std_names.ads
+++ b/src/std_names.ads
@@ -473,8 +473,9 @@ package Std_Names is
    Name_Maximum :        constant Name_Id := Name_First_Misc + 023;
    Name_Untruncated_Text_Read : constant Name_Id := Name_First_Misc + 024;
    Name_Textio_Read_Real :      constant Name_Id := Name_First_Misc + 025;
-   Name_Get_Resolution_Limit :  constant Name_Id := Name_First_Misc + 026;
-   Name_Control_Simulation :    constant Name_Id := Name_First_Misc + 027;
+   Name_Textio_Write_Real :     constant Name_Id := Name_First_Misc + 026;
+   Name_Get_Resolution_Limit :  constant Name_Id := Name_First_Misc + 027;
+   Name_Control_Simulation :    constant Name_Id := Name_First_Misc + 028;
    Name_Last_Misc :      constant Name_Id := Name_Control_Simulation;
 
    Name_First_Ieee         : constant Name_Id := Name_Last_Misc + 1;