From b85a4d387b378d3b15e115293c0bf01728229f52 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Wed, 24 Jun 2020 07:47:03 +0200 Subject: vhdl/translate: rework object type elaboration. For #641 --- src/vhdl/translate/trans-chap2.adb | 4 +-- src/vhdl/translate/trans-chap3.adb | 72 ++++++++++++++++++++++++++++++-------- src/vhdl/translate/trans-chap3.ads | 4 +-- src/vhdl/translate/trans-chap4.adb | 40 +++++++++++++-------- src/vhdl/translate/trans-chap5.adb | 4 +-- src/vhdl/translate/trans-chap8.adb | 2 +- src/vhdl/translate/trans-chap9.adb | 6 ++-- src/vhdl/vhdl-sem_names.adb | 2 +- 8 files changed, 93 insertions(+), 41 deletions(-) (limited to 'src/vhdl') diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb index 6016a4c6e..6d918b63a 100644 --- a/src/vhdl/translate/trans-chap2.adb +++ b/src/vhdl/translate/trans-chap2.adb @@ -148,7 +148,7 @@ package body Trans.Chap2 is -- Translate interface types. Inter := Get_Interface_Declaration_Chain (Spec); while Inter /= Null_Iir loop - Chap3.Translate_Object_Subtype (Inter); + Chap3.Translate_Object_Subtype_Indication (Inter); Inter := Get_Chain (Inter); end loop; @@ -211,7 +211,7 @@ package body Trans.Chap2 is -- Translate interface types. Inter := Get_Interface_Declaration_Chain (Spec); while Inter /= Null_Iir loop - Chap3.Elab_Object_Subtype (Get_Type (Inter)); + Chap3.Elab_Object_Subtype_Indication (Inter); Inter := Get_Chain (Inter); end loop; end Elab_Subprogram_Interfaces; diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb index 1f7472938..652087b92 100644 --- a/src/vhdl/translate/trans-chap3.adb +++ b/src/vhdl/translate/trans-chap3.adb @@ -2465,6 +2465,7 @@ package body Trans.Chap3 is procedure Elab_Type_Definition_Depend is new Handle_Anonymous_Subtypes (Handle_A_Subtype => Elab_Type_Definition); + procedure Elab_Type_Definition (Def : Iir) is begin case Get_Kind (Def) is @@ -2528,30 +2529,71 @@ package body Trans.Chap3 is Pop_Identifier_Prefix (Mark); end Translate_Anonymous_Subtype_Definition; - procedure Translate_Object_Subtype (Decl : Iir; - With_Vars : Boolean := True) + procedure Translate_Object_Subtype_Definition + (Decl : Iir; Def : Iir; With_Vars : Boolean := True) is - Def : constant Iir := Get_Type (Decl); Parent_Type : Iir; Mark : Id_Mark_Type; Mark2 : Id_Mark_Type; begin - if Is_Anonymous_Type_Definition (Def) then - Push_Identifier_Prefix (Mark, Get_Identifier (Decl)); - Push_Identifier_Prefix (Mark2, "OT"); - Parent_Type := Get_Parent_Type (Def); - Chap3.Translate_Subtype_Definition (Def, Parent_Type, With_Vars); - Pop_Identifier_Prefix (Mark2); - Pop_Identifier_Prefix (Mark); + Push_Identifier_Prefix (Mark, Get_Identifier (Decl)); + Push_Identifier_Prefix (Mark2, "OT"); + Parent_Type := Get_Parent_Type (Def); + Chap3.Translate_Subtype_Definition (Def, Parent_Type, With_Vars); + Pop_Identifier_Prefix (Mark2); + Pop_Identifier_Prefix (Mark); + end Translate_Object_Subtype_Definition; + + procedure Translate_Object_Subtype_Indication (Decl : Iir; + With_Vars : Boolean := True) + is + Def : constant Iir := Get_Type (Decl); + begin + if not Is_Anonymous_Type_Definition (Def) then + -- The type refers to a declared type, so already handled. + return; end if; - end Translate_Object_Subtype; - procedure Elab_Object_Subtype (Def : Iir) is + declare + Ind : constant Iir := Get_Subtype_Indication (Decl); + begin + if Ind /= Null_Iir + and then Get_Kind (Ind) = Iir_Kind_Subtype_Attribute + then + if Is_Fully_Constrained_Type (Get_Type (Get_Prefix (Ind))) then + return; + end if; + raise Internal_Error; + else + Translate_Object_Subtype_Definition (Decl, Def, With_Vars); + end if; + end; + end Translate_Object_Subtype_Indication; + + procedure Elab_Object_Subtype_Indication (Decl : Iir) + is + Def : constant Iir := Get_Type (Decl); begin - if Is_Anonymous_Type_Definition (Def) then - Elab_Type_Definition (Def); + if not Is_Anonymous_Type_Definition (Def) then + -- The type refers to a declared type, so already handled. + return; end if; - end Elab_Object_Subtype; + + declare + Ind : constant Iir := Get_Subtype_Indication (Decl); + begin + if Ind /= Null_Iir + and then Get_Kind (Ind) = Iir_Kind_Subtype_Attribute + then + if Is_Fully_Constrained_Type (Get_Type (Get_Prefix (Ind))) then + return; + end if; + raise Internal_Error; + else + Elab_Type_Definition (Def); + end if; + end; + end Elab_Object_Subtype_Indication; procedure Elab_Type_Declaration (Decl : Iir) is begin diff --git a/src/vhdl/translate/trans-chap3.ads b/src/vhdl/translate/trans-chap3.ads index 7e252f521..aa5a98742 100644 --- a/src/vhdl/translate/trans-chap3.ads +++ b/src/vhdl/translate/trans-chap3.ads @@ -21,9 +21,9 @@ package Trans.Chap3 is -- a subtype. -- This can be done only for a declaration. -- DECL must have an identifier and a type. - procedure Translate_Object_Subtype + procedure Translate_Object_Subtype_Indication (Decl : Iir; With_Vars : Boolean := True); - procedure Elab_Object_Subtype (Def : Iir); + procedure Elab_Object_Subtype_Indication (Decl : Iir); -- Translate the subtype of a literal. -- This can be done not at declaration time, ie no variables are created diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb index f2ed9cd33..9a98e79ee 100644 --- a/src/vhdl/translate/trans-chap4.adb +++ b/src/vhdl/translate/trans-chap4.adb @@ -114,19 +114,16 @@ package body Trans.Chap4 is Info : Object_Info_Acc; Tinfo : Type_Info_Acc; Def : Iir; - Val : Iir; + Val : constant Iir := Get_Default_Value (El); Storage : O_Storage; Deferred : Iir; begin - Def := Get_Type (El); - Val := Get_Default_Value (El); - -- Be sure the object type was translated. if Get_Kind (El) = Iir_Kind_Constant_Declaration and then Get_Deferred_Declaration_Flag (El) = False and then Get_Deferred_Declaration (El) /= Null_Iir then - -- This is a full constant declaration which complete a previous + -- This is a full constant declaration which completes a previous -- incomplete constant declaration. -- -- Do not create the subtype of this full constant declaration, @@ -137,8 +134,9 @@ package body Trans.Chap4 is Info := Get_Info (Deferred); Set_Info (El, Info); else - Chap3.Translate_Object_Subtype (El); + Chap3.Translate_Object_Subtype_Indication (El); Info := Add_Info (El, Kind_Object); + Def := Get_Type (El); end if; Tinfo := Get_Info (Def); @@ -197,7 +195,9 @@ package body Trans.Chap4 is Type_Info : Type_Info_Acc; Info : Signal_Info_Acc; begin - Chap3.Translate_Object_Subtype (Decl); + if Get_Kind (Decl) /= Iir_Kind_Anonymous_Signal_Declaration then + Chap3.Translate_Object_Subtype_Indication (Decl); + end if; Type_Info := Get_Info (Sig_Type_Def); Info := Add_Info (Decl, Kind_Signal); @@ -494,7 +494,12 @@ package body Trans.Chap4 is Size : O_Enode; begin -- Elaborate subtype. - Chap3.Elab_Object_Subtype (Obj_Type); + case Get_Kind (Obj) is + when Iir_Kind_Attribute_Value => + null; + when others => + Chap3.Elab_Object_Subtype_Indication (Obj); + end case; Type_Info := Get_Info (Obj_Type); @@ -1076,12 +1081,18 @@ package body Trans.Chap4 is Open_Temp; - Chap3.Elab_Object_Subtype (Sig_Type); + if Get_Kind (Decl) /= Iir_Kind_Anonymous_Signal_Declaration then + Chap3.Elab_Object_Subtype_Indication (Decl); + end if; + Type_Info := Get_Info (Sig_Type); if Type_Info.Type_Mode in Type_Mode_Unbounded then -- Unbounded types are only allowed for ports; in that case the -- bounds have already been set. + pragma Assert (Is_Port); + + -- Allocate storage. if Has_Copy then Name_Sig := Chap6.Translate_Name (Decl, Mode_Signal); Name_Val := Mnode_Null; @@ -1586,7 +1597,7 @@ package body Trans.Chap4 is Atype : O_Tnode; Id : Var_Ident_Type; begin - Chap3.Translate_Object_Subtype (Decl, True); + Chap3.Translate_Object_Subtype_Indication (Decl, True); Info := Add_Info (Decl, Kind_Alias); if Is_Signal_Name (Decl) then @@ -1659,7 +1670,7 @@ package body Trans.Chap4 is begin New_Debug_Line_Stmt (Get_Line_Number (Decl)); - Chap3.Elab_Object_Subtype (Decl_Type); + Chap3.Elab_Object_Subtype_Indication (Decl); Open_Temp; @@ -1841,8 +1852,8 @@ package body Trans.Chap4 is Create_File_Object (Decl); when Iir_Kind_Attribute_Declaration => - -- Useless as attribute declarations have a type mark. - Chap3.Translate_Object_Subtype (Decl); + -- Attribute declarations have a type mark. + null; when Iir_Kind_Attribute_Specification => Chap5.Translate_Attribute_Specification (Decl); @@ -2607,7 +2618,8 @@ package body Trans.Chap4 is Need_Final := True; when Iir_Kind_Attribute_Declaration => - Chap3.Elab_Object_Subtype (Get_Type (Decl)); + -- An attribute declaration can only have a type mark. + null; when Iir_Kind_Attribute_Specification => Chap5.Elab_Attribute_Specification (Decl); diff --git a/src/vhdl/translate/trans-chap5.adb b/src/vhdl/translate/trans-chap5.adb index b8264f3db..a1f89f57f 100644 --- a/src/vhdl/translate/trans-chap5.adb +++ b/src/vhdl/translate/trans-chap5.adb @@ -101,8 +101,6 @@ package body Trans.Chap5 is Expr : constant Iir := Get_Expression (Spec); Val : Iir; begin - Chap3.Elab_Object_Subtype (Get_Type (Expr)); - Val := Get_Attribute_Value_Spec_Chain (Spec); while Is_Valid (Val) loop Chap4.Elab_Object_Value (Val, Expr); @@ -844,7 +842,7 @@ package body Trans.Chap5 is Bounds : Mnode; begin Set_Map_Env (Formal_Env); - Chap3.Elab_Object_Subtype (Formal_Type); + Chap3.Elab_Object_Subtype_Indication (Formal); -- FIXME? Type_Info := Get_Info (Formal_Type); Formal_Node := Get_Var (Obj_Info.Object_Var, Type_Info, Mode_Value); diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb index ace7f61b6..acda82aff 100644 --- a/src/vhdl/translate/trans-chap8.adb +++ b/src/vhdl/translate/trans-chap8.adb @@ -534,7 +534,7 @@ package body Trans.Chap8 is Range_Type : O_Tnode; begin -- Iterator range. - Chap3.Translate_Object_Subtype (Iterator, False); + Chap3.Translate_Object_Subtype_Indication (Iterator, False); -- Iterator variable. It_Info := Add_Info (Iterator, Kind_Iterator); diff --git a/src/vhdl/translate/trans-chap9.adb b/src/vhdl/translate/trans-chap9.adb index 5ec57edc7..2c7fd68cc 100644 --- a/src/vhdl/translate/trans-chap9.adb +++ b/src/vhdl/translate/trans-chap9.adb @@ -894,7 +894,7 @@ package body Trans.Chap9 is begin Push_Identifier_Prefix (Mark, Get_Identifier (Stmt)); - Chap3.Translate_Object_Subtype (Param, True); + Chap3.Translate_Object_Subtype_Indication (Param, True); Info := Add_Info (Bod, Kind_Block); Chap1.Start_Block_Decl (Bod); @@ -2465,7 +2465,7 @@ package body Trans.Chap9 is Open_Temp; -- Evaluate iterator range. - Chap3.Elab_Object_Subtype (Iter_Type); + Chap3.Elab_Object_Subtype_Indication (Iter); Range_Ptr := Create_Temp_Ptr (Iter_Type_Info.B.Range_Ptr_Type, @@ -2580,7 +2580,7 @@ package body Trans.Chap9 is Open_Temp; -- Evaluate iterator range. - Chap3.Elab_Object_Subtype (Iter_Type); + Chap3.Elab_Object_Subtype_Indication (Iter); -- Allocate instances. Var_Inst := Create_Temp_Init diff --git a/src/vhdl/vhdl-sem_names.adb b/src/vhdl/vhdl-sem_names.adb index 7f1766b5b..9463b1b37 100644 --- a/src/vhdl/vhdl-sem_names.adb +++ b/src/vhdl/vhdl-sem_names.adb @@ -3630,7 +3630,7 @@ package body Vhdl.Sem_Names is -- The type defined by 'subtype is always constrained. Create -- a subtype if it is not. Attr_Type := Get_Type (Prefix_Name); - if False then + if not Is_Fully_Constrained_Type (Attr_Type) then Attr_Type := Sem_Types.Build_Constrained_Subtype (Attr_Type, Attr); end if; -- cgit v1.2.3