diff options
Diffstat (limited to 'src/vhdl')
| -rw-r--r-- | src/vhdl/translate/trans-chap4.adb | 4 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap6.adb | 4 | ||||
| -rw-r--r-- | src/vhdl/vhdl-nodes.adb | 16 | ||||
| -rw-r--r-- | src/vhdl/vhdl-nodes.ads | 14 | ||||
| -rw-r--r-- | src/vhdl/vhdl-nodes_meta.adb | 162 | ||||
| -rw-r--r-- | src/vhdl/vhdl-nodes_meta.ads | 2 | ||||
| -rw-r--r-- | src/vhdl/vhdl-sem.adb | 98 | ||||
| -rw-r--r-- | src/vhdl/vhdl-sem_names.adb | 1 | ||||
| -rw-r--r-- | src/vhdl/vhdl-sem_stmts.adb | 13 | ||||
| -rw-r--r-- | src/vhdl/vhdl-utils.adb | 15 |
10 files changed, 135 insertions, 194 deletions
diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb index 37ca1646b..5a412dd08 100644 --- a/src/vhdl/translate/trans-chap4.adb +++ b/src/vhdl/translate/trans-chap4.adb @@ -2864,6 +2864,7 @@ package body Trans.Chap4 is (El_List, Conv_Info.Instance_Field, Wki_Instance, Block_Info.Block_Decls_Ptr_Type); + -- Add instance field for the entity in case of direct instantiation. if Entity /= Null_Iir then Conv_Info.Instantiated_Entity := Entity; Entity_Info := Get_Info (Entity); @@ -3137,6 +3138,9 @@ package body Trans.Chap4 is end loop; end Translate_Association_Subprograms; + -- Register conversion CONV in association between SIG_IN and SIG_OUT. + -- This procedure allocates a record data (described by INFO), fill it + -- with addresses of signals and register it to REG_SUBPRG. procedure Elab_Conversion (Sig_In : Iir; Sig_Out : Iir; Conv : Iir; diff --git a/src/vhdl/translate/trans-chap6.adb b/src/vhdl/translate/trans-chap6.adb index f380efb07..02ed20f1e 100644 --- a/src/vhdl/translate/trans-chap6.adb +++ b/src/vhdl/translate/trans-chap6.adb @@ -302,6 +302,7 @@ package body Trans.Chap6 is Cond1, Cond2 : O_Enode; Cond : O_Enode; begin + -- FIXME: not correct for enumerations Cond1 := New_Compare_Op (ON_Lt, New_Obj_Value (Off), @@ -1133,7 +1134,8 @@ package body Trans.Chap6 is begin pragma Assert (Mode <= Name_Info.Alias_Kind); case Type_Info.Type_Mode is - when Type_Mode_Unbounded_Array => + when Type_Mode_Unbounded_Array + | Type_Mode_Unbounded_Record => return Get_Var (Name_Info.Alias_Var (Mode), Type_Info, Mode); when Type_Mode_Bounded_Arrays diff --git a/src/vhdl/vhdl-nodes.adb b/src/vhdl/vhdl-nodes.adb index 8acd7f6ac..b5dd5e0bd 100644 --- a/src/vhdl/vhdl-nodes.adb +++ b/src/vhdl/vhdl-nodes.adb @@ -5762,22 +5762,6 @@ package body Vhdl.Nodes is Set_Field4 (Name, Val); end Set_Named_Entity; - function Get_Alias_Declaration (Name : Iir) return Iir is - begin - pragma Assert (Name /= Null_Iir); - pragma Assert (Has_Alias_Declaration (Get_Kind (Name)), - "no field Alias_Declaration"); - return Get_Field2 (Name); - end Get_Alias_Declaration; - - procedure Set_Alias_Declaration (Name : Iir; Val : Iir) is - begin - pragma Assert (Name /= Null_Iir); - pragma Assert (Has_Alias_Declaration (Get_Kind (Name)), - "no field Alias_Declaration"); - Set_Field2 (Name, Val); - end Set_Alias_Declaration; - function Get_Referenced_Name (N : Iir) return Iir is begin pragma Assert (N /= Null_Iir); diff --git a/src/vhdl/vhdl-nodes.ads b/src/vhdl/vhdl-nodes.ads index 7d79ca43d..da01e6bc4 100644 --- a/src/vhdl/vhdl-nodes.ads +++ b/src/vhdl/vhdl-nodes.ads @@ -4310,8 +4310,6 @@ package Vhdl.Nodes is -- -- Get/Set_Type (Field1) -- - -- Get/Set_Alias_Declaration (Field2) - -- -- Get/Set_Identifier (Field3) -- -- Get/Set_Named_Entity (Field4) @@ -4328,8 +4326,6 @@ package Vhdl.Nodes is -- -- Get/Set_Type (Field1) -- - -- Get/Set_Alias_Declaration (Field2) - -- -- Get/Set_Identifier (Field3) -- -- Get/Set_Named_Entity (Field4) @@ -4346,8 +4342,6 @@ package Vhdl.Nodes is -- -- Get/Set_Type (Field1) -- - -- Get/Set_Alias_Declaration (Field2) - -- -- Get/Set_Identifier (Field3) -- -- Get/Set_Named_Entity (Field4) @@ -4379,8 +4373,6 @@ package Vhdl.Nodes is -- -- Get/Set_Type (Field1) -- - -- Get/Set_Alias_Declaration (Field2) - -- -- Get/Set_Identifier (Field3) -- -- Get/Set_Named_Entity (Field4) @@ -8788,12 +8780,6 @@ package Vhdl.Nodes is function Get_Named_Entity (Name : Iir) return Iir; procedure Set_Named_Entity (Name : Iir; Val : Iir); - -- If a name designate a non-object alias, the designated alias. - -- Named_Entity will designate the aliased entity. - -- Field: Field2 Ref - function Get_Alias_Declaration (Name : Iir) return Iir; - procedure Set_Alias_Declaration (Name : Iir; Val : Iir); - -- Field: Field2 Ref function Get_Referenced_Name (N : Iir) return Iir; procedure Set_Referenced_Name (N : Iir; Name : Iir); diff --git a/src/vhdl/vhdl-nodes_meta.adb b/src/vhdl/vhdl-nodes_meta.adb index bd85e083c..91f764376 100644 --- a/src/vhdl/vhdl-nodes_meta.adb +++ b/src/vhdl/vhdl-nodes_meta.adb @@ -289,7 +289,6 @@ package body Vhdl.Nodes_Meta is Field_Default_Entity_Aspect => Type_Iir, Field_Binding_Indication => Type_Iir, Field_Named_Entity => Type_Iir, - Field_Alias_Declaration => Type_Iir, Field_Referenced_Name => Type_Iir, Field_Expr_Staticness => Type_Iir_Staticness, Field_Scalar_Size => Type_Scalar_Size, @@ -942,8 +941,6 @@ package body Vhdl.Nodes_Meta is return "binding_indication"; when Field_Named_Entity => return "named_entity"; - when Field_Alias_Declaration => - return "alias_declaration"; when Field_Referenced_Name => return "referenced_name"; when Field_Expr_Staticness => @@ -2332,8 +2329,6 @@ package body Vhdl.Nodes_Meta is return Attr_Maybe_Ref; when Field_Named_Entity => return Attr_Maybe_Forward_Ref; - when Field_Alias_Declaration => - return Attr_Ref; when Field_Referenced_Name => return Attr_Ref; when Field_Expr_Staticness => @@ -4767,7 +4762,6 @@ package body Vhdl.Nodes_Meta is Field_Expr_Staticness, Field_Name_Staticness, Field_Type, - Field_Alias_Declaration, Field_Named_Entity, Field_Base_Name, -- Iir_Kind_Simple_Name @@ -4776,7 +4770,6 @@ package body Vhdl.Nodes_Meta is Field_Expr_Staticness, Field_Name_Staticness, Field_Type, - Field_Alias_Declaration, Field_Named_Entity, Field_Base_Name, -- Iir_Kind_Selected_Name @@ -4786,14 +4779,12 @@ package body Vhdl.Nodes_Meta is Field_Name_Staticness, Field_Prefix, Field_Type, - Field_Alias_Declaration, Field_Named_Entity, Field_Base_Name, -- Iir_Kind_Operator_Symbol Field_Identifier, Field_Is_Forward_Ref, Field_Type, - Field_Alias_Declaration, Field_Named_Entity, Field_Base_Name, -- Iir_Kind_Reference_Name @@ -5494,74 +5485,74 @@ package body Vhdl.Nodes_Meta is Iir_Kind_Break_Statement => 1959, Iir_Kind_If_Statement => 1969, Iir_Kind_Elsif => 1975, - Iir_Kind_Character_Literal => 1983, - Iir_Kind_Simple_Name => 1991, - Iir_Kind_Selected_Name => 2000, - Iir_Kind_Operator_Symbol => 2006, - Iir_Kind_Reference_Name => 2011, - Iir_Kind_External_Constant_Name => 2020, - Iir_Kind_External_Signal_Name => 2029, - Iir_Kind_External_Variable_Name => 2039, - Iir_Kind_Selected_By_All_Name => 2045, - Iir_Kind_Parenthesis_Name => 2050, - Iir_Kind_Package_Pathname => 2054, - Iir_Kind_Absolute_Pathname => 2055, - Iir_Kind_Relative_Pathname => 2056, - Iir_Kind_Pathname_Element => 2061, - Iir_Kind_Base_Attribute => 2063, - Iir_Kind_Subtype_Attribute => 2068, - Iir_Kind_Element_Attribute => 2073, - Iir_Kind_Across_Attribute => 2078, - Iir_Kind_Through_Attribute => 2083, - Iir_Kind_Nature_Reference_Attribute => 2087, - Iir_Kind_Left_Type_Attribute => 2092, - Iir_Kind_Right_Type_Attribute => 2097, - Iir_Kind_High_Type_Attribute => 2102, - Iir_Kind_Low_Type_Attribute => 2107, - Iir_Kind_Ascending_Type_Attribute => 2112, - Iir_Kind_Image_Attribute => 2118, - Iir_Kind_Value_Attribute => 2124, - Iir_Kind_Pos_Attribute => 2130, - Iir_Kind_Val_Attribute => 2136, - Iir_Kind_Succ_Attribute => 2142, - Iir_Kind_Pred_Attribute => 2148, - Iir_Kind_Leftof_Attribute => 2154, - Iir_Kind_Rightof_Attribute => 2160, - Iir_Kind_Signal_Slew_Attribute => 2168, - Iir_Kind_Quantity_Slew_Attribute => 2176, - Iir_Kind_Ramp_Attribute => 2184, - Iir_Kind_Zoh_Attribute => 2192, - Iir_Kind_Ltf_Attribute => 2200, - Iir_Kind_Ztf_Attribute => 2210, - Iir_Kind_Dot_Attribute => 2217, - Iir_Kind_Integ_Attribute => 2224, - Iir_Kind_Above_Attribute => 2232, - Iir_Kind_Quantity_Delayed_Attribute => 2240, - Iir_Kind_Delayed_Attribute => 2249, - Iir_Kind_Stable_Attribute => 2258, - Iir_Kind_Quiet_Attribute => 2267, - Iir_Kind_Transaction_Attribute => 2276, - Iir_Kind_Event_Attribute => 2280, - Iir_Kind_Active_Attribute => 2284, - Iir_Kind_Last_Event_Attribute => 2288, - Iir_Kind_Last_Active_Attribute => 2292, - Iir_Kind_Last_Value_Attribute => 2296, - Iir_Kind_Driving_Attribute => 2300, - Iir_Kind_Driving_Value_Attribute => 2304, - Iir_Kind_Behavior_Attribute => 2304, - Iir_Kind_Structure_Attribute => 2304, - Iir_Kind_Simple_Name_Attribute => 2311, - Iir_Kind_Instance_Name_Attribute => 2316, - Iir_Kind_Path_Name_Attribute => 2321, - Iir_Kind_Left_Array_Attribute => 2328, - Iir_Kind_Right_Array_Attribute => 2335, - Iir_Kind_High_Array_Attribute => 2342, - Iir_Kind_Low_Array_Attribute => 2349, - Iir_Kind_Length_Array_Attribute => 2356, - Iir_Kind_Ascending_Array_Attribute => 2363, - Iir_Kind_Range_Array_Attribute => 2370, - Iir_Kind_Reverse_Range_Array_Attribute => 2377, - Iir_Kind_Attribute_Name => 2386 + Iir_Kind_Character_Literal => 1982, + Iir_Kind_Simple_Name => 1989, + Iir_Kind_Selected_Name => 1997, + Iir_Kind_Operator_Symbol => 2002, + Iir_Kind_Reference_Name => 2007, + Iir_Kind_External_Constant_Name => 2016, + Iir_Kind_External_Signal_Name => 2025, + Iir_Kind_External_Variable_Name => 2035, + Iir_Kind_Selected_By_All_Name => 2041, + Iir_Kind_Parenthesis_Name => 2046, + Iir_Kind_Package_Pathname => 2050, + Iir_Kind_Absolute_Pathname => 2051, + Iir_Kind_Relative_Pathname => 2052, + Iir_Kind_Pathname_Element => 2057, + Iir_Kind_Base_Attribute => 2059, + Iir_Kind_Subtype_Attribute => 2064, + Iir_Kind_Element_Attribute => 2069, + Iir_Kind_Across_Attribute => 2074, + Iir_Kind_Through_Attribute => 2079, + Iir_Kind_Nature_Reference_Attribute => 2083, + Iir_Kind_Left_Type_Attribute => 2088, + Iir_Kind_Right_Type_Attribute => 2093, + Iir_Kind_High_Type_Attribute => 2098, + Iir_Kind_Low_Type_Attribute => 2103, + Iir_Kind_Ascending_Type_Attribute => 2108, + Iir_Kind_Image_Attribute => 2114, + Iir_Kind_Value_Attribute => 2120, + Iir_Kind_Pos_Attribute => 2126, + Iir_Kind_Val_Attribute => 2132, + Iir_Kind_Succ_Attribute => 2138, + Iir_Kind_Pred_Attribute => 2144, + Iir_Kind_Leftof_Attribute => 2150, + Iir_Kind_Rightof_Attribute => 2156, + Iir_Kind_Signal_Slew_Attribute => 2164, + Iir_Kind_Quantity_Slew_Attribute => 2172, + Iir_Kind_Ramp_Attribute => 2180, + Iir_Kind_Zoh_Attribute => 2188, + Iir_Kind_Ltf_Attribute => 2196, + Iir_Kind_Ztf_Attribute => 2206, + Iir_Kind_Dot_Attribute => 2213, + Iir_Kind_Integ_Attribute => 2220, + Iir_Kind_Above_Attribute => 2228, + Iir_Kind_Quantity_Delayed_Attribute => 2236, + Iir_Kind_Delayed_Attribute => 2245, + Iir_Kind_Stable_Attribute => 2254, + Iir_Kind_Quiet_Attribute => 2263, + Iir_Kind_Transaction_Attribute => 2272, + Iir_Kind_Event_Attribute => 2276, + Iir_Kind_Active_Attribute => 2280, + Iir_Kind_Last_Event_Attribute => 2284, + Iir_Kind_Last_Active_Attribute => 2288, + Iir_Kind_Last_Value_Attribute => 2292, + Iir_Kind_Driving_Attribute => 2296, + Iir_Kind_Driving_Value_Attribute => 2300, + Iir_Kind_Behavior_Attribute => 2300, + Iir_Kind_Structure_Attribute => 2300, + Iir_Kind_Simple_Name_Attribute => 2307, + Iir_Kind_Instance_Name_Attribute => 2312, + Iir_Kind_Path_Name_Attribute => 2317, + Iir_Kind_Left_Array_Attribute => 2324, + Iir_Kind_Right_Array_Attribute => 2331, + Iir_Kind_High_Array_Attribute => 2338, + Iir_Kind_Low_Array_Attribute => 2345, + Iir_Kind_Length_Array_Attribute => 2352, + Iir_Kind_Ascending_Array_Attribute => 2359, + Iir_Kind_Range_Array_Attribute => 2366, + Iir_Kind_Reverse_Range_Array_Attribute => 2373, + Iir_Kind_Attribute_Name => 2382 ); function Get_Fields_First (K : Iir_Kind) return Fields_Index is @@ -6360,8 +6351,6 @@ package body Vhdl.Nodes_Meta is return Get_Binding_Indication (N); when Field_Named_Entity => return Get_Named_Entity (N); - when Field_Alias_Declaration => - return Get_Alias_Declaration (N); when Field_Referenced_Name => return Get_Referenced_Name (N); when Field_Error_Origin => @@ -6818,8 +6807,6 @@ package body Vhdl.Nodes_Meta is Set_Binding_Indication (N, V); when Field_Named_Entity => Set_Named_Entity (N, V); - when Field_Alias_Declaration => - Set_Alias_Declaration (N, V); when Field_Referenced_Name => Set_Referenced_Name (N, V); when Field_Error_Origin => @@ -11124,19 +11111,6 @@ package body Vhdl.Nodes_Meta is end case; end Has_Named_Entity; - function Has_Alias_Declaration (K : Iir_Kind) return Boolean is - begin - case K is - when Iir_Kind_Character_Literal - | Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name - | Iir_Kind_Operator_Symbol => - return True; - when others => - return False; - end case; - end Has_Alias_Declaration; - function Has_Referenced_Name (K : Iir_Kind) return Boolean is begin return K = Iir_Kind_Reference_Name; diff --git a/src/vhdl/vhdl-nodes_meta.ads b/src/vhdl/vhdl-nodes_meta.ads index 65ace54bb..0585fbe93 100644 --- a/src/vhdl/vhdl-nodes_meta.ads +++ b/src/vhdl/vhdl-nodes_meta.ads @@ -333,7 +333,6 @@ package Vhdl.Nodes_Meta is Field_Default_Entity_Aspect, Field_Binding_Indication, Field_Named_Entity, - Field_Alias_Declaration, Field_Referenced_Name, Field_Expr_Staticness, Field_Scalar_Size, @@ -922,7 +921,6 @@ package Vhdl.Nodes_Meta is function Has_Default_Entity_Aspect (K : Iir_Kind) return Boolean; function Has_Binding_Indication (K : Iir_Kind) return Boolean; function Has_Named_Entity (K : Iir_Kind) return Boolean; - function Has_Alias_Declaration (K : Iir_Kind) return Boolean; function Has_Referenced_Name (K : Iir_Kind) return Boolean; function Has_Expr_Staticness (K : Iir_Kind) return Boolean; function Has_Scalar_Size (K : Iir_Kind) return Boolean; diff --git a/src/vhdl/vhdl-sem.adb b/src/vhdl/vhdl-sem.adb index 663adac7b..06b6fbced 100644 --- a/src/vhdl/vhdl-sem.adb +++ b/src/vhdl/vhdl-sem.adb @@ -1367,6 +1367,21 @@ package body Vhdl.Sem is end loop; end Are_Trees_Chain_Equal; + function Are_Trees_List_Equal (Left, Right : Iir_Flist) return Boolean + is + El_Left, El_Right : Iir; + begin + pragma Assert (Flist_Last (Left) = Flist_Last (Right)); + for I in Flist_First .. Flist_Last (Left) loop + El_Left := Get_Nth_Element (Left, I); + El_Right := Get_Nth_Element (Right, I); + if not Are_Trees_Equal (El_Left, El_Right) then + return False; + end if; + end loop; + return True; + end Are_Trees_List_Equal; + -- Return TRUE iff LEFT and RIGHT are (in depth) equal. -- This corresponds to conformance rules, LRM93 2.7 function Are_Trees_Equal (Left, Right : Iir) return Boolean @@ -1489,46 +1504,21 @@ package body Vhdl.Sem is then return False; end if; - declare - L_Left : constant Iir_Flist := Get_Index_Subtype_List (Left); - L_Right : constant Iir_Flist := Get_Index_Subtype_List (Right); - begin - if Get_Nbr_Elements (L_Left) /= Get_Nbr_Elements (L_Right) then - return False; - end if; - for I in Flist_First .. Flist_Last (L_Left) loop - El_Left := Get_Nth_Element (L_Left, I); - El_Right := Get_Nth_Element (L_Right, I); - if not Are_Trees_Equal (El_Left, El_Right) then - return False; - end if; - end loop; - end; + if not Are_Trees_List_Equal (Get_Index_Subtype_List (Left), + Get_Index_Subtype_List (Right)) + then + return False; + end if; return True; when Iir_Kind_Record_Subtype_Definition => if Get_Base_Type (Left) /= Get_Base_Type (Right) then return False; end if; - if not Are_Trees_Equal (Get_Resolution_Indication (Left), + return Are_Trees_Equal (Get_Resolution_Indication (Left), Get_Resolution_Indication (Right)) - then - return False; - end if; - declare - L_Left : constant Iir_Flist := - Get_Elements_Declaration_List (Left); - L_Right : constant Iir_Flist := - Get_Elements_Declaration_List (Right); - begin - for I in Flist_First .. Flist_Last (L_Left) loop - El_Left := Get_Nth_Element (L_Left, I); - El_Right := Get_Nth_Element (L_Right, I); - if not Are_Trees_Equal (El_Left, El_Right) then - return False; - end if; - end loop; - end; - return True; + and then + Are_Trees_List_Equal (Get_Elements_Declaration_List (Left), + Get_Elements_Declaration_List (Right)); when Iir_Kind_Integer_Literal => if Get_Value (Left) /= Get_Value (Right) then @@ -1596,6 +1586,18 @@ package body Vhdl.Sem is Are_Trees_Equal (Get_Expression (Left), Get_Expression (Right)); + when Iir_Kind_Indexed_Name => + return Are_Trees_Equal (Get_Prefix (Left), + Get_Prefix (Right)) + and then + Are_Trees_List_Equal (Get_Index_List (Left), + Get_Index_List (Right)); + when Iir_Kind_Slice_Name => + return Are_Trees_Equal (Get_Prefix (Left), + Get_Prefix (Right)) + and then Are_Trees_Equal (Get_Suffix (Left), + Get_Suffix (Right)); + when Iir_Kind_Access_Type_Definition | Iir_Kind_Record_Type_Definition | Iir_Kind_Array_Type_Definition @@ -1609,14 +1611,10 @@ package body Vhdl.Sem is then return False; end if; - if not Are_Trees_Equal (Get_Left_Limit (Left), + return Are_Trees_Equal (Get_Left_Limit (Left), Get_Left_Limit (Right)) - or else not Are_Trees_Equal (Get_Right_Limit (Left), - Get_Right_Limit (Right)) - then - return False; - end if; - return True; + and then Are_Trees_Equal (Get_Right_Limit (Left), + Get_Right_Limit (Right)); when Iir_Kind_High_Type_Attribute | Iir_Kind_Low_Type_Attribute @@ -1661,21 +1659,9 @@ package body Vhdl.Sem is if not Are_Trees_Equal (Get_Type (Left), Get_Type (Right)) then return False; end if; - declare - El_L, El_R : Iir; - begin - El_L := Get_Association_Choices_Chain (Left); - El_R := Get_Association_Choices_Chain (Right); - loop - exit when El_L = Null_Iir and El_R = Null_Iir; - if not Are_Trees_Equal (El_L, El_R) then - return False; - end if; - El_L := Get_Chain (El_L); - El_R := Get_Chain (El_R); - end loop; - return True; - end; + return Are_Trees_Chain_Equal + (Get_Association_Choices_Chain (Left), + Get_Association_Choices_Chain (Right)); when Iir_Kind_Choice_By_None | Iir_Kind_Choice_By_Others => diff --git a/src/vhdl/vhdl-sem_names.adb b/src/vhdl/vhdl-sem_names.adb index ab4451d77..1ed7c7b64 100644 --- a/src/vhdl/vhdl-sem_names.adb +++ b/src/vhdl/vhdl-sem_names.adb @@ -2152,7 +2152,6 @@ package body Vhdl.Sem_Names is if not Keep_Alias and then Get_Kind (Res) = Iir_Kind_Non_Object_Alias_Declaration then - Set_Alias_Declaration (Name, Res); Res := Get_Named_Entity (Get_Name (Res)); end if; else diff --git a/src/vhdl/vhdl-sem_stmts.adb b/src/vhdl/vhdl-sem_stmts.adb index b0b0447da..b52476f9b 100644 --- a/src/vhdl/vhdl-sem_stmts.adb +++ b/src/vhdl/vhdl-sem_stmts.adb @@ -879,6 +879,7 @@ package body Vhdl.Sem_Stmts is Target : Iir; Target_Type : Iir; Target_Object : Iir; + Target_Prefix : Iir; Expr : Iir; Constrained : Boolean; begin @@ -894,6 +895,7 @@ package body Vhdl.Sem_Stmts is Target := Sem_Expression_Wildcard (Target, Wildcard_Any_Type); Target_Object := Null_Iir; + Target_Prefix := Null_Iir; Target_Type := Wildcard_Any_Type; if Target = Null_Iir then -- To avoid spurious errors, assume the target is fully @@ -905,21 +907,22 @@ package body Vhdl.Sem_Stmts is Check_Target (Stmt, Target); Target_Type := Get_Type (Target); Target_Object := Check_Simple_Signal_Target_Object (Target); + Target_Prefix := Get_Object_Prefix (Target_Object); Constrained := Is_Object_Name_Fully_Constrained (Target_Object); else Constrained := False; end if; end if; - if Target_Object /= Null_Iir then + if Target_Prefix /= Null_Iir then -- LRM08 10.5.2 Simple signal assignments -- If the right-hand side of a simple force assignment or a simple -- release assignment does not specify a force mode, then a default -- force mode is used as follow: if not Get_Has_Force_Mode (Stmt) then - case Get_Kind (Target_Object) is + case Get_Kind (Target_Prefix) is when Iir_Kind_Interface_Signal_Declaration => - case Get_Mode (Target_Object) is + case Get_Mode (Target_Prefix) is when Iir_In_Mode => -- - If the target is a port or signal parameter of -- mode IN, a force mode IN is used. @@ -950,10 +953,10 @@ package body Vhdl.Sem_Stmts is else -- It is an error if a force mode of OUT is specified and the -- target is a port of mode IN. - case Get_Kind (Target_Object) is + case Get_Kind (Target_Prefix) is when Iir_Kind_Interface_Signal_Declaration => if Get_Force_Mode (Stmt) = Iir_Force_Out - and then Get_Mode (Target_Object) = Iir_In_Mode + and then Get_Mode (Target_Prefix) = Iir_In_Mode then Error_Msg_Sem (+Stmt, "cannot use force OUT for IN port %n", diff --git a/src/vhdl/vhdl-utils.adb b/src/vhdl/vhdl-utils.adb index 578576e1e..46c9bcd72 100644 --- a/src/vhdl/vhdl-utils.adb +++ b/src/vhdl/vhdl-utils.adb @@ -1088,11 +1088,16 @@ package body Vhdl.Utils is | Iir_Kind_Interface_Variable_Declaration | Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Object_Alias_Declaration => - if (Get_Kind (Get_Subtype_Indication (Base)) - = Iir_Kind_Subtype_Attribute) - then - return True; - end if; + declare + Ind : constant Iir := Get_Subtype_Indication (Base); + begin + -- Note: an object alias may not have subtype indication. + if Ind /= Null_Iir + and then Get_Kind (Ind) = Iir_Kind_Subtype_Attribute + then + return True; + end if; + end; when Iir_Kind_Dereference | Iir_Kind_Implicit_Dereference => null; |