diff options
| -rw-r--r-- | src/vhdl/iirs.adb | 16 | ||||
| -rw-r--r-- | src/vhdl/iirs.ads | 29 | ||||
| -rw-r--r-- | src/vhdl/nodes_meta.adb | 344 | ||||
| -rw-r--r-- | src/vhdl/nodes_meta.ads | 2 | ||||
| -rw-r--r-- | src/vhdl/sem.adb | 51 | ||||
| -rw-r--r-- | src/vhdl/sem_stmts.adb | 48 |
6 files changed, 316 insertions, 174 deletions
diff --git a/src/vhdl/iirs.adb b/src/vhdl/iirs.adb index ac25a83..1e57b03 100644 --- a/src/vhdl/iirs.adb +++ b/src/vhdl/iirs.adb @@ -5139,6 +5139,22 @@ package body Iirs is Set_Flag11 (Decl, Flag); end Set_Has_Class; + function Get_Suspend_Flag (Stmt : Iir) return Boolean is + begin + pragma Assert (Stmt /= Null_Iir); + pragma Assert (Has_Suspend_Flag (Get_Kind (Stmt)), + "no field Suspend_Flag"); + return Get_Flag11 (Stmt); + end Get_Suspend_Flag; + + procedure Set_Suspend_Flag (Stmt : Iir; Flag : Boolean) is + begin + pragma Assert (Stmt /= Null_Iir); + pragma Assert (Has_Suspend_Flag (Get_Kind (Stmt)), + "no field Suspend_Flag"); + Set_Flag11 (Stmt, Flag); + end Set_Suspend_Flag; + function Get_Is_Ref (N : Iir) return Boolean is begin pragma Assert (N /= Null_Iir); diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads index 0db83ca..3732791 100644 --- a/src/vhdl/iirs.ads +++ b/src/vhdl/iirs.ads @@ -1271,6 +1271,9 @@ package Iirs is -- True is the specification is immediately followed by a body. -- Get/Set_Has_Body (Flag9) -- + -- Only for Iir_Kind_Procedure_Declaration: + -- Get/Set_Suspend_Flag (Flag11) + -- -- Get/Set_Wait_State (State1) -- -- Only for Iir_Kind_Procedure_Declaration: @@ -1314,6 +1317,9 @@ package Iirs is -- Get/Set_End_Has_Reserved_Id (Flag8) -- -- Get/Set_End_Has_Identifier (Flag9) + -- + -- Only for Iir_Kind_Procedure_Body: + -- Get/Set_Suspend_Flag (Flag11) -- Iir_Kind_Signal_Declaration (Short) -- @@ -2418,6 +2424,9 @@ package Iirs is -- Get/Set_End_Has_Identifier (Flag9) -- -- Get/Set_End_Has_Postponed (Flag10) + -- + -- Only for Iir_Kind_Process_Statement: + -- Get/Set_Suspend_Flag (Flag11) -- Iir_Kind_Concurrent_Assertion_Statement (Short) -- @@ -2689,6 +2698,9 @@ package Iirs is -- Get/Set_Visible_Flag (Flag4) -- -- Get/Set_End_Has_Identifier (Flag9) + -- + -- Only for Iir_Kind_If_Statement: + -- Get/Set_Suspend_Flag (Flag11) -- LRM08 10.10 Loop statement / LRM93 8.9 -- @@ -2724,6 +2736,8 @@ package Iirs is -- Get/Set_Is_Within_Flag (Flag5) -- -- Get/Set_End_Has_Identifier (Flag9) + -- + -- Get/Set_Suspend_Flag (Flag11) -- Iir_Kind_While_Loop_Statement (Short) -- @@ -2741,6 +2755,8 @@ package Iirs is -- Get/Set_Visible_Flag (Flag4) -- -- Get/Set_End_Has_Identifier (Flag9) + -- + -- Get/Set_Suspend_Flag (Flag11) -- Iir_Kind_Exit_Statement (Short) -- Iir_Kind_Next_Statement (Short) @@ -2892,6 +2908,8 @@ package Iirs is -- Get/Set_Visible_Flag (Flag4) -- -- Get/Set_End_Has_Identifier (Flag9) + -- + -- Get/Set_Suspend_Flag (Flag11) -- Iir_Kind_Procedure_Call_Statement (Short) -- Iir_Kind_Concurrent_Procedure_Call_Statement (Short) @@ -2909,6 +2927,8 @@ package Iirs is -- Get/Set_Postponed_Flag (Flag3) -- -- Get/Set_Visible_Flag (Flag4) + -- + -- Get/Set_Suspend_Flag (Flag11) -- Iir_Kind_Procedure_Call (Short) -- @@ -6496,6 +6516,15 @@ package Iirs is function Get_Has_Class (Decl : Iir) return Boolean; procedure Set_Has_Class (Decl : Iir; Flag : Boolean); + -- Set on wait, procedure call and composite statements when there is a + -- sub-statement that can suspend a procedure or a process. Also set + -- on procedure declaration. Note that the flag is conservative: it must + -- be true if the node contains directly or indirectly a wait statement, + -- but need not to be false otherwise. + -- Field: Flag11 + function Get_Suspend_Flag (Stmt : Iir) return Boolean; + procedure Set_Suspend_Flag (Stmt : Iir; Flag : Boolean); + -- Set to True if Maybe_Ref fields are references. This cannot be shared -- with Has_Identifier_List as: Is_Ref is set to True on all items but -- the first, while Has_Identifier_List is set to True on all items but diff --git a/src/vhdl/nodes_meta.adb b/src/vhdl/nodes_meta.adb index c935825..c10ad33 100644 --- a/src/vhdl/nodes_meta.adb +++ b/src/vhdl/nodes_meta.adb @@ -307,6 +307,7 @@ package body Nodes_Meta is Field_Has_Identifier_List => Type_Boolean, Field_Has_Mode => Type_Boolean, Field_Has_Class => Type_Boolean, + Field_Suspend_Flag => Type_Boolean, Field_Is_Ref => Type_Boolean, Field_Psl_Property => Type_PSL_Node, Field_Psl_Declaration => Type_PSL_Node, @@ -900,6 +901,8 @@ package body Nodes_Meta is return "has_mode"; when Field_Has_Class => return "has_class"; + when Field_Suspend_Flag => + return "suspend_flag"; when Field_Is_Ref => return "is_ref"; when Field_Psl_Property => @@ -2000,6 +2003,8 @@ package body Nodes_Meta is return Attr_None; when Field_Has_Class => return Attr_None; + when Field_Suspend_Flag => + return Attr_None; when Field_Is_Ref => return Attr_None; when Field_Psl_Property => @@ -2761,6 +2766,7 @@ package body Nodes_Meta is Field_Subprogram_Hash, Field_Implicit_Definition, Field_Seen_Flag, + Field_Suspend_Flag, Field_Passive_Flag, Field_Foreign_Flag, Field_Visible_Flag, @@ -2790,6 +2796,7 @@ package body Nodes_Meta is Field_Callees_List, -- Iir_Kind_Procedure_Body Field_Impure_Depth, + Field_Suspend_Flag, Field_End_Has_Reserved_Id, Field_End_Has_Identifier, Field_Declaration_Chain, @@ -3335,6 +3342,7 @@ package body Nodes_Meta is Field_Label, Field_Seen_Flag, Field_End_Has_Postponed, + Field_Suspend_Flag, Field_Passive_Flag, Field_Postponed_Flag, Field_Visible_Flag, @@ -3412,6 +3420,7 @@ package body Nodes_Meta is Field_Parent, -- Iir_Kind_Concurrent_Procedure_Call_Statement Field_Label, + Field_Suspend_Flag, Field_Postponed_Flag, Field_Visible_Flag, Field_Procedure_Call, @@ -3543,6 +3552,7 @@ package body Nodes_Meta is Field_Type, -- Iir_Kind_For_Loop_Statement Field_Label, + Field_Suspend_Flag, Field_Visible_Flag, Field_Is_Within_Flag, Field_End_Has_Identifier, @@ -3552,6 +3562,7 @@ package body Nodes_Meta is Field_Parent, -- Iir_Kind_While_Loop_Statement Field_Label, + Field_Suspend_Flag, Field_Visible_Flag, Field_End_Has_Identifier, Field_Condition, @@ -3574,6 +3585,7 @@ package body Nodes_Meta is Field_Parent, -- Iir_Kind_Case_Statement Field_Label, + Field_Suspend_Flag, Field_Visible_Flag, Field_End_Has_Identifier, Field_Case_Statement_Alternative_Chain, @@ -3582,12 +3594,14 @@ package body Nodes_Meta is Field_Parent, -- Iir_Kind_Procedure_Call_Statement Field_Label, + Field_Suspend_Flag, Field_Visible_Flag, Field_Procedure_Call, Field_Chain, Field_Parent, -- Iir_Kind_If_Statement Field_Label, + Field_Suspend_Flag, Field_Visible_Flag, Field_End_Has_Identifier, Field_Condition, @@ -4040,160 +4054,160 @@ package body Nodes_Meta is Iir_Kind_Through_Quantity_Declaration => 604, Iir_Kind_Enumeration_Literal => 615, Iir_Kind_Function_Declaration => 639, - Iir_Kind_Procedure_Declaration => 661, - Iir_Kind_Function_Body => 671, - Iir_Kind_Procedure_Body => 681, - Iir_Kind_Object_Alias_Declaration => 693, - Iir_Kind_File_Declaration => 708, - Iir_Kind_Guard_Signal_Declaration => 721, - Iir_Kind_Signal_Declaration => 738, - Iir_Kind_Variable_Declaration => 751, - Iir_Kind_Constant_Declaration => 765, - Iir_Kind_Iterator_Declaration => 777, - Iir_Kind_Interface_Constant_Declaration => 793, - Iir_Kind_Interface_Variable_Declaration => 809, - Iir_Kind_Interface_Signal_Declaration => 830, - Iir_Kind_Interface_File_Declaration => 846, - Iir_Kind_Interface_Package_Declaration => 855, - Iir_Kind_Identity_Operator => 859, - Iir_Kind_Negation_Operator => 863, - Iir_Kind_Absolute_Operator => 867, - Iir_Kind_Not_Operator => 871, - Iir_Kind_Condition_Operator => 875, - Iir_Kind_Reduction_And_Operator => 879, - Iir_Kind_Reduction_Or_Operator => 883, - Iir_Kind_Reduction_Nand_Operator => 887, - Iir_Kind_Reduction_Nor_Operator => 891, - Iir_Kind_Reduction_Xor_Operator => 895, - Iir_Kind_Reduction_Xnor_Operator => 899, - Iir_Kind_And_Operator => 904, - Iir_Kind_Or_Operator => 909, - Iir_Kind_Nand_Operator => 914, - Iir_Kind_Nor_Operator => 919, - Iir_Kind_Xor_Operator => 924, - Iir_Kind_Xnor_Operator => 929, - Iir_Kind_Equality_Operator => 934, - Iir_Kind_Inequality_Operator => 939, - Iir_Kind_Less_Than_Operator => 944, - Iir_Kind_Less_Than_Or_Equal_Operator => 949, - Iir_Kind_Greater_Than_Operator => 954, - Iir_Kind_Greater_Than_Or_Equal_Operator => 959, - Iir_Kind_Match_Equality_Operator => 964, - Iir_Kind_Match_Inequality_Operator => 969, - Iir_Kind_Match_Less_Than_Operator => 974, - Iir_Kind_Match_Less_Than_Or_Equal_Operator => 979, - Iir_Kind_Match_Greater_Than_Operator => 984, - Iir_Kind_Match_Greater_Than_Or_Equal_Operator => 989, - Iir_Kind_Sll_Operator => 994, - Iir_Kind_Sla_Operator => 999, - Iir_Kind_Srl_Operator => 1004, - Iir_Kind_Sra_Operator => 1009, - Iir_Kind_Rol_Operator => 1014, - Iir_Kind_Ror_Operator => 1019, - Iir_Kind_Addition_Operator => 1024, - Iir_Kind_Substraction_Operator => 1029, - Iir_Kind_Concatenation_Operator => 1034, - Iir_Kind_Multiplication_Operator => 1039, - Iir_Kind_Division_Operator => 1044, - Iir_Kind_Modulus_Operator => 1049, - Iir_Kind_Remainder_Operator => 1054, - Iir_Kind_Exponentiation_Operator => 1059, - Iir_Kind_Function_Call => 1067, - Iir_Kind_Aggregate => 1073, - Iir_Kind_Parenthesis_Expression => 1076, - Iir_Kind_Qualified_Expression => 1080, - Iir_Kind_Type_Conversion => 1085, - Iir_Kind_Allocator_By_Expression => 1089, - Iir_Kind_Allocator_By_Subtype => 1093, - Iir_Kind_Selected_Element => 1099, - Iir_Kind_Dereference => 1104, - Iir_Kind_Implicit_Dereference => 1109, - Iir_Kind_Slice_Name => 1116, - Iir_Kind_Indexed_Name => 1122, - Iir_Kind_Psl_Expression => 1124, - Iir_Kind_Sensitized_Process_Statement => 1144, - Iir_Kind_Process_Statement => 1163, - Iir_Kind_Concurrent_Conditional_Signal_Assignment => 1174, - Iir_Kind_Concurrent_Selected_Signal_Assignment => 1186, - Iir_Kind_Concurrent_Assertion_Statement => 1194, - Iir_Kind_Psl_Default_Clock => 1198, - Iir_Kind_Psl_Assert_Statement => 1207, - Iir_Kind_Psl_Cover_Statement => 1216, - Iir_Kind_Concurrent_Procedure_Call_Statement => 1222, - Iir_Kind_Block_Statement => 1235, - Iir_Kind_If_Generate_Statement => 1245, - Iir_Kind_For_Generate_Statement => 1254, - Iir_Kind_Component_Instantiation_Statement => 1264, - Iir_Kind_Simple_Simultaneous_Statement => 1271, - Iir_Kind_Generate_Statement_Body => 1282, - Iir_Kind_If_Generate_Else_Clause => 1287, - Iir_Kind_Signal_Assignment_Statement => 1296, - Iir_Kind_Null_Statement => 1300, - Iir_Kind_Assertion_Statement => 1307, - Iir_Kind_Report_Statement => 1313, - Iir_Kind_Wait_Statement => 1320, - Iir_Kind_Variable_Assignment_Statement => 1326, - Iir_Kind_Return_Statement => 1332, - Iir_Kind_For_Loop_Statement => 1340, - Iir_Kind_While_Loop_Statement => 1347, - Iir_Kind_Next_Statement => 1353, - Iir_Kind_Exit_Statement => 1359, - Iir_Kind_Case_Statement => 1366, - Iir_Kind_Procedure_Call_Statement => 1371, - Iir_Kind_If_Statement => 1379, - Iir_Kind_Elsif => 1384, - Iir_Kind_Character_Literal => 1391, - Iir_Kind_Simple_Name => 1398, - Iir_Kind_Selected_Name => 1406, - Iir_Kind_Operator_Symbol => 1411, - Iir_Kind_Selected_By_All_Name => 1416, - Iir_Kind_Parenthesis_Name => 1420, - Iir_Kind_External_Constant_Name => 1429, - Iir_Kind_External_Signal_Name => 1438, - Iir_Kind_External_Variable_Name => 1447, - Iir_Kind_Package_Pathname => 1450, - Iir_Kind_Absolute_Pathname => 1451, - Iir_Kind_Relative_Pathname => 1452, - Iir_Kind_Pathname_Element => 1456, - Iir_Kind_Base_Attribute => 1458, - Iir_Kind_Left_Type_Attribute => 1463, - Iir_Kind_Right_Type_Attribute => 1468, - Iir_Kind_High_Type_Attribute => 1473, - Iir_Kind_Low_Type_Attribute => 1478, - Iir_Kind_Ascending_Type_Attribute => 1483, - Iir_Kind_Image_Attribute => 1489, - Iir_Kind_Value_Attribute => 1495, - Iir_Kind_Pos_Attribute => 1501, - Iir_Kind_Val_Attribute => 1507, - Iir_Kind_Succ_Attribute => 1513, - Iir_Kind_Pred_Attribute => 1519, - Iir_Kind_Leftof_Attribute => 1525, - Iir_Kind_Rightof_Attribute => 1531, - Iir_Kind_Delayed_Attribute => 1539, - Iir_Kind_Stable_Attribute => 1547, - Iir_Kind_Quiet_Attribute => 1555, - Iir_Kind_Transaction_Attribute => 1563, - Iir_Kind_Event_Attribute => 1567, - Iir_Kind_Active_Attribute => 1571, - Iir_Kind_Last_Event_Attribute => 1575, - Iir_Kind_Last_Active_Attribute => 1579, - Iir_Kind_Last_Value_Attribute => 1583, - Iir_Kind_Driving_Attribute => 1587, - Iir_Kind_Driving_Value_Attribute => 1591, - Iir_Kind_Behavior_Attribute => 1591, - Iir_Kind_Structure_Attribute => 1591, - Iir_Kind_Simple_Name_Attribute => 1598, - Iir_Kind_Instance_Name_Attribute => 1603, - Iir_Kind_Path_Name_Attribute => 1608, - Iir_Kind_Left_Array_Attribute => 1615, - Iir_Kind_Right_Array_Attribute => 1622, - Iir_Kind_High_Array_Attribute => 1629, - Iir_Kind_Low_Array_Attribute => 1636, - Iir_Kind_Length_Array_Attribute => 1643, - Iir_Kind_Ascending_Array_Attribute => 1650, - Iir_Kind_Range_Array_Attribute => 1657, - Iir_Kind_Reverse_Range_Array_Attribute => 1664, - Iir_Kind_Attribute_Name => 1672 + Iir_Kind_Procedure_Declaration => 662, + Iir_Kind_Function_Body => 672, + Iir_Kind_Procedure_Body => 683, + Iir_Kind_Object_Alias_Declaration => 695, + Iir_Kind_File_Declaration => 710, + Iir_Kind_Guard_Signal_Declaration => 723, + Iir_Kind_Signal_Declaration => 740, + Iir_Kind_Variable_Declaration => 753, + Iir_Kind_Constant_Declaration => 767, + Iir_Kind_Iterator_Declaration => 779, + Iir_Kind_Interface_Constant_Declaration => 795, + Iir_Kind_Interface_Variable_Declaration => 811, + Iir_Kind_Interface_Signal_Declaration => 832, + Iir_Kind_Interface_File_Declaration => 848, + Iir_Kind_Interface_Package_Declaration => 857, + Iir_Kind_Identity_Operator => 861, + Iir_Kind_Negation_Operator => 865, + Iir_Kind_Absolute_Operator => 869, + Iir_Kind_Not_Operator => 873, + Iir_Kind_Condition_Operator => 877, + Iir_Kind_Reduction_And_Operator => 881, + Iir_Kind_Reduction_Or_Operator => 885, + Iir_Kind_Reduction_Nand_Operator => 889, + Iir_Kind_Reduction_Nor_Operator => 893, + Iir_Kind_Reduction_Xor_Operator => 897, + Iir_Kind_Reduction_Xnor_Operator => 901, + Iir_Kind_And_Operator => 906, + Iir_Kind_Or_Operator => 911, + Iir_Kind_Nand_Operator => 916, + Iir_Kind_Nor_Operator => 921, + Iir_Kind_Xor_Operator => 926, + Iir_Kind_Xnor_Operator => 931, + Iir_Kind_Equality_Operator => 936, + Iir_Kind_Inequality_Operator => 941, + Iir_Kind_Less_Than_Operator => 946, + Iir_Kind_Less_Than_Or_Equal_Operator => 951, + Iir_Kind_Greater_Than_Operator => 956, + Iir_Kind_Greater_Than_Or_Equal_Operator => 961, + Iir_Kind_Match_Equality_Operator => 966, + Iir_Kind_Match_Inequality_Operator => 971, + Iir_Kind_Match_Less_Than_Operator => 976, + Iir_Kind_Match_Less_Than_Or_Equal_Operator => 981, + Iir_Kind_Match_Greater_Than_Operator => 986, + Iir_Kind_Match_Greater_Than_Or_Equal_Operator => 991, + Iir_Kind_Sll_Operator => 996, + Iir_Kind_Sla_Operator => 1001, + Iir_Kind_Srl_Operator => 1006, + Iir_Kind_Sra_Operator => 1011, + Iir_Kind_Rol_Operator => 1016, + Iir_Kind_Ror_Operator => 1021, + Iir_Kind_Addition_Operator => 1026, + Iir_Kind_Substraction_Operator => 1031, + Iir_Kind_Concatenation_Operator => 1036, + Iir_Kind_Multiplication_Operator => 1041, + Iir_Kind_Division_Operator => 1046, + Iir_Kind_Modulus_Operator => 1051, + Iir_Kind_Remainder_Operator => 1056, + Iir_Kind_Exponentiation_Operator => 1061, + Iir_Kind_Function_Call => 1069, + Iir_Kind_Aggregate => 1075, + Iir_Kind_Parenthesis_Expression => 1078, + Iir_Kind_Qualified_Expression => 1082, + Iir_Kind_Type_Conversion => 1087, + Iir_Kind_Allocator_By_Expression => 1091, + Iir_Kind_Allocator_By_Subtype => 1095, + Iir_Kind_Selected_Element => 1101, + Iir_Kind_Dereference => 1106, + Iir_Kind_Implicit_Dereference => 1111, + Iir_Kind_Slice_Name => 1118, + Iir_Kind_Indexed_Name => 1124, + Iir_Kind_Psl_Expression => 1126, + Iir_Kind_Sensitized_Process_Statement => 1146, + Iir_Kind_Process_Statement => 1166, + Iir_Kind_Concurrent_Conditional_Signal_Assignment => 1177, + Iir_Kind_Concurrent_Selected_Signal_Assignment => 1189, + Iir_Kind_Concurrent_Assertion_Statement => 1197, + Iir_Kind_Psl_Default_Clock => 1201, + Iir_Kind_Psl_Assert_Statement => 1210, + Iir_Kind_Psl_Cover_Statement => 1219, + Iir_Kind_Concurrent_Procedure_Call_Statement => 1226, + Iir_Kind_Block_Statement => 1239, + Iir_Kind_If_Generate_Statement => 1249, + Iir_Kind_For_Generate_Statement => 1258, + Iir_Kind_Component_Instantiation_Statement => 1268, + Iir_Kind_Simple_Simultaneous_Statement => 1275, + Iir_Kind_Generate_Statement_Body => 1286, + Iir_Kind_If_Generate_Else_Clause => 1291, + Iir_Kind_Signal_Assignment_Statement => 1300, + Iir_Kind_Null_Statement => 1304, + Iir_Kind_Assertion_Statement => 1311, + Iir_Kind_Report_Statement => 1317, + Iir_Kind_Wait_Statement => 1324, + Iir_Kind_Variable_Assignment_Statement => 1330, + Iir_Kind_Return_Statement => 1336, + Iir_Kind_For_Loop_Statement => 1345, + Iir_Kind_While_Loop_Statement => 1353, + Iir_Kind_Next_Statement => 1359, + Iir_Kind_Exit_Statement => 1365, + Iir_Kind_Case_Statement => 1373, + Iir_Kind_Procedure_Call_Statement => 1379, + Iir_Kind_If_Statement => 1388, + Iir_Kind_Elsif => 1393, + Iir_Kind_Character_Literal => 1400, + Iir_Kind_Simple_Name => 1407, + Iir_Kind_Selected_Name => 1415, + Iir_Kind_Operator_Symbol => 1420, + Iir_Kind_Selected_By_All_Name => 1425, + Iir_Kind_Parenthesis_Name => 1429, + Iir_Kind_External_Constant_Name => 1438, + Iir_Kind_External_Signal_Name => 1447, + Iir_Kind_External_Variable_Name => 1456, + Iir_Kind_Package_Pathname => 1459, + Iir_Kind_Absolute_Pathname => 1460, + Iir_Kind_Relative_Pathname => 1461, + Iir_Kind_Pathname_Element => 1465, + Iir_Kind_Base_Attribute => 1467, + Iir_Kind_Left_Type_Attribute => 1472, + Iir_Kind_Right_Type_Attribute => 1477, + Iir_Kind_High_Type_Attribute => 1482, + Iir_Kind_Low_Type_Attribute => 1487, + Iir_Kind_Ascending_Type_Attribute => 1492, + Iir_Kind_Image_Attribute => 1498, + Iir_Kind_Value_Attribute => 1504, + Iir_Kind_Pos_Attribute => 1510, + Iir_Kind_Val_Attribute => 1516, + Iir_Kind_Succ_Attribute => 1522, + Iir_Kind_Pred_Attribute => 1528, + Iir_Kind_Leftof_Attribute => 1534, + Iir_Kind_Rightof_Attribute => 1540, + Iir_Kind_Delayed_Attribute => 1548, + Iir_Kind_Stable_Attribute => 1556, + Iir_Kind_Quiet_Attribute => 1564, + Iir_Kind_Transaction_Attribute => 1572, + Iir_Kind_Event_Attribute => 1576, + Iir_Kind_Active_Attribute => 1580, + Iir_Kind_Last_Event_Attribute => 1584, + Iir_Kind_Last_Active_Attribute => 1588, + Iir_Kind_Last_Value_Attribute => 1592, + Iir_Kind_Driving_Attribute => 1596, + Iir_Kind_Driving_Value_Attribute => 1600, + Iir_Kind_Behavior_Attribute => 1600, + Iir_Kind_Structure_Attribute => 1600, + Iir_Kind_Simple_Name_Attribute => 1607, + Iir_Kind_Instance_Name_Attribute => 1612, + Iir_Kind_Path_Name_Attribute => 1617, + Iir_Kind_Left_Array_Attribute => 1624, + Iir_Kind_Right_Array_Attribute => 1631, + Iir_Kind_High_Array_Attribute => 1638, + Iir_Kind_Low_Array_Attribute => 1645, + Iir_Kind_Length_Array_Attribute => 1652, + Iir_Kind_Ascending_Array_Attribute => 1659, + Iir_Kind_Range_Array_Attribute => 1666, + Iir_Kind_Reverse_Range_Array_Attribute => 1673, + Iir_Kind_Attribute_Name => 1681 ); function Get_Fields (K : Iir_Kind) return Fields_Array @@ -4333,6 +4347,8 @@ package body Nodes_Meta is return Get_Has_Mode (N); when Field_Has_Class => return Get_Has_Class (N); + when Field_Suspend_Flag => + return Get_Suspend_Flag (N); when Field_Is_Ref => return Get_Is_Ref (N); when others => @@ -4439,6 +4455,8 @@ package body Nodes_Meta is Set_Has_Mode (N, V); when Field_Has_Class => Set_Has_Class (N, V); + when Field_Suspend_Flag => + Set_Suspend_Flag (N, V); when Field_Is_Ref => Set_Is_Ref (N, V); when others => @@ -9537,6 +9555,24 @@ package body Nodes_Meta is end case; end Has_Has_Class; + function Has_Suspend_Flag (K : Iir_Kind) return Boolean is + begin + case K is + when Iir_Kind_Procedure_Declaration + | Iir_Kind_Procedure_Body + | Iir_Kind_Process_Statement + | Iir_Kind_Concurrent_Procedure_Call_Statement + | Iir_Kind_For_Loop_Statement + | Iir_Kind_While_Loop_Statement + | Iir_Kind_Case_Statement + | Iir_Kind_Procedure_Call_Statement + | Iir_Kind_If_Statement => + return True; + when others => + return False; + end case; + end Has_Suspend_Flag; + function Has_Is_Ref (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 ce1d33c..e0face0 100644 --- a/src/vhdl/nodes_meta.ads +++ b/src/vhdl/nodes_meta.ads @@ -347,6 +347,7 @@ package Nodes_Meta is Field_Has_Identifier_List, Field_Has_Mode, Field_Has_Class, + Field_Suspend_Flag, Field_Is_Ref, Field_Psl_Property, Field_Psl_Declaration, @@ -831,6 +832,7 @@ package Nodes_Meta is function Has_Has_Identifier_List (K : Iir_Kind) return Boolean; function Has_Has_Mode (K : Iir_Kind) return Boolean; function Has_Has_Class (K : Iir_Kind) return Boolean; + function Has_Suspend_Flag (K : Iir_Kind) return Boolean; function Has_Is_Ref (K : Iir_Kind) return Boolean; function Has_Psl_Property (K : Iir_Kind) return Boolean; function Has_Psl_Declaration (K : Iir_Kind) return Boolean; diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb index b78b6cf..ca44e17 100644 --- a/src/vhdl/sem.adb +++ b/src/vhdl/sem.adb @@ -1776,29 +1776,27 @@ package body Sem is -- LRM 2.1 Subprogram Declarations. procedure Sem_Subprogram_Declaration (Subprg: Iir) is + Parent : constant Iir := Get_Parent (Subprg); Spec: Iir; Interface_Chain : Iir; Subprg_Body : Iir; Return_Type : Iir; begin -- Set depth. - declare - Parent : constant Iir := Get_Parent (Subprg); - begin - case Get_Kind (Parent) is - when Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration => - raise Internal_Error; - when Iir_Kind_Function_Body - | Iir_Kind_Procedure_Body => - Set_Subprogram_Depth - (Subprg, - Get_Subprogram_Depth - (Get_Subprogram_Specification (Parent)) + 1); - when others => - Set_Subprogram_Depth (Subprg, 0); - end case; - end; + case Get_Kind (Parent) is + when Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => + raise Internal_Error; + when Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body => + Set_Subprogram_Depth + (Subprg, + Get_Subprogram_Depth + (Get_Subprogram_Specification (Parent)) + 1); + when others => + -- FIXME: protected type ? + Set_Subprogram_Depth (Subprg, 0); + end case; -- LRM 10.1 Declarative Region -- 3. A subprogram declaration, together with the corresponding @@ -1877,6 +1875,14 @@ package body Sem is Inter := Get_Chain (Inter); end loop; end; + + -- Mark the procedure as suspendable, unless in a std packages. + -- This is a minor optimization. + if Get_Library (Get_Design_File (Get_Current_Design_Unit)) + /= Libraries.Std_Library + then + Set_Suspend_Flag (Subprg, True); + end if; when others => Error_Kind ("sem_subprogram_declaration", Subprg); end case; @@ -1940,10 +1946,9 @@ package body Sem is procedure Sem_Subprogram_Body (Subprg : Iir) is - Spec : Iir; + Spec : constant Iir := Get_Subprogram_Specification (Subprg); El : Iir; begin - Spec := Get_Subprogram_Specification (Subprg); Set_Impure_Depth (Subprg, Iir_Depth_Pure); -- LRM 10.1 Declarative regions @@ -1969,6 +1974,14 @@ package body Sem is case Get_Kind (Spec) is when Iir_Kind_Procedure_Declaration => + if Get_Suspend_Flag (Subprg) + and then not Get_Suspend_Flag (Spec) + then + -- Incoherence: procedures declared in std library are not + -- expected to suspend. This is an internal check. + Error_Msg_Sem ("unexpected suspendable procedure", Subprg); + end if; + -- Update purity state of procedure if there are no callees. case Get_Purity_State (Spec) is when Pure diff --git a/src/vhdl/sem_stmts.adb b/src/vhdl/sem_stmts.adb index fdc590d..593ded8 100644 --- a/src/vhdl/sem_stmts.adb +++ b/src/vhdl/sem_stmts.adb @@ -1012,6 +1012,33 @@ package body Sem_Stmts is end loop; end Sem_Sensitivity_List; + -- Mark STMT and its parents as suspendable. + procedure Mark_Suspendable (Stmt : Iir) + is + Parent : Iir; + begin + Parent := Get_Parent (Stmt); + loop + case Get_Kind (Parent) is + when Iir_Kind_Function_Body + | Iir_Kind_Sensitized_Process_Statement => + exit; + when Iir_Kind_Process_Statement + | Iir_Kind_Procedure_Body => + Set_Suspend_Flag (Parent, True); + exit; + when Iir_Kind_If_Statement + | Iir_Kind_While_Loop_Statement + | Iir_Kind_For_Loop_Statement + | Iir_Kind_Case_Statement => + Set_Suspend_Flag (Parent, True); + Parent := Get_Parent (Parent); + when others => + Error_Kind ("mark_suspendable", Parent); + end case; + end loop; + end Mark_Suspendable; + procedure Sem_Wait_Statement (Stmt: Iir_Wait_Statement) is Expr: Iir; @@ -1054,11 +1081,13 @@ package body Sem_Stmts is if Sensitivity_List /= Null_Iir_List then Sem_Sensitivity_List (Sensitivity_List); end if; + Expr := Get_Condition_Clause (Stmt); if Expr /= Null_Iir then Expr := Sem_Condition (Expr); Set_Condition_Clause (Stmt, Expr); end if; + Expr := Get_Timeout_Clause (Stmt); if Expr /= Null_Iir then Expr := Sem_Expression (Expr, Time_Type_Definition); @@ -1073,6 +1102,8 @@ package body Sem_Stmts is end if; end if; end if; + + Mark_Suspendable (Stmt); end Sem_Wait_Statement; procedure Sem_Exit_Next_Statement (Stmt : Iir) @@ -1208,7 +1239,22 @@ package body Sem_Stmts is when Iir_Kind_Wait_Statement => Sem_Wait_Statement (Stmt); when Iir_Kind_Procedure_Call_Statement => - Sem_Procedure_Call (Get_Procedure_Call (Stmt), Stmt); + declare + Call : constant Iir := Get_Procedure_Call (Stmt); + Imp : Iir; + begin + Sem_Procedure_Call (Call, Stmt); + + -- Set suspend flag. + Imp := Get_Implementation (Call); + if Imp /= Null_Iir + and then Get_Kind (Imp) = Iir_Kind_Procedure_Declaration + and then Get_Suspend_Flag (Imp) + then + Set_Suspend_Flag (Stmt, True); + Mark_Suspendable (Stmt); + end if; + end; when Iir_Kind_Next_Statement | Iir_Kind_Exit_Statement => Sem_Exit_Next_Statement (Stmt); |