generic override: handle i32.

3 files changed, 97 insertions, 15 deletions

diff --git a/src/grt/grt-change_generics.adb b/src/grt/grt-change_generics.adb
index bbec5e4..f181e1a 100644
--- a/src/grt/grt-change_generics.adb
+++ b/src/grt/grt-change_generics.adb
@@ -31,16 +31,22 @@ with Grt.Avhpi_Utils; use Grt.Avhpi_Utils;
 with Grt.Errors; use Grt.Errors;
 with Grt.Rtis; use Grt.Rtis;
 with Grt.Rtis_Addr; use Grt.Rtis_Addr;
+with Grt.Values;
 
 package body Grt.Change_Generics is
    procedure Error_Override (Msg : String; Over : Generic_Override_Acc) is
    begin
       Error_C (Msg);
-      Error_E (" '");
+      Error_C (" '");
       Error_C (Over.Name.all);
       Error_E ("'");
    end Error_Override;
 
+   procedure Error_Range (Over : Generic_Override_Acc) is
+   begin
+      Error_Override ("value not in range for generic", Over);
+   end Error_Range;
+
    --  Convert C to E8 values
    procedure Ghdl_Value_E8_Char (Res : out Ghdl_E8;
                                  Err : out Boolean;
@@ -141,6 +147,43 @@ package body Grt.Change_Generics is
                        Bounds => Rng.all'Address);
    end Override_Generic_Array;
 
+   procedure Override_Generic_I32 (Obj_Rti : Ghdl_Rtin_Object_Acc;
+                                     Ctxt : Rti_Context;
+                                     Over : Generic_Override_Acc)
+   is
+      Subtype_Rti : constant Ghdl_Rtin_Subtype_Scalar_Acc :=
+        To_Ghdl_Rtin_Subtype_Scalar_Acc (Obj_Rti.Obj_Type);
+      Rng : Ghdl_Range_Ptr;
+      Res : Ghdl_I64;
+      Ptr : Ghdl_Value_Ptr;
+   begin
+      Res := Grt.Values.Value_I64
+        (To_Std_String_Basep (Over.Value.all'Address), Over.Value'Length, 0);
+
+      --  Check range.
+      Rng := To_Ghdl_Range_Ptr
+        (Loc_To_Addr (Subtype_Rti.Common.Depth, Subtype_Rti.Range_Loc, Ctxt));
+      case Rng.I32.Dir is
+         when Dir_To =>
+            if Res < Ghdl_I64 (Rng.I32.Left)
+              or else Res > Ghdl_I64 (Rng.I32.Right)
+            then
+               Error_Range (Over);
+            end if;
+         when Dir_Downto =>
+            if Res > Ghdl_I64 (Rng.I32.Left)
+              or else Res < Ghdl_I64 (Rng.I32.Right)
+            then
+               Error_Range (Over);
+            end if;
+      end case;
+
+      --  Assign.
+      Ptr := To_Ghdl_Value_Ptr
+        (Loc_To_Addr (Obj_Rti.Common.Depth, Obj_Rti.Loc, Ctxt));
+      Ptr.I32 := Ghdl_I32 (Res);
+   end Override_Generic_I32;
+
    --  Override DECL with OVER.  Dispatch according to generic type.
    procedure Override_Generic_Value (Decl : VhpiHandleT;
                                      Over : Generic_Override_Acc)
@@ -155,6 +198,19 @@ package body Grt.Change_Generics is
       case Type_Rti.Kind is
          when Ghdl_Rtik_Type_Array =>
             Override_Generic_Array (Obj_Rti, Ctxt, Over);
+         when Ghdl_Rtik_Subtype_Scalar =>
+            declare
+               Subtype_Rti : constant Ghdl_Rtin_Subtype_Scalar_Acc :=
+                 To_Ghdl_Rtin_Subtype_Scalar_Acc (Type_Rti);
+            begin
+               case Subtype_Rti.Basetype.Kind is
+                  when Ghdl_Rtik_Type_I32 =>
+                     Override_Generic_I32 (Obj_Rti, Ctxt, Over);
+                  when others =>
+                     Error_Override
+                       ("unhandled type for generic override of", Over);
+               end case;
+            end;
          when others =>
             Error_Override ("unhandled type for generic override of", Over);
       end case;
diff --git a/src/grt/grt-values.adb b/src/grt/grt-values.adb
index 2454e17..9d7cf20 100644
--- a/src/grt/grt-values.adb
+++ b/src/grt/grt-values.adb
@@ -140,29 +140,42 @@ package body Grt.Values is
    end Ghdl_Value_E32;
 
    --  Convert S (INIT_POS .. LEN) to a signed integer.
-   function Ghdl_Value_I64 (S : Std_String_Basep;
-                            Len : Ghdl_Index_Type;
-                            Init_Pos : Ghdl_Index_Type)
-                           return Ghdl_I64
+   function Value_I64
+     (S : Std_String_Basep; Len : Ghdl_Index_Type; Init_Pos : Ghdl_Index_Type)
+     return Ghdl_I64
    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);
 
-      --  Be user friendly.
-      --  FIXME: reference.
-      if C = '-' or C = '+' then
-         Error_E ("'value: leading sign +/- not allowed");
+      --  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
+            Error_E ("'value: missing digit after +/-");
+         end if;
+         Pos := Pos + 1;
+         Is_Neg := C = '-';
+         C := S (Pos);
       end if;
 
       Val := 0;
       loop
          if C in '0' .. '9' then
-            Val := Val * 10 + Character'Pos (C) - Character'Pos ('0');
+            Val := Val * 10 - (Character'Pos (C) - Character'Pos ('0'));
             Pos := Pos + 1;
             exit when Pos >= Len;
             C := S (Pos);
@@ -192,6 +205,9 @@ package body Grt.Values is
       end loop;
 
       if Pos >= Len then
+         if not Is_Neg then
+            Val := -Val;
+         end if;
          return Val;
       end if;
 
@@ -221,7 +237,7 @@ package body Grt.Values is
             if D >= Base then
                Error_E ("'value: digit >= base");
             end if;
-            Val := Val * Base + D;
+            Val := Val * Base - D;
             Pos := Pos + 1;
             if Pos >= Len then
                Error_E ("'value: missing end sign number");
@@ -300,8 +316,12 @@ package body Grt.Values is
          Error_E ("'value: trailing characters after blank");
       end if;
 
+      if not Is_Neg then
+         Val := -Val;
+      end if;
+
       return Val;
-   end Ghdl_Value_I64;
+   end Value_I64;
 
    function Ghdl_Value_I64 (Str : Std_String_Ptr) return Ghdl_I64
    is
@@ -315,7 +335,7 @@ package body Grt.Values is
       --  GHDL: allow several leading whitespace.
       Remove_Whitespaces (S, Len, Pos);
 
-      return Ghdl_Value_I64 (S, Len, Pos);
+      return Value_I64 (S, Len, Pos);
    end Ghdl_Value_I64;
 
    function Ghdl_Value_I32 (Str : Std_String_Ptr) return Ghdl_I32
@@ -611,7 +631,7 @@ package body Grt.Values is
             return Ghdl_I64
               (Ghdl_Value_F64 (S, Lit_End, Lit_Pos) * Ghdl_F64 (Mult));
          else
-            return Ghdl_Value_I64 (S, Lit_End, Lit_Pos) * Mult;
+            return Value_I64 (S, Lit_End, Lit_Pos) * Mult;
          end if;
       end if;
    end Ghdl_Value_Physical_Type;
diff --git a/src/grt/grt-values.ads b/src/grt/grt-values.ads
index 8df8c3f..b1747b4 100644
--- a/src/grt/grt-values.ads
+++ b/src/grt/grt-values.ads
@@ -56,7 +56,13 @@ package Grt.Values is
    function Ghdl_Value_P64 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access)
       return Ghdl_I64;
    function Ghdl_Value_P32 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access)
-      return Ghdl_I32;
+                           return Ghdl_I32;
+
+   --  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 Ghdl_I64;
+
 private
    pragma Export (Ada, Ghdl_Value_B1, "__ghdl_value_b1");
    pragma Export (C, Ghdl_Value_E8, "__ghdl_value_e8");