From 787d1d010ba53f2572aa11a78407e846ee4061dc Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Thu, 30 Jun 2016 06:14:11 +0200 Subject: Initial support of direct recursive instantiation. Fix issue #2. --- src/vhdl/configuration.adb | 21 +- src/vhdl/iirs.adb | 32 +++ src/vhdl/iirs.ads | 16 ++ src/vhdl/nodes_meta.adb | 534 ++++++++++++++++++++----------------- src/vhdl/nodes_meta.ads | 4 + src/vhdl/translate/trans-chap1.adb | 59 +++- src/vhdl/translate/trans-chap1.ads | 3 +- src/vhdl/translate/trans-chap2.adb | 10 +- src/vhdl/translate/trans-chap5.adb | 276 +++++++++++-------- src/vhdl/translate/trans-chap5.ads | 21 +- src/vhdl/translate/trans-chap9.adb | 22 +- src/vhdl/translate/trans.ads | 1 + src/vhdl/translate/translation.adb | 6 +- 13 files changed, 605 insertions(+), 400 deletions(-) diff --git a/src/vhdl/configuration.adb b/src/vhdl/configuration.adb index dea38ce13..e4b862f3b 100644 --- a/src/vhdl/configuration.adb +++ b/src/vhdl/configuration.adb @@ -51,10 +51,13 @@ package body Configuration is end if; -- If already in the table, then nothing to do. - if Get_Elab_Flag (Unit) then + if Get_Configuration_Mark_Flag (Unit) then + if not Get_Configuration_Done_Flag (Unit) then + raise Internal_Error; + end if; return; end if; - Set_Elab_Flag (Unit, True); + Set_Configuration_Mark_Flag (Unit, True); -- May be enabled to debug dependency construction. if False then @@ -167,6 +170,8 @@ package body Configuration is -- Add it in the table, after the dependencies. Design_Units.Append (Unit); + Set_Configuration_Done_Flag (Unit, True); + -- Restore now the file dependence. -- Indeed, we may add a package body when we are in a package -- declaration. However, the later does not depend on the former. @@ -312,7 +317,14 @@ package body Configuration is Config := Get_Default_Configuration_Declaration (Get_Library_Unit (Arch)); if Config /= Null_Iir then - Add_Design_Unit (Config, Aspect); + if Get_Configuration_Mark_Flag (Config) + and then not Get_Configuration_Done_Flag (Config) + then + -- Recursive instantiation. + return; + else + Add_Design_Unit (Config, Aspect); + end if; end if; end if; @@ -599,7 +611,8 @@ package body Configuration is return Null_Iir; end case; - Set_Elab_Flag (Std_Package.Std_Standard_Unit, True); + Set_Configuration_Mark_Flag (Std_Package.Std_Standard_Unit, True); + Set_Configuration_Done_Flag (Std_Package.Std_Standard_Unit, True); Add_Design_Unit (Top, Null_Iir); return Top; diff --git a/src/vhdl/iirs.adb b/src/vhdl/iirs.adb index f692cb876..34170bf04 100644 --- a/src/vhdl/iirs.adb +++ b/src/vhdl/iirs.adb @@ -3362,6 +3362,38 @@ package body Iirs is Set_Flag3 (Design, Flag); end Set_Elab_Flag; + function Get_Configuration_Mark_Flag (Design : Iir) return Boolean is + begin + pragma Assert (Design /= Null_Iir); + pragma Assert (Has_Configuration_Mark_Flag (Get_Kind (Design)), + "no field Configuration_Mark_Flag"); + return Get_Flag4 (Design); + end Get_Configuration_Mark_Flag; + + procedure Set_Configuration_Mark_Flag (Design : Iir; Flag : Boolean) is + begin + pragma Assert (Design /= Null_Iir); + pragma Assert (Has_Configuration_Mark_Flag (Get_Kind (Design)), + "no field Configuration_Mark_Flag"); + Set_Flag4 (Design, Flag); + end Set_Configuration_Mark_Flag; + + function Get_Configuration_Done_Flag (Design : Iir) return Boolean is + begin + pragma Assert (Design /= Null_Iir); + pragma Assert (Has_Configuration_Done_Flag (Get_Kind (Design)), + "no field Configuration_Done_Flag"); + return Get_Flag5 (Design); + end Get_Configuration_Done_Flag; + + procedure Set_Configuration_Done_Flag (Design : Iir; Flag : Boolean) is + begin + pragma Assert (Design /= Null_Iir); + pragma Assert (Has_Configuration_Done_Flag (Get_Kind (Design)), + "no field Configuration_Done_Flag"); + Set_Flag5 (Design, Flag); + end Set_Configuration_Done_Flag; + function Get_Index_Constraint_Flag (Atype : Iir) return Boolean is begin pragma Assert (Atype /= Null_Iir); diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads index 955268023..7e8c4133f 100644 --- a/src/vhdl/iirs.ads +++ b/src/vhdl/iirs.ads @@ -239,6 +239,10 @@ package Iirs is -- -- Flag used during elaboration. Set when the file was already seen. -- Get/Set_Elab_Flag (Flag3) + -- + -- Flags used during configuration + -- Get/Set_Configuration_Mark_Flag (Flag4) + -- Get/Set_Configuration_Done_Flag (Flag5) -- Iir_Kind_Library_Clause (Short) -- @@ -6144,6 +6148,18 @@ package Iirs is function Get_Elab_Flag (Design : Iir) return Boolean; procedure Set_Elab_Flag (Design : Iir; Flag : Boolean); + -- Used only by configuration to mark a design unit as already inserted in + -- the list of units. Used to avoid double insertion. + -- Field: Flag4 + function Get_Configuration_Mark_Flag (Design : Iir) return Boolean; + procedure Set_Configuration_Mark_Flag (Design : Iir; Flag : Boolean); + + -- Used only by configuration to flag units completely handled. Used to + -- detect recursion. + -- Field: Flag5 + function Get_Configuration_Done_Flag (Design : Iir) return Boolean; + procedure Set_Configuration_Done_Flag (Design : Iir; Flag : Boolean); + -- Set on an array_subtype if there is an index constraint. -- If not set, the subtype is unconstrained. -- Field: Flag4 diff --git a/src/vhdl/nodes_meta.adb b/src/vhdl/nodes_meta.adb index 5a0c88de0..2635072cd 100644 --- a/src/vhdl/nodes_meta.adb +++ b/src/vhdl/nodes_meta.adb @@ -196,6 +196,8 @@ package body Nodes_Meta is Field_Has_Signal_Flag => Type_Boolean, Field_Purity_State => Type_Iir_Pure_State, Field_Elab_Flag => Type_Boolean, + Field_Configuration_Mark_Flag => Type_Boolean, + Field_Configuration_Done_Flag => Type_Boolean, Field_Index_Constraint_Flag => Type_Boolean, Field_Hide_Implicit_Flag => Type_Boolean, Field_Assertion_Condition => Type_Iir, @@ -685,6 +687,10 @@ package body Nodes_Meta is return "purity_state"; when Field_Elab_Flag => return "elab_flag"; + when Field_Configuration_Mark_Flag => + return "configuration_mark_flag"; + when Field_Configuration_Done_Flag => + return "configuration_done_flag"; when Field_Index_Constraint_Flag => return "index_constraint_flag"; when Field_Hide_Implicit_Flag => @@ -1811,6 +1817,10 @@ package body Nodes_Meta is return Attr_None; when Field_Elab_Flag => return Attr_None; + when Field_Configuration_Mark_Flag => + return Attr_None; + when Field_Configuration_Done_Flag => + return Attr_None; when Field_Index_Constraint_Flag => return Attr_None; when Field_Hide_Implicit_Flag => @@ -2095,6 +2105,8 @@ package body Nodes_Meta is Field_Date, Field_End_Location, Field_Elab_Flag, + Field_Configuration_Mark_Flag, + Field_Configuration_Done_Flag, Field_Date_State, Field_Context_Items, Field_Chain, @@ -4068,258 +4080,258 @@ package body Nodes_Meta is Iir_Kind_Unused => -1, Iir_Kind_Error => 7, Iir_Kind_Design_File => 17, - Iir_Kind_Design_Unit => 32, - Iir_Kind_Library_Clause => 37, - Iir_Kind_Use_Clause => 41, - Iir_Kind_Context_Reference => 45, - Iir_Kind_Integer_Literal => 49, - Iir_Kind_Floating_Point_Literal => 53, - Iir_Kind_Null_Literal => 55, - Iir_Kind_String_Literal8 => 65, - Iir_Kind_Physical_Int_Literal => 70, - Iir_Kind_Physical_Fp_Literal => 75, - Iir_Kind_Simple_Aggregate => 80, - Iir_Kind_Overflow_Literal => 83, - Iir_Kind_Waveform_Element => 86, - Iir_Kind_Conditional_Waveform => 89, - Iir_Kind_Conditional_Expression => 92, - Iir_Kind_Association_Element_By_Expression => 99, - Iir_Kind_Association_Element_By_Individual => 106, - Iir_Kind_Association_Element_Open => 111, - Iir_Kind_Association_Element_Package => 117, - Iir_Kind_Choice_By_Others => 122, - Iir_Kind_Choice_By_Expression => 129, - Iir_Kind_Choice_By_Range => 136, - Iir_Kind_Choice_By_None => 141, - Iir_Kind_Choice_By_Name => 147, - Iir_Kind_Entity_Aspect_Entity => 149, - Iir_Kind_Entity_Aspect_Configuration => 150, - Iir_Kind_Entity_Aspect_Open => 150, - Iir_Kind_Block_Configuration => 156, - Iir_Kind_Block_Header => 160, - Iir_Kind_Component_Configuration => 166, - Iir_Kind_Binding_Indication => 172, - Iir_Kind_Entity_Class => 174, - Iir_Kind_Attribute_Value => 182, - Iir_Kind_Signature => 185, - Iir_Kind_Aggregate_Info => 192, - Iir_Kind_Procedure_Call => 196, - Iir_Kind_Record_Element_Constraint => 202, - Iir_Kind_Array_Element_Resolution => 203, - Iir_Kind_Record_Resolution => 204, - Iir_Kind_Record_Element_Resolution => 207, - Iir_Kind_Attribute_Specification => 216, - Iir_Kind_Disconnection_Specification => 221, - Iir_Kind_Configuration_Specification => 226, - Iir_Kind_Access_Type_Definition => 233, - Iir_Kind_Incomplete_Type_Definition => 240, - Iir_Kind_File_Type_Definition => 247, - Iir_Kind_Protected_Type_Declaration => 256, - Iir_Kind_Record_Type_Definition => 266, - Iir_Kind_Array_Type_Definition => 278, - Iir_Kind_Array_Subtype_Definition => 293, - Iir_Kind_Record_Subtype_Definition => 304, - Iir_Kind_Access_Subtype_Definition => 312, - Iir_Kind_Physical_Subtype_Definition => 321, - Iir_Kind_Floating_Subtype_Definition => 331, - Iir_Kind_Integer_Subtype_Definition => 340, - Iir_Kind_Enumeration_Subtype_Definition => 349, - Iir_Kind_Enumeration_Type_Definition => 358, - Iir_Kind_Integer_Type_Definition => 364, - Iir_Kind_Floating_Type_Definition => 370, - Iir_Kind_Physical_Type_Definition => 379, - Iir_Kind_Range_Expression => 385, - Iir_Kind_Protected_Type_Body => 392, - Iir_Kind_Wildcard_Type_Definition => 397, - Iir_Kind_Subtype_Definition => 401, - Iir_Kind_Scalar_Nature_Definition => 405, - Iir_Kind_Overload_List => 406, - Iir_Kind_Type_Declaration => 412, - Iir_Kind_Anonymous_Type_Declaration => 417, - Iir_Kind_Subtype_Declaration => 425, - Iir_Kind_Nature_Declaration => 431, - Iir_Kind_Subnature_Declaration => 437, - Iir_Kind_Package_Declaration => 447, - Iir_Kind_Package_Instantiation_Declaration => 458, - Iir_Kind_Package_Body => 465, - Iir_Kind_Configuration_Declaration => 474, - Iir_Kind_Entity_Declaration => 486, - Iir_Kind_Architecture_Body => 498, - Iir_Kind_Context_Declaration => 504, - Iir_Kind_Package_Header => 506, - Iir_Kind_Unit_Declaration => 515, - Iir_Kind_Library_Declaration => 522, - Iir_Kind_Component_Declaration => 532, - Iir_Kind_Attribute_Declaration => 539, - Iir_Kind_Group_Template_Declaration => 545, - Iir_Kind_Group_Declaration => 552, - Iir_Kind_Element_Declaration => 559, - Iir_Kind_Non_Object_Alias_Declaration => 567, - Iir_Kind_Psl_Declaration => 575, - Iir_Kind_Psl_Endpoint_Declaration => 589, - Iir_Kind_Terminal_Declaration => 595, - Iir_Kind_Free_Quantity_Declaration => 604, - Iir_Kind_Across_Quantity_Declaration => 616, - Iir_Kind_Through_Quantity_Declaration => 628, - Iir_Kind_Enumeration_Literal => 639, - Iir_Kind_Function_Declaration => 663, - Iir_Kind_Procedure_Declaration => 686, - Iir_Kind_Function_Body => 696, - Iir_Kind_Procedure_Body => 707, - Iir_Kind_Object_Alias_Declaration => 719, - Iir_Kind_File_Declaration => 734, - Iir_Kind_Guard_Signal_Declaration => 747, - Iir_Kind_Signal_Declaration => 764, - Iir_Kind_Variable_Declaration => 777, - Iir_Kind_Constant_Declaration => 791, - Iir_Kind_Iterator_Declaration => 803, - Iir_Kind_Interface_Constant_Declaration => 819, - Iir_Kind_Interface_Variable_Declaration => 835, - Iir_Kind_Interface_Signal_Declaration => 856, - Iir_Kind_Interface_File_Declaration => 872, - Iir_Kind_Interface_Package_Declaration => 881, - Iir_Kind_Identity_Operator => 885, - Iir_Kind_Negation_Operator => 889, - Iir_Kind_Absolute_Operator => 893, - Iir_Kind_Not_Operator => 897, - Iir_Kind_Condition_Operator => 901, - Iir_Kind_Reduction_And_Operator => 905, - Iir_Kind_Reduction_Or_Operator => 909, - Iir_Kind_Reduction_Nand_Operator => 913, - Iir_Kind_Reduction_Nor_Operator => 917, - Iir_Kind_Reduction_Xor_Operator => 921, - Iir_Kind_Reduction_Xnor_Operator => 925, - Iir_Kind_And_Operator => 930, - Iir_Kind_Or_Operator => 935, - Iir_Kind_Nand_Operator => 940, - Iir_Kind_Nor_Operator => 945, - Iir_Kind_Xor_Operator => 950, - Iir_Kind_Xnor_Operator => 955, - Iir_Kind_Equality_Operator => 960, - Iir_Kind_Inequality_Operator => 965, - Iir_Kind_Less_Than_Operator => 970, - Iir_Kind_Less_Than_Or_Equal_Operator => 975, - Iir_Kind_Greater_Than_Operator => 980, - Iir_Kind_Greater_Than_Or_Equal_Operator => 985, - Iir_Kind_Match_Equality_Operator => 990, - Iir_Kind_Match_Inequality_Operator => 995, - Iir_Kind_Match_Less_Than_Operator => 1000, - Iir_Kind_Match_Less_Than_Or_Equal_Operator => 1005, - Iir_Kind_Match_Greater_Than_Operator => 1010, - Iir_Kind_Match_Greater_Than_Or_Equal_Operator => 1015, - Iir_Kind_Sll_Operator => 1020, - Iir_Kind_Sla_Operator => 1025, - Iir_Kind_Srl_Operator => 1030, - Iir_Kind_Sra_Operator => 1035, - Iir_Kind_Rol_Operator => 1040, - Iir_Kind_Ror_Operator => 1045, - Iir_Kind_Addition_Operator => 1050, - Iir_Kind_Substraction_Operator => 1055, - Iir_Kind_Concatenation_Operator => 1060, - Iir_Kind_Multiplication_Operator => 1065, - Iir_Kind_Division_Operator => 1070, - Iir_Kind_Modulus_Operator => 1075, - Iir_Kind_Remainder_Operator => 1080, - Iir_Kind_Exponentiation_Operator => 1085, - Iir_Kind_Function_Call => 1093, - Iir_Kind_Aggregate => 1099, - Iir_Kind_Parenthesis_Expression => 1102, - Iir_Kind_Qualified_Expression => 1106, - Iir_Kind_Type_Conversion => 1111, - Iir_Kind_Allocator_By_Expression => 1115, - Iir_Kind_Allocator_By_Subtype => 1121, - Iir_Kind_Selected_Element => 1127, - Iir_Kind_Dereference => 1132, - Iir_Kind_Implicit_Dereference => 1137, - Iir_Kind_Slice_Name => 1144, - Iir_Kind_Indexed_Name => 1150, - Iir_Kind_Psl_Expression => 1152, - Iir_Kind_Sensitized_Process_Statement => 1172, - Iir_Kind_Process_Statement => 1192, - Iir_Kind_Concurrent_Simple_Signal_Assignment => 1203, - Iir_Kind_Concurrent_Conditional_Signal_Assignment => 1214, - Iir_Kind_Concurrent_Selected_Signal_Assignment => 1226, - Iir_Kind_Concurrent_Assertion_Statement => 1234, - Iir_Kind_Psl_Default_Clock => 1238, - Iir_Kind_Psl_Assert_Statement => 1250, - Iir_Kind_Psl_Cover_Statement => 1262, - Iir_Kind_Concurrent_Procedure_Call_Statement => 1269, - Iir_Kind_Block_Statement => 1282, - Iir_Kind_If_Generate_Statement => 1292, - Iir_Kind_For_Generate_Statement => 1301, - Iir_Kind_Component_Instantiation_Statement => 1311, - Iir_Kind_Simple_Simultaneous_Statement => 1318, - Iir_Kind_Generate_Statement_Body => 1329, - Iir_Kind_If_Generate_Else_Clause => 1334, - Iir_Kind_Simple_Signal_Assignment_Statement => 1343, - Iir_Kind_Conditional_Signal_Assignment_Statement => 1352, - Iir_Kind_Null_Statement => 1356, - Iir_Kind_Assertion_Statement => 1363, - Iir_Kind_Report_Statement => 1369, - Iir_Kind_Wait_Statement => 1376, - Iir_Kind_Variable_Assignment_Statement => 1382, - Iir_Kind_Conditional_Variable_Assignment_Statement => 1388, - Iir_Kind_Return_Statement => 1394, - Iir_Kind_For_Loop_Statement => 1403, - Iir_Kind_While_Loop_Statement => 1411, - Iir_Kind_Next_Statement => 1417, - Iir_Kind_Exit_Statement => 1423, - Iir_Kind_Case_Statement => 1431, - Iir_Kind_Procedure_Call_Statement => 1437, - Iir_Kind_If_Statement => 1446, - Iir_Kind_Elsif => 1451, - Iir_Kind_Character_Literal => 1458, - Iir_Kind_Simple_Name => 1465, - Iir_Kind_Selected_Name => 1473, - Iir_Kind_Operator_Symbol => 1478, - Iir_Kind_Selected_By_All_Name => 1483, - Iir_Kind_Parenthesis_Name => 1487, - Iir_Kind_External_Constant_Name => 1496, - Iir_Kind_External_Signal_Name => 1505, - Iir_Kind_External_Variable_Name => 1514, - Iir_Kind_Package_Pathname => 1517, - Iir_Kind_Absolute_Pathname => 1518, - Iir_Kind_Relative_Pathname => 1519, - Iir_Kind_Pathname_Element => 1523, - Iir_Kind_Base_Attribute => 1525, - Iir_Kind_Left_Type_Attribute => 1530, - Iir_Kind_Right_Type_Attribute => 1535, - Iir_Kind_High_Type_Attribute => 1540, - Iir_Kind_Low_Type_Attribute => 1545, - Iir_Kind_Ascending_Type_Attribute => 1550, - Iir_Kind_Image_Attribute => 1556, - Iir_Kind_Value_Attribute => 1562, - Iir_Kind_Pos_Attribute => 1568, - Iir_Kind_Val_Attribute => 1574, - Iir_Kind_Succ_Attribute => 1580, - Iir_Kind_Pred_Attribute => 1586, - Iir_Kind_Leftof_Attribute => 1592, - Iir_Kind_Rightof_Attribute => 1598, - Iir_Kind_Delayed_Attribute => 1606, - Iir_Kind_Stable_Attribute => 1614, - Iir_Kind_Quiet_Attribute => 1622, - Iir_Kind_Transaction_Attribute => 1630, - Iir_Kind_Event_Attribute => 1634, - Iir_Kind_Active_Attribute => 1638, - Iir_Kind_Last_Event_Attribute => 1642, - Iir_Kind_Last_Active_Attribute => 1646, - Iir_Kind_Last_Value_Attribute => 1650, - Iir_Kind_Driving_Attribute => 1654, - Iir_Kind_Driving_Value_Attribute => 1658, - Iir_Kind_Behavior_Attribute => 1658, - Iir_Kind_Structure_Attribute => 1658, - Iir_Kind_Simple_Name_Attribute => 1665, - Iir_Kind_Instance_Name_Attribute => 1670, - Iir_Kind_Path_Name_Attribute => 1675, - Iir_Kind_Left_Array_Attribute => 1682, - Iir_Kind_Right_Array_Attribute => 1689, - Iir_Kind_High_Array_Attribute => 1696, - Iir_Kind_Low_Array_Attribute => 1703, - Iir_Kind_Length_Array_Attribute => 1710, - Iir_Kind_Ascending_Array_Attribute => 1717, - Iir_Kind_Range_Array_Attribute => 1724, - Iir_Kind_Reverse_Range_Array_Attribute => 1731, - Iir_Kind_Attribute_Name => 1739 + Iir_Kind_Design_Unit => 34, + Iir_Kind_Library_Clause => 39, + Iir_Kind_Use_Clause => 43, + Iir_Kind_Context_Reference => 47, + Iir_Kind_Integer_Literal => 51, + Iir_Kind_Floating_Point_Literal => 55, + Iir_Kind_Null_Literal => 57, + Iir_Kind_String_Literal8 => 67, + Iir_Kind_Physical_Int_Literal => 72, + Iir_Kind_Physical_Fp_Literal => 77, + Iir_Kind_Simple_Aggregate => 82, + Iir_Kind_Overflow_Literal => 85, + Iir_Kind_Waveform_Element => 88, + Iir_Kind_Conditional_Waveform => 91, + Iir_Kind_Conditional_Expression => 94, + Iir_Kind_Association_Element_By_Expression => 101, + Iir_Kind_Association_Element_By_Individual => 108, + Iir_Kind_Association_Element_Open => 113, + Iir_Kind_Association_Element_Package => 119, + Iir_Kind_Choice_By_Others => 124, + Iir_Kind_Choice_By_Expression => 131, + Iir_Kind_Choice_By_Range => 138, + Iir_Kind_Choice_By_None => 143, + Iir_Kind_Choice_By_Name => 149, + Iir_Kind_Entity_Aspect_Entity => 151, + Iir_Kind_Entity_Aspect_Configuration => 152, + Iir_Kind_Entity_Aspect_Open => 152, + Iir_Kind_Block_Configuration => 158, + Iir_Kind_Block_Header => 162, + Iir_Kind_Component_Configuration => 168, + Iir_Kind_Binding_Indication => 174, + Iir_Kind_Entity_Class => 176, + Iir_Kind_Attribute_Value => 184, + Iir_Kind_Signature => 187, + Iir_Kind_Aggregate_Info => 194, + Iir_Kind_Procedure_Call => 198, + Iir_Kind_Record_Element_Constraint => 204, + Iir_Kind_Array_Element_Resolution => 205, + Iir_Kind_Record_Resolution => 206, + Iir_Kind_Record_Element_Resolution => 209, + Iir_Kind_Attribute_Specification => 218, + Iir_Kind_Disconnection_Specification => 223, + Iir_Kind_Configuration_Specification => 228, + Iir_Kind_Access_Type_Definition => 235, + Iir_Kind_Incomplete_Type_Definition => 242, + Iir_Kind_File_Type_Definition => 249, + Iir_Kind_Protected_Type_Declaration => 258, + Iir_Kind_Record_Type_Definition => 268, + Iir_Kind_Array_Type_Definition => 280, + Iir_Kind_Array_Subtype_Definition => 295, + Iir_Kind_Record_Subtype_Definition => 306, + Iir_Kind_Access_Subtype_Definition => 314, + Iir_Kind_Physical_Subtype_Definition => 323, + Iir_Kind_Floating_Subtype_Definition => 333, + Iir_Kind_Integer_Subtype_Definition => 342, + Iir_Kind_Enumeration_Subtype_Definition => 351, + Iir_Kind_Enumeration_Type_Definition => 360, + Iir_Kind_Integer_Type_Definition => 366, + Iir_Kind_Floating_Type_Definition => 372, + Iir_Kind_Physical_Type_Definition => 381, + Iir_Kind_Range_Expression => 387, + Iir_Kind_Protected_Type_Body => 394, + Iir_Kind_Wildcard_Type_Definition => 399, + Iir_Kind_Subtype_Definition => 403, + Iir_Kind_Scalar_Nature_Definition => 407, + Iir_Kind_Overload_List => 408, + Iir_Kind_Type_Declaration => 414, + Iir_Kind_Anonymous_Type_Declaration => 419, + Iir_Kind_Subtype_Declaration => 427, + Iir_Kind_Nature_Declaration => 433, + Iir_Kind_Subnature_Declaration => 439, + Iir_Kind_Package_Declaration => 449, + Iir_Kind_Package_Instantiation_Declaration => 460, + Iir_Kind_Package_Body => 467, + Iir_Kind_Configuration_Declaration => 476, + Iir_Kind_Entity_Declaration => 488, + Iir_Kind_Architecture_Body => 500, + Iir_Kind_Context_Declaration => 506, + Iir_Kind_Package_Header => 508, + Iir_Kind_Unit_Declaration => 517, + Iir_Kind_Library_Declaration => 524, + Iir_Kind_Component_Declaration => 534, + Iir_Kind_Attribute_Declaration => 541, + Iir_Kind_Group_Template_Declaration => 547, + Iir_Kind_Group_Declaration => 554, + Iir_Kind_Element_Declaration => 561, + Iir_Kind_Non_Object_Alias_Declaration => 569, + Iir_Kind_Psl_Declaration => 577, + Iir_Kind_Psl_Endpoint_Declaration => 591, + Iir_Kind_Terminal_Declaration => 597, + Iir_Kind_Free_Quantity_Declaration => 606, + Iir_Kind_Across_Quantity_Declaration => 618, + Iir_Kind_Through_Quantity_Declaration => 630, + Iir_Kind_Enumeration_Literal => 641, + Iir_Kind_Function_Declaration => 665, + Iir_Kind_Procedure_Declaration => 688, + Iir_Kind_Function_Body => 698, + Iir_Kind_Procedure_Body => 709, + Iir_Kind_Object_Alias_Declaration => 721, + Iir_Kind_File_Declaration => 736, + Iir_Kind_Guard_Signal_Declaration => 749, + Iir_Kind_Signal_Declaration => 766, + Iir_Kind_Variable_Declaration => 779, + Iir_Kind_Constant_Declaration => 793, + Iir_Kind_Iterator_Declaration => 805, + Iir_Kind_Interface_Constant_Declaration => 821, + Iir_Kind_Interface_Variable_Declaration => 837, + Iir_Kind_Interface_Signal_Declaration => 858, + Iir_Kind_Interface_File_Declaration => 874, + Iir_Kind_Interface_Package_Declaration => 883, + Iir_Kind_Identity_Operator => 887, + Iir_Kind_Negation_Operator => 891, + Iir_Kind_Absolute_Operator => 895, + Iir_Kind_Not_Operator => 899, + Iir_Kind_Condition_Operator => 903, + Iir_Kind_Reduction_And_Operator => 907, + Iir_Kind_Reduction_Or_Operator => 911, + Iir_Kind_Reduction_Nand_Operator => 915, + Iir_Kind_Reduction_Nor_Operator => 919, + Iir_Kind_Reduction_Xor_Operator => 923, + Iir_Kind_Reduction_Xnor_Operator => 927, + Iir_Kind_And_Operator => 932, + Iir_Kind_Or_Operator => 937, + Iir_Kind_Nand_Operator => 942, + Iir_Kind_Nor_Operator => 947, + Iir_Kind_Xor_Operator => 952, + Iir_Kind_Xnor_Operator => 957, + Iir_Kind_Equality_Operator => 962, + Iir_Kind_Inequality_Operator => 967, + Iir_Kind_Less_Than_Operator => 972, + Iir_Kind_Less_Than_Or_Equal_Operator => 977, + Iir_Kind_Greater_Than_Operator => 982, + Iir_Kind_Greater_Than_Or_Equal_Operator => 987, + Iir_Kind_Match_Equality_Operator => 992, + Iir_Kind_Match_Inequality_Operator => 997, + Iir_Kind_Match_Less_Than_Operator => 1002, + Iir_Kind_Match_Less_Than_Or_Equal_Operator => 1007, + Iir_Kind_Match_Greater_Than_Operator => 1012, + Iir_Kind_Match_Greater_Than_Or_Equal_Operator => 1017, + Iir_Kind_Sll_Operator => 1022, + Iir_Kind_Sla_Operator => 1027, + Iir_Kind_Srl_Operator => 1032, + Iir_Kind_Sra_Operator => 1037, + Iir_Kind_Rol_Operator => 1042, + Iir_Kind_Ror_Operator => 1047, + Iir_Kind_Addition_Operator => 1052, + Iir_Kind_Substraction_Operator => 1057, + Iir_Kind_Concatenation_Operator => 1062, + Iir_Kind_Multiplication_Operator => 1067, + Iir_Kind_Division_Operator => 1072, + Iir_Kind_Modulus_Operator => 1077, + Iir_Kind_Remainder_Operator => 1082, + Iir_Kind_Exponentiation_Operator => 1087, + Iir_Kind_Function_Call => 1095, + Iir_Kind_Aggregate => 1101, + Iir_Kind_Parenthesis_Expression => 1104, + Iir_Kind_Qualified_Expression => 1108, + Iir_Kind_Type_Conversion => 1113, + Iir_Kind_Allocator_By_Expression => 1117, + Iir_Kind_Allocator_By_Subtype => 1123, + Iir_Kind_Selected_Element => 1129, + Iir_Kind_Dereference => 1134, + Iir_Kind_Implicit_Dereference => 1139, + Iir_Kind_Slice_Name => 1146, + Iir_Kind_Indexed_Name => 1152, + Iir_Kind_Psl_Expression => 1154, + Iir_Kind_Sensitized_Process_Statement => 1174, + Iir_Kind_Process_Statement => 1194, + Iir_Kind_Concurrent_Simple_Signal_Assignment => 1205, + Iir_Kind_Concurrent_Conditional_Signal_Assignment => 1216, + Iir_Kind_Concurrent_Selected_Signal_Assignment => 1228, + Iir_Kind_Concurrent_Assertion_Statement => 1236, + Iir_Kind_Psl_Default_Clock => 1240, + Iir_Kind_Psl_Assert_Statement => 1252, + Iir_Kind_Psl_Cover_Statement => 1264, + Iir_Kind_Concurrent_Procedure_Call_Statement => 1271, + Iir_Kind_Block_Statement => 1284, + Iir_Kind_If_Generate_Statement => 1294, + Iir_Kind_For_Generate_Statement => 1303, + Iir_Kind_Component_Instantiation_Statement => 1313, + Iir_Kind_Simple_Simultaneous_Statement => 1320, + Iir_Kind_Generate_Statement_Body => 1331, + Iir_Kind_If_Generate_Else_Clause => 1336, + Iir_Kind_Simple_Signal_Assignment_Statement => 1345, + Iir_Kind_Conditional_Signal_Assignment_Statement => 1354, + Iir_Kind_Null_Statement => 1358, + Iir_Kind_Assertion_Statement => 1365, + Iir_Kind_Report_Statement => 1371, + Iir_Kind_Wait_Statement => 1378, + Iir_Kind_Variable_Assignment_Statement => 1384, + Iir_Kind_Conditional_Variable_Assignment_Statement => 1390, + Iir_Kind_Return_Statement => 1396, + Iir_Kind_For_Loop_Statement => 1405, + Iir_Kind_While_Loop_Statement => 1413, + Iir_Kind_Next_Statement => 1419, + Iir_Kind_Exit_Statement => 1425, + Iir_Kind_Case_Statement => 1433, + Iir_Kind_Procedure_Call_Statement => 1439, + Iir_Kind_If_Statement => 1448, + Iir_Kind_Elsif => 1453, + Iir_Kind_Character_Literal => 1460, + Iir_Kind_Simple_Name => 1467, + Iir_Kind_Selected_Name => 1475, + Iir_Kind_Operator_Symbol => 1480, + Iir_Kind_Selected_By_All_Name => 1485, + Iir_Kind_Parenthesis_Name => 1489, + Iir_Kind_External_Constant_Name => 1498, + Iir_Kind_External_Signal_Name => 1507, + Iir_Kind_External_Variable_Name => 1516, + Iir_Kind_Package_Pathname => 1519, + Iir_Kind_Absolute_Pathname => 1520, + Iir_Kind_Relative_Pathname => 1521, + Iir_Kind_Pathname_Element => 1525, + Iir_Kind_Base_Attribute => 1527, + Iir_Kind_Left_Type_Attribute => 1532, + Iir_Kind_Right_Type_Attribute => 1537, + Iir_Kind_High_Type_Attribute => 1542, + Iir_Kind_Low_Type_Attribute => 1547, + Iir_Kind_Ascending_Type_Attribute => 1552, + Iir_Kind_Image_Attribute => 1558, + Iir_Kind_Value_Attribute => 1564, + Iir_Kind_Pos_Attribute => 1570, + Iir_Kind_Val_Attribute => 1576, + Iir_Kind_Succ_Attribute => 1582, + Iir_Kind_Pred_Attribute => 1588, + Iir_Kind_Leftof_Attribute => 1594, + Iir_Kind_Rightof_Attribute => 1600, + Iir_Kind_Delayed_Attribute => 1608, + Iir_Kind_Stable_Attribute => 1616, + Iir_Kind_Quiet_Attribute => 1624, + Iir_Kind_Transaction_Attribute => 1632, + Iir_Kind_Event_Attribute => 1636, + Iir_Kind_Active_Attribute => 1640, + Iir_Kind_Last_Event_Attribute => 1644, + Iir_Kind_Last_Active_Attribute => 1648, + Iir_Kind_Last_Value_Attribute => 1652, + Iir_Kind_Driving_Attribute => 1656, + Iir_Kind_Driving_Value_Attribute => 1660, + Iir_Kind_Behavior_Attribute => 1660, + Iir_Kind_Structure_Attribute => 1660, + Iir_Kind_Simple_Name_Attribute => 1667, + Iir_Kind_Instance_Name_Attribute => 1672, + Iir_Kind_Path_Name_Attribute => 1677, + Iir_Kind_Left_Array_Attribute => 1684, + Iir_Kind_Right_Array_Attribute => 1691, + Iir_Kind_High_Array_Attribute => 1698, + Iir_Kind_Low_Array_Attribute => 1705, + Iir_Kind_Length_Array_Attribute => 1712, + Iir_Kind_Ascending_Array_Attribute => 1719, + Iir_Kind_Range_Array_Attribute => 1726, + Iir_Kind_Reverse_Range_Array_Attribute => 1733, + Iir_Kind_Attribute_Name => 1741 ); function Get_Fields (K : Iir_Kind) return Fields_Array @@ -4417,6 +4429,10 @@ package body Nodes_Meta is return Get_Has_Signal_Flag (N); when Field_Elab_Flag => return Get_Elab_Flag (N); + when Field_Configuration_Mark_Flag => + return Get_Configuration_Mark_Flag (N); + when Field_Configuration_Done_Flag => + return Get_Configuration_Done_Flag (N); when Field_Index_Constraint_Flag => return Get_Index_Constraint_Flag (N); when Field_Hide_Implicit_Flag => @@ -4529,6 +4545,10 @@ package body Nodes_Meta is Set_Has_Signal_Flag (N, V); when Field_Elab_Flag => Set_Elab_Flag (N, V); + when Field_Configuration_Mark_Flag => + Set_Configuration_Mark_Flag (N, V); + when Field_Configuration_Done_Flag => + Set_Configuration_Done_Flag (N, V); when Field_Index_Constraint_Flag => Set_Index_Constraint_Flag (N, V); when Field_Hide_Implicit_Flag => @@ -8232,6 +8252,16 @@ package body Nodes_Meta is end case; end Has_Elab_Flag; + function Has_Configuration_Mark_Flag (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Design_Unit; + end Has_Configuration_Mark_Flag; + + function Has_Configuration_Done_Flag (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Design_Unit; + end Has_Configuration_Done_Flag; + function Has_Index_Constraint_Flag (K : Iir_Kind) return Boolean is begin case K is diff --git a/src/vhdl/nodes_meta.ads b/src/vhdl/nodes_meta.ads index 8d7d63d33..fdca99ff4 100644 --- a/src/vhdl/nodes_meta.ads +++ b/src/vhdl/nodes_meta.ads @@ -236,6 +236,8 @@ package Nodes_Meta is Field_Has_Signal_Flag, Field_Purity_State, Field_Elab_Flag, + Field_Configuration_Mark_Flag, + Field_Configuration_Done_Flag, Field_Index_Constraint_Flag, Field_Hide_Implicit_Flag, Field_Assertion_Condition, @@ -723,6 +725,8 @@ package Nodes_Meta is function Has_Has_Signal_Flag (K : Iir_Kind) return Boolean; function Has_Purity_State (K : Iir_Kind) return Boolean; function Has_Elab_Flag (K : Iir_Kind) return Boolean; + function Has_Configuration_Mark_Flag (K : Iir_Kind) return Boolean; + function Has_Configuration_Done_Flag (K : Iir_Kind) return Boolean; function Has_Index_Constraint_Flag (K : Iir_Kind) return Boolean; function Has_Hide_Implicit_Flag (K : Iir_Kind) return Boolean; function Has_Assertion_Condition (K : Iir_Kind) return Boolean; diff --git a/src/vhdl/translate/trans-chap1.adb b/src/vhdl/translate/trans-chap1.adb index b9f00ddee..c54c6aa13 100644 --- a/src/vhdl/translate/trans-chap1.adb +++ b/src/vhdl/translate/trans-chap1.adb @@ -27,6 +27,7 @@ with Trans.Chap7; with Trans.Chap9; with Trans.Rtis; with Trans.Helpers2; use Trans.Helpers2; +with Name_Table; package body Trans.Chap1 is use Trans.Helpers; @@ -263,6 +264,28 @@ package body Trans.Chap1 is Rtis.Generate_Unit (Arch); end if; + -- Default configuration + declare + Default_Config : constant Iir := + Get_Default_Configuration_Declaration (Arch); + Config_Mark : Id_Mark_Type; + begin + -- In case of direct and recursive instantiation, the default + -- configuration may be needed while translating the architecture. + -- So translate the declarations of the default configuration before + -- translating the architecture. + if Default_Config /= Null_Iir + and then Get_Configuration_Done_Flag (Default_Config) + then + Push_Identifier_Prefix + (Config_Mark, Name_Table.Get_Identifier ("DEFAULT_CONFIG")); + Translate_Configuration_Declaration_Decl + (Get_Library_Unit + (Get_Default_Configuration_Declaration (Arch))); + Pop_Identifier_Prefix (Config_Mark); + end if; + end; + if Global_Storage = O_Storage_External then return; end if; @@ -384,7 +407,8 @@ package body Trans.Chap1 is if Block /= Null_Iir then Push_Identifier_Prefix (Mark2, "CONFIG"); - Translate_Configuration_Declaration (Cfg); + Translate_Configuration_Declaration_Decl (Cfg); + Translate_Configuration_Declaration_Body (Cfg); Pop_Identifier_Prefix (Mark2); Conf_Override := Cfg; Conf_Info := Get_Info (Cfg); @@ -853,7 +877,7 @@ package body Trans.Chap1 is end loop; end Translate_Block_Configuration_Calls; - procedure Translate_Configuration_Declaration (Config : Iir) + procedure Translate_Configuration_Declaration_Decl (Config : Iir) is Block_Config : constant Iir_Block_Configuration := Get_Block_Configuration (Config); @@ -862,27 +886,36 @@ package body Trans.Chap1 is Arch_Info : constant Block_Info_Acc := Get_Info (Arch); Interface_List : O_Inter_List; Config_Info : Config_Info_Acc; - Instance : O_Dnode; - Num : Iir_Int32; - Final : Boolean; begin - if Get_Kind (Config) = Iir_Kind_Configuration_Declaration then - Chap4.Translate_Declaration_Chain (Config); - end if; - Config_Info := Add_Info (Config, Kind_Config); -- Configurator. Start_Procedure_Decl (Interface_List, Create_Identifier, Global_Storage); - New_Interface_Decl (Interface_List, Instance, Wki_Instance, - Arch_Info.Block_Decls_Ptr_Type); + New_Interface_Decl (Interface_List, Config_Info.Config_Instance, + Wki_Instance, Arch_Info.Block_Decls_Ptr_Type); Finish_Subprogram_Decl (Interface_List, Config_Info.Config_Subprg); + end Translate_Configuration_Declaration_Decl; + procedure Translate_Configuration_Declaration_Body (Config : Iir) + is + Block_Config : constant Iir_Block_Configuration := + Get_Block_Configuration (Config); + Arch : constant Iir_Architecture_Body := + Strip_Denoting_Name (Get_Block_Specification (Block_Config)); + Arch_Info : constant Block_Info_Acc := Get_Info (Arch); + Config_Info : constant Config_Info_Acc := Get_Info (Config); + Num : Iir_Int32; + Final : Boolean; + begin if Global_Storage = O_Storage_External then return; end if; + if Get_Kind (Config) = Iir_Kind_Configuration_Declaration then + Chap4.Translate_Declaration_Chain (Config); + end if; + -- Declare subprograms for configuration. Num := 0; Translate_Block_Configuration_Decls (Block_Config, Arch, Arch, Num); @@ -891,7 +924,7 @@ package body Trans.Chap1 is Start_Subprogram_Body (Config_Info.Config_Subprg); Push_Local_Factory; - Push_Architecture_Scope (Arch, Instance); + Push_Architecture_Scope (Arch, Config_Info.Config_Instance); if Get_Kind (Config) = Iir_Kind_Configuration_Declaration then Open_Temp; @@ -907,5 +940,5 @@ package body Trans.Chap1 is Pop_Architecture_Scope (Arch); Pop_Local_Factory; Finish_Subprogram_Body; - end Translate_Configuration_Declaration; + end Translate_Configuration_Declaration_Body; end Trans.Chap1; diff --git a/src/vhdl/translate/trans-chap1.ads b/src/vhdl/translate/trans-chap1.ads index 005363a66..eaf3c6ade 100644 --- a/src/vhdl/translate/trans-chap1.ads +++ b/src/vhdl/translate/trans-chap1.ads @@ -35,5 +35,6 @@ package Trans.Chap1 is -- CONFIG may be one of: -- * configuration_declaration -- * component_configuration - procedure Translate_Configuration_Declaration (Config : Iir); + procedure Translate_Configuration_Declaration_Decl (Config : Iir); + procedure Translate_Configuration_Declaration_Body (Config : Iir); end Trans.Chap1; diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb index 267f3d5ef..fe1ffc7e0 100644 --- a/src/vhdl/translate/trans-chap2.adb +++ b/src/vhdl/translate/trans-chap2.adb @@ -1296,23 +1296,23 @@ package body Trans.Chap2 is Set_Scope_Via_Decl (Pkg_Info.Package_Body_Scope, Get_Var_Label (Info.Package_Instance_Body_Var)); + Set_Scope_Via_Field (Pkg_Info.Package_Spec_Scope, Pkg_Info.Package_Spec_Field, Pkg_Info.Package_Body_Scope'Access); - Chap5.Elab_Generic_Map_Aspect (Inst); + Chap5.Elab_Generic_Map_Aspect (Inst, (Pkg_Info.Package_Body_Scope'Access, + Pkg_Info.Package_Body_Scope)); Clear_Scope (Pkg_Info.Package_Spec_Scope); - Clear_Scope (Pkg_Info.Package_Body_Scope); -- Call the elaborator of the generic. The generic must be -- temporary associated with the instance variable. Start_Association (Constr, Pkg_Info.Package_Elab_Body_Subprg); - Set_Scope_Via_Decl (Pkg_Info.Package_Body_Scope, - Get_Var_Label (Info.Package_Instance_Body_Var)); Add_Subprg_Instance_Assoc (Constr, Pkg_Info.Package_Elab_Body_Instance); - Clear_Scope (Pkg_Info.Package_Body_Scope); New_Procedure_Call (Constr); + Clear_Scope (Pkg_Info.Package_Body_Scope); + -- Chap2.Finish_Subprg_Instance_Use -- (Info.Package_Instance_Elab_Instance); Finish_Subprogram_Body; diff --git a/src/vhdl/translate/trans-chap5.adb b/src/vhdl/translate/trans-chap5.adb index a0c90ba6f..c115b84b4 100644 --- a/src/vhdl/translate/trans-chap5.adb +++ b/src/vhdl/translate/trans-chap5.adb @@ -30,6 +30,17 @@ with Trans.Foreach_Non_Composite; package body Trans.Chap5 is use Trans.Helpers; + procedure Save_Map_Env (Env : out Map_Env; Scope_Ptr : Var_Scope_Acc) is + begin + Env := (Scope_Ptr => Scope_Ptr, + Scope => Scope_Ptr.all); + end Save_Map_Env; + + procedure Set_Map_Env (Env : Map_Env) is + begin + Env.Scope_Ptr.all := Env.Scope; + end Set_Map_Env; + procedure Translate_Attribute_Specification (Spec : Iir_Attribute_Specification) is @@ -330,7 +341,10 @@ package body Trans.Chap5 is Update_Data_Record => Connect_Update_Data_Record, Finish_Data_Record => Connect_Finish_Data_Composite); - procedure Elab_Port_Map_Aspect_Assoc (Assoc : Iir; By_Copy : Boolean) + procedure Elab_Port_Map_Aspect_Assoc (Assoc : Iir; + By_Copy : Boolean; + Formal_Env : Map_Env; + Actual_Env : Map_Env) is Formal : constant Iir := Get_Formal (Assoc); Actual : constant Iir := Get_Actual (Assoc); @@ -341,6 +355,7 @@ package body Trans.Chap5 is Formal_Val : Mnode; Actual_Sig : Mnode; Actual_Val : Mnode; + Actual_En : O_Enode; Data : Connect_Data; Mode : Connect_Mode; begin @@ -384,13 +399,11 @@ package body Trans.Chap5 is raise Internal_Error; end case; - -- translate actual (abort if not a signal). - Chap6.Translate_Signal_Name (Formal, Formal_Sig, Formal_Val); - Actual_Sig := Chap6.Translate_Name (Actual, Mode_Signal); - if By_Copy then - Chap6.Translate_Signal_Name (Formal, Formal_Sig, Formal_Val); + Set_Map_Env (Actual_Env); Chap6.Translate_Signal_Name (Actual, Actual_Sig, Actual_Val); + Set_Map_Env (Formal_Env); + Chap6.Translate_Signal_Name (Formal, Formal_Sig, Formal_Val); -- Copy pointer to the values. if Get_Info (Formal_Type).Type_Mode in Type_Mode_Arrays then @@ -401,15 +414,18 @@ package body Trans.Chap5 is New_Assign_Stmt (M2Lp (Formal_Val), M2Addr (Actual_Val)); end if; else - Formal_Sig := Chap6.Translate_Name (Formal, Mode_Signal); + Set_Map_Env (Actual_Env); Actual_Sig := Chap6.Translate_Name (Actual, Mode_Signal); + Set_Map_Env (Formal_Env); + Formal_Sig := Chap6.Translate_Name (Formal, Mode_Signal); end if; else + Set_Map_Env (Actual_Env); + Actual_En := Chap7.Translate_Expression (Actual, Formal_Type); + Set_Map_Env (Formal_Env); + Actual_Sig := E2M (Actual_En, Get_Info (Formal_Type), Mode_Value); Chap6.Translate_Signal_Name (Formal, Formal_Sig, Formal_Val); - Actual_Sig := - E2M (Chap7.Translate_Expression (Actual, Formal_Type), - Get_Info (Formal_Type), Mode_Value); Mode := Connect_Value; -- raise Internal_Error; end if; @@ -431,7 +447,9 @@ package body Trans.Chap5 is else if Get_In_Conversion (Assoc) /= Null_Iir then Chap4.Elab_In_Conversion (Assoc, Actual_Sig); + Set_Map_Env (Formal_Env); Formal_Sig := Chap6.Translate_Name (Formal, Mode_Signal); + Set_Map_Env (Actual_Env); Data := (Actual_Sig => Actual_Sig, Actual_Type => Formal_Type, Mode => Connect_Effective, @@ -441,11 +459,13 @@ package body Trans.Chap5 is if Get_Out_Conversion (Assoc) /= Null_Iir then -- flow: FORMAL to ACTUAL Chap4.Elab_Out_Conversion (Assoc, Formal_Sig); + Set_Map_Env (Actual_Env); Actual_Sig := Chap6.Translate_Name (Actual, Mode_Signal); Data := (Actual_Sig => Actual_Sig, Actual_Type => Actual_Type, Mode => Connect_Source, By_Copy => False); + Set_Map_Env (Formal_Env); Connect (Formal_Sig, Actual_Type, Data); end if; end if; @@ -453,102 +473,7 @@ package body Trans.Chap5 is Close_Temp; end Elab_Port_Map_Aspect_Assoc; - procedure Elab_Generic_Map_Aspect (Mapping : Iir) - is - Assoc : Iir; - Formal : Iir; - begin - -- Elab generics, and associate. - Assoc := Get_Generic_Map_Aspect_Chain (Mapping); - while Assoc /= Null_Iir loop - Open_Temp; - Formal := Strip_Denoting_Name (Get_Formal (Assoc)); - case Get_Kind (Assoc) is - when Iir_Kind_Association_Element_By_Expression => - declare - Targ : Mnode; - begin - if Get_Whole_Association_Flag (Assoc) then - Chap4.Elab_Object_Storage (Formal); - Targ := Chap6.Translate_Name (Formal, Mode_Value); - Chap4.Elab_Object_Init - (Targ, Formal, Get_Actual (Assoc)); - else - Targ := Chap6.Translate_Name (Formal, Mode_Value); - Chap7.Translate_Assign - (Targ, Get_Actual (Assoc), Get_Type (Formal)); - end if; - end; - when Iir_Kind_Association_Element_Open => - declare - Value : constant Iir := Get_Default_Value (Formal); - begin - Chap4.Elab_Object_Value (Formal, Value); - Chap9.Destroy_Types (Value); - end; - when Iir_Kind_Association_Element_By_Individual => - -- Create the object. - declare - Formal_Type : constant Iir := Get_Type (Formal); - Obj_Info : constant Object_Info_Acc := Get_Info (Formal); - Obj_Type : constant Iir := Get_Actual_Type (Assoc); - Formal_Node : Mnode; - Type_Info : Type_Info_Acc; - Bounds : Mnode; - begin - Chap3.Elab_Object_Subtype (Formal_Type); - Type_Info := Get_Info (Formal_Type); - Formal_Node := Get_Var - (Obj_Info.Object_Var, Type_Info, Mode_Value); - Stabilize (Formal_Node); - if Obj_Type = Null_Iir then - Chap4.Allocate_Complex_Object - (Formal_Type, Alloc_System, Formal_Node); - else - Chap3.Create_Array_Subtype (Obj_Type); - Bounds := Chap3.Get_Array_Type_Bounds (Obj_Type); - Chap3.Translate_Object_Allocation - (Formal_Node, Alloc_System, Formal_Type, Bounds); - end if; - end; - when Iir_Kind_Association_Element_Package => - pragma Assert (Get_Kind (Formal) = - Iir_Kind_Interface_Package_Declaration); - declare - Uninst_Pkg : constant Iir := Get_Named_Entity - (Get_Uninstantiated_Package_Name (Formal)); - Uninst_Info : constant Ortho_Info_Acc := - Get_Info (Uninst_Pkg); - Formal_Info : constant Ortho_Info_Acc := - Get_Info (Formal); - Actual : constant Iir := Get_Named_Entity - (Get_Actual (Assoc)); - Actual_Info : constant Ortho_Info_Acc := - Get_Info (Actual); - begin - New_Assign_Stmt - (Get_Var (Formal_Info.Package_Instance_Spec_Var), - New_Address - (Get_Instance_Ref - (Actual_Info.Package_Instance_Spec_Scope), - Uninst_Info.Package_Spec_Ptr_Type)); - New_Assign_Stmt - (Get_Var (Formal_Info.Package_Instance_Body_Var), - New_Address - (Get_Instance_Ref - (Actual_Info.Package_Instance_Body_Scope), - Uninst_Info.Package_Body_Ptr_Type)); - end; - when others => - Error_Kind ("elab_generic_map_aspect(1)", Assoc); - end case; - Close_Temp; - Assoc := Get_Chain (Assoc); - end loop; - end Elab_Generic_Map_Aspect; - - function Alloc_Bounds (Atype : Iir; Alloc : Allocation_Kind) - return Mnode + function Alloc_Bounds (Atype : Iir; Alloc : Allocation_Kind) return Mnode is Tinfo : constant Type_Info_Acc := Get_Info (Atype); Var : O_Dnode; @@ -663,9 +588,7 @@ package body Trans.Chap5 is Open_Temp; case Iir_Kinds_Association_Element (Get_Kind (Assoc)) is when Iir_Kind_Association_Element_By_Expression => - if not Get_Whole_Association_Flag (Assoc) then - return; - end if; + pragma Assert (Get_Whole_Association_Flag (Assoc)); Bounds := Get_Unconstrained_Port_Bounds (Assoc); when Iir_Kind_Association_Element_Open => declare @@ -697,10 +620,14 @@ package body Trans.Chap5 is Close_Temp; end Elab_Unconstrained_Port_Bounds; - procedure Elab_Port_Map_Aspect (Mapping : Iir; Block_Parent : Iir) + procedure Elab_Port_Map_Aspect + (Mapping : Iir; Block_Parent : Iir; Formal_Env : Map_Env) is + Actual_Env : Map_Env; Assoc : Iir; begin + Save_Map_Env (Actual_Env, Formal_Env.Scope_Ptr); + -- Ports. Assoc := Get_Port_Map_Aspect_Chain (Mapping); while Assoc /= Null_Iir loop @@ -710,6 +637,7 @@ package body Trans.Chap5 is Fb_Type : constant Iir := Get_Type (Formal_Base); Fbt_Info : constant Type_Info_Acc := Get_Info (Fb_Type); begin + Set_Map_Env (Formal_Env); -- Set bounds of unconstrained ports. if Fbt_Info.Type_Mode = Type_Mode_Fat_Array then Open_Temp; @@ -739,20 +667,23 @@ package body Trans.Chap5 is if Get_Whole_Association_Flag (Assoc) then if Get_Collapse_Signal_Flag (Assoc) then -- For collapsed association, copy signals. - Elab_Port_Map_Aspect_Assoc (Assoc, True); + Elab_Port_Map_Aspect_Assoc + (Assoc, True, Formal_Env, Actual_Env); else -- Create non-collapsed signals. Chap4.Elab_Signal_Declaration_Object (Formal, Block_Parent, False); -- And associate. - Elab_Port_Map_Aspect_Assoc (Assoc, False); + Elab_Port_Map_Aspect_Assoc + (Assoc, False, Formal_Env, Actual_Env); end if; else -- By sub-element. -- Either the whole signal is collapsed or it was already -- created. -- And associate. - Elab_Port_Map_Aspect_Assoc (Assoc, False); + Elab_Port_Map_Aspect_Assoc + (Assoc, False, Formal_Env, Actual_Env); end if; when Iir_Kind_Association_Element_Open | Iir_Kind_Association_Element_By_Individual => @@ -765,14 +696,127 @@ package body Trans.Chap5 is end; Assoc := Get_Chain (Assoc); end loop; + Set_Map_Env (Actual_Env); end Elab_Port_Map_Aspect; - procedure Elab_Map_Aspect (Mapping : Iir; Block_Parent : Iir) is + procedure Elab_Generic_Map_Aspect (Mapping : Iir; Formal_Env : Map_Env) + is + Actual_Env : Map_Env; + Assoc : Iir; + Formal : Iir; + begin + Save_Map_Env (Actual_Env, Formal_Env.Scope_Ptr); + + -- Elab generics, and associate. + Assoc := Get_Generic_Map_Aspect_Chain (Mapping); + while Assoc /= Null_Iir loop + Open_Temp; + Formal := Strip_Denoting_Name (Get_Formal (Assoc)); + case Get_Kind (Assoc) is + when Iir_Kind_Association_Element_By_Expression => + declare + Targ : Mnode; + begin + if Get_Whole_Association_Flag (Assoc) then + Set_Map_Env (Formal_Env); + Chap4.Elab_Object_Storage (Formal); + Targ := Chap6.Translate_Name (Formal, Mode_Value); + Set_Map_Env (Actual_Env); + Chap4.Elab_Object_Init + (Targ, Formal, Get_Actual (Assoc)); + else + Set_Map_Env (Formal_Env); + Targ := Chap6.Translate_Name (Formal, Mode_Value); + Set_Map_Env (Actual_Env); + Chap7.Translate_Assign + (Targ, Get_Actual (Assoc), Get_Type (Formal)); + end if; + end; + when Iir_Kind_Association_Element_Open => + declare + Value : constant Iir := Get_Default_Value (Formal); + begin + Set_Map_Env (Formal_Env); + Chap4.Elab_Object_Value (Formal, Value); + Chap9.Destroy_Types (Value); + Set_Map_Env (Actual_Env); + end; + when Iir_Kind_Association_Element_By_Individual => + -- Create the object. + declare + Formal_Type : constant Iir := Get_Type (Formal); + Obj_Info : constant Object_Info_Acc := Get_Info (Formal); + Obj_Type : constant Iir := Get_Actual_Type (Assoc); + Formal_Node : Mnode; + Type_Info : Type_Info_Acc; + Bounds : Mnode; + begin + Set_Map_Env (Formal_Env); + Chap3.Elab_Object_Subtype (Formal_Type); + Type_Info := Get_Info (Formal_Type); + Formal_Node := Get_Var + (Obj_Info.Object_Var, Type_Info, Mode_Value); + Stabilize (Formal_Node); + if Obj_Type = Null_Iir then + Chap4.Allocate_Complex_Object + (Formal_Type, Alloc_System, Formal_Node); + else + Chap3.Create_Array_Subtype (Obj_Type); + Bounds := Chap3.Get_Array_Type_Bounds (Obj_Type); + Chap3.Translate_Object_Allocation + (Formal_Node, Alloc_System, Formal_Type, Bounds); + end if; + Set_Map_Env (Actual_Env); + end; + when Iir_Kind_Association_Element_Package => + pragma Assert (Get_Kind (Formal) = + Iir_Kind_Interface_Package_Declaration); + declare + Uninst_Pkg : constant Iir := Get_Named_Entity + (Get_Uninstantiated_Package_Name (Formal)); + Uninst_Info : constant Ortho_Info_Acc := + Get_Info (Uninst_Pkg); + Formal_Info : constant Ortho_Info_Acc := + Get_Info (Formal); + Actual : constant Iir := Get_Named_Entity + (Get_Actual (Assoc)); + Actual_Info : constant Ortho_Info_Acc := + Get_Info (Actual); + begin + New_Assign_Stmt + (Get_Var (Formal_Info.Package_Instance_Spec_Var), + New_Address + (Get_Instance_Ref + (Actual_Info.Package_Instance_Spec_Scope), + Uninst_Info.Package_Spec_Ptr_Type)); + New_Assign_Stmt + (Get_Var (Formal_Info.Package_Instance_Body_Var), + New_Address + (Get_Instance_Ref + (Actual_Info.Package_Instance_Body_Scope), + Uninst_Info.Package_Body_Ptr_Type)); + end; + when others => + Error_Kind ("elab_generic_map_aspect(1)", Assoc); + end case; + Close_Temp; + Assoc := Get_Chain (Assoc); + end loop; + end Elab_Generic_Map_Aspect; + + procedure Elab_Map_Aspect + (Mapping : Iir; Block_Parent : Iir; Formal_Env : Map_Env) is begin + -- The use of FORMAL_ENV (and then later ACTUAL_ENV) is rather fragile + -- as in some cases both the formal and the actual are referenced in the + -- same time (like Check_Array_Match). But the env are different only + -- in case of direct recursive instantation (rare). To stay on the safe + -- side, FORMAL_ENV must be active/set. + -- The generic map must be done before the elaboration of -- the ports, since a port subtype may depend on a generic. - Elab_Generic_Map_Aspect (Mapping); + Elab_Generic_Map_Aspect (Mapping, Formal_Env); - Elab_Port_Map_Aspect (Mapping, Block_Parent); + Elab_Port_Map_Aspect (Mapping, Block_Parent, Formal_Env); end Elab_Map_Aspect; end Trans.Chap5; diff --git a/src/vhdl/translate/trans-chap5.ads b/src/vhdl/translate/trans-chap5.ads index 4912dc224..6902d3b3b 100644 --- a/src/vhdl/translate/trans-chap5.ads +++ b/src/vhdl/translate/trans-chap5.ads @@ -30,7 +30,22 @@ package Trans.Chap5 is -- Elab an unconstrained port. procedure Elab_Unconstrained_Port_Bounds (Port : Iir; Assoc : Iir); - procedure Elab_Generic_Map_Aspect (Mapping : Iir); + -- Describe how to set the environment to access to formal in a map. This + -- is really useful only for recursive instantiation where the formal is + -- the same as the actual, but their environment differs. + type Map_Env is record + -- The scope that has to be modified. + Scope_Ptr : Var_Scope_Acc; + + -- The value for the scope. + Scope : Var_Scope_Type; + end record; + + -- Save and restore the map environment defined by ENV. + procedure Save_Map_Env (Env : out Map_Env; Scope_Ptr : Var_Scope_Acc); + procedure Set_Map_Env (Env : Map_Env); + + procedure Elab_Generic_Map_Aspect (Mapping : Iir; Formal_Env : Map_Env); -- There are 4 cases of generic/port map: -- 1) component instantiation @@ -40,5 +55,7 @@ package Trans.Chap5 is -- 4) direct (entity + architecture or configuration) instantiation -- -- MAPPING is the node containing the generic/port map aspects. - procedure Elab_Map_Aspect (Mapping : Iir; Block_Parent : Iir); + + procedure Elab_Map_Aspect + (Mapping : Iir; Block_Parent : Iir; Formal_Env : Map_Env); end Trans.Chap5; diff --git a/src/vhdl/translate/trans-chap9.adb b/src/vhdl/translate/trans-chap9.adb index 8cfaf6a3c..9500bbd88 100644 --- a/src/vhdl/translate/trans-chap9.adb +++ b/src/vhdl/translate/trans-chap9.adb @@ -905,7 +905,8 @@ package body Trans.Chap9 is -- instantiation statement. Set_Component_Link (Comp_Info.Comp_Scope, Comp_Info.Comp_Link); - Chap5.Elab_Map_Aspect (Stmt, Comp); + Chap5.Elab_Map_Aspect (Stmt, Comp, (Comp_Info.Comp_Scope'Access, + Comp_Info.Comp_Scope)); Clear_Scope (Comp_Info.Comp_Scope); end if; @@ -1654,9 +1655,15 @@ package body Trans.Chap9 is end; -- Elab map aspects. - Set_Scope_Via_Param_Ptr (Entity_Info.Block_Scope, Var_Sub); - Chap5.Elab_Map_Aspect (Mapping, Entity); - Clear_Scope (Entity_Info.Block_Scope); + declare + use Chap5; + Entity_Map : Map_Env; + begin + Entity_Map.Scope_Ptr := Entity_Info.Block_Scope'Access; + Set_Scope_Via_Param_Ptr (Entity_Map.Scope, Var_Sub); + Chap5.Elab_Map_Aspect (Mapping, Entity, Entity_Map); + Clear_Scope (Entity_Map.Scope); + end; -- 3) Elab instance. declare @@ -2200,6 +2207,8 @@ package body Trans.Chap9 is Header : constant Iir_Block_Header := Get_Block_Header (Block); Guard : constant Iir := Get_Guard_Decl (Block); + Block_Env : Chap5.Map_Env; + Block_Info : Block_Info_Acc; begin if Guard /= Null_Iir then New_Debug_Line_Stmt (Get_Line_Number (Guard)); @@ -2207,7 +2216,10 @@ package body Trans.Chap9 is end if; if Header /= Null_Iir then New_Debug_Line_Stmt (Get_Line_Number (Header)); - Chap5.Elab_Map_Aspect (Header, Block); + Block_Info := Get_Info (Block); + Block_Env := (Block_Info.Block_Scope'Access, + Block_Info.Block_Scope); + Chap5.Elab_Map_Aspect (Header, Block, Block_Env); Merge_Signals_Rti_Of_Port_Chain (Get_Port_Chain (Header)); end if; end; diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads index fc53a0cea..1ce061817 100644 --- a/src/vhdl/translate/trans.ads +++ b/src/vhdl/translate/trans.ads @@ -1426,6 +1426,7 @@ package Trans is when Kind_Config => -- Subprogram that configure the block. Config_Subprg : O_Dnode; + Config_Instance : O_Dnode; when Kind_Field => -- Node for a record element declaration. diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb index 8ed651ab0..79999f78a 100644 --- a/src/vhdl/translate/translation.adb +++ b/src/vhdl/translate/translation.adb @@ -298,6 +298,7 @@ package body Translation is when Iir_Kind_Configuration_Declaration => New_Debug_Comment_Decl ("configuration " & Image_Identifier (El)); if Id = Null_Identifier then + -- Default configuration. declare Mark : Id_Mark_Type; Mark_Entity : Id_Mark_Type; @@ -315,14 +316,15 @@ package body Translation is Push_Identifier_Prefix (Mark_Arch, Get_Identifier (Arch)); Push_Identifier_Prefix (Mark, Name_Table.Get_Identifier ("DEFAULT_CONFIG")); - Chap1.Translate_Configuration_Declaration (El); + Chap1.Translate_Configuration_Declaration_Body (El); Pop_Identifier_Prefix (Mark); Pop_Identifier_Prefix (Mark_Arch); Pop_Identifier_Prefix (Mark_Sep); Pop_Identifier_Prefix (Mark_Entity); end; else - Chap1.Translate_Configuration_Declaration (El); + Chap1.Translate_Configuration_Declaration_Decl (El); + Chap1.Translate_Configuration_Declaration_Body (El); end if; when Iir_Kind_Context_Declaration => New_Debug_Comment_Decl ("context " & Image_Identifier (El)); -- cgit v1.2.3