grt: refactoring to fix build failure. For #1913

1 files changed, 36 insertions, 366 deletions

diff --git a/src/grt/grt-values.adb b/src/grt/grt-values.adb
index 404fec43c..7a2f09ed5 100644
--- a/src/grt/grt-values.adb
+++ b/src/grt/grt-values.adb
@@ -23,12 +23,9 @@
 with Grt.Errors; use Grt.Errors;
 with Grt.Rtis_Utils;
 with Grt.Strings; use Grt.Strings;
+with Grt.To_Strings; use Grt.To_Strings;
 
 package body Grt.Values is
-
-   NBSP : constant Character := Character'Val (160);
-   HT : constant Character := Character'Val (9);
-
    --  Increase POS to skip leading whitespace characters, decrease LEN to
    --  skip trailing whitespaces in string S.
    procedure Remove_Whitespaces (S     : Std_String_Basep;
@@ -134,189 +131,28 @@ package body Grt.Values is
       return Ghdl_E32'Val (Ghdl_Value_Enum (Str, Rti));
    end Ghdl_Value_E32;
 
-   --  Convert S (INIT_POS .. LEN) to a signed integer.
-   function Value_I64 (S : Std_String_Basep;
-                       Len : Ghdl_Index_Type;
-                       Init_Pos : Ghdl_Index_Type) return Value_I64_Result
-   is
-      Pos : Ghdl_Index_Type := Init_Pos;
-      C : Character;
-      Sep : Character;
-      Val, D, Base : Ghdl_I64;
-      Exp : Integer;
-      Is_Neg : Boolean;
-   begin
-      C := S (Pos);
-      Val := 0;
-
-      --  LRM02 14.1 Predefined attributes
-      --  Restrictions: It is an error is the parameter is not a valid string
-      --  representation of a literal ot type T.
-      --
-      --  Apparently there is no definition of 'string representation', the
-      --  closest is:
-      --
-      --  LRM02 14.3 Package TEXTIO
-      --  The representation of both INTEGER and REAL values [...]
-      Is_Neg := False;
-      if C = '+' or C = '-' then
-         if Pos = Len then
-            return (Status => Value_Err_No_Digit, Pos => Pos);
-         end if;
-         Pos := Pos + 1;
-         Is_Neg := C = '-';
-         C := S (Pos);
-      end if;
-
-      loop
-         if C in '0' .. '9' then
-            Val := Val * 10 - (Character'Pos (C) - Character'Pos ('0'));
-            Pos := Pos + 1;
-            exit when Pos >= Len;
-            C := S (Pos);
-         else
-            return (Status => Value_Err_No_Digit, Pos => Pos);
-         end if;
-         case C is
-            when '_' =>
-               Pos := Pos + 1;
-               if Pos >= Len then
-                  return (Status => Value_Err_Underscore, Pos => Pos);
-               end if;
-               C := S (Pos);
-            when '#'
-              | ':'
-              | 'E'
-              | 'e' =>
-               exit;
-            when ' '
-              | NBSP
-              | HT =>
-               Pos := Pos + 1;
-               exit;
-            when others =>
-               null;
-         end case;
-      end loop;
-
-      if Pos >= Len then
-         if not Is_Neg then
-            Val := -Val;
-         end if;
-         return (Status => Value_Ok, Val => Val);
-      end if;
-
-      if C = '#' or C = ':' then
-         Base := -Val;
-         Val := 0;
-         Sep := C;
-         Pos := Pos + 1;
-         if Base < 2 or Base > 16 then
-            return (Status => Value_Err_Bad_Base, Pos => Pos);
-         end if;
-         if Pos >= Len then
-            return (Status => Value_Err_No_Digit, Pos => Pos);
-         end if;
-         C := S (Pos);
-         loop
-            case C is
-               when '0' .. '9' =>
-                  D := Character'Pos (C) - Character'Pos ('0');
-               when 'a' .. 'f' =>
-                  D := Character'Pos (C) - Character'Pos ('a') + 10;
-               when 'A' .. 'F' =>
-                  D := Character'Pos (C) - Character'Pos ('A') + 10;
-               when others =>
-                  return (Status => Value_Err_Bad_Digit, Pos => Pos);
-            end case;
-            if D >= Base then
-               return (Status => Value_Err_Bad_Digit, Pos => Pos);
-            end if;
-            Val := Val * Base - D;
-            Pos := Pos + 1;
-            if Pos >= Len then
-               return (Status => Value_Err_Bad_End_Sign, Pos => Pos);
-            end if;
-            C := S (Pos);
-            if C = '#' or C = ':' then
-               if C /= Sep then
-                  return (Status => Value_Err_Bad_End_Sign, Pos => Pos);
-               end if;
-               Pos := Pos + 1;
-               exit;
-            elsif C = '_' then
-               Pos := Pos + 1;
-               if Pos >= Len then
-                  return (Status => Value_Err_Underscore, Pos => Pos);
-               end if;
-               C := S (Pos);
-            end if;
-         end loop;
-      else
-         Base := 10;
-      end if;
-
-      -- Handle exponent.
-      if C = 'e' or C = 'E' then
-         Pos := Pos + 1;
-         if Pos >= Len then
-            return (Status => Value_Err_No_Digit, Pos => Pos);
-         end if;
-         C := S (Pos);
-         if C = '+' then
-            Pos := Pos + 1;
-            if Pos >= Len then
-               return (Status => Value_Err_No_Digit, Pos => Pos);
-            end if;
-            C := S (Pos);
-         elsif C = '-' then
-            return (Status => Value_Err_Bad_Exponent, Pos => Pos);
-         end if;
-         Exp := 0;
-         loop
-            if C in '0' .. '9' then
-               Exp := Exp * 10 + Character'Pos (C) - Character'Pos ('0');
-               Pos := Pos + 1;
-               exit when Pos >= Len;
-               C := S (Pos);
-            else
-               return (Status => Value_Err_Bad_Digit, Pos => Pos);
-            end if;
-            case C is
-               when '_' =>
-                  Pos := Pos + 1;
-                  if Pos >= Len then
-                     return (Status => Value_Err_Underscore, Pos => Pos);
-                  end if;
-                  C := S (Pos);
-               when ' '
-                 | NBSP
-                 | HT =>
-                  Pos := Pos + 1;
-                  exit;
-               when others =>
-                  null;
-            end case;
-         end loop;
-         while Exp > 0 loop
-            if Exp mod 2 = 1 then
-               Val := Val * Base;
-            end if;
-            Exp := Exp / 2;
-            Base := Base * Base;
-         end loop;
-      end if;
-
-      if Pos /= Len then
-         return (Status => Value_Err_Trailing_Chars, Pos => Pos);
-      end if;
-
-      if not Is_Neg then
-         Val := -Val;
-      end if;
+   procedure Value_Error (Status : Value_Status_Error);
+   pragma No_Return (Value_Error);
 
-      return (Status => Value_Ok, Val => Val);
-   end Value_I64;
+   procedure Value_Error (Status : Value_Status_Error) is
+   begin
+      case Status is
+         when Value_Err_No_Digit =>
+            Error_E ("'value: missing digit");
+         when Value_Err_Underscore =>
+            Error_E ("'value: incorrect underscore");
+         when Value_Err_Bad_Base =>
+            Error_E ("'value: bad base");
+         when Value_Err_Bad_Digit =>
+            Error_E ("'value: digit expected");
+         when Value_Err_Bad_End_Sign =>
+            Error_E ("'value: incorrect or missing sign number");
+         when Value_Err_Bad_Exponent =>
+            Error_E ("'value: negativ exponent not allowed");
+         when Value_Err_Trailing_Chars =>
+            Error_E ("'value: trailing characters after blank");
+      end case;
+   end Value_Error;
 
    function Value_I64
      (S : Std_String_Basep; Len : Ghdl_Index_Type; Init_Pos : Ghdl_Index_Type)
@@ -366,194 +202,28 @@ package body Grt.Values is
       return Ghdl_I32 (Ghdl_Value_I64 (Str));
    end Ghdl_Value_I32;
 
-   -- From patch attached to https://gna.org/bugs/index.php?18352
-   -- thanks to Christophe Curis https://gna.org/users/lobotomy
-   function Ghdl_Value_F64 (S : Std_String_Basep;
-                            Len : Ghdl_Index_Type;
-                            Init_Pos : Ghdl_Index_Type)
-                           return Ghdl_F64
+   function Value_F64 (S : Std_String_Basep;
+                       Len : Ghdl_Index_Type;
+                       Init_Pos : Ghdl_Index_Type) return Ghdl_F64
    is
-      Pos     : Ghdl_Index_Type := Init_Pos;
-      C       : Character;
-      Is_Negative, Is_Neg_Exp : Boolean := False;
-      Base    : Ghdl_F64;
-      Intg    : Ghdl_I32;
-      Val, Df : Ghdl_F64;
-      Sep     : Character;
-      FrcExp  : Ghdl_F64;
+      Res : Value_F64_Result;
    begin
-      C := S (Pos);
-      if C = '-' then
-         Is_Negative := True;
-         Pos := Pos + 1;
-      elsif C = '+' then
-         Pos := Pos + 1;
-      end if;
-
-      if Pos >= Len then
-         Error_E ("'value: decimal digit expected");
-      end if;
-
-      -- Read Integer-or-Base part (may be optional)
-      Intg := 0;
-      while Pos < Len loop
-         C := S (Pos);
-         if C in '0' .. '9' then
-            Intg := Intg * 10 + Character'Pos (C) - Character'Pos ('0');
-         elsif C /= '_' then
-            exit;
-         end if;
-         Pos := Pos + 1;
-      end loop;
-
-      if Pos = Len then
-         return Ghdl_F64 (Intg);
-      end if;
-
-      -- Special case: base was specified
-      if C = '#' or C = ':' then
-         if Intg < 2 or Intg > 16 then
-            Error_E ("'value: bad base");
-         end if;
-         Base := Ghdl_F64 (Intg);
-         Val  := 0.0;
-         Sep  := C;
-         Pos  := Pos + 1;
-         if Pos >= Len then
-            Error_E ("'value: missing based decimal");
-         end if;
+      Res := Value_F64 (S, Len, Init_Pos);
 
-         -- Get the Integer part of the Value
-         while Pos < Len loop
-            C := S (Pos);
-            case C is
-               when '0' .. '9' =>
-                  Df := Ghdl_F64 (Character'Pos (C) - Character'Pos('0') );
-               when 'A' .. 'F' =>
-                  Df := Ghdl_F64 (Character'Pos (C) - Character'Pos('A') + 10);
-               when 'a' .. 'f' =>
-                  Df := Ghdl_F64 (Character'Pos (C) - Character'Pos('a') + 10);
-               when others =>
-                  exit;
-            end case;
-            if C /= '_' then
-               if Df >= Base then
-                  Error_E ("'value: digit greater than base");
-               end if;
-               Val := Val * Base + Df;
-            end if;
-            Pos := Pos + 1;
-         end loop;
-         if Pos >= Len then
-            Error_E ("'value: missing end sign number");
-         end if;
+      if Res.Status = Value_Ok then
+         return Res.Val;
       else
-         Base := 10.0;
-         Sep  := ' ';
-         Val  := Ghdl_F64 (Intg);
-      end if;
-
-      -- Handle the Fractional part
-      if C = '.' then
-         Pos := Pos + 1;
-         FrcExp := 1.0;
-         while Pos < Len loop
-            C := S (Pos);
-            case C is
-               when '0' .. '9' =>
-                  Df := Ghdl_F64 (Character'Pos (C) - Character'Pos('0'));
-               when 'A' .. 'F' =>
-                  exit when Sep = ' ';
-                  Df := Ghdl_F64 (Character'Pos (C) - Character'Pos('A') + 10);
-               when 'a' .. 'f' =>
-                  exit when Sep = ' ';
-                  Df := Ghdl_F64 (Character'Pos (C) - Character'Pos('a') + 10);
-               when others =>
-                  exit;
-            end case;
-            if C /= '_' then
-               FrcExp := FrcExp / Base;
-               if Df > Base then
-                  Error_E ("'value: digit greater than base");
-               end if;
-               Val := Val + Df * FrcExp;
-            end if;
-            Pos := Pos + 1;
-         end loop;
-      end if;
-
-      -- If base was specified, we must find here the end marker
-      if Sep /= ' ' then
-         if Pos >= Len then
-            Error_E ("'value: missing end sign number");
-         end if;
-         if C /= Sep then
-            Error_E ("'value: sign number mismatch");
-         end if;
-         Pos := Pos + 1;
-      end if;
-
-      -- Handle exponent
-      if Pos < Len then
-         C := S (Pos);
-         if C = 'e' or C = 'E' then
-            Pos := Pos + 1;
-            if Pos >= Len then
-               Error_E ("'value: no character after exponent");
-            end if;
-            C := S (Pos);
-            if C = '-' then
-               Is_Neg_Exp := True;
-               Pos := Pos + 1;
-            elsif C = '+' then
-               Pos := Pos + 1;
-            end if;
-            Intg := 0;
-            while Pos < Len loop
-               C := S (Pos);
-               if C in '0' .. '9' then
-                  Intg := Intg * 10 + Character'Pos (C) - Character'Pos ('0');
-               else
-                  exit;
-               end if;
-               Pos := Pos + 1;
-            end loop;
-            -- This Exponentiation method is sub-optimal,
-            -- but it does not depend on any library
-            FrcExp := 1.0;
-            if Is_Neg_Exp then
-               while Intg > 0 loop
-                  FrcExp := FrcExp / 10.0;
-                  Intg := Intg - 1;
-               end loop;
-            else
-               while Intg > 0 loop
-                  FrcExp := FrcExp * 10.0;
-                  Intg := Intg - 1;
-               end loop;
-            end if;
-            Val := Val * FrcExp;
-         end if;
-      end if;
-
-      if Pos /= Len then
-         Error_E ("'value: trailing characters after blank");
-      end if;
-
-      if Is_Negative then
-         Val := -Val;
+         Value_Error (Res.Status);
       end if;
-
-      return Val;
-   end Ghdl_Value_F64;
+   end Value_F64;
 
    -- From patch attached to https://gna.org/bugs/index.php?18352
    -- thanks to Christophe Curis https://gna.org/users/lobotomy
    function Ghdl_Value_F64 (Str : Std_String_Ptr) return Ghdl_F64
    is
-      S       : constant Std_String_Basep := Str.Base;
-      Len     : Ghdl_Index_Type  := Str.Bounds.Dim_1.Length;
-      Pos     : Ghdl_Index_Type := 0;
+      S   : constant Std_String_Basep := Str.Base;
+      Len : Ghdl_Index_Type  := Str.Bounds.Dim_1.Length;
+      Pos : Ghdl_Index_Type := 0;
    begin
       --  LRM 14.1
       --  Leading and trailing whitespace is allowed and ignored.
@@ -561,7 +231,7 @@ package body Grt.Values is
       --  GHDL: allow several leading whitespace.
       Remove_Whitespaces (S, Len, Pos);
 
-      return Ghdl_Value_F64 (S, Len, Pos);
+      return Value_F64 (S, Len, Pos);
    end Ghdl_Value_F64;
 
    procedure Ghdl_Value_Physical_Split (Str : Std_String_Ptr;
@@ -651,7 +321,7 @@ package body Grt.Values is
       else
          if Found_Real then
             return Ghdl_I64
-              (Ghdl_Value_F64 (S, Lit_End, Lit_Pos) * Ghdl_F64 (Mult));
+              (Value_F64 (S, Lit_End, Lit_Pos) * Ghdl_F64 (Mult));
          else
             return Value_I64 (S, Lit_End, Lit_Pos) * Mult;
          end if;