From 1c4ce754b16f53442da151cb47d3b5a5ecdc5fe0 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Tue, 18 Apr 2017 06:05:30 +0200 Subject: textio: use grt.fcvt to read real numbers. --- libraries/std/textio_body.vhdl | 133 +++++++++++++++++------------------------ src/ghdldrv/ghdlrun.adb | 2 + src/grt/grt-lib.adb | 9 +++ src/grt/grt-lib.ads | 5 ++ src/std_names.adb | 1 + src/std_names.ads | 5 +- 6 files changed, 75 insertions(+), 80 deletions(-) diff --git a/libraries/std/textio_body.vhdl b/libraries/std/textio_body.vhdl index 2042e681a..823b4b67e 100644 --- a/libraries/std/textio_body.vhdl +++ b/libraries/std/textio_body.vhdl @@ -492,13 +492,14 @@ package body textio is write (l, to_hstring (value), justified, field); end Hwrite; --END-V08 - + + attribute foreign : string; --V87 + procedure untruncated_text_read --V87 (variable f : text; str : out string; len : out natural); --V87 procedure untruncated_text_read --!V87 (file f : text; str : out string; len : out natural); --!V87 - attribute foreign : string; --V87 attribute foreign of untruncated_text_read : procedure is "GHDL intrinsic"; procedure untruncated_text_read @@ -923,57 +924,42 @@ package body textio is severity failure; end read; - procedure read (l: inout line; value: out real; good: out boolean) - is - -- The result. - variable val : real; - -- True if the result is negative. - variable val_neg : boolean; + function textio_read_real (s : string) return real; - -- Number of digits after the dot. - variable nbr_dec : natural; + attribute foreign of textio_read_real : function is "GHDL intrinsic"; - -- Value of the exponent. - variable exp : integer; - -- True if the exponent is negative. - variable exp_neg : boolean; + function textio_read_real (s : string) return real is + begin + assert false report "must not be called" severity failure; + return 0.0; + end textio_read_real; + procedure read (l: inout line; value: out real; good: out boolean) + is -- The parsing is done with a state machine. -- LEADING: leading blank suppression. -- SIGN: a sign has been found. -- DIGITS: integer parts - -- DECIMALS: digits after the dot. + -- DECIMALS, DECIMALS2: digits after the dot. -- EXPONENT_SIGN: sign after "E" -- EXPONENT_1: first digit of the exponent. -- EXPONENT: digits of the exponent. - type state_t is (leading, sign, digits, decimals, + type state_t is (leading, sign, digits, decimals, decimals2, exponent_sign, exponent_1, exponent); - variable cur_state : state_t := leading; + variable state : state_t := leading; - -- Set VALUE to the result, and set GOOD to TRUE. - procedure set_value is - begin - good := true; + variable left : positive; - if exp_neg then - val := val * 10.0 ** (-exp); - else - val := val * 10.0 ** exp; - end if; - if val_neg then - value := -val; + procedure set_value (right : positive; off : natural) is + begin + if right > left then + value := textio_read_real (l (left to right - off)); else - value := val; + value := textio_read_real (l (left downto right + off)); end if; + good := True; end set_value; - begin - -- Initialization. - val_neg := false; - nbr_dec := 1; - exp := 0; - exp_neg := false; - -- By default, parsing has failed. good := false; @@ -981,99 +967,89 @@ package body textio is -- Return immediatly in case of parse error. -- Trim L and call SET_VALUE and return in case of success. for i in l'range loop - case cur_state is + case state is when leading => - case l(i) is + left := i; + case l (i) is when ' ' | NBSP --!V87 | ht => null; - when '+' => - cur_state := sign; - when '-' => - val_neg := true; - cur_state := sign; + when '+' | '-' => + state := sign; when '0' to '9' => - val := real (char_to_nat (l(i))); - cur_state := digits; + state := digits; when others => return; end case; when sign => - case l(i) is + case l (i) is when '0' to '9' => - val := real (char_to_nat (l(i))); - cur_state := digits; + state := digits; when others => return; end case; when digits => - case l(i) is + case l (i) is when '0' to '9' => - val := val * 10.0 + real (char_to_nat (l(i))); + null; when '.' => - cur_state := decimals; + state := decimals; when others => -- A "." (dot) is required in the string. return; end case; - when decimals => - case l(i) is + when decimals | decimals2 => + case l (i) is when '0' to '9' => - val := val + real (char_to_nat (l(i))) / (10.0 ** nbr_dec); - nbr_dec := nbr_dec + 1; + state := decimals2; when 'e' | 'E' => -- "nnn.E" is erroneous. - if nbr_dec = 1 then + if state = decimals then return; end if; - cur_state := exponent_sign; + state := exponent_sign; when others => -- "nnn.XX" is erroneous. - if nbr_dec = 1 then + if state = decimals then return; end if; - trim (l, i); - set_value; - return; + set_value (i, 1); + trim (l, i); + return; end case; when exponent_sign => - case l(i) is - when '+' => - cur_state := exponent_1; - when '-' => - exp_neg := true; - cur_state := exponent_1; + case l (i) is + when '+' | '-' => + state := exponent_1; when '0' to '9' => - exp := char_to_nat (l(i)); - cur_state := exponent; + state := exponent; when others => -- Error. return; end case; when exponent_1 | exponent => - case l(i) is + case l (i) is when '0' to '9' => - exp := exp * 10 + char_to_nat (l(i)); - cur_state := exponent; + state := exponent; when others => + set_value (i, 1); trim (l, i); - set_value; return; end case; end case; end loop; -- End of string. - case cur_state is + case state is when leading | sign | digits => -- Erroneous. return; when decimals => -- "nnn.XX" is erroneous. - if nbr_dec = 1 then - return; - end if; + return; + when decimals2 => + null; when exponent_sign => -- Erroneous ("NNN.NNNE") return; @@ -1084,9 +1060,10 @@ package body textio is null; end case; + set_value (l'right, 0); + deallocate (l); l := new string'(""); - set_value; end read; procedure read (l: inout line; value: out real) diff --git a/src/ghdldrv/ghdlrun.adb b/src/ghdldrv/ghdlrun.adb index c9183433f..6e2351343 100644 --- a/src/ghdldrv/ghdlrun.adb +++ b/src/ghdldrv/ghdlrun.adb @@ -187,6 +187,8 @@ package body Ghdlrun is begin if Name = "untruncated_text_read" then 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 = "control_simulation" then Def (Ortho, Grt.Lib.Ghdl_Control_Simulation'Address); elsif Name = "get_resolution_limit" then diff --git a/src/grt/grt-lib.adb b/src/grt/grt-lib.adb index 95a4a0948..3c16392be 100644 --- a/src/grt/grt-lib.adb +++ b/src/grt/grt-lib.adb @@ -24,6 +24,7 @@ -- covered by the GNU Public License. with Grt.Errors; use Grt.Errors; with Grt.Options; +with Grt.Fcvt; package body Grt.Lib is --procedure Memcpy (Dst : Address; Src : Address; Size : Size_T); @@ -271,6 +272,14 @@ package body Grt.Lib is end if; end Ghdl_Real_Exp; + function Textio_Read_Real (Str : Std_String_Ptr) return Ghdl_F64 + 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)))); + end Textio_Read_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 2ee918ba2..97ee669a8 100644 --- a/src/grt/grt-lib.ads +++ b/src/grt/grt-lib.ads @@ -92,6 +92,8 @@ package Grt.Lib is False -- - ); + function Textio_Read_Real (Str : Std_String_Ptr) return Ghdl_F64; + function Ghdl_Get_Resolution_Limit return Std_Time; procedure Ghdl_Control_Simulation @@ -120,6 +122,9 @@ private pragma Export (C, Ghdl_Std_Ulogic_To_Boolean_Array, "__ghdl_std_ulogic_to_boolean_array"); + pragma Export (C, Textio_Read_Real, + "std__textio__textio_read_real"); + pragma Export (C, Ghdl_Get_Resolution_Limit, "std__env__get_resolution_limit"); pragma Export (Ada, Ghdl_Control_Simulation, diff --git a/src/std_names.adb b/src/std_names.adb index 96bbc543e..60d96d4f4 100644 --- a/src/std_names.adb +++ b/src/std_names.adb @@ -398,6 +398,7 @@ package body Std_Names is Def ("minimum", Name_Minimum); Def ("maximum", Name_Maximum); Def ("untruncated_text_read", Name_Untruncated_Text_Read); + Def ("textio_read_real", Name_Textio_Read_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 b54dcb693..0dc3143f3 100644 --- a/src/std_names.ads +++ b/src/std_names.ads @@ -472,8 +472,9 @@ package Std_Names is Name_Minimum : constant Name_Id := Name_First_Misc + 022; Name_Maximum : constant Name_Id := Name_First_Misc + 023; Name_Untruncated_Text_Read : constant Name_Id := Name_First_Misc + 024; - Name_Get_Resolution_Limit : constant Name_Id := Name_First_Misc + 025; - Name_Control_Simulation : constant Name_Id := Name_First_Misc + 026; + 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_Last_Misc : constant Name_Id := Name_Control_Simulation; Name_First_Ieee : constant Name_Id := Name_Last_Misc + 1; -- cgit v1.2.3