diff options
| -rw-r--r-- | src/vhdl/evaluation.adb | 22 | ||||
| -rw-r--r-- | src/vhdl/evaluation.ads | 5 | ||||
| -rw-r--r-- | src/vhdl/simulate/elaboration.adb | 99 |
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)); |