textio: use grt.fcvt to read real numbers.

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;