diff options
| -rw-r--r-- | iirs.adb | 25 | ||||
| -rw-r--r-- | iirs.ads | 13 | ||||
| -rw-r--r-- | parse.adb | 10 | ||||
| -rw-r--r-- | sem.adb | 23 |
4 files changed, 58 insertions, 13 deletions
@@ -380,7 +380,6 @@ package body Iirs is | Iir_Kind_Subtype_Declaration | Iir_Kind_Nature_Declaration | Iir_Kind_Subnature_Declaration - | Iir_Kind_Configuration_Declaration | Iir_Kind_Package_Declaration | Iir_Kind_Package_Body | Iir_Kind_Attribute_Declaration @@ -514,6 +513,7 @@ package body Iirs is | Iir_Kind_Floating_Subtype_Definition | Iir_Kind_Subtype_Definition | Iir_Kind_Scalar_Nature_Definition + | Iir_Kind_Configuration_Declaration | Iir_Kind_Entity_Declaration | Iir_Kind_Architecture_Body | Iir_Kind_Package_Instantiation_Declaration @@ -1997,6 +1997,29 @@ package body Iirs is Set_Field2 (Decl, Entity); end Set_Entity; + procedure Check_Kind_For_Entity_Name (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Configuration_Declaration + | Iir_Kind_Architecture_Body => + null; + when others => + Failed ("Entity_Name", Target); + end case; + end Check_Kind_For_Entity_Name; + + function Get_Entity_Name (Arch : Iir) return Iir is + begin + Check_Kind_For_Entity_Name (Arch); + return Get_Field7 (Arch); + end Get_Entity_Name; + + procedure Set_Entity_Name (Arch : Iir; Entity : Iir) is + begin + Check_Kind_For_Entity_Name (Arch); + Set_Field7 (Arch, Entity); + end Set_Entity_Name; + procedure Check_Kind_For_Package (Target : Iir) is begin case Get_Kind (Target) is @@ -638,18 +638,21 @@ package Iirs is -- Get/Set_Identifier (Field3) -- -- Get/Set_Attribute_Value_Chain (Field4) + -- -- Get/Set_Concurrent_Statement_Chain (Field5) -- -- The default configuration created by canon. This is a design unit. -- Get/Set_Default_Configuration_Declaration (Field6) -- + -- Get/Set_Entity_Name (Field7) + -- -- Get/Set_Foreign_Flag (Flag3) -- -- Get/Set_Visible_Flag (Flag4) -- -- Get/Set_Is_Within_Flag (Flag5) - -- Iir_Kind_Configuration_Declaration (Short) + -- Iir_Kind_Configuration_Declaration (Medium) -- -- Get/Set_Parent (Field0) -- Get/Set_Design_Unit (Alias Field0) @@ -666,6 +669,8 @@ package Iirs is -- -- Get/Set_Block_Configuration (Field5) -- + -- Get/Set_Entity_Name (Field7) + -- -- Get/Set_Visible_Flag (Flag4) -- Iir_Kind_Package_Header (Medium) @@ -4599,10 +4604,16 @@ package Iirs is function Get_Attribute_Value_Spec_Chain (Target : Iir) return Iir; procedure Set_Attribute_Value_Spec_Chain (Target : Iir; Chain : Iir); + -- The entity declaration for an architecture or a configuration. -- Field: Field2 function Get_Entity (Decl : Iir) return Iir; procedure Set_Entity (Decl : Iir; Entity : Iir); + -- The entity name for an architecture or a configuration. + -- Field: Field7 + function Get_Entity_Name (Arch : Iir) return Iir; + procedure Set_Entity_Name (Arch : Iir; Entity : Iir); + -- The package declaration corresponding to the body. -- Field: Field4 function Get_Package (Package_Body : Iir) return Iir_Package_Declaration; @@ -5952,7 +5952,7 @@ package body Parse is -- BEGIN -- architecture_statement_part -- END [ ARCHITECTURE ] [ ARCHITECTURE_simple_name ] ; - procedure Parse_Architecture (Unit : Iir_Design_Unit) + procedure Parse_Architecture_Body (Unit : Iir_Design_Unit) is Res: Iir_Architecture_Body; begin @@ -5969,7 +5969,7 @@ package body Parse is else Expect (Tok_Of); Scan; - Set_Entity (Res, Parse_Name (False)); + Set_Entity_Name (Res, Parse_Name (False)); Expect (Tok_Is); end if; @@ -5992,7 +5992,7 @@ package body Parse is Check_End_Name (Res); Expect (Tok_Semi_Colon); Set_Library_Unit (Unit, Res); - end Parse_Architecture; + end Parse_Architecture_Body; -- precond : next token -- postcond: a token @@ -6375,7 +6375,7 @@ package body Parse is Set_Location (Res); Scan_Expect (Tok_Of); Scan; - Set_Entity (Res, Parse_Name (False)); + Set_Entity_Name (Res, Parse_Name (False)); Expect (Tok_Is); Scan; @@ -6643,7 +6643,7 @@ package body Parse is when Tok_Entity => Parse_Entity_Declaration (Res); when Tok_Architecture => - Parse_Architecture (Res); + Parse_Architecture_Body (Res); when Tok_Package => Parse_Package (Res); when Tok_Configuration => @@ -89,14 +89,24 @@ package body Sem is -- Return NULL_IIR in case of error (not found, bad library). function Sem_Entity_Name (Library_Unit : Iir) return Iir is - Name : Iir; + Name : constant Iir := Get_Entity_Name (Library_Unit); Library : Iir_Library_Declaration; Entity : Iir; begin - Name := Get_Entity (Library_Unit); + -- Get the library of architecture/configuration. Library := Get_Library (Get_Design_File (Get_Design_Unit (Library_Unit))); + if Get_Kind (Name) = Iir_Kind_Simple_Name then + -- LRM93 10.1 Declarative Region + -- LRM08 12.1 Declarative Region + -- a) An entity declaration, tohether with a corresponding + -- architecture body. + -- + -- GHDL: simple name needs to be handled specially. Because + -- architecture body is in the declarative region of its entity, + -- the entity name is directly visible. But we cannot really use + -- that rule as is, as we don't know which is the entity. Entity := Libraries.Load_Primary_Unit (Library, Get_Identifier (Name), Library_Unit); if Entity = Null_Iir then @@ -114,6 +124,7 @@ package body Sem is end if; end if; Xrefs.Xref_Ref (Name, Entity); + if Get_Kind (Entity) = Iir_Kind_Entity_Declaration then -- LRM 1.2 Architecture bodies -- For a given design entity, both the entity declaration and the @@ -131,11 +142,11 @@ package body Sem is return Null_Iir; end if; return Entity; + else + Error_Msg_Sem ("entity name expected, found " & Disp_Node (Entity), + Library_Unit); + return Null_Iir; end if; - - Error_Msg_Sem ("entity name expected, found " & Disp_Node (Entity), - Library_Unit); - return Null_Iir; end Sem_Entity_Name; -- LRM 1.2 Architecture bodies. |