simul: handle generic override.

3 files changed, 106 insertions, 20 deletions

diff --git a/src/vhdl/evaluation.adb b/src/vhdl/evaluation.adb
index 8f93d379d..850691045 100644
--- a/src/vhdl/evaluation.adb
+++ b/src/vhdl/evaluation.adb
@@ -2177,7 +2177,6 @@ package body Evaluation is
          when Iir_Kind_Value_Attribute =>
             declare
                Param : Iir;
-               Param_Type : Iir;
             begin
                Param := Get_Parameter (Expr);
                Param := Eval_Static_Expr (Param);
@@ -2187,25 +2186,8 @@ package body Evaluation is
                   Warning_Msg_Sem ("'value argument not a string", Expr);
                   return Build_Overflow (Expr);
                else
-                  -- what type are we converting the string to?
-                  Param_Type := Get_Base_Type (Get_Type (Expr));
-                  declare
-                     Value : constant String := Image_String_Lit (Param);
-                  begin
-                     case Get_Kind (Param_Type) is
-                     when Iir_Kind_Integer_Type_Definition =>
-                        return Build_Discrete (Iir_Int64'Value (Value), Expr);
-                     when Iir_Kind_Enumeration_Type_Definition =>
-                        return Build_Enumeration_Value (Value, Param_Type,
-                                                        Expr);
-                     when Iir_Kind_Floating_Type_Definition =>
-                        return Build_Floating (Iir_Fp64'value (Value), Expr);
-                     when Iir_Kind_Physical_Type_Definition =>
-                        return Build_Physical_Value (Value, Param_Type, Expr);
-                     when others =>
-                        Error_Kind ("eval_static_expr('value)", Param);
-                     end case;
-                  end;
+                  return Eval_Value_Attribute
+                    (Image_String_Lit (Param), Get_Type (Expr), Expr);
                end if;
             end;
 
diff --git a/src/vhdl/evaluation.ads b/src/vhdl/evaluation.ads
index 440570796..256d687bf 100644
--- a/src/vhdl/evaluation.ads
+++ b/src/vhdl/evaluation.ads
@@ -142,6 +142,11 @@ package Evaluation is
      (A_Type : Iir; Len : Iir_Int64; Loc : Location_Type)
      return Iir;
 
+   --  Compute ATYPE'value (VALUE) using origin ORIG, but without checking
+   --  bounds.
+   function Eval_Value_Attribute
+     (Value : String; Atype : Iir; Orig : Iir) return Iir;
+
    --  Store into NAME_BUFFER, NAME_LENGTH the simple name, character literal
    --  or operator sumbol of ID, using the same format as SIMPLE_NAME
    --  attribute.
diff --git a/src/vhdl/simulate/elaboration.adb b/src/vhdl/simulate/elaboration.adb
index a183916f3..b18dda1b8 100644
--- a/src/vhdl/simulate/elaboration.adb
+++ b/src/vhdl/simulate/elaboration.adb
@@ -18,7 +18,9 @@
 
 with Ada.Text_IO;
 with Types; use Types;
+with Str_Table;
 with Errorout; use Errorout;
+with Evaluation;
 with Execution; use Execution;
 with Simulation; use Simulation;
 with Iirs_Utils; use Iirs_Utils;
@@ -30,6 +32,7 @@ with Grt.Types; use Grt.Types;
 with Simulation.AMS; use Simulation.AMS;
 with Areapools; use Areapools;
 with Grt.Errors;
+with Grt.Options;
 
 package body Elaboration is
 
@@ -2668,6 +2671,101 @@ package body Elaboration is
       return Instance;
    end Elaborate_Architecture;
 
+   function Override_Generic (Formal : Iir; Str : String) return Iir
+   is
+      use Evaluation;
+      Formal_Type : constant Iir := Get_Type (Formal);
+      Formal_Btype : constant Iir := Get_Base_Type (Formal_Type);
+      Res : Iir;
+   begin
+      case Get_Kind (Formal_Btype) is
+         when Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Enumeration_Type_Definition =>
+            Res := Eval_Value_Attribute (Str, Formal_Type, Formal);
+            if not Eval_Is_In_Bound (Res, Formal_Type) then
+               Error_Msg_Elab
+                 ("override for " & Disp_Node (Formal) & " is out of bounds");
+               return Null_Iir;
+            end if;
+            return Res;
+         when Iir_Kind_Array_Type_Definition =>
+            if Is_One_Dimensional_Array_Type (Formal_Btype) then
+               declare
+                  use Str_Table;
+                  Str8 : String8_Id;
+                  Ntype : Iir;
+               begin
+                  Str8 := Create_String8;
+                  Append_String8_String (Str);
+                  Res := Create_Iir (Iir_Kind_String_Literal8);
+                  Set_String8_Id (Res, Str8);
+                  --  FIXME: check characters are in the type.
+                  Set_String_Length (Res, Str'Length);
+                  Set_Expr_Staticness (Res, Locally);
+                  Ntype := Create_Unidim_Array_By_Length
+                    (Get_Base_Type (Formal_Type), Str'Length, Res);
+                  Set_Type (Res, Ntype);
+                  Set_Literal_Subtype (Res, Ntype);
+                  return Res;
+               end;
+            end if;
+         when others =>
+            null;
+      end case;
+      Error_Msg_Elab ("unhandled override for " & Disp_Node (Formal));
+      return Null_Iir;
+   end Override_Generic;
+
+   procedure Override_Generics
+     (Map : in out Iir; First : Grt.Options.Generic_Override_Acc)
+   is
+      use Grt.Options;
+      Over : Generic_Override_Acc;
+      Id : Name_Id;
+      Gen : Iir;
+      Prev : Iir;
+      Val : Iir;
+      Assoc : Iir;
+   begin
+      Over := First;
+      Prev := Null_Iir;
+      while Over /= null loop
+         Id := Name_Table.Get_Identifier (Over.Name.all);
+
+         --  Find existing association in map.  There should be one association
+         --  for each generic.
+         Gen := Map;
+         while Gen /= Null_Iir loop
+            exit when Get_Identifier (Get_Formal (Map)) = Id;
+            Prev := Gen;
+            Gen := Get_Chain (Gen);
+         end loop;
+
+         if Gen = Null_Iir then
+            Error_Msg_Elab
+              ("no generic '" & Name_Table.Image (Id) & "' for -g");
+         else
+            --  Replace the association with one for the override value.
+            Val := Override_Generic (Get_Formal (Map), Over.Value.all);
+            if Val /= Null_Iir then
+               Assoc :=
+                 Create_Iir (Iir_Kind_Association_Element_By_Expression);
+               Set_Actual (Assoc, Val);
+               Set_Whole_Association_Flag (Assoc, True);
+               Set_Formal (Assoc, Get_Formal (Map));
+
+               Set_Chain (Assoc, Get_Chain (Gen));
+               if Prev = Null_Iir then
+                  Map := Assoc;
+               else
+                  Set_Chain (Prev, Assoc);
+               end if;
+            end if;
+         end if;
+         Over := Over.Next;
+      end loop;
+   end Override_Generics;
+
    -- Elaborate a design.
    procedure Elaborate_Design (Design: Iir_Design_Unit)
    is
@@ -2717,6 +2815,7 @@ package body Elaboration is
         (Get_Generic_Chain (Entity), Null_Iir, Entity);
       Port_Map := Create_Default_Association
         (Get_Port_Chain (Entity), Null_Iir, Entity);
+      Override_Generics (Generic_Map, Grt.Options.First_Generic_Override);
 
       --  Elaborate from the top configuration.
       Conf := Get_Block_Configuration (Get_Library_Unit (Conf_Unit));