generic override: handle i32.

1 files changed, 57 insertions, 1 deletions

diff --git a/src/grt/grt-change_generics.adb b/src/grt/grt-change_generics.adb
index bbec5e47f..f181e1ad8 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;