Add Entity_Name for architecture and configuration.

4 files changed, 58 insertions, 13 deletions

diff --git a/iirs.adb b/iirs.adb
index 0e8e07598..7de512390 100644
--- a/iirs.adb
+++ b/iirs.adb
@@ -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
diff --git a/iirs.ads b/iirs.ads
index 028fa9e75..34e86891d 100644
--- a/iirs.ads
+++ b/iirs.ads
@@ -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;
diff --git a/parse.adb b/parse.adb
index 39e1e6678..51e04e0a8 100644
--- a/parse.adb
+++ b/parse.adb
@@ -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 =>
diff --git a/sem.adb b/sem.adb
index d483ba8bd..56a62615c 100644
--- a/sem.adb
+++ b/sem.adb
@@ -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.