diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ghdldrv/ghdlrun.adb | 2 | ||||
| -rw-r--r-- | src/grt/grt-files.ads | 3 | ||||
| -rw-r--r-- | src/grt/grt-lib.adb | 21 | ||||
| -rw-r--r-- | src/grt/grt-lib.ads | 7 | ||||
| -rw-r--r-- | src/grt/grt-types.ads | 3 | ||||
| -rw-r--r-- | src/std_names.adb | 1 | ||||
| -rw-r--r-- | src/std_names.ads | 5 |
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; |