diff options
| -rw-r--r-- | src/vhdl/iirs.adb | 16 | ||||
| -rw-r--r-- | src/vhdl/iirs.ads | 8 | ||||
| -rw-r--r-- | src/vhdl/nodes_meta.adb | 195 | ||||
| -rw-r--r-- | src/vhdl/nodes_meta.ads | 2 | ||||
| -rw-r--r-- | src/vhdl/sem_expr.adb | 6 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap2.adb | 2 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap3.adb | 11 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap3.ads | 8 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap4.adb | 7 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap5.adb | 8 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap6.adb | 2 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap7.adb | 19 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap8.adb | 28 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap9.adb | 6 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap9.ads | 1 | ||||
| -rw-r--r-- | src/vhdl/translate/trans.adb | 45 | ||||
| -rw-r--r-- | src/vhdl/translate/trans.ads | 18 |
17 files changed, 180 insertions, 202 deletions
diff --git a/src/vhdl/iirs.adb b/src/vhdl/iirs.adb index 1e57b03..010d48d 100644 --- a/src/vhdl/iirs.adb +++ b/src/vhdl/iirs.adb @@ -1119,6 +1119,22 @@ package body Iirs is Set_Field3 (Lit, Atype); end Set_Literal_Subtype; + function Get_Allocator_Subtype (Lit : Iir) return Iir is + begin + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_Allocator_Subtype (Get_Kind (Lit)), + "no field Allocator_Subtype"); + return Get_Field3 (Lit); + end Get_Allocator_Subtype; + + procedure Set_Allocator_Subtype (Lit : Iir; Atype : Iir) is + begin + pragma Assert (Lit /= Null_Iir); + pragma Assert (Has_Allocator_Subtype (Get_Kind (Lit)), + "no field Allocator_Subtype"); + Set_Field3 (Lit, Atype); + end Set_Allocator_Subtype; + function Get_Entity_Class (Target : Iir) return Token_Type is begin pragma Assert (Target /= Null_Iir); diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads index f0ab7ff..70072f6 100644 --- a/src/vhdl/iirs.ads +++ b/src/vhdl/iirs.ads @@ -3108,6 +3108,10 @@ package Iirs is -- expression or the subtype) -- Get/Set_Allocator_Designated_Type (Field2) -- + -- Only for Iir_Kind_Allocator_By_Subtype: + -- Same as subtype indication but set to own the subtype. + -- Get/Set_Allocator_Subtype (Field3) + -- -- Only for Iir_Kind_Allocator_By_Expression: -- Contains the expression for a by expression allocator. -- Get/Set_Expression (Field5) @@ -5243,6 +5247,10 @@ package Iirs is function Get_Literal_Subtype (Lit : Iir) return Iir; procedure Set_Literal_Subtype (Lit : Iir; Atype : Iir); + -- Field: Field3 + function Get_Allocator_Subtype (Lit : Iir) return Iir; + procedure Set_Allocator_Subtype (Lit : Iir; Atype : Iir); + -- Field: Field3 (uc) function Get_Entity_Class (Target : Iir) return Token_Type; procedure Set_Entity_Class (Target : Iir; Kind : Token_Type); diff --git a/src/vhdl/nodes_meta.adb b/src/vhdl/nodes_meta.adb index 4cc8a15..2af55d4 100644 --- a/src/vhdl/nodes_meta.adb +++ b/src/vhdl/nodes_meta.adb @@ -57,6 +57,7 @@ package body Nodes_Meta is Field_Literal_Origin => Type_Iir, Field_Range_Origin => Type_Iir, Field_Literal_Subtype => Type_Iir, + Field_Allocator_Subtype => Type_Iir, Field_Entity_Class => Type_Token_Type, Field_Entity_Name_List => Type_Iir_List, Field_Attribute_Designator => Type_Iir, @@ -401,6 +402,8 @@ package body Nodes_Meta is return "range_origin"; when Field_Literal_Subtype => return "literal_subtype"; + when Field_Allocator_Subtype => + return "allocator_subtype"; when Field_Entity_Class => return "entity_class"; when Field_Entity_Name_List => @@ -1503,6 +1506,8 @@ package body Nodes_Meta is return Attr_None; when Field_Literal_Subtype => return Attr_None; + when Field_Allocator_Subtype => + return Attr_None; when Field_Entity_Class => return Attr_None; when Field_Entity_Name_List => @@ -3278,6 +3283,7 @@ package body Nodes_Meta is -- Iir_Kind_Allocator_By_Subtype Field_Is_Ref, Field_Expr_Staticness, + Field_Allocator_Subtype, Field_Subtype_Indication, Field_Type, Field_Allocator_Designated_Type, @@ -4119,96 +4125,96 @@ package body Nodes_Meta is Iir_Kind_Qualified_Expression => 1082, Iir_Kind_Type_Conversion => 1087, Iir_Kind_Allocator_By_Expression => 1091, - Iir_Kind_Allocator_By_Subtype => 1096, - Iir_Kind_Selected_Element => 1102, - Iir_Kind_Dereference => 1107, - Iir_Kind_Implicit_Dereference => 1112, - Iir_Kind_Slice_Name => 1119, - Iir_Kind_Indexed_Name => 1125, - Iir_Kind_Psl_Expression => 1127, - Iir_Kind_Sensitized_Process_Statement => 1147, - Iir_Kind_Process_Statement => 1167, - Iir_Kind_Concurrent_Conditional_Signal_Assignment => 1178, - Iir_Kind_Concurrent_Selected_Signal_Assignment => 1190, - Iir_Kind_Concurrent_Assertion_Statement => 1198, - Iir_Kind_Psl_Default_Clock => 1202, - Iir_Kind_Psl_Assert_Statement => 1211, - Iir_Kind_Psl_Cover_Statement => 1220, - Iir_Kind_Concurrent_Procedure_Call_Statement => 1227, - Iir_Kind_Block_Statement => 1240, - Iir_Kind_If_Generate_Statement => 1250, - Iir_Kind_For_Generate_Statement => 1259, - Iir_Kind_Component_Instantiation_Statement => 1269, - Iir_Kind_Simple_Simultaneous_Statement => 1276, - Iir_Kind_Generate_Statement_Body => 1287, - Iir_Kind_If_Generate_Else_Clause => 1292, - Iir_Kind_Signal_Assignment_Statement => 1301, - Iir_Kind_Null_Statement => 1305, - Iir_Kind_Assertion_Statement => 1312, - Iir_Kind_Report_Statement => 1318, - Iir_Kind_Wait_Statement => 1325, - Iir_Kind_Variable_Assignment_Statement => 1331, - Iir_Kind_Return_Statement => 1337, - Iir_Kind_For_Loop_Statement => 1346, - Iir_Kind_While_Loop_Statement => 1354, - Iir_Kind_Next_Statement => 1360, - Iir_Kind_Exit_Statement => 1366, - Iir_Kind_Case_Statement => 1374, - Iir_Kind_Procedure_Call_Statement => 1380, - Iir_Kind_If_Statement => 1389, - Iir_Kind_Elsif => 1394, - Iir_Kind_Character_Literal => 1401, - Iir_Kind_Simple_Name => 1408, - Iir_Kind_Selected_Name => 1416, - Iir_Kind_Operator_Symbol => 1421, - Iir_Kind_Selected_By_All_Name => 1426, - Iir_Kind_Parenthesis_Name => 1430, - Iir_Kind_External_Constant_Name => 1439, - Iir_Kind_External_Signal_Name => 1448, - Iir_Kind_External_Variable_Name => 1457, - Iir_Kind_Package_Pathname => 1460, - Iir_Kind_Absolute_Pathname => 1461, - Iir_Kind_Relative_Pathname => 1462, - Iir_Kind_Pathname_Element => 1466, - Iir_Kind_Base_Attribute => 1468, - Iir_Kind_Left_Type_Attribute => 1473, - Iir_Kind_Right_Type_Attribute => 1478, - Iir_Kind_High_Type_Attribute => 1483, - Iir_Kind_Low_Type_Attribute => 1488, - Iir_Kind_Ascending_Type_Attribute => 1493, - Iir_Kind_Image_Attribute => 1499, - Iir_Kind_Value_Attribute => 1505, - Iir_Kind_Pos_Attribute => 1511, - Iir_Kind_Val_Attribute => 1517, - Iir_Kind_Succ_Attribute => 1523, - Iir_Kind_Pred_Attribute => 1529, - Iir_Kind_Leftof_Attribute => 1535, - Iir_Kind_Rightof_Attribute => 1541, - Iir_Kind_Delayed_Attribute => 1549, - Iir_Kind_Stable_Attribute => 1557, - Iir_Kind_Quiet_Attribute => 1565, - Iir_Kind_Transaction_Attribute => 1573, - Iir_Kind_Event_Attribute => 1577, - Iir_Kind_Active_Attribute => 1581, - Iir_Kind_Last_Event_Attribute => 1585, - Iir_Kind_Last_Active_Attribute => 1589, - Iir_Kind_Last_Value_Attribute => 1593, - Iir_Kind_Driving_Attribute => 1597, - Iir_Kind_Driving_Value_Attribute => 1601, - Iir_Kind_Behavior_Attribute => 1601, - Iir_Kind_Structure_Attribute => 1601, - Iir_Kind_Simple_Name_Attribute => 1608, - Iir_Kind_Instance_Name_Attribute => 1613, - Iir_Kind_Path_Name_Attribute => 1618, - Iir_Kind_Left_Array_Attribute => 1625, - Iir_Kind_Right_Array_Attribute => 1632, - Iir_Kind_High_Array_Attribute => 1639, - Iir_Kind_Low_Array_Attribute => 1646, - Iir_Kind_Length_Array_Attribute => 1653, - Iir_Kind_Ascending_Array_Attribute => 1660, - Iir_Kind_Range_Array_Attribute => 1667, - Iir_Kind_Reverse_Range_Array_Attribute => 1674, - Iir_Kind_Attribute_Name => 1682 + Iir_Kind_Allocator_By_Subtype => 1097, + Iir_Kind_Selected_Element => 1103, + Iir_Kind_Dereference => 1108, + Iir_Kind_Implicit_Dereference => 1113, + Iir_Kind_Slice_Name => 1120, + Iir_Kind_Indexed_Name => 1126, + Iir_Kind_Psl_Expression => 1128, + Iir_Kind_Sensitized_Process_Statement => 1148, + Iir_Kind_Process_Statement => 1168, + Iir_Kind_Concurrent_Conditional_Signal_Assignment => 1179, + Iir_Kind_Concurrent_Selected_Signal_Assignment => 1191, + Iir_Kind_Concurrent_Assertion_Statement => 1199, + Iir_Kind_Psl_Default_Clock => 1203, + Iir_Kind_Psl_Assert_Statement => 1212, + Iir_Kind_Psl_Cover_Statement => 1221, + Iir_Kind_Concurrent_Procedure_Call_Statement => 1228, + Iir_Kind_Block_Statement => 1241, + Iir_Kind_If_Generate_Statement => 1251, + Iir_Kind_For_Generate_Statement => 1260, + Iir_Kind_Component_Instantiation_Statement => 1270, + Iir_Kind_Simple_Simultaneous_Statement => 1277, + Iir_Kind_Generate_Statement_Body => 1288, + Iir_Kind_If_Generate_Else_Clause => 1293, + Iir_Kind_Signal_Assignment_Statement => 1302, + Iir_Kind_Null_Statement => 1306, + Iir_Kind_Assertion_Statement => 1313, + Iir_Kind_Report_Statement => 1319, + Iir_Kind_Wait_Statement => 1326, + Iir_Kind_Variable_Assignment_Statement => 1332, + Iir_Kind_Return_Statement => 1338, + Iir_Kind_For_Loop_Statement => 1347, + Iir_Kind_While_Loop_Statement => 1355, + Iir_Kind_Next_Statement => 1361, + Iir_Kind_Exit_Statement => 1367, + Iir_Kind_Case_Statement => 1375, + Iir_Kind_Procedure_Call_Statement => 1381, + Iir_Kind_If_Statement => 1390, + Iir_Kind_Elsif => 1395, + Iir_Kind_Character_Literal => 1402, + Iir_Kind_Simple_Name => 1409, + Iir_Kind_Selected_Name => 1417, + Iir_Kind_Operator_Symbol => 1422, + Iir_Kind_Selected_By_All_Name => 1427, + Iir_Kind_Parenthesis_Name => 1431, + Iir_Kind_External_Constant_Name => 1440, + Iir_Kind_External_Signal_Name => 1449, + Iir_Kind_External_Variable_Name => 1458, + Iir_Kind_Package_Pathname => 1461, + Iir_Kind_Absolute_Pathname => 1462, + Iir_Kind_Relative_Pathname => 1463, + Iir_Kind_Pathname_Element => 1467, + Iir_Kind_Base_Attribute => 1469, + Iir_Kind_Left_Type_Attribute => 1474, + Iir_Kind_Right_Type_Attribute => 1479, + Iir_Kind_High_Type_Attribute => 1484, + Iir_Kind_Low_Type_Attribute => 1489, + Iir_Kind_Ascending_Type_Attribute => 1494, + Iir_Kind_Image_Attribute => 1500, + Iir_Kind_Value_Attribute => 1506, + Iir_Kind_Pos_Attribute => 1512, + Iir_Kind_Val_Attribute => 1518, + Iir_Kind_Succ_Attribute => 1524, + Iir_Kind_Pred_Attribute => 1530, + Iir_Kind_Leftof_Attribute => 1536, + Iir_Kind_Rightof_Attribute => 1542, + Iir_Kind_Delayed_Attribute => 1550, + Iir_Kind_Stable_Attribute => 1558, + Iir_Kind_Quiet_Attribute => 1566, + Iir_Kind_Transaction_Attribute => 1574, + Iir_Kind_Event_Attribute => 1578, + Iir_Kind_Active_Attribute => 1582, + Iir_Kind_Last_Event_Attribute => 1586, + Iir_Kind_Last_Active_Attribute => 1590, + Iir_Kind_Last_Value_Attribute => 1594, + Iir_Kind_Driving_Attribute => 1598, + Iir_Kind_Driving_Value_Attribute => 1602, + Iir_Kind_Behavior_Attribute => 1602, + Iir_Kind_Structure_Attribute => 1602, + Iir_Kind_Simple_Name_Attribute => 1609, + Iir_Kind_Instance_Name_Attribute => 1614, + Iir_Kind_Path_Name_Attribute => 1619, + Iir_Kind_Left_Array_Attribute => 1626, + Iir_Kind_Right_Array_Attribute => 1633, + Iir_Kind_High_Array_Attribute => 1640, + Iir_Kind_Low_Array_Attribute => 1647, + Iir_Kind_Length_Array_Attribute => 1654, + Iir_Kind_Ascending_Array_Attribute => 1661, + Iir_Kind_Range_Array_Attribute => 1668, + Iir_Kind_Reverse_Range_Array_Attribute => 1675, + Iir_Kind_Attribute_Name => 1683 ); function Get_Fields (K : Iir_Kind) return Fields_Array @@ -4570,6 +4576,8 @@ package body Nodes_Meta is return Get_Range_Origin (N); when Field_Literal_Subtype => return Get_Literal_Subtype (N); + when Field_Allocator_Subtype => + return Get_Allocator_Subtype (N); when Field_Attribute_Designator => return Get_Attribute_Designator (N); when Field_Attribute_Specification_Chain => @@ -4936,6 +4944,8 @@ package body Nodes_Meta is Set_Range_Origin (N, V); when Field_Literal_Subtype => Set_Literal_Subtype (N, V); + when Field_Allocator_Subtype => + Set_Allocator_Subtype (N, V); when Field_Attribute_Designator => Set_Attribute_Designator (N, V); when Field_Attribute_Specification_Chain => @@ -6249,6 +6259,11 @@ package body Nodes_Meta is end case; end Has_Literal_Subtype; + function Has_Allocator_Subtype (K : Iir_Kind) return Boolean is + begin + return K = Iir_Kind_Allocator_By_Subtype; + end Has_Allocator_Subtype; + function Has_Entity_Class (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 e0face0..844fee1 100644 --- a/src/vhdl/nodes_meta.ads +++ b/src/vhdl/nodes_meta.ads @@ -97,6 +97,7 @@ package Nodes_Meta is Field_Literal_Origin, Field_Range_Origin, Field_Literal_Subtype, + Field_Allocator_Subtype, Field_Entity_Class, Field_Entity_Name_List, Field_Attribute_Designator, @@ -574,6 +575,7 @@ package Nodes_Meta is function Has_Literal_Origin (K : Iir_Kind) return Boolean; function Has_Range_Origin (K : Iir_Kind) return Boolean; function Has_Literal_Subtype (K : Iir_Kind) return Boolean; + function Has_Allocator_Subtype (K : Iir_Kind) return Boolean; function Has_Entity_Class (K : Iir_Kind) return Boolean; function Has_Entity_Name_List (K : Iir_Kind) return Boolean; function Has_Attribute_Designator (K : Iir_Kind) return Boolean; diff --git a/src/vhdl/sem_expr.adb b/src/vhdl/sem_expr.adb index 1cab4d1..ec796b9 100644 --- a/src/vhdl/sem_expr.adb +++ b/src/vhdl/sem_expr.adb @@ -3640,7 +3640,9 @@ package body Sem_Expr is Check_Read (Arg); Set_Expression (Expr, Arg); Arg_Type := Get_Type (Arg); + when Iir_Kind_Allocator_By_Subtype => + -- Analyze subtype indication. Arg := Get_Subtype_Indication (Expr); Arg := Sem_Types.Sem_Subtype_Indication (Arg); Set_Subtype_Indication (Expr, Arg); @@ -3648,6 +3650,10 @@ package body Sem_Expr is if Arg = Null_Iir or else Is_Error (Arg) then return Null_Iir; end if; + if Is_Anonymous_Type_Definition (Arg) then + Set_Allocator_Subtype (Expr, Get_Subtype_Indication (Expr)); + end if; + -- LRM93 7.3.6 -- If an allocator includes a subtype indication and if the -- type of the object created is an array type, then the diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb index 1b18e0a..5fa301b 100644 --- a/src/vhdl/translate/trans-chap2.adb +++ b/src/vhdl/translate/trans-chap2.adb @@ -866,11 +866,9 @@ package body Trans.Chap2 is C => null, Ortho_Type => Src.Ortho_Type, Ortho_Ptr_Type => Src.Ortho_Ptr_Type, - Type_Transient_Chain => Null_Iir, T => Src.T, Type_Rti => Src.Type_Rti); pragma Assert (Src.C = null); - pragma Assert (Src.Type_Transient_Chain = Null_Iir); when Kind_Object => Dest.all := (Kind => Kind_Object, diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb index cb58488..6ab2802 100644 --- a/src/vhdl/translate/trans-chap3.adb +++ b/src/vhdl/translate/trans-chap3.adb @@ -2180,8 +2180,7 @@ package body Trans.Chap3 is Pop_Identifier_Prefix (Mark); end Translate_Named_Type_Definition; - procedure Translate_Anonymous_Type_Definition - (Def : Iir; Transient : Boolean) + procedure Translate_Anonymous_Type_Definition (Def : Iir) is Type_Info : constant Type_Info_Acc := Get_Info (Def); Mark : Id_Mark_Type; @@ -2191,9 +2190,6 @@ package body Trans.Chap3 is end if; Push_Identifier_Prefix_Uniq (Mark); Chap3.Translate_Type_Definition (Def, False); - if Transient then - Add_Transient_Type_In_Temp (Def); - end if; Pop_Identifier_Prefix (Mark); end Translate_Anonymous_Type_Definition; @@ -2550,7 +2546,7 @@ package body Trans.Chap3 is Maybe_Call_Type_Builder (Res, Arr_Type); end Allocate_Fat_Array_Base; - procedure Create_Array_Subtype (Sub_Type : Iir; Transient : Boolean) + procedure Create_Array_Subtype (Sub_Type : Iir) is Mark : Id_Mark_Type; begin @@ -2558,9 +2554,6 @@ package body Trans.Chap3 is if Get_Info (Sub_Type) = null then -- Minimal subtype creation. Translate_Type_Definition (Sub_Type, False); - if Transient then - Add_Transient_Type_In_Temp (Sub_Type); - end if; end if; -- Force creation of variables. Chap3.Create_Array_Subtype_Bounds_Var (Sub_Type, True); diff --git a/src/vhdl/translate/trans-chap3.ads b/src/vhdl/translate/trans-chap3.ads index 69d1137..459b1c8 100644 --- a/src/vhdl/translate/trans-chap3.ads +++ b/src/vhdl/translate/trans-chap3.ads @@ -41,16 +41,14 @@ package Trans.Chap3 is (Def : Iir; With_Vars : Boolean := True); procedure Translate_Named_Type_Definition (Def : Iir; Id : Name_Id); - procedure Translate_Anonymous_Type_Definition - (Def : Iir; Transient : Boolean); + procedure Translate_Anonymous_Type_Definition (Def : Iir); -- Translate subprograms for types. procedure Translate_Type_Subprograms (Decl : Iir); procedure Create_Type_Definition_Type_Range (Def : Iir); function Create_Static_Array_Subtype_Bounds - (Def : Iir_Array_Subtype_Definition) - return O_Cnode; + (Def : Iir_Array_Subtype_Definition) return O_Cnode; -- Same as Translate_type_definition only for std.standard.boolean and -- std.standard.bit. @@ -222,7 +220,7 @@ package Trans.Chap3 is -- Create the bounds for SUB_TYPE. -- SUB_TYPE is expected to be a non-static, anonymous array type. - procedure Create_Array_Subtype (Sub_Type : Iir; Transient : Boolean); + procedure Create_Array_Subtype (Sub_Type : Iir); -- Return TRUE if VALUE is not is the range specified by ATYPE. -- VALUE must be stable. diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb index 34521c0..848daf8 100644 --- a/src/vhdl/translate/trans-chap4.adb +++ b/src/vhdl/translate/trans-chap4.adb @@ -464,7 +464,7 @@ package body Trans.Chap4 is Aggr_Type : Iir; begin Aggr_Type := Get_Type (Value); - Chap3.Create_Array_Subtype (Aggr_Type, True); + Chap3.Create_Array_Subtype (Aggr_Type); Name_Node := Stabilize (Name); New_Assign_Stmt (M2Lp (Chap3.Get_Array_Bounds (Name_Node)), @@ -502,7 +502,6 @@ package body Trans.Chap4 is else Chap3.Translate_Object_Copy (Name, Value_Node, Obj_Type); end if; - Destroy_Local_Transient_Types; end if; end Elab_Object_Init; @@ -2264,8 +2263,8 @@ package body Trans.Chap4 is (Mark3, Get_Identifier (Get_Association_Interface (Assoc))); -- Handle anonymous subtypes. - Chap3.Translate_Anonymous_Type_Definition (Out_Type, False); - Chap3.Translate_Anonymous_Type_Definition (In_Type, False); + Chap3.Translate_Anonymous_Type_Definition (Out_Type); + Chap3.Translate_Anonymous_Type_Definition (In_Type); Out_Info := Get_Info (Out_Type); In_Info := Get_Info (In_Type); diff --git a/src/vhdl/translate/trans-chap5.adb b/src/vhdl/translate/trans-chap5.adb index e6ac7e5..7897d8e 100644 --- a/src/vhdl/translate/trans-chap5.adb +++ b/src/vhdl/translate/trans-chap5.adb @@ -344,7 +344,7 @@ package body Trans.Chap5 is begin Open_Temp; if Is_Fully_Constrained_Type (Actual_Type) then - Chap3.Create_Array_Subtype (Actual_Type, False); + Chap3.Create_Array_Subtype (Actual_Type); Tinfo := Get_Info (Actual_Type); Bounds := Chap3.Get_Array_Type_Bounds (Actual_Type); if Get_Alloc_Kind_For_Var (Tinfo.T.Array_Bounds) = Alloc_Stack then @@ -574,7 +574,7 @@ package body Trans.Chap5 is Chap4.Allocate_Complex_Object (Formal_Type, Alloc_System, Formal_Node); else - Chap3.Create_Array_Subtype (Obj_Type, False); + 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); @@ -649,7 +649,7 @@ package body Trans.Chap5 is begin Actual_Type := Get_Type (Get_Default_Value (Formal_Base)); - Chap3.Create_Array_Subtype (Actual_Type, True); + Chap3.Create_Array_Subtype (Actual_Type); Bounds := Chap3.Get_Array_Type_Bounds (Actual_Type); Formal_Node := Chap6.Translate_Name (Formal); New_Assign_Stmt @@ -663,7 +663,7 @@ package body Trans.Chap5 is Formal_Node : Mnode; begin Actual_Type := Get_Actual_Type (Assoc); - Chap3.Create_Array_Subtype (Actual_Type, False); + Chap3.Create_Array_Subtype (Actual_Type); Bounds := Chap3.Get_Array_Type_Bounds (Actual_Type); Formal_Node := Chap6.Translate_Name (Formal); New_Assign_Stmt diff --git a/src/vhdl/translate/trans-chap6.adb b/src/vhdl/translate/trans-chap6.adb index 368b3d6..9640f44 100644 --- a/src/vhdl/translate/trans-chap6.adb +++ b/src/vhdl/translate/trans-chap6.adb @@ -503,7 +503,7 @@ package body Trans.Chap6 is If_Blk, If_Blk1 : O_If_Block; begin -- Evaluate slice bounds. - Chap3.Create_Array_Subtype (Slice_Type, True); + Chap3.Create_Array_Subtype (Slice_Type); -- The info may have just been created. Prefix_Info := Get_Info (Prefix_Type); diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb index 0b2479d..7f12ff1 100644 --- a/src/vhdl/translate/trans-chap7.adb +++ b/src/vhdl/translate/trans-chap7.adb @@ -225,7 +225,7 @@ package body Trans.Chap7 is List : O_Array_Aggr_List; Res : O_Cnode; begin - Chap3.Translate_Anonymous_Type_Definition (Aggr_Type, False); + Chap3.Translate_Anonymous_Type_Definition (Aggr_Type); Start_Array_Aggr (List, Get_Ortho_Type (Aggr_Type, Mode_Value)); Translate_Static_Aggregate_1 @@ -243,7 +243,7 @@ package body Trans.Chap7 is List : O_Array_Aggr_List; Res : O_Cnode; begin - Chap3.Translate_Anonymous_Type_Definition (Aggr_Type, False); + Chap3.Translate_Anonymous_Type_Definition (Aggr_Type); Start_Array_Aggr (List, Get_Ortho_Type (Aggr_Type, Mode_Value)); for I in Natural loop @@ -267,7 +267,7 @@ package body Trans.Chap7 is List : O_Array_Aggr_List; Res : O_Cnode; begin - Chap3.Translate_Anonymous_Type_Definition (Lit_Type, True); + Chap3.Translate_Anonymous_Type_Definition (Lit_Type); Arr_Type := Get_Ortho_Type (Lit_Type, Mode_Value); Start_Array_Aggr (List, Arr_Type); @@ -413,7 +413,7 @@ package body Trans.Chap7 is List : O_Array_Aggr_List; Res : O_Cnode; begin - Chap3.Translate_Anonymous_Type_Definition (Str_Type, True); + Chap3.Translate_Anonymous_Type_Definition (Str_Type); Start_Array_Aggr (List, Get_Ortho_Type (Str_Type, Mode_Value)); @@ -440,7 +440,7 @@ package body Trans.Chap7 is if Get_Constraint_State (Str_Type) = Fully_Constrained and then Get_Type_Staticness (Get_Index_Type (Str_Type, 0)) = Locally then - Chap3.Create_Array_Subtype (Str_Type, False); + Chap3.Create_Array_Subtype (Str_Type); case Get_Kind (Str) is when Iir_Kind_String_Literal8 => Res := Translate_Static_String_Literal8 (Str); @@ -3126,8 +3126,7 @@ package body Trans.Chap7 is A_Range : Mnode; begin -- Evaluate the range. - Chap3.Translate_Anonymous_Type_Definition - (Subaggr_Type, True); + Chap3.Translate_Anonymous_Type_Definition (Subaggr_Type); A_Range := Dv2M (Create_Temp (Rinfo.T.Range_Type), Rinfo, Mode_Value, @@ -3234,7 +3233,7 @@ package body Trans.Chap7 is -- FIXME: creating aggregate subtype is expensive and rarely used. -- (one of the current use - only ? - is check_array_match). - Chap3.Translate_Anonymous_Type_Definition (Aggr_Type, False); + Chap3.Translate_Anonymous_Type_Definition (Aggr_Type); end Translate_Array_Aggregate; procedure Translate_Aggregate @@ -3367,7 +3366,7 @@ package body Trans.Chap7 is begin Sub_Type := Get_Subtype_Indication (Expr); Sub_Type := Get_Type_Of_Subtype_Indication (Sub_Type); - Chap3.Create_Array_Subtype (Sub_Type, True); + Chap3.Create_Array_Subtype (Sub_Type); Ptr := Create_Temp (A_Info.Ortho_Type (Mode_Value)); @@ -3825,7 +3824,7 @@ package body Trans.Chap7 is if Get_Kind (Aggr_Type) = Iir_Kind_Array_Subtype_Definition then - Chap3.Create_Array_Subtype (Aggr_Type, True); + Chap3.Create_Array_Subtype (Aggr_Type); end if; -- FIXME: this may be not necessary diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb index e291efe..a30a68e 100644 --- a/src/vhdl/translate/trans-chap8.adb +++ b/src/vhdl/translate/trans-chap8.adb @@ -614,7 +614,7 @@ package body Trans.Chap8 is E : O_Enode; Temp : Mnode; begin - Chap3.Translate_Anonymous_Type_Definition (Targ_Type, True); + Chap3.Translate_Anonymous_Type_Definition (Targ_Type); -- Use a temporary variable, to avoid overlap. Temp := Create_Temp (Get_Info (Targ_Type)); @@ -1810,7 +1810,7 @@ package body Trans.Chap8 is if Ftype_Info.Type_Mode = Type_Mode_Fat_Array then -- Create the constraints and then the object. - Chap3.Create_Array_Subtype (Actual_Type, True); + Chap3.Create_Array_Subtype (Actual_Type); Bounds := Chap3.Get_Array_Type_Bounds (Actual_Type); Param := Create_Temp (Ftype_Info, Formal_Object_Kind); Chap3.Translate_Object_Allocation @@ -2066,16 +2066,15 @@ package body Trans.Chap8 is procedure Translate_Wait_Statement (Stmt : Iir) is + Cond : constant Iir := Get_Condition_Clause (Stmt); + Timeout : constant Iir := Get_Timeout_Clause (Stmt); Sensitivity : Iir_List; - Cond : Iir; - Timeout : Iir; Constr : O_Assoc_List; begin Sensitivity := Get_Sensitivity_List (Stmt); - Cond := Get_Condition_Clause (Stmt); - Timeout := Get_Timeout_Clause (Stmt); if Sensitivity = Null_Iir_List and Cond /= Null_Iir then + -- Extract sensitivity list. Sensitivity := Create_Iir_List; Canon.Canon_Extract_Sensitivity (Cond, Sensitivity); Set_Sensitivity_List (Stmt, Sensitivity); @@ -2111,6 +2110,7 @@ package body Trans.Chap8 is if Sensitivity /= Null_Iir_List then Register_Signal_List (Sensitivity, Ghdl_Process_Wait_Add_Sensitivity); + Chap9.Destroy_Types_In_List (Sensitivity); end if; if Cond = Null_Iir then @@ -2770,20 +2770,19 @@ package body Trans.Chap8 is Get_Info (Target_Type), Mode_Value); Arg.Expr_Node := We; Gen_Signal_Direct_Assign (Targ_Sig, Target_Type, Arg); + Chap9.Destroy_Types (Target); end Translate_Direct_Signal_Assignment; procedure Translate_Signal_Assignment_Statement (Stmt : Iir) is - Target : Iir; - Target_Type : Iir; + Target : constant Iir := Get_Target (Stmt); + Target_Type : constant Iir := Get_Type (Target); We : Iir_Waveform_Element; Targ : Mnode; Val : O_Enode; Value : Iir; Is_Simple : Boolean; begin - Target := Get_Target (Stmt); - Target_Type := Get_Type (Target); We := Get_Waveform_Chain (Stmt); if We /= Null_Iir @@ -2800,7 +2799,7 @@ package body Trans.Chap8 is end if; if Get_Kind (Target) = Iir_Kind_Aggregate then - Chap3.Translate_Anonymous_Type_Definition (Target_Type, True); + Chap3.Translate_Anonymous_Type_Definition (Target_Type); Targ := Create_Temp (Get_Info (Target_Type), Mode_Signal); Chap4.Allocate_Complex_Object (Target_Type, Alloc_Stack, Targ); Translate_Signal_Target_Aggr (Targ, Target, Target_Type); @@ -2813,14 +2812,13 @@ package body Trans.Chap8 is return; end if; Targ := Chap6.Translate_Name (Target); - if Get_Object_Kind (Targ) /= Mode_Signal then - raise Internal_Error; - end if; + pragma Assert (Get_Object_Kind (Targ) = Mode_Signal); end if; if We = Null_Iir then -- Implicit disconnect statment. Register_Signal (Targ, Target_Type, Ghdl_Signal_Disconnect); + Chap9.Destroy_Types (Target); return; end if; @@ -2836,6 +2834,7 @@ package body Trans.Chap8 is then Val := Chap7.Translate_Expression (Value, Target_Type); Gen_Simple_Signal_Assign (Targ, Target_Type, Val); + Chap9.Destroy_Types (Target); return; end if; @@ -2934,6 +2933,7 @@ package body Trans.Chap8 is Close_Temp; end; + Chap9.Destroy_Types (Target); end Translate_Signal_Assignment_Statement; procedure Translate_Statement (Stmt : Iir) diff --git a/src/vhdl/translate/trans-chap9.adb b/src/vhdl/translate/trans-chap9.adb index e17dc2e..d96ad6f 100644 --- a/src/vhdl/translate/trans-chap9.adb +++ b/src/vhdl/translate/trans-chap9.adb @@ -1040,7 +1040,8 @@ package body Trans.Chap9 is F := Fields (I); case F is when Field_Literal_Subtype - | Field_Slice_Subtype => + | Field_Slice_Subtype + | Field_Allocator_Subtype => declare T : constant Iir := Get_Iir (N, F); Info : Type_Info_Acc; @@ -1280,6 +1281,7 @@ package body Trans.Chap9 is Get_Type (Sig), Ghdl_Process_Add_Driver); end if; + Chap9.Destroy_Types (Sig); Close_Temp; end loop; end; @@ -1302,6 +1304,8 @@ package body Trans.Chap9 is else List := List_Orig; end if; + -- For extracted sensitivity, any signal can appear in the list. + -- Remove transient types now. Destroy_Types_In_List (List); Register_Signal_List (List, Ghdl_Process_Add_Sensitivity); if List_Orig = Iir_List_All then diff --git a/src/vhdl/translate/trans-chap9.ads b/src/vhdl/translate/trans-chap9.ads index 748911b..61b1f9c 100644 --- a/src/vhdl/translate/trans-chap9.ads +++ b/src/vhdl/translate/trans-chap9.ads @@ -37,5 +37,6 @@ package Trans.Chap9 is -- This is not the case for elaborator subprogram (which may references -- slices in the sensitivity or driver list) and the process subprg. procedure Destroy_Types (N : Iir); + procedure Destroy_Types_In_List (L : Iir_List); end Trans.Chap9; diff --git a/src/vhdl/translate/trans.adb b/src/vhdl/translate/trans.adb index de5abc3..e8ba4a0 100644 --- a/src/vhdl/translate/trans.adb +++ b/src/vhdl/translate/trans.adb @@ -1768,9 +1768,6 @@ package body Trans is -- Declaration of the variable for the stack2 mark. The stack2 will -- be released at the end of the scope (if used). Stack2_Mark : O_Dnode; - - -- List of transient types to be removed at the end of the scope. - Transient_Types : Iir; end record; -- Current level. Temp_Level : Temp_Level_Acc := null; @@ -1796,8 +1793,7 @@ package body Trans is Level => 0, Id => 0, Emitted => False, - Stack2_Mark => O_Dnode_Null, - Transient_Types => Null_Iir); + Stack2_Mark => O_Dnode_Null); if Temp_Level /= null then L.Level := Temp_Level.Level + 1; end if; @@ -1814,42 +1810,6 @@ package body Trans is Temp_Level.Emitted := True; end Open_Local_Temp; - procedure Add_Transient_Type_In_Temp (Atype : Iir) - is - Type_Info : Type_Info_Acc; - begin - Type_Info := Get_Info (Atype); - Type_Info.Type_Transient_Chain := Temp_Level.Transient_Types; - Temp_Level.Transient_Types := Atype; - end Add_Transient_Type_In_Temp; - - -- Some expressions may be evaluated several times in different - -- contexts. Type info created for these expressions may not be - -- shared between these contexts. - procedure Destroy_Type_Info (Atype : Iir) - is - Type_Info : Type_Info_Acc; - begin - Type_Info := Get_Info (Atype); - Free_Type_Info (Type_Info); - Clear_Info (Atype); - end Destroy_Type_Info; - - procedure Release_Transient_Types (Chain : in out Iir) is - N_Atype : Iir; - begin - while Chain /= Null_Iir loop - N_Atype := Get_Info (Chain).Type_Transient_Chain; - Destroy_Type_Info (Chain); - Chain := N_Atype; - end loop; - end Release_Transient_Types; - - procedure Destroy_Local_Transient_Types is - begin - Release_Transient_Types (Temp_Level.Transient_Types); - end Destroy_Local_Transient_Types; - function Has_Stack2_Mark return Boolean is begin return Temp_Level.Stack2_Mark /= O_Dnode_Null; @@ -1888,9 +1848,6 @@ package body Trans is Finish_Declare_Stmt; end if; - -- Destroy transcient types. - Release_Transient_Types (Temp_Level.Transient_Types); - -- Unlink temp_level. L := Temp_Level; Temp_Level := L.Prev; diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads index b135929..47c050b 100644 --- a/src/vhdl/translate/trans.ads +++ b/src/vhdl/translate/trans.ads @@ -1103,9 +1103,6 @@ package Trans is -- ortho_type. Ortho_Ptr_Type : O_Tnode_Array; - -- Chain of temporary types to be destroyed at end of scope. - Type_Transient_Chain : Iir := Null_Iir; - -- More info according to the type. T : Ortho_Info_Type_Type; @@ -1723,19 +1720,6 @@ package Trans is -- stack2 can be released. procedure Create_Temp_Stack2_Mark; - -- Some constructs (slices, aggregates) implicitly define a subtype. - -- This subtype (and its bounds) is created dynamically and its life - -- is short. - -- However, in some cases (default expression, target of signal - -- assignment) the construct may be evaluated several time (eg: to - -- compute the drivers). In that case, bounds are created many times - -- and therefore must be forgotten at the end of its life to avoid any - -- incorrect reuse. - -- - -- Add ATYPE in the chain of types to be destroyed at the end of the - -- temp scope. - procedure Add_Transient_Type_In_Temp (Atype : Iir); - -- Close the temporary region. procedure Close_Temp; @@ -1743,8 +1727,6 @@ package Trans is -- only within a subprogram, to use the declare region of the -- subprogram. procedure Open_Local_Temp; - -- Destroy transient types created in a temporary region. - procedure Destroy_Local_Transient_Types; procedure Close_Local_Temp; -- Return TRUE if stack2 will be released. Used for fine-tuning only |