vhdl: move sem* packages to vhdl children.

1 files changed, 3314 insertions, 0 deletions

diff --git a/src/vhdl/vhdl-sem.adb b/src/vhdl/vhdl-sem.adb
new file mode 100644
index 000000000..b1875bc1e
--- /dev/null
+++ b/src/vhdl/vhdl-sem.adb
@@ -0,0 +1,3314 @@
+--  Semantic analysis pass.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Errorout; use Errorout;
+with Std_Package; use Std_Package;
+with Ieee.Std_Logic_1164;
+with Libraries;
+with Std_Names;
+with Vhdl.Sem_Scopes; use Vhdl.Sem_Scopes;
+with Vhdl.Sem_Expr; use Vhdl.Sem_Expr;
+with Vhdl.Sem_Names; use Vhdl.Sem_Names;
+with Vhdl.Sem_Specs; use Vhdl.Sem_Specs;
+with Vhdl.Sem_Decls; use Vhdl.Sem_Decls;
+with Vhdl.Sem_Assocs; use Vhdl.Sem_Assocs;
+with Vhdl.Sem_Inst;
+with Vhdl.Sem_Lib; use Vhdl.Sem_Lib;
+with Iirs_Utils; use Iirs_Utils;
+with Flags; use Flags;
+with Str_Table;
+with Vhdl.Sem_Utils;
+with Vhdl.Sem_Stmts; use Vhdl.Sem_Stmts;
+with Iir_Chains;
+with Xrefs; use Xrefs;
+
+package body Vhdl.Sem is
+   -- Forward declarations.
+   procedure Sem_Context_Clauses (Unit: Iir);
+   procedure Sem_Block_Configuration
+     (Block_Conf : Iir_Block_Configuration; Father: Iir);
+   procedure Sem_Component_Configuration
+     (Conf : Iir_Component_Configuration; Father : Iir);
+
+   procedure Add_Dependence (Unit : Iir)
+   is
+      Targ : constant Iir := Get_Current_Design_Unit;
+   begin
+      --  During normal analysis, there is a current design unit.  But not
+      --  during debugging outside of any context.
+      if Targ = Null_Iir then
+         return;
+      end if;
+
+      Add_Dependence (Targ, Unit);
+   end Add_Dependence;
+
+   --  LRM 1.1  Entity declaration.
+   procedure Sem_Entity_Declaration (Entity : Iir_Entity_Declaration) is
+   begin
+      Xrefs.Xref_Decl (Entity);
+      Sem_Scopes.Add_Name (Entity);
+      Set_Visible_Flag (Entity, True);
+
+      Set_Is_Within_Flag (Entity, True);
+
+      --  LRM 10.1
+      --  1.  An entity declaration, together with a corresponding architecture
+      --      body.
+      Open_Declarative_Region;
+
+      -- Sem generics.
+      Sem_Interface_Chain (Get_Generic_Chain (Entity), Generic_Interface_List);
+
+      -- Sem ports.
+      Sem_Interface_Chain (Get_Port_Chain (Entity), Port_Interface_List);
+
+      --  Entity declarative part and concurrent statements.
+      Sem_Block (Entity);
+
+      Close_Declarative_Region;
+      Set_Is_Within_Flag (Entity, False);
+   end Sem_Entity_Declaration;
+
+   --  Get the entity unit for LIBRARY_UNIT (an architecture or a
+   --  configuration declaration).
+   --  Return NULL_IIR in case of error (not found, bad library).
+   function Sem_Entity_Name (Library_Unit : Iir) return Iir
+   is
+      Name : Iir;
+      Library : Iir_Library_Declaration;
+      Entity : Iir;
+   begin
+      --  Get the library of architecture/configuration.
+      Library := Get_Library
+        (Get_Design_File (Get_Design_Unit (Library_Unit)));
+
+      --  Resolve the name.
+
+      Name := Get_Entity_Name (Library_Unit);
+      if Is_Error (Name) then
+         pragma Assert (Flags.Flag_Force_Analysis);
+         return Null_Iir;
+      end if;
+
+      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 := Load_Primary_Unit
+           (Library, Get_Identifier (Name), Library_Unit);
+         if Entity = Null_Iir then
+            Error_Msg_Sem (+Library_Unit, "entity %n was not analysed", +Name);
+            return Null_Iir;
+         end if;
+         Entity := Get_Library_Unit (Entity);
+         Set_Named_Entity (Name, Entity);
+         Xrefs.Xref_Ref (Name, Entity);
+      else
+         --  Certainly an expanded name.  Use the standard name analysis.
+         Name := Sem_Denoting_Name (Name);
+         Set_Entity_Name (Library_Unit, Name);
+         Entity := Get_Named_Entity (Name);
+      end if;
+
+      if Get_Kind (Entity) /= Iir_Kind_Entity_Declaration then
+         Error_Class_Match (Name, "entity");
+         return Null_Iir;
+      end if;
+
+      --  LRM 1.2 Architecture bodies
+      --  For a given design entity, both the entity declaration and the
+      --  associated architecture body must reside in the same library.
+
+      --  LRM 1.3 Configuration Declarations
+      --  For a configuration of a given design entity, both the
+      --  configuration declaration and the corresponding entity
+      --  declaration must reside in the same library.
+      if Get_Library (Get_Design_File (Get_Design_Unit (Entity))) /= Library
+      then
+         Error_Msg_Sem
+           (+Library_Unit, "%n does not reside in %n", (+Entity, +Library));
+         return Null_Iir;
+      end if;
+
+      return Entity;
+   end Sem_Entity_Name;
+
+   --  LRM 1.2  Architecture bodies.
+   procedure Sem_Architecture_Body (Arch: Iir_Architecture_Body)
+   is
+      Entity_Unit : Iir_Design_Unit;
+      Entity_Library : Iir_Entity_Declaration;
+   begin
+      Xrefs.Xref_Decl (Arch);
+      -- First, find the entity.
+      Entity_Library := Sem_Entity_Name (Arch);
+      if Entity_Library = Null_Iir then
+         return;
+      end if;
+      Entity_Unit := Get_Design_Unit (Entity_Library);
+
+      --  LRM93 11.4
+      --   In each case, the second unit depends on the first unit.
+      --  GHDL: an architecture depends on its entity.
+      Add_Dependence (Entity_Unit);
+
+      Add_Context_Clauses (Entity_Unit);
+
+      Set_Is_Within_Flag (Arch, True);
+      Set_Is_Within_Flag (Entity_Library, True);
+
+      --  Makes the entity name visible.
+      --  FIXME: quote LRM.
+      Sem_Scopes.Add_Name
+        (Entity_Library, Get_Identifier (Entity_Library), False);
+
+      --  LRM 10.1 Declarative Region
+      --  1. An entity declaration, together with a corresponding architecture
+      --     body.
+      Open_Declarative_Region;
+      Sem_Scopes.Add_Entity_Declarations (Entity_Library);
+
+      --  LRM02 1.2  Architecture bodies
+      --  For the purpose of interpreting the scope and visibility of the
+      --  identifier (see 10.2 and 10.3), the declaration of the identifier is
+      --  considered to occur after the final declarative item of the entity
+      --  declarative part of the corresponding entity declaration.
+      --
+      --  FIXME: before VHDL-02, an architecture is not a declaration.
+      Sem_Scopes.Add_Name (Arch, Get_Identifier (Arch), True);
+      Set_Visible_Flag (Arch, True);
+
+      --  LRM02 10.1  Declarative region
+      --  The declarative region associated with an architecture body is
+      --  considered to occur immediatly within the declarative region
+      --  associated with the entity declaration corresponding to the given
+      --  architecture body.
+      --
+      --  GHDL: this is only in vhdl-2002.
+      if Vhdl_Std = Vhdl_02 then
+         Open_Declarative_Region;
+      end if;
+
+      Current_Psl_Default_Clock := Null_Iir;
+      Sem_Block (Arch);
+
+      if Vhdl_Std = Vhdl_02 then
+         Close_Declarative_Region;
+      end if;
+
+      Close_Declarative_Region;
+      Set_Is_Within_Flag (Arch, False);
+      Set_Is_Within_Flag (Entity_Library, False);
+   end Sem_Architecture_Body;
+
+   --  Return the real resolver used for (sub) object OBJ.
+   --  Return NULL_IIR if none.
+   function Get_Resolver (Obj : Iir) return Iir
+   is
+      Obj_Type : Iir;
+      Res : Iir;
+   begin
+      case Get_Kind (Obj) is
+         when Iir_Kind_Indexed_Name
+           | Iir_Kind_Slice_Name
+           | Iir_Kind_Selected_Element =>
+            Res := Get_Resolver (Get_Prefix (Obj));
+            if Res /= Null_Iir then
+               return Res;
+            end if;
+         when Iir_Kind_Signal_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Guard_Signal_Declaration =>
+            null;
+         when Iir_Kind_Object_Alias_Declaration =>
+            return Get_Resolver (Get_Name (Obj));
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name =>
+            return Get_Resolver (Get_Named_Entity (Obj));
+         when others =>
+            Error_Kind ("get_resolved", Obj);
+      end case;
+
+      Obj_Type := Get_Type (Obj);
+      if Get_Kind (Obj_Type) in Iir_Kinds_Subtype_Definition then
+         return Get_Resolution_Indication (Obj_Type);
+      else
+         return Null_Iir;
+      end if;
+   end Get_Resolver;
+
+   --  Return TRUE iff the actual of ASSOC can be the formal.
+   --  ASSOC must be an association_element_by_expression.
+   function Can_Collapse_Signals (Assoc : Iir; Formal : Iir) return Boolean
+   is
+      Actual : Iir;
+      Actual_Res : Iir;
+      Formal_Res : Iir;
+      Formal_Base : Iir;
+      Actual_Base : Iir;
+   begin
+      --  If there is a conversion, signals types are not necessarily
+      --  the same, and sharing is not possible.
+      --  FIXME: optimize type conversions
+      --    (unsigned <-> signed <-> std_ulogic_vector <-> ...)
+      if Get_Actual_Conversion (Assoc) /= Null_Iir
+        or else Get_Formal_Conversion (Assoc) /= Null_Iir
+      then
+         return False;
+      end if;
+
+      --  Here we may assume formal and actual have the same type and the
+      --  same lengths.  This is caught at elaboration time.
+
+      Actual := Name_To_Object (Get_Actual (Assoc));
+      if Actual = Null_Iir then
+         --  This is an expression.
+         return False;
+      end if;
+
+      Formal_Base := Get_Object_Prefix (Formal);
+      Actual_Base := Get_Object_Prefix (Actual);
+
+      --  If the formal is of mode IN, then it has no driving value, and its
+      --  effective value is the effective value of the actual.
+      --  Always collapse in this case.
+      if Get_Mode (Formal_Base) = Iir_In_Mode then
+         return True;
+      end if;
+
+      --  Otherwise, these rules are applied:
+      --
+      --  In this table, E means element, S means signal.
+      --                 Er means the element is resolved,
+      --                 Sr means the signal is resolved (at the signal level).
+      --
+      --                            Actual
+      --               | E,S   | Er,S  | E,Sr  | Er,Sr |
+      --         ------+-------+-------+-------+-------+
+      --         E,S   |collap | no(3) | no(3) | no(3) |
+      --         ------+-------+-------+-------+-------+
+      --         Er,S  | no(1) |if same| no(2) | no(2) |
+      --  Formal ------+-------+-------+-------+-------+
+      --         E,Sr  | no(1) | no(2) |if same| no(4) |
+      --         ------+-------+-------+-------+-------+
+      --         Er,Sr | no(1) | no(2) | no(4) |if same|
+      --         ------+-------+-------+-------+-------+
+      --
+      --  Notes: (1): formal may have several sources.
+      --         (2): resolver is not the same.
+      --         (3): this prevents to catch several sources error in instance.
+      --         (4): resolver is not the same, because the types are not the
+      --              same.
+      --
+      --  Furthermore, signals cannot be collapsed if the kind (none, bus or
+      --  register) is not the same.
+      --
+      --  Default value:  default value is the effective value.
+
+      --  Resolution function.
+      Actual_Res := Get_Resolver (Actual);
+      Formal_Res := Get_Resolver (Formal);
+
+      --  If the resolutions are not the same, signals cannot be collapsed.
+      if Actual_Res /= Formal_Res then
+         return False;
+      end if;
+
+      --  If neither the actual nor the formal is resolved, then collapsing is
+      --  possible.
+      --  (this is case ES/ES).
+      if Actual_Res = Null_Iir and Formal_Res = Null_Iir then
+         return True;
+      end if;
+
+      --  If the formal can have sources and is guarded, but the actual is
+      --  not guarded (or has not the same kind of guard), signals cannot
+      --  be collapsed.
+      if (Get_Guarded_Signal_Flag (Formal_Base)
+            /= Get_Guarded_Signal_Flag (Actual_Base))
+        or else (Get_Signal_Kind (Formal_Base)
+                   /= Get_Signal_Kind (Actual_Base))
+      then
+         return False;
+      end if;
+
+      return True;
+   end Can_Collapse_Signals;
+
+   --  INTER_PARENT contains generics interfaces;
+   --  ASSOC_PARENT constains generic aspects.
+   function Sem_Generic_Association_Chain
+     (Inter_Parent : Iir; Assoc_Parent : Iir) return Boolean
+   is
+      El : Iir;
+      Match : Compatibility_Level;
+      Assoc_Chain : Iir;
+      Inter_Chain : Iir;
+      Miss : Missing_Type;
+   begin
+      --  LRM08 6.5.6.2 Generic clauses
+      --  If no such actual is specified for a given formal generic constant
+      --  (either because the formal generic is unassociated or because the
+      --  actual is open), and if a default expression is specified for that
+      --  generic, the value of this expression is the value of the generic.
+      --  It is an error if no actual is specified for a given formal generic
+      --  constant and no default expression is present in the corresponding
+      --  interface element.
+
+      --  Note: CHECK_MATCH argument of sem_subprogram_arguments must be
+      --   true if parent is a component instantiation.
+      case Get_Kind (Assoc_Parent) is
+         when Iir_Kind_Component_Instantiation_Statement =>
+            --  LRM 9.6 Component Instantiation Statement
+            --  Each local generic (or subelement or slice thereof) must be
+            --  associated {VHDL87: exactly}{VHDL93: at most} once.
+            --  ...
+            --  Each local port (or subelement or slice therof) must be
+            --  associated {VHDL87: exactly}{VHDL93: at most} once.
+
+            --  GHDL: for a direct instantiation, follow rules of
+            --  LRM 1.1.1.1 Generic and LRM 1.1.1.2 Ports.
+            --  The difference between 87 and 93 is simply a clarification:
+            --  missing association are left open, but need a default
+            --  expression in the formal declaration.
+            Miss := Missing_Generic;
+         when Iir_Kind_Binding_Indication =>
+            --  LRM 5.2.1.2  Generic map and port map aspects
+            Miss := Missing_Allowed;
+         when Iir_Kind_Block_Header =>
+            Miss := Missing_Generic;
+         when Iir_Kind_Package_Instantiation_Declaration
+           | Iir_Kind_Interface_Package_Declaration
+           | Iir_Kind_Package_Header =>
+            --  LRM08 4.9
+            --  Each formal generic (or member thereof) shall be associated
+            --  at most once.
+            Miss := Missing_Generic;
+         when others =>
+            Error_Kind ("sem_generic_association_list", Assoc_Parent);
+      end case;
+
+      --  The generics
+      Inter_Chain := Get_Generic_Chain (Inter_Parent);
+      Assoc_Chain := Get_Generic_Map_Aspect_Chain (Assoc_Parent);
+
+      --  Extract non-object associations, as the actual cannot be analyzed
+      --  as an expression.
+      Assoc_Chain := Extract_Non_Object_Association (Assoc_Chain, Inter_Chain);
+      Set_Generic_Map_Aspect_Chain (Assoc_Parent, Assoc_Chain);
+
+      if not Sem_Actual_Of_Association_Chain (Assoc_Chain) then
+         return False;
+      end if;
+
+      Sem_Association_Chain
+        (Inter_Chain, Assoc_Chain, True, Miss, Assoc_Parent, Match);
+      Set_Generic_Map_Aspect_Chain (Assoc_Parent, Assoc_Chain);
+      if Match = Not_Compatible then
+         return False;
+      end if;
+
+      --  LRM 5.2.1.2   Generic map and port map aspects
+      --  An actual associated with a formal generic map aspect must be an
+      --  expression or the reserved word open;
+      El := Assoc_Chain;
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Association_Element_By_Expression =>
+               Check_Read (Get_Actual (El));
+            when Iir_Kind_Association_Element_Open
+              | Iir_Kind_Association_Element_By_Individual
+              | Iir_Kind_Association_Element_Package
+              | Iir_Kind_Association_Element_Type
+              | Iir_Kind_Association_Element_Subprogram =>
+               null;
+            when others =>
+               Error_Kind ("sem_generic_association_chain(1)", El);
+         end case;
+         El := Get_Chain (El);
+      end loop;
+
+      return True;
+   end Sem_Generic_Association_Chain;
+
+   procedure Sem_Generic_Association_Chain
+     (Inter_Parent : Iir; Assoc_Parent : Iir)
+   is
+      Res : Boolean;
+      pragma Unreferenced (Res);
+   begin
+      Res := Sem_Generic_Association_Chain (Inter_Parent, Assoc_Parent);
+   end Sem_Generic_Association_Chain;
+
+   --  INTER_PARENT contains ports interfaces;
+   --  ASSOC_PARENT constains ports map aspects.
+   procedure Sem_Port_Association_Chain
+     (Inter_Parent : Iir; Assoc_Parent : Iir)
+   is
+      Assoc : Iir;
+      Actual : Iir;
+      Prefix : Iir;
+      Object : Iir;
+      Match : Compatibility_Level;
+      Assoc_Chain : Iir;
+      Miss : Missing_Type;
+      Inter : Iir;
+      Formal : Iir;
+      Formal_Base : Iir;
+   begin
+      --  Note: CHECK_MATCH argument of sem_subprogram_arguments must be
+      --   true if parent is a component instantiation.
+      case Get_Kind (Assoc_Parent) is
+         when Iir_Kind_Component_Instantiation_Statement =>
+            --  LRM 9.6 Component Instantiation Statement
+            --  Each local generic (or subelement or slice thereof) must be
+            --  associated {VHDL87: exactly}{VHDL93: at most} once.
+            --  ...
+            --  Each local port (or subelement or slice therof) must be
+            --  associated {VHDL87: exactly}{VHDL93: at most} once.
+
+            --  GHDL: for a direct instantiation, follow rules of
+            --  LRM 1.1.1.1 Generic and LRM 1.1.1.2 Ports.
+            Miss := Missing_Port;
+         when Iir_Kind_Binding_Indication =>
+            --  LRM 5.2.1.2  Generic map and port map aspects
+            Miss := Missing_Allowed;
+         when Iir_Kind_Block_Header =>
+            --  FIXME: it is possible to have port unassociated ?
+            Miss := Missing_Port;
+         when others =>
+            Error_Kind ("sem_port_association_list", Assoc_Parent);
+      end case;
+
+      --  The ports
+      Assoc_Chain := Get_Port_Map_Aspect_Chain (Assoc_Parent);
+      if not Sem_Actual_Of_Association_Chain (Assoc_Chain) then
+         return;
+      end if;
+      Sem_Association_Chain (Get_Port_Chain (Inter_Parent), Assoc_Chain,
+                             True, Miss, Assoc_Parent, Match);
+      Set_Port_Map_Aspect_Chain (Assoc_Parent, Assoc_Chain);
+      if Match = Not_Compatible then
+         return;
+      end if;
+
+      --  LRM 5.2.1.2  Generic map and port map aspects
+      --  [...]; an actual associated with a formal port in a port map aspect
+      --  must be a signal, an expression, or the reserved word open.
+      --
+      --  Certain restriction apply to the actual associated with a formal in
+      --  a port map aspect; these restrictions are described in 1.1.1.2
+
+      --  LRM93 1.1.1.2
+      --  The actual, if a port or signal, must be denoted by a static name.
+      --  The actual, if an expression, must be a globally static expression.
+      Assoc := Assoc_Chain;
+      Inter := Get_Port_Chain (Inter_Parent);
+      while Assoc /= Null_Iir loop
+         Formal := Get_Association_Formal (Assoc, Inter);
+         Formal_Base := Get_Interface_Of_Formal (Formal);
+
+         if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression then
+            Actual := Get_Actual (Assoc);
+            --  There has been an error, exit from the loop.
+            exit when Actual = Null_Iir;
+            Object := Name_To_Object (Actual);
+            if Is_Valid (Object) and then Is_Signal_Object (Object) then
+               --  Port or signal.
+               Set_Collapse_Signal_Flag
+                 (Assoc, Can_Collapse_Signals (Assoc, Formal));
+               if Get_Name_Staticness (Object) < Globally then
+                  Error_Msg_Sem (+Actual, "actual must be a static name");
+               end if;
+               Check_Port_Association_Bounds_Restrictions
+                 (Formal, Actual, Assoc);
+               Prefix := Get_Object_Prefix (Object);
+               if Get_Kind (Prefix) = Iir_Kind_Interface_Signal_Declaration
+               then
+                  declare
+                     P : Boolean;
+                     pragma Unreferenced (P);
+                  begin
+                     P := Check_Port_Association_Mode_Restrictions
+                       (Formal_Base, Prefix, Assoc);
+                  end;
+               end if;
+            else
+               --  Expression.
+               Set_Collapse_Signal_Flag (Assoc, False);
+
+               pragma Assert (Is_Null (Get_Actual_Conversion (Assoc)));
+               if Flags.Vhdl_Std >= Vhdl_93c then
+                  --  LRM93 1.1.1.2 Ports
+                  --  Moreover, the ports of a block may be associated
+                  --  with an expression, in order to provide these ports
+                  --  with constant driving values; such ports must be
+                  --  of mode in.
+                  if Get_Mode (Formal_Base) /= Iir_In_Mode then
+                     Error_Msg_Sem
+                       (+Assoc, "only 'in' ports may be associated with "
+                          & "expression");
+                  end if;
+
+                  --  LRM93 1.1.1.2 Ports
+                  --  The actual, if an expression, must be a globally
+                  --  static expression.
+                  if Get_Expr_Staticness (Actual) < Globally then
+                     Error_Msg_Sem
+                       (+Actual,
+                        "actual expression must be globally static");
+                  end if;
+               else
+                  Error_Msg_Sem
+                    (+Assoc,
+                     "cannot associate ports with expression in vhdl87");
+               end if;
+            end if;
+         end if;
+         Next_Association_Interface (Assoc, Inter);
+      end loop;
+   end Sem_Port_Association_Chain;
+
+   --  INTER_PARENT contains generics and ports interfaces;
+   --  ASSOC_PARENT constains generics and ports map aspects.
+   procedure Sem_Generic_Port_Association_Chain
+     (Inter_Parent : Iir; Assoc_Parent : Iir)
+   is
+      Res : Boolean;
+      pragma Unreferenced (Res);
+   begin
+      Sem_Generic_Association_Chain (Inter_Parent, Assoc_Parent);
+      Sem_Port_Association_Chain (Inter_Parent, Assoc_Parent);
+   end Sem_Generic_Port_Association_Chain;
+
+   --  LRM 1.3  Configuration Declarations.
+   procedure Sem_Configuration_Declaration (Decl: Iir)
+   is
+      Entity: Iir_Entity_Declaration;
+      Entity_Unit : Iir_Design_Unit;
+   begin
+      Xref_Decl (Decl);
+
+      --  LRM 1.3
+      --  The entity name identifies the name of the entity declaration that
+      --  defines the design entity at the apex of the design hierarchy.
+      Entity := Sem_Entity_Name (Decl);
+      if Entity = Null_Iir then
+         return;
+      end if;
+      Entity_Unit := Get_Design_Unit (Entity);
+
+      --  LRM 11.4
+      --  A primary unit whose name is referenced within a given design unit
+      --  must be analyzed prior to the analysis of the given design unit.
+      Add_Dependence (Entity_Unit);
+
+      Sem_Scopes.Add_Name (Decl);
+
+      Set_Visible_Flag (Decl, True);
+
+      --  LRM 10.1 Declarative Region
+      --  2.  A configuration declaration.
+      Open_Declarative_Region;
+
+      --  LRM93 10.2
+      --  In addition to the above rules, the scope of any declaration that
+      --  includes the end of the declarative part of a given block (whether
+      --  it be an external block defined by a design entity or an internal
+      --  block defined by a block statement) extends into a configuration
+      --  declaration that configures the given block.
+      Add_Context_Clauses (Entity_Unit);
+      Sem_Scopes.Add_Entity_Declarations (Entity);
+
+      Sem_Declaration_Chain (Decl);
+      --  GHDL: no need to check for missing subprogram bodies, since they are
+      --  not allowed in configuration declarations.
+
+      Sem_Block_Configuration (Get_Block_Configuration (Decl), Decl);
+      Close_Declarative_Region;
+   end Sem_Configuration_Declaration;
+
+   --  Analyze the block specification of a block statement or of a generate
+   --  statement.  Return the corresponding block statement, generate
+   --  statement body, or Null_Iir in case of error.
+   function Sem_Block_Specification_Of_Statement
+     (Block_Conf : Iir_Block_Configuration; Father : Iir) return Iir
+   is
+      Block_Spec : Iir;
+      Block_Name : Iir;
+      Block_Stmts : Iir;
+      Prev : Iir_Block_Configuration;
+      Block : Iir;
+      Res : Iir;
+      Assoc : Iir;
+      Clause : Iir;
+      Gen_Spec : Iir;
+   begin
+      Block_Spec := Get_Block_Specification (Block_Conf);
+      case Get_Kind (Block_Spec) is
+         when Iir_Kind_Simple_Name =>
+            Block_Name := Block_Spec;
+         when Iir_Kind_Parenthesis_Name
+           | Iir_Kind_Slice_Name =>
+            Block_Name := Get_Prefix (Block_Spec);
+         when others =>
+            Error_Msg_Sem (+Block_Spec, "label expected");
+            return Null_Iir;
+      end case;
+
+      --  Analyze the label and generate specification.
+      Block_Name := Sem_Denoting_Name (Block_Name);
+      Block := Get_Named_Entity (Block_Name);
+      case Get_Kind (Block) is
+         when Iir_Kind_Block_Statement =>
+            if Get_Kind (Block_Spec) /= Iir_Kind_Simple_Name then
+               Error_Msg_Sem (+Block_Spec,
+                              "label does not denote a generate statement");
+            end if;
+            Set_Block_Specification (Block_Conf, Block_Name);
+            Prev := Get_Block_Block_Configuration (Block);
+            Res := Block;
+
+         when Iir_Kind_For_Generate_Statement =>
+            Res := Get_Generate_Statement_Body (Block);
+            Set_Named_Entity (Block_Name, Res);
+            Prev := Get_Generate_Block_Configuration (Res);
+
+            case Get_Kind (Block_Spec) is
+               when Iir_Kind_Simple_Name =>
+                  Set_Block_Specification (Block_Conf, Block_Name);
+               when Iir_Kind_Parenthesis_Name =>
+                  Block_Spec := Sem_Index_Specification
+                    (Block_Spec,
+                     Get_Type (Get_Parameter_Specification (Block)));
+                  if Block_Spec /= Null_Iir then
+                     Set_Prefix (Block_Spec, Block_Name);
+                     Set_Block_Specification (Block_Conf, Block_Spec);
+                  end if;
+               when others =>
+                  raise Internal_Error;
+            end case;
+
+         when Iir_Kind_If_Generate_Statement =>
+            case Get_Kind (Block_Spec) is
+               when Iir_Kind_Simple_Name =>
+                  --  LRM08 3.4.2 Block configuration
+                  --  If no generate specification appears in such a block
+                  --  configuration, then it applies to exactly one of the
+                  --  following sets of blocks:
+                  --  [...]
+                  --  - The implicit block generated by the corresponding
+                  --    generate statement, if and only if the corresponding
+                  --    generate is an if generate statement and if the first
+                  --    condition after IF evaluates to TRUE.
+                  Res := Get_Generate_Statement_Body (Block);
+
+                  --  LRM08 3.4.2 Block configuration
+                  --  If the block specification of a block configuration
+                  --  contains a generate statement label that denotes an if
+                  --  generate statement, and if the first condition after IF
+                  --  has an alternative label, then it is an error if the
+                  --  generate statement label does not contain a generate
+                  --  specification that is an alternative label.
+                  if Get_Has_Label (Res) then
+                     Error_Msg_Sem
+                       (+Block_Spec,
+                        "alternative label required in block specification");
+                  end if;
+
+                  Set_Block_Specification (Block_Conf, Block_Name);
+
+               when Iir_Kind_Parenthesis_Name =>
+                  if Vhdl_Std < Vhdl_08 then
+                     Error_Msg_Sem
+                       (+Block_Spec,
+                        "alternative label only allowed by vhdl08");
+                     return Null_Iir;
+                  end if;
+                  Assoc := Get_Association_Chain (Block_Spec);
+                  pragma Assert
+                    (Get_Kind (Assoc)
+                       = Iir_Kind_Association_Element_By_Expression);
+                  Gen_Spec := Get_Actual (Assoc);
+                  if Get_Kind (Gen_Spec) /= Iir_Kind_Simple_Name then
+                     Error_Msg_Sem
+                       (+Gen_Spec,
+                        "alternative label expected for if-generate");
+                     return Null_Iir;
+                  end if;
+                  --  Search label.
+                  Clause := Block;
+                  while Clause /= Null_Iir loop
+                     Res := Get_Generate_Statement_Body (Clause);
+                     exit when Get_Alternative_Label (Res)
+                       = Get_Identifier (Gen_Spec);
+                     Clause := Get_Generate_Else_Clause (Clause);
+                  end loop;
+                  if Clause = Null_Iir then
+                     Error_Msg_Sem
+                       (+Gen_Spec,
+                        "alternative label %i not found for if-generate",
+                        +Gen_Spec);
+                     return Null_Iir;
+                  end if;
+                  Set_Named_Entity (Block_Spec, Res);
+                  Xref_Ref (Gen_Spec, Res);
+                  Set_Prefix (Block_Spec, Block_Name);
+                  Set_Block_Specification (Block_Conf, Block_Spec);
+
+               when others =>
+                  raise Internal_Error;
+            end case;
+
+            Set_Named_Entity (Block_Name, Res);
+            Prev := Get_Generate_Block_Configuration (Res);
+
+         when Iir_Kind_Case_Generate_Statement =>
+            case Get_Kind (Block_Spec) is
+               when Iir_Kind_Simple_Name =>
+                  --  LRM08 3.4.2 Block configuration
+                  --  If no generate specification appears in such a block
+                  --  configuration, [...]
+                  --  GHDL: doesn't apply to case generate statement
+                  Error_Msg_Sem
+                    (+Block_Spec,
+                     "missing alternative label for a case-generate");
+                  return Null_Iir;
+               when Iir_Kind_Parenthesis_Name =>
+                  Assoc := Get_Association_Chain (Block_Spec);
+                  pragma Assert
+                    (Get_Kind (Assoc)
+                       = Iir_Kind_Association_Element_By_Expression);
+                  Gen_Spec := Get_Actual (Assoc);
+                  if Get_Kind (Gen_Spec) /= Iir_Kind_Simple_Name then
+                     Error_Msg_Sem
+                       (+Gen_Spec,
+                        "alternative label expected for case-generate");
+                     return Null_Iir;
+                  end if;
+                  --  Search label.
+                  Clause := Get_Case_Statement_Alternative_Chain (Block);
+                  while Clause /= Null_Iir loop
+                     Res := Get_Associated_Block (Clause);
+                     exit when Get_Alternative_Label (Res)
+                       = Get_Identifier (Gen_Spec);
+                     Clause := Get_Chain (Clause);
+                  end loop;
+                  if Clause = Null_Iir then
+                     Error_Msg_Sem
+                       (+Gen_Spec,
+                        "alternative label %i not found for case-generate",
+                        +Gen_Spec);
+                     return Null_Iir;
+                  end if;
+                  Set_Named_Entity (Block_Spec, Res);
+                  Xref_Ref (Gen_Spec, Res);
+                  Set_Prefix (Block_Spec, Block_Name);
+                  Set_Block_Specification (Block_Conf, Block_Spec);
+
+               when others =>
+                  raise Internal_Error;
+            end case;
+
+            Set_Named_Entity (Block_Name, Res);
+            Prev := Get_Generate_Block_Configuration (Res);
+
+         when others =>
+            Error_Msg_Sem (+Block_Conf,
+                           "block or generate statement label expected");
+            return Null_Iir;
+      end case;
+
+      --  LRM93 1.3.1 / LRM08 3.4.2 Block configuration
+      --  [...], and the label must denote a block statement or generate
+      --  statement that is contained immediatly within the block denoted by
+      --  the block specification of the containing block configuration.
+      Block_Stmts := Get_Concurrent_Statement_Chain
+        (Get_Block_From_Block_Specification
+           (Get_Block_Specification (Father)));
+      if not Is_In_Chain (Block_Stmts, Block) then
+         Error_Msg_Sem (+Block_Conf,
+                        "label does not denotes an inner block statement");
+         return Null_Iir;
+      end if;
+
+      case Get_Kind (Block) is
+         when Iir_Kind_Block_Statement =>
+            --  LRM93 1.3
+            --  It is an error if, in a given block configuration, more than
+            --  one configuration item is defined for the same block [or
+            --  component instance].
+            if Prev /= Null_Iir then
+               Error_Msg_Sem
+                 (+Block_Conf,
+                  "%n was already configured at %l", (+Block, +Prev));
+               return Null_Iir;
+            end if;
+            Set_Block_Block_Configuration (Res, Block_Conf);
+
+         when Iir_Kind_If_Generate_Statement
+           | Iir_Kind_Case_Generate_Statement =>
+            --  LRM93 1.3
+            --  It is an error if, in a given block configuration, more than
+            --  one configuration item is defined for the same block [or
+            --  component instance].
+            if Prev /= Null_Iir then
+               Error_Msg_Sem
+                 (+Block_Conf,
+                  "%n was already configured at %l", (+Block, +Prev));
+               return Null_Iir;
+            end if;
+            Set_Generate_Block_Configuration (Res, Block_Conf);
+
+         when Iir_Kind_For_Generate_Statement =>
+            --  LRM93 1.3
+            --  For any name that is the label of a generate statement
+            --  immediately wihin a given block, one or more corresponding
+            --  block configuration may appear as configuration items
+            --  immediately within a block configuration corresponding to the
+            --  given block.
+            --  GHDL: keep them in a linked list, but don't try to detect
+            --  duplicate as values may not be static.  FIXME: try for
+            --  static values only ?
+            Set_Prev_Block_Configuration (Block_Conf, Prev);
+            Set_Generate_Block_Configuration (Res, Block_Conf);
+         when others =>
+            raise Internal_Error;
+      end case;
+      return Res;
+   end Sem_Block_Specification_Of_Statement;
+
+   --  LRM 1.3.1  Block Configuration.
+   --  FATHER is the block_configuration, configuration_declaration,
+   --  component_configuration containing the block_configuration BLOCK_CONF.
+   procedure Sem_Block_Configuration
+     (Block_Conf : Iir_Block_Configuration; Father: Iir)
+   is
+      El : Iir;
+      Block : Iir;
+   begin
+      case Get_Kind (Father) is
+         when Iir_Kind_Configuration_Declaration =>
+            --  LRM93 1.3.1
+            --  If a block configuration appears immediately within a
+            --  configuration declaration, then the block specification of that
+            --  block configuration must be an architecture name, and that
+            --  architecture name must denote a design entity body whose
+            --  interface is defined by the entity declaration denoted by the
+            --  entity name of the enclosing configuration declaration.
+            declare
+               Block_Spec : Iir;
+               Arch : Iir_Architecture_Body;
+               Design: Iir_Design_Unit;
+            begin
+               Block_Spec := Get_Block_Specification (Block_Conf);
+               --  FIXME: handle selected name.
+               if Get_Kind (Block_Spec) /= Iir_Kind_Simple_Name then
+                  Error_Msg_Sem (+Block_Spec, "architecture name expected");
+                  return;
+               end if;
+               --  LRM 10.3 rule b)
+               --  For an architecture body associated with a given entity
+               --  declaration: at the place of the block specification in a
+               --  block configuration for an external block whose interface
+               --  is defined by that entity declaration.
+               Design := Load_Secondary_Unit
+                 (Get_Design_Unit (Get_Entity (Father)),
+                  Get_Identifier (Block_Spec),
+                  Block_Conf);
+               if Design = Null_Iir then
+                  Error_Msg_Sem
+                    (+Block_Conf, "no architecture %i", +Block_Spec);
+                  return;
+               end if;
+               Arch := Get_Library_Unit (Design);
+               Set_Named_Entity (Block_Spec, Arch);
+               Xref_Ref (Block_Spec, Arch);
+               Block := Arch;
+               Add_Dependence (Design);
+            end;
+
+         when Iir_Kind_Component_Configuration =>
+            --  LRM93 1.3.1
+            --  If a block configuration appears immediately within a component
+            --  configuration, then the corresponding components must be
+            --  fully bound, the block specification of that block
+            --  configuration must be an architecture name, and that
+            --  architecture name must denote the same architecture body as
+            --  that to which the corresponding components are bound.
+            declare
+               Block_Spec : Iir;
+               Arch : Iir_Architecture_Body;
+               Design: Iir_Design_Unit;
+               Entity_Aspect : Iir;
+               Entity : Iir;
+               Comp_Arch : Iir;
+            begin
+               Entity_Aspect :=
+                 Get_Entity_Aspect (Get_Binding_Indication (Father));
+               if Entity_Aspect = Null_Iir or else
+                 Get_Kind (Entity_Aspect) /= Iir_Kind_Entity_Aspect_Entity
+               then
+                  Error_Msg_Sem
+                    (+Block_Conf, "corresponding component not fully bound");
+               end if;
+
+               Block_Spec := Get_Block_Specification (Block_Conf);
+               --  FIXME: handle selected name.
+               if Get_Kind (Block_Spec) /= Iir_Kind_Simple_Name then
+                  Error_Msg_Sem (+Block_Spec, "architecture name expected");
+                  return;
+               end if;
+
+               Comp_Arch := Get_Architecture (Entity_Aspect);
+               if Comp_Arch /= Null_Iir then
+                  pragma Assert (Get_Kind (Comp_Arch) = Iir_Kind_Simple_Name);
+                  if Get_Identifier (Comp_Arch) /= Get_Identifier (Block_Spec)
+                  then
+                     Error_Msg_Sem
+                       (+Block_Spec, "block specification name is different "
+                          & "from component architecture name");
+                     return;
+                  end if;
+               end if;
+
+               Entity := Get_Entity (Entity_Aspect);
+               if Entity = Null_Iir then
+                  return;
+               end if;
+
+               Design := Load_Secondary_Unit (Get_Design_Unit (Entity),
+                                              Get_Identifier (Block_Spec),
+                                              Block_Conf);
+               if Design = Null_Iir then
+                  Error_Msg_Sem
+                    (+Block_Conf, "no architecture %i", +Block_Spec);
+                  return;
+               end if;
+               Add_Dependence (Design);
+               Arch := Get_Library_Unit (Design);
+               Set_Named_Entity (Block_Spec, Arch);
+               Xref_Ref (Block_Spec, Arch);
+               Block := Arch;
+            end;
+
+         when Iir_Kind_Block_Configuration =>
+            --  LRM93 1.3.1 / LRM08 3.4.2 Block configuration
+            --  If a block configuration appears immediately within another
+            --  block configuration, then the block specification of the
+            --  contained block configuration must be a block statement or
+            --  generate statement label, and the label must denote a block
+            --  statement or generate statement that is contained immediatly
+            --  within the block denoted by the block specification of the
+            --  containing block configuration.
+            Block := Sem_Block_Specification_Of_Statement (Block_Conf, Father);
+            if Block = Null_Iir then
+               return;
+            end if;
+
+         when others =>
+            Error_Kind ("sem_block_configuration", Father);
+      end case;
+
+      --  LRM93 §10.1
+      --  10. A block configuration
+      Sem_Scopes.Open_Scope_Extension;
+
+      --  LRM 10.3
+      --  In addition, any declaration that is directly visible at the end of
+      --  the declarative part of a given block is directly visible in a block
+      --  configuration that configure the given block.  This rule holds unless
+      --  a use clause that makes a homograph of the declaration potentially
+      --  visible (see 10.4) appears in the corresponding configuration
+      --  declaration, and if the scope of that use clause encompasses all or
+      --  part of those configuration items.  If such a use clase appears, then
+      --  the declaration will be directly visible within the corresponding
+      --  configuration items, except at hose places that fall within the scope
+      --  of the additional use clause.  At such places, neither name will be
+      --  directly visible.
+      --  FIXME: handle use clauses.
+      Sem_Scopes.Extend_Scope_Of_Block_Declarations (Block);
+
+      declare
+         El : Iir;
+      begin
+         El := Get_Declaration_Chain (Block_Conf);
+         while El /= Null_Iir loop
+            case Get_Kind (El) is
+               when Iir_Kind_Use_Clause =>
+                  Sem_Use_Clause (El);
+               when others =>
+                  --  Parse checks there are only use clauses.
+                  raise Internal_Error;
+            end case;
+            El := Get_Chain (El);
+         end loop;
+      end;
+
+      --  VHDL 87: do not remove configuration specification in generate stmts.
+      Clear_Instantiation_Configuration (Block, False);
+
+      El := Get_Configuration_Item_Chain (Block_Conf);
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Block_Configuration =>
+               Sem_Block_Configuration (El, Block_Conf);
+            when Iir_Kind_Component_Configuration =>
+               Sem_Component_Configuration (El, Block_Conf);
+            when others =>
+               Error_Kind ("sem_block_configuration(2)", El);
+         end case;
+         El := Get_Chain (El);
+      end loop;
+      Sem_Scopes.Close_Scope_Extension;
+   end Sem_Block_Configuration;
+
+   --  Check that incremental binding of the component configuration CONF only
+   --  rebinds non associated ports of each instantiations of CONFIGURED_BLOCK
+   --  which CONF applies to.
+   procedure Check_Incremental_Binding (Configured_Block : Iir; Conf : Iir)
+   is
+      Comp : constant Iir := Get_Named_Entity (Get_Component_Name (Conf));
+      Inter_Chain : constant Iir := Get_Port_Chain (Comp);
+      Binding : constant Iir := Get_Binding_Indication (Conf);
+      Inst : Iir;
+   begin
+      --  Check each component instantiation of the block configured by CONF.
+      Inst := Get_Concurrent_Statement_Chain (Configured_Block);
+      while Inst /= Null_Iir loop
+         if Get_Kind (Inst) = Iir_Kind_Component_Instantiation_Statement
+           and then Get_Component_Configuration (Inst) = Conf
+         then
+            --  Check this instantiation.
+            declare
+               Primary_Binding : constant Iir := Get_Binding_Indication
+                 (Get_Configuration_Specification (Inst));
+               F_Chain : constant Iir :=
+                 Get_Port_Map_Aspect_Chain (Primary_Binding);
+               S_El : Iir;
+               S_Inter : Iir;
+               F_El : Iir;
+               Formal : Iir;
+            begin
+               S_El := Get_Port_Map_Aspect_Chain (Binding);
+               S_Inter := Inter_Chain;
+               while S_El /= Null_Iir loop
+                  --  Find S_EL formal in F_CHAIN.
+                  Formal := Get_Association_Interface (S_El, S_Inter);
+                  F_El := Find_First_Association_For_Interface
+                    (F_Chain, Inter_Chain, Formal);
+                  if F_El /= Null_Iir
+                    and then
+                    Get_Kind (F_El) /= Iir_Kind_Association_Element_Open
+                  then
+                     Error_Msg_Sem
+                       (+S_El,
+                        "%n already associated in primary binding", +Formal);
+                  end if;
+                  Next_Association_Interface (S_El, S_Inter);
+               end loop;
+            end;
+         end if;
+         Inst := Get_Chain (Inst);
+      end loop;
+   end Check_Incremental_Binding;
+
+   --  LRM 1.3.2
+   procedure Sem_Component_Configuration
+     (Conf : Iir_Component_Configuration; Father : Iir)
+   is
+      Block : Iir;
+      Configured_Block : Iir;
+      Binding : Iir;
+      Entity : Iir_Design_Unit;
+      Comp : Iir_Component_Declaration;
+      Primary_Entity_Aspect : Iir;
+   begin
+      --  LRM 10.1 Declarative Region
+      --  11. A component configuration.
+      Open_Declarative_Region;
+
+      --  LRM93 10.2
+      --  If a component configuration appears as a configuration item
+      --  immediatly within a block configuration that configures a given
+      --  block, and the scope of a given declaration includes the end of the
+      --  declarative part of that block, then the scope of the given
+      --  declaration extends from the beginning to the end of the
+      --  declarative region associated with the given component configuration.
+      -- GHDL: this is for labels of component instantiation statements, and
+      -- for local ports and generics of the component.
+      if Get_Kind (Father) = Iir_Kind_Block_Configuration then
+         Configured_Block := Get_Block_Specification (Father);
+         pragma Assert (Get_Kind (Configured_Block) /= Iir_Kind_Design_Unit);
+         Configured_Block :=
+           Get_Block_From_Block_Specification (Configured_Block);
+         Sem_Scopes.Extend_Scope_Of_Block_Declarations (Configured_Block);
+      else
+         --  Can a component configuration not be just inside a block
+         --  configuration ?
+         raise Internal_Error;
+      end if;
+      --  FIXME: this is wrong (all declarations should be considered).
+      Sem_Component_Specification
+        (Configured_Block, Conf, Primary_Entity_Aspect);
+
+      Comp := Get_Named_Entity (Get_Component_Name (Conf));
+      if Get_Kind (Comp) /= Iir_Kind_Component_Declaration then
+         --  There has been an error in sem_component_specification.
+         --  Leave here.
+         Close_Declarative_Region;
+         return;
+      end if;
+
+      --  FIXME: (todo)
+      --  If a given component instance is unbound in the corresponding block,
+      --  then any explicit component configuration for that instance that does
+      --  not contain an explicit binding indication will contain an implicit,
+      --  default binding indication (see 5.2.2).  Similarly, if a given
+      --  component instance is unbound in the corresponding block, then any
+      --  implicit component configuration for that instance will contain an
+      --  implicit, default binding indication.
+      Open_Declarative_Region;
+      Sem_Scopes.Add_Component_Declarations (Comp);
+      Binding := Get_Binding_Indication (Conf);
+      if Binding /= Null_Iir then
+         Sem_Binding_Indication (Binding, Conf, Primary_Entity_Aspect);
+
+         if Primary_Entity_Aspect /= Null_Iir then
+            --  LRM93 5.2.1  Binding Indication
+            --  It is an error if a formal port appears in the port map aspect
+            --  of the incremental binding indication and it is a formal
+            --  port that is associated with an actual other than OPEN in one
+            --  of the primary binding indications.
+            Check_Incremental_Binding (Configured_Block, Conf);
+         end if;
+      elsif Primary_Entity_Aspect = Null_Iir then
+         --  LRM93 5.2.1
+         --  If the generic map aspect or port map aspect of a primary binding
+         --  indication is not present, then the default rules as described
+         --  in 5.2.2 apply.
+
+         --  Create a default binding indication.
+         Entity := Get_Visible_Entity_Declaration (Comp);
+         Binding := Sem_Create_Default_Binding_Indication
+           (Comp, Entity, Conf, False, False);
+
+         if Binding /= Null_Iir then
+            --  Remap to defaults.
+            Set_Default_Entity_Aspect (Binding, Get_Entity_Aspect (Binding));
+            Set_Entity_Aspect (Binding, Null_Iir);
+
+            Set_Binding_Indication (Conf, Binding);
+         end if;
+      end if;
+      Close_Declarative_Region;
+
+      --  External block.
+      Block := Get_Block_Configuration (Conf);
+      if Block /= Null_Iir and then Binding /= Null_Iir then
+         Sem_Block_Configuration (Block, Conf);
+      end if;
+      Close_Declarative_Region;
+   end Sem_Component_Configuration;
+
+   function Are_Trees_Chain_Equal (Left, Right : Iir) return Boolean
+   is
+      El_Left, El_Right : Iir;
+   begin
+      if Left = Right then
+         return True;
+      end if;
+      El_Left := Left;
+      El_Right := Right;
+      loop
+         if El_Left = Null_Iir and El_Right = Null_Iir then
+            return True;
+         end if;
+         if El_Left = Null_Iir or El_Right = Null_Iir then
+            return False;
+         end if;
+         if not Are_Trees_Equal (El_Left, El_Right) then
+            return False;
+         end if;
+         El_Left := Get_Chain (El_Left);
+         El_Right := Get_Chain (El_Right);
+      end loop;
+   end Are_Trees_Chain_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
+   is
+      El_Left, El_Right : Iir;
+   begin
+      --  Short-cut to speed up.
+      if Left = Right then
+         return True;
+      end if;
+
+      --  Handle null_iir.
+      if Left = Null_Iir or Right = Null_Iir then
+         --  Note: LEFT *xor* RIGHT is null_iir.
+         return False;
+      end if;
+
+      --  LRM 2.7  Conformance Rules
+      --  A simple name can be replaced by an expanded name in which this
+      --  simple name is the selector, if and only if at both places the
+      --  meaning of the simple name is given by the same declaration.
+      case Get_Kind (Left) is
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name =>
+            case Get_Kind (Right) is
+               when Iir_Kind_Simple_Name
+                 | Iir_Kind_Selected_Name =>
+                  return Are_Trees_Equal (Get_Named_Entity (Left),
+                                          Get_Named_Entity (Right));
+               when others =>
+                  return False;
+            end case;
+         when others =>
+            null;
+      end case;
+
+      --  If nodes are not of the same kind, then they are not equals!
+      if Get_Kind (Left) /= Get_Kind (Right) then
+         return False;
+      end if;
+
+      case Get_Kind (Left) is
+         when Iir_Kind_Procedure_Declaration =>
+            return Are_Trees_Chain_Equal
+              (Get_Interface_Declaration_Chain (Left),
+               Get_Interface_Declaration_Chain (Right));
+         when Iir_Kind_Function_Declaration =>
+            if not Are_Trees_Equal (Get_Return_Type (Left),
+                                    Get_Return_Type (Right))
+            then
+               return False;
+            end if;
+            if Get_Pure_Flag (Left) /= Get_Pure_Flag (Right) then
+               return False;
+            end if;
+            if not Are_Trees_Chain_Equal
+              (Get_Interface_Declaration_Chain (Left),
+               Get_Interface_Declaration_Chain (Right))
+            then
+               return False;
+            end if;
+            return True;
+         when Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Interface_File_Declaration =>
+            if Get_Identifier (Left) /= Get_Identifier (Right) then
+               return False;
+            end if;
+            if Get_Has_Mode (Left) /= Get_Has_Mode (Right)
+              or else Get_Has_Class (Left) /= Get_Has_Class (Right)
+              or else (Get_Has_Identifier_List (Left)
+                         /= Get_Has_Identifier_List (Right))
+              or else Get_Mode (Left) /= Get_Mode (Right)
+            then
+               return False;
+            end if;
+            if not Are_Trees_Equal (Get_Type (Left), Get_Type (Right)) then
+               return False;
+            end if;
+            El_Left := Get_Default_Value (Left);
+            El_Right := Get_Default_Value (Right);
+            if (El_Left = Null_Iir) xor (El_Right = Null_Iir)  then
+               return False;
+            end if;
+            if El_Left /= Null_Iir
+              and then Are_Trees_Equal (El_Left, El_Right) = False
+            then
+               return False;
+            end if;
+            return True;
+
+         when Iir_Kind_Integer_Subtype_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition
+           | Iir_Kind_Floating_Subtype_Definition
+           | Iir_Kind_Physical_Subtype_Definition =>
+            if Get_Base_Type (Left) /= Get_Base_Type (Right) then
+               return False;
+            end if;
+            if Get_Type_Declarator (Left) /= Get_Type_Declarator (Right) then
+               return False;
+            end if;
+            if not Are_Trees_Equal (Get_Resolution_Indication (Left),
+                                    Get_Resolution_Indication (Right))
+            then
+               return False;
+            end if;
+            if Are_Trees_Equal (Get_Range_Constraint (Left),
+                                Get_Range_Constraint (Right)) = False
+            then
+               return False;
+            end if;
+            return True;
+         when Iir_Kind_Array_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),
+                                    Get_Resolution_Indication (Right))
+            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;
+            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),
+                                    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;
+
+         when Iir_Kind_Integer_Literal =>
+            if Get_Value (Left) /= Get_Value (Right) then
+               return False;
+            end if;
+            return Are_Trees_Equal (Get_Literal_Origin (Left),
+                                    Get_Literal_Origin (Right));
+         when Iir_Kind_Enumeration_Literal =>
+            if Get_Enum_Pos (Left) /= Get_Enum_Pos (Right) then
+               return False;
+            end if;
+            return Are_Trees_Equal (Get_Literal_Origin (Left),
+                                    Get_Literal_Origin (Right));
+         when Iir_Kind_Physical_Int_Literal =>
+            if Get_Value (Left) /= Get_Value (Right)
+              or else not Are_Trees_Equal (Get_Unit_Name (Left),
+                                           Get_Unit_Name (Right))
+            then
+               return False;
+            end if;
+            return Are_Trees_Equal (Get_Literal_Origin (Left),
+                                    Get_Literal_Origin (Right));
+         when Iir_Kind_Physical_Fp_Literal =>
+            if Get_Fp_Value (Left) /= Get_Fp_Value (Right)
+              or else not Are_Trees_Equal (Get_Unit_Name (Left),
+                                           Get_Unit_Name (Right))
+            then
+               return False;
+            end if;
+            return Are_Trees_Equal (Get_Literal_Origin (Left),
+                                    Get_Literal_Origin (Right));
+         when Iir_Kind_Unit_Declaration =>
+            return Left = Right;
+         when Iir_Kind_Floating_Point_Literal =>
+            if Get_Fp_Value (Left) /= Get_Fp_Value (Right) then
+               return False;
+            end if;
+            return Are_Trees_Equal (Get_Literal_Origin (Left),
+                                    Get_Literal_Origin (Right));
+
+         when Iir_Kinds_Dyadic_Operator =>
+            return Are_Trees_Equal (Get_Left (Left), Get_Left (Right))
+              and then Are_Trees_Equal (Get_Right (Left), Get_Right (Right));
+         when Iir_Kinds_Monadic_Operator =>
+            return Are_Trees_Equal (Get_Operand (Left), Get_Operand (Right));
+
+         when Iir_Kind_Function_Call =>
+            return Are_Trees_Equal (Get_Prefix (Left), Get_Prefix (Right))
+              and then
+              Are_Trees_Chain_Equal (Get_Parameter_Association_Chain (Left),
+                                     Get_Parameter_Association_Chain (Right));
+
+         when Iir_Kind_Association_Element_By_Expression =>
+            return Are_Trees_Equal (Get_Actual (Left), Get_Actual (Right))
+              and then Are_Trees_Equal (Get_Formal (Left), Get_Formal (Right))
+              and then Are_Trees_Equal (Get_Actual_Conversion (Left),
+                                        Get_Actual_Conversion (Right))
+              and then Are_Trees_Equal (Get_Formal_Conversion (Left),
+                                        Get_Formal_Conversion (Right));
+
+         when Iir_Kind_Type_Conversion =>
+            return Are_Trees_Equal (Get_Type_Mark (Left),
+                                    Get_Type_Mark (Right))
+              and then
+              Are_Trees_Equal (Get_Expression (Left),
+                               Get_Expression (Right));
+
+         when Iir_Kind_Access_Type_Definition
+           | Iir_Kind_Record_Type_Definition
+           | Iir_Kind_Array_Type_Definition
+           | Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_File_Type_Definition =>
+            return Left = Right;
+
+         when Iir_Kind_Range_Expression =>
+            if Get_Type (Left) /= Get_Type (Right)
+              or else Get_Direction (Left) /= Get_Direction (Right)
+            then
+               return False;
+            end if;
+            if not 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;
+
+         when Iir_Kind_High_Type_Attribute
+           | Iir_Kind_Low_Type_Attribute
+           | Iir_Kind_Left_Type_Attribute
+           | Iir_Kind_Right_Type_Attribute
+           | Iir_Kind_Ascending_Type_Attribute =>
+            return Are_Trees_Equal (Get_Prefix (Left), Get_Prefix (Right));
+
+         when Iir_Kind_String_Literal8 =>
+            if Get_Bit_String_Base (Left) /= Get_Bit_String_Base (Right) then
+               return False;
+            end if;
+            declare
+               use Str_Table;
+               Len : constant Nat32 := Get_String_Length (Left);
+               L_Id : constant String8_Id := Get_String8_Id (Left);
+               R_Id : constant String8_Id := Get_String8_Id (Right);
+            begin
+               if Get_String_Length (Right) /= Len then
+                  return False;
+               end if;
+               for I in 1 .. Len loop
+                  if Element_String8 (L_Id, I) /= Element_String8 (R_Id, I)
+                  then
+                     return False;
+                  end if;
+               end loop;
+               return True;
+            end;
+
+         when Iir_Kind_Aggregate =>
+            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;
+
+         when Iir_Kind_Choice_By_None
+              | Iir_Kind_Choice_By_Others =>
+            return Are_Trees_Equal (Get_Associated_Expr (Left),
+                                    Get_Associated_Expr (Right));
+         when Iir_Kind_Choice_By_Name =>
+            if not Are_Trees_Equal (Get_Choice_Name (Left),
+                                    Get_Choice_Name (Right))
+            then
+               return False;
+            end if;
+            return Are_Trees_Equal (Get_Associated_Expr (Left),
+                                    Get_Associated_Expr (Right));
+         when Iir_Kind_Choice_By_Expression =>
+            if not Are_Trees_Equal (Get_Choice_Expression (Left),
+                                    Get_Choice_Expression (Right)) then
+               return False;
+            end if;
+            return Are_Trees_Equal (Get_Associated_Expr (Left),
+                                    Get_Associated_Expr (Right));
+         when Iir_Kind_Choice_By_Range =>
+            if not Are_Trees_Equal (Get_Choice_Range (Left),
+                                    Get_Choice_Range (Right)) then
+               return False;
+            end if;
+            return Are_Trees_Equal (Get_Associated_Expr (Left),
+                                    Get_Associated_Expr (Right));
+         when Iir_Kind_Character_Literal =>
+            return Are_Trees_Equal (Get_Named_Entity (Left),
+                                    Get_Named_Entity (Right));
+         when Iir_Kind_Allocator_By_Subtype =>
+            return Are_Trees_Equal (Get_Subtype_Indication (Left),
+                                    Get_Subtype_Indication (Right));
+         when Iir_Kind_Allocator_By_Expression =>
+            return Are_Trees_Equal (Get_Expression (Left),
+                                    Get_Expression (Right));
+         when others =>
+            Error_Kind ("are_trees_equal", Left);
+      end case;
+   end Are_Trees_Equal;
+
+   --  LRM 2.7  Conformance Rules.
+   procedure Check_Conformance_Rules (Subprg, Spec: Iir) is
+   begin
+      if not Are_Trees_Equal (Subprg, Spec) then
+         --  FIXME: should explain why it does not conform ?
+         Error_Msg_Sem
+           (+Subprg, "body of %n does not conform with specification at %l",
+            (+Subprg, +Spec));
+      end if;
+   end Check_Conformance_Rules;
+
+   -- Return the specification corresponding to a declaration DECL, or
+   -- null_Iir if none.
+   -- FIXME: respect rules of LRM93 2.7
+   function Find_Subprogram_Specification (Decl: Iir) return Iir
+   is
+      Interpretation : Name_Interpretation_Type;
+      Decl1: Iir;
+      Hash : Iir_Int32;
+   begin
+      Hash := Get_Subprogram_Hash (Decl);
+      Interpretation := Get_Interpretation (Get_Identifier (Decl));
+      while Valid_Interpretation (Interpretation) loop
+         if not Is_In_Current_Declarative_Region (Interpretation) then
+            --  The declaration does not belong to the current declarative
+            --  region, neither will the following one.  So, we do not found
+            --  it.
+            return Null_Iir;
+         end if;
+         Decl1 := Get_Declaration (Interpretation);
+         --  Should be sure DECL1 and DECL belongs to the same declarative
+         --  region, ie DECL1 was not made visible via a USE clause.
+         --
+         --  Also, only check for explicitly subprograms (and not
+         --  implicit one).
+         if not Is_Implicit_Subprogram (Decl1)
+           and then Get_Kind (Decl1) in Iir_Kinds_Subprogram_Declaration
+           and then not Is_Potentially_Visible (Interpretation)
+           and then Get_Subprogram_Hash (Decl1) = Hash
+           and then Is_Same_Profile (Decl, Decl1)
+         then
+            return Decl1;
+         end if;
+         Interpretation := Get_Next_Interpretation (Interpretation);
+      end loop;
+      return Null_Iir;
+   end Find_Subprogram_Specification;
+
+   procedure Set_Subprogram_Overload_Number (Decl : Iir)
+   is
+      Id : constant Name_Id := Get_Identifier (Decl);
+      Inter : Name_Interpretation_Type;
+      Prev : Iir;
+      Num : Iir_Int32;
+   begin
+      Inter := Get_Interpretation (Id);
+      while Valid_Interpretation (Inter)
+        and then Is_In_Current_Declarative_Region (Inter)
+      loop
+         --  There is a previous declaration with the same name in the
+         --  current declarative region.
+         Prev := Get_Declaration (Inter);
+         case Get_Kind (Prev) is
+            when Iir_Kind_Function_Declaration
+              | Iir_Kind_Procedure_Declaration =>
+               if Is_Implicit_Subprogram (Prev) then
+                  --  Implicit declarations aren't taken into account (as they
+                  --  are mangled differently).
+                  Inter := Get_Next_Interpretation (Inter);
+               else
+                  --  The previous declaration is a user subprogram.
+                  Num := Get_Overload_Number (Prev) + 1;
+                  if Num = 1
+                    and then Get_Parent (Prev) = Get_Parent (Decl)
+                  then
+                     --  The previous was not (yet) overloaded.  Mark it as
+                     --  overloaded.
+                     --  Do not mark it if it is not in the same declarative
+                     --  part (ie, do not change a subprogram declaration in
+                     -- the package while analyzing the body).
+                     Set_Overload_Number (Prev, 1);
+                     Num := 2;
+                  end if;
+                  Set_Overload_Number (Decl, Num);
+                  return;
+               end if;
+            when Iir_Kind_Enumeration_Literal =>
+               --  Enumeration literal are ignored for overload number.
+               Inter := Get_Next_Interpretation (Inter);
+            when Iir_Kind_Non_Object_Alias_Declaration =>
+               --  Subprogram aliases aren't considered, just skip them.
+               --  (No subprogram is created by an alias).
+               Inter := Get_Next_Interpretation (Inter);
+            when others =>
+               --  Case of user error: redefinition of an identifier.
+               --  Error message is generated by sem_scope.
+               Set_Overload_Number (Decl, 0);
+               return;
+         end case;
+      end loop;
+      --  No previous declaration in the current declarative region.
+      Set_Overload_Number (Decl, 0);
+   end Set_Subprogram_Overload_Number;
+
+   --  Check requirements on number of interfaces for subprogram specification
+   --  SUBPRG.  Requirements only concern operators, and are defined in
+   --  LRM 2.3.1
+   procedure Check_Operator_Requirements (Id : Name_Id; Subprg : Iir)
+   is
+      use Std_Names;
+
+      Nbr_Interfaces : Natural;
+      Is_Method : Boolean;
+   begin
+      Nbr_Interfaces := Iir_Chains.Get_Chain_Length
+        (Get_Interface_Declaration_Chain (Subprg));
+
+      --  For vhdl-02, the protected variable is an implicit parameter.
+      if Flags.Vhdl_Std >= Vhdl_02
+        and then Is_Subprogram_Method (Subprg)
+      then
+         Nbr_Interfaces := Nbr_Interfaces + 1;
+      else
+         Is_Method := False;
+      end if;
+
+      case Id is
+         when Name_Abs
+           | Name_Not =>
+            --  LRM93 2.3.1
+            --  The subprogram specification of a unary operator must have a
+            --  single parameter.
+
+            --  LRM02 2.3.1
+            --  ..., unless the subprogram specification is a method (see
+            --  3.5.1) of a protected type.  In this latter case, the
+            --  subprogram specification must have no parameters.
+            if Nbr_Interfaces = 1 then
+               return;
+            end if;
+            Error_Msg_Sem
+              (+Subprg, "unary operator must have a single parameter");
+         when Name_Mod
+           | Name_Rem
+           | Name_Op_Mul
+           | Name_Op_Div
+           | Name_Relational_Operators
+           | Name_Op_Concatenation
+           | Name_Shift_Operators
+           | Name_Op_Exp =>
+            --  LRM93 2.3.1
+            --  The subprogram specification of a binary operator must have
+            --  two parameters.
+
+            --  LRM02 2.3.1
+            --  ..., unless the subprogram specification is a method of a
+            --  protected type, in which case, the subprogram specification
+            --  must have a single parameter.
+            if Nbr_Interfaces = 2 then
+               return;
+            end if;
+            Error_Msg_Sem
+              (+Subprg, "binary operators must have two parameters");
+         when Name_Logical_Operators
+           | Name_Xnor =>
+            --  LRM08 4.5.2 Operator overloading
+            --  For each of the "+", "-", "and", "or", "xor", "nand", "nor"
+            --  and "xnor", overloading is allowed both as a unary operator
+            --  and as a binary operator.
+            if Nbr_Interfaces = 2 then
+               return;
+            end if;
+            if Nbr_Interfaces = 1 then
+               if Vhdl_Std >= Vhdl_08 then
+                  return;
+               end if;
+               Error_Msg_Sem
+                 (+Subprg,
+                  "logical operators must have two parameters before vhdl08");
+            else
+               Error_Msg_Sem
+                 (+Subprg, "logical operators must have two parameters");
+            end if;
+         when Name_Op_Plus
+           | Name_Op_Minus =>
+            --  LRM93 2.3.1
+            --  For each of the operators "+" and "-", overloading is allowed
+            --  both as a unary operator and as a binary operator.
+            if Nbr_Interfaces in 1 .. 2 then
+               return;
+            end if;
+            Error_Msg_Sem
+              (+Subprg,
+               """+"" and ""-"" operators must have 1 or 2 parameters");
+         when others =>
+            return;
+      end case;
+      if Is_Method then
+         Error_Msg_Sem
+           (+Subprg,
+            " (the protected object is an implicit parameter of methods)");
+      end if;
+   end Check_Operator_Requirements;
+
+   procedure Sem_Subprogram_Specification (Subprg: Iir)
+   is
+      Interface_Chain : Iir;
+      Return_Type : Iir;
+   begin
+      --  LRM 10.1 Declarative Region
+      --  3. A subprogram declaration, together with the corresponding
+      --     subprogram body.
+      Open_Declarative_Region;
+
+      --  Sem interfaces.
+      Interface_Chain := Get_Interface_Declaration_Chain (Subprg);
+      case Get_Kind (Subprg) is
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Interface_Function_Declaration =>
+            Sem_Interface_Chain
+              (Interface_Chain, Function_Parameter_Interface_List);
+            Return_Type := Get_Return_Type_Mark (Subprg);
+            Return_Type := Sem_Type_Mark (Return_Type);
+            Set_Return_Type_Mark (Subprg, Return_Type);
+            Return_Type := Get_Type (Return_Type);
+            Set_Return_Type (Subprg, Return_Type);
+            Set_All_Sensitized_State (Subprg, Unknown);
+
+            --  LRM08 4.2 Subprogram declarations
+            --  It is an error if the result subtype of a function denotes
+            --  either a file type or a protected type.  Moreover, it is an
+            --  error if the result subtype of a pure function denotes an
+            --  access type or a subtype that has a subelement of an access
+            --  type.
+
+            --  GHDL: this was added by VHDL 2008, but vital packages don't
+            --  follow that rule.  So, it is not retroactive.
+            case Get_Kind (Return_Type) is
+               when Iir_Kind_File_Type_Definition =>
+                  Error_Msg_Sem
+                    (+Subprg, "result subtype cannot denote a file type");
+               when Iir_Kind_Protected_Type_Declaration =>
+                  Error_Msg_Sem
+                    (+Subprg, "result subtype cannot denote a protected type");
+               when Iir_Kind_Access_Type_Definition
+                 | Iir_Kind_Access_Subtype_Definition =>
+                  if Vhdl_Std >= Vhdl_08
+                    and then Get_Pure_Flag (Subprg)
+                  then
+                     Error_Msg_Sem_Relaxed
+                       (Subprg, Warnid_Pure,
+                        "result subtype of a pure function cannot denote an"
+                          & " access type");
+                  end if;
+               when others =>
+                  if  Vhdl_Std >= Vhdl_08
+                    and then not Get_Signal_Type_Flag (Return_Type)
+                    and then Get_Pure_Flag (Subprg)
+                  then
+                     Error_Msg_Sem_Relaxed
+                       (Subprg, Warnid_Pure,
+                        "result subtype of a pure function cannot have"
+                          & " access subelements");
+                  end if;
+            end case;
+
+         when Iir_Kind_Interface_Procedure_Declaration =>
+            Sem_Interface_Chain
+              (Interface_Chain, Procedure_Parameter_Interface_List);
+
+         when Iir_Kind_Procedure_Declaration =>
+            Sem_Interface_Chain
+              (Interface_Chain, Procedure_Parameter_Interface_List);
+
+            --  Unless the body is analyzed, the procedure purity is unknown.
+            Set_Purity_State (Subprg, Unknown);
+            --  Check if the procedure is passive.
+            Set_Passive_Flag (Subprg, True);
+            Set_All_Sensitized_State (Subprg, Unknown);
+            declare
+               Inter : Iir;
+            begin
+               Inter := Interface_Chain;
+               while Inter /= Null_Iir loop
+                  if Get_Kind (Inter) = Iir_Kind_Interface_Signal_Declaration
+                    and then Get_Mode (Inter) /= Iir_In_Mode
+                  then
+                     --  There is a driver for this signal interface.
+                     Set_Passive_Flag (Subprg, False);
+                     exit;
+                  end if;
+                  Inter := Get_Chain (Inter);
+               end loop;
+            end;
+
+            --  Mark the procedure as suspendable, unless in a std packages.
+            --  This is a minor optimization.
+            if Get_Library (Get_Design_File (Get_Current_Design_Unit))
+              /= Libraries.Std_Library
+            then
+               Set_Suspend_Flag (Subprg, True);
+            end if;
+         when others =>
+            Error_Kind ("sem_subprogram_declaration", Subprg);
+      end case;
+
+      Check_Operator_Requirements (Get_Identifier (Subprg), Subprg);
+
+      Sem_Utils.Compute_Subprogram_Hash (Subprg);
+
+      --  The specification has been analyzed, close the declarative region
+      --  now.
+      Close_Declarative_Region;
+   end Sem_Subprogram_Specification;
+
+   --  LRM 2.1  Subprogram Declarations.
+   procedure Sem_Subprogram_Declaration (Subprg: Iir)
+   is
+      Parent : constant Iir := Get_Parent (Subprg);
+      Spec: Iir;
+      Subprg_Body : Iir;
+   begin
+      --  Set depth.
+      case Get_Kind (Parent) is
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Procedure_Declaration =>
+            raise Internal_Error;
+         when Iir_Kind_Function_Body
+           | Iir_Kind_Procedure_Body =>
+            Set_Subprogram_Depth
+              (Subprg,
+               Get_Subprogram_Depth
+                 (Get_Subprogram_Specification (Parent)) + 1);
+         when others =>
+            --  FIXME: protected type ?
+            Set_Subprogram_Depth (Subprg, 0);
+      end case;
+
+      Sem_Subprogram_Specification (Subprg);
+
+      --  Look if there is an associated body (the next node).
+      Subprg_Body := Get_Chain (Subprg);
+      if Subprg_Body /= Null_Iir
+        and then Get_Kind (Subprg_Body) in Iir_Kinds_Subprogram_Body
+      then
+         Spec := Find_Subprogram_Specification (Subprg);
+      else
+         Spec := Null_Iir;
+      end if;
+
+      if Spec /= Null_Iir then
+         -- SUBPRG is the body of the specification SPEC.
+         if Get_Subprogram_Body (Spec) /= Null_Iir then
+            Error_Msg_Sem (+Subprg, "%n body already defined at %l",
+                           (+Spec, +Get_Subprogram_Body (Spec)));
+            --  Kill warning.
+            Set_Use_Flag (Subprg, True);
+         else
+            Check_Conformance_Rules (Subprg, Spec);
+            Xref_Body (Subprg, Spec);
+            Set_Subprogram_Body (Subprg, Subprg_Body);
+            Set_Subprogram_Specification (Subprg_Body, Spec);
+            Set_Subprogram_Body (Spec, Subprg_Body);
+         end if;
+      else
+         --  Forward declaration or specification followed by body.
+         Set_Subprogram_Overload_Number (Subprg);
+         Sem_Scopes.Add_Name (Subprg);
+         Name_Visible (Subprg);
+         Xref_Decl (Subprg);
+      end if;
+   end Sem_Subprogram_Declaration;
+
+   procedure Add_Analysis_Checks_List (El : Iir)
+   is
+      Design : constant Iir := Get_Current_Design_Unit;
+      List : Iir_List;
+   begin
+      List := Get_Analysis_Checks_List (Design);
+      if List = Null_Iir_List then
+         List := Create_Iir_List;
+         Set_Analysis_Checks_List (Design, List);
+      end if;
+      Add_Element (List, El);
+   end Add_Analysis_Checks_List;
+
+   procedure Sem_Subprogram_Body (Subprg : Iir)
+   is
+      Spec : constant Iir := Get_Subprogram_Specification (Subprg);
+      Warn_Hide_Enabled : constant Boolean := Is_Warning_Enabled (Warnid_Hide);
+      El : Iir;
+   begin
+      Set_Impure_Depth (Subprg, Iir_Depth_Pure);
+
+      --  LRM 10.1  Declarative regions
+      --  3.  A subprogram declaration, together with the corresponding
+      --     subprogram body.
+      Open_Declarative_Region;
+      Set_Is_Within_Flag (Spec, True);
+
+      --  Add the interface names into the current declarative region.
+      --  (Do not emit warnings for hiding, they were already emitted during
+      --   analysis of the subprogram spec).
+      Enable_Warning (Warnid_Hide, False);
+      El := Get_Interface_Declaration_Chain (Spec);
+      while El /= Null_Iir loop
+         Add_Name (El, Get_Identifier (El), False);
+         if Get_Kind (El) = Iir_Kind_Interface_Signal_Declaration then
+            Set_Has_Active_Flag (El, False);
+         end if;
+         El := Get_Chain (El);
+      end loop;
+      Enable_Warning (Warnid_Hide, Warn_Hide_Enabled);
+
+      Sem_Sequential_Statements (Spec, Subprg);
+
+      Set_Is_Within_Flag (Spec, False);
+      Close_Declarative_Region;
+
+      case Get_Kind (Spec) is
+         when Iir_Kind_Procedure_Declaration =>
+            if Get_Suspend_Flag (Subprg)
+              and then not Get_Suspend_Flag (Spec)
+            then
+               --  Incoherence: procedures declared in std library are not
+               --  expected to suspend.  This is an internal check.
+               Error_Msg_Sem (+Subprg, "unexpected suspendable procedure");
+            end if;
+
+            --  Update purity state of procedure if there are no callees.
+            case Get_Purity_State (Spec) is
+               when Pure
+                 | Maybe_Impure =>
+                  --  We can't know this yet.
+                  raise Internal_Error;
+               when Impure =>
+                  null;
+               when Unknown =>
+                  if Get_Callees_List (Subprg) = Null_Iir_List then
+                     --  Since there are no callees, purity state can
+                     --  be updated.
+                     if Get_Impure_Depth (Subprg) = Iir_Depth_Pure then
+                        Set_Purity_State (Spec, Pure);
+                     else
+                        Set_Purity_State (Spec, Maybe_Impure);
+                     end if;
+                  end if;
+            end case;
+
+            --  Update wait state if the state of all callees is known.
+            if Get_Wait_State (Spec) = Unknown then
+               declare
+                  Callees : constant Iir_List := Get_Callees_List (Subprg);
+                  Callees_It : List_Iterator;
+                  Callee : Iir;
+                  State : Tri_State_Type;
+               begin
+                  --  Per default, has no wait.
+                  Set_Wait_State (Spec, False);
+                  Callees_It := List_Iterate_Safe (Callees);
+                  while Is_Valid (Callees_It) loop
+                     Callee := Get_Element (Callees_It);
+                     case Get_Kind (Callee) is
+                        when Iir_Kind_Function_Declaration =>
+                           null;
+                        when Iir_Kind_Procedure_Declaration =>
+                           State := Get_Wait_State (Callee);
+                           case State is
+                              when False =>
+                                 null;
+                              when Unknown =>
+                                 --  Yet unknown, but can be TRUE.
+                                 Set_Wait_State (Spec, Unknown);
+                              when True =>
+                                 --  Can this happen ?
+                                 raise Internal_Error;
+                                 --Set_Wait_State (Spec, True);
+                                 --exit;
+                           end case;
+                        when others =>
+                           Error_Kind ("sem_subprogram_body(2)", Callee);
+                     end case;
+                     Next (Callees_It);
+                  end loop;
+               end;
+            end if;
+
+            --  Do not add to Analysis_Checks_List as procedures can't
+            --  generate purity/wait/all-sensitized errors by themselves.
+
+         when Iir_Kind_Function_Declaration =>
+            if Get_Callees_List (Subprg) /= Null_Iir_List then
+               --  Purity calls to be checked later.
+               --  No wait statements in procedures called.
+               Add_Analysis_Checks_List (Spec);
+            end if;
+         when others =>
+            Error_Kind ("sem_subprogram_body", Spec);
+      end case;
+
+      --  Set All_Sensitized_State in trivial cases.
+      if Get_All_Sensitized_State (Spec) = Unknown
+        and then Get_Callees_List (Subprg) = Null_Iir_List
+      then
+         Set_All_Sensitized_State (Spec, No_Signal);
+      end if;
+   end Sem_Subprogram_Body;
+
+   --  Return the subprogram body of SPEC.  If there is no body, and if SPEC
+   --  is an instance, returns the body of the generic specification but only
+   --  if known.
+   function Get_Subprogram_Body_Or_Generic (Spec : Iir) return Iir
+   is
+      Bod : Iir;
+      Orig : Iir;
+   begin
+      Bod := Get_Subprogram_Body (Spec);
+
+      if Bod /= Null_Iir then
+         return Bod;
+      end if;
+
+      Orig := Sem_Inst.Get_Origin (Spec);
+      if Orig = Null_Iir then
+         return Null_Iir;
+      end if;
+
+      return Get_Subprogram_Body (Orig);
+   end Get_Subprogram_Body_Or_Generic;
+
+   --  Status of Update_And_Check_Pure_Wait.
+   type Update_Pure_Status is
+     (
+      --  The purity/wait/all-sensitized are computed and known.
+      Update_Pure_Done,
+      --  A missing body prevents from computing the purity/wait/all-sensitized
+      Update_Pure_Missing,
+      --  Purity/wait/all-sensitized is unknown (recursion).
+      Update_Pure_Unknown
+     );
+
+   function Update_And_Check_Pure_Wait (Subprg : Iir) return Update_Pure_Status
+   is
+      procedure Error_Wait (Caller : Iir; Callee : Iir) is
+      begin
+         Error_Msg_Sem
+           (+Caller, "%n must not contain wait statement, but calls",
+            (1 => +Caller), Cont => True);
+         Error_Msg_Sem
+           (+Callee, "%n which has (indirectly) a wait statement", +Callee);
+      end Error_Wait;
+
+      --  Kind of subprg.
+      type Caller_Kind is (K_Function, K_Process, K_Procedure);
+      Kind : Caller_Kind;
+
+      Callees_List : Iir_List;
+      Callees_List_Holder : Iir;
+      Callees_It : List_Iterator;
+      Callee : Iir;
+      Callee_Bod : Iir;
+      Subprg_Depth : Iir_Int32;
+      Subprg_Bod : Iir;
+      --  Current purity depth of SUBPRG.
+      Depth : Iir_Int32;
+      Depth_Callee : Iir_Int32;
+      Has_Wait_Errors : Boolean := False;
+      New_List : Iir_List;
+      Res, Res1 : Update_Pure_Status;
+   begin
+      case Get_Kind (Subprg) is
+         when Iir_Kind_Function_Declaration =>
+            Kind := K_Function;
+            Subprg_Bod := Get_Subprogram_Body_Or_Generic (Subprg);
+            if Subprg_Bod = Null_Iir then
+               return Update_Pure_Missing;
+            end if;
+            Subprg_Depth := Get_Subprogram_Depth (Subprg);
+            Callees_List_Holder := Subprg_Bod;
+            if Get_Pure_Flag (Subprg) then
+               Depth := Iir_Depth_Pure;
+            else
+               Depth := Iir_Depth_Impure;
+            end if;
+
+         when Iir_Kind_Procedure_Declaration =>
+            Kind := K_Procedure;
+            Subprg_Bod := Get_Subprogram_Body_Or_Generic (Subprg);
+            if Subprg_Bod = Null_Iir then
+               return Update_Pure_Missing;
+            end if;
+            if Get_Purity_State (Subprg) = Impure
+              and then Get_Wait_State (Subprg) /= Unknown
+              and then Get_All_Sensitized_State (Subprg) /= Unknown
+            then
+               --  No need to go further.
+               if Get_All_Sensitized_State (Subprg) = No_Signal
+                 or else Vhdl_Std < Vhdl_08
+               then
+                  Callees_List := Get_Callees_List (Subprg_Bod);
+                  Destroy_Iir_List (Callees_List);
+                  Set_Callees_List (Subprg_Bod, Null_Iir_List);
+               end if;
+               return Update_Pure_Done;
+            end if;
+            Subprg_Depth := Get_Subprogram_Depth (Subprg);
+            Depth := Get_Impure_Depth (Subprg_Bod);
+            Callees_List_Holder := Subprg_Bod;
+
+         when Iir_Kind_Sensitized_Process_Statement =>
+            Kind := K_Process;
+            Subprg_Bod := Null_Iir;
+            Subprg_Depth := Iir_Depth_Top;
+            Depth := Iir_Depth_Impure;
+            Callees_List_Holder := Subprg;
+
+         when others =>
+            Error_Kind ("update_and_check_pure_wait(1)", Subprg);
+      end case;
+
+      --  If the subprogram has no callee list, there is nothing to do.
+      Callees_List := Get_Callees_List (Callees_List_Holder);
+      if Callees_List = Null_Iir_List then
+         --  There are two reasons why a callees_list is null:
+         --  * either because SUBPRG does not call any procedure
+         --    in this case, the status are already known and we should have
+         --    returned in the above case.
+         --  * or because of a recursion
+         --    in this case the status are still unknown here.
+         return Update_Pure_Unknown;
+      end if;
+
+      --  By default we don't know the status.
+      Res := Update_Pure_Unknown;
+
+      --  This subprogram is being considered.
+      --  To avoid infinite loop, suppress its callees list.
+      Set_Callees_List (Callees_List_Holder, Null_Iir_List);
+
+      --  First loop: check without recursion.
+      --  Second loop: recurse if necessary.
+      for J in 0 .. 1 loop
+         New_List := Create_Iir_List;
+         Callees_It := List_Iterate (Callees_List);
+         while Is_Valid (Callees_It) loop
+            Callee := Get_Element (Callees_It);
+
+            --  Note:
+            --  Pure functions should not be in the list.
+            --  Impure functions must have directly set Purity_State.
+
+            --  The body of subprograms may not be set for instances.
+            --  Use the body from the generic (if any).
+            --  This is meaningful for non macro-expanded package interface,
+            --  because there is no associated body and because the call
+            --  tree is known (if there were an interface subprogram, it
+            --  would have been macro-expanded).
+            --  Do not set the body, as it would trigger an assert during
+            --  macro-expansion (maybe this shouldn't be called for macro
+            --  expanded packages).
+            Callee_Bod := Get_Subprogram_Body_Or_Generic (Callee);
+
+            --  Check pure.
+            if Callee_Bod = Null_Iir then
+               --  No body yet for the subprogram called.
+               --  Nothing can be extracted from it, postpone the checks until
+               --  elaboration.
+               Res := Update_Pure_Missing;
+            else
+               --  Second loop: recurse if a state is not known.
+               if J = 1
+                 and then
+                 ((Get_Kind (Callee) = Iir_Kind_Procedure_Declaration
+                     and then Get_Purity_State (Callee) = Unknown)
+                  or else Get_Wait_State (Callee) = Unknown
+                  or else Get_All_Sensitized_State (Callee) = Unknown)
+               then
+                  Res1 := Update_And_Check_Pure_Wait (Callee);
+                  if Res1 = Update_Pure_Missing then
+                     Res := Update_Pure_Missing;
+                  end if;
+               end if;
+
+               --  Check purity only if the subprogram is not impure.
+               if Depth /= Iir_Depth_Impure then
+                  Depth_Callee := Get_Impure_Depth (Callee_Bod);
+
+                  --  Check purity depth.
+                  if Depth_Callee < Subprg_Depth then
+                     --  The call is an impure call because it calls an outer
+                     --   subprogram (or an impure subprogram).
+                     --  FIXME: check the compare.
+                     Depth_Callee := Iir_Depth_Impure;
+                     if Kind = K_Function then
+                        --  FIXME: report call location
+                        Error_Pure (Elaboration, Subprg_Bod, Callee, Null_Iir);
+                     end if;
+                  end if;
+
+                  --  Update purity depth.
+                  if Depth_Callee < Depth then
+                     Depth := Depth_Callee;
+                     if Kind = K_Procedure then
+                        --  Update for recursivity.
+                        Set_Impure_Depth (Subprg_Bod, Depth);
+                        if Depth = Iir_Depth_Impure then
+                           Set_Purity_State (Subprg, Impure);
+                        end if;
+                     end if;
+                  end if;
+               end if;
+            end if;
+
+            --  Check wait.
+            if Has_Wait_Errors = False
+              and then Get_Wait_State (Callee) = True
+            then
+               if Kind = K_Procedure then
+                  Set_Wait_State (Subprg, True);
+               else
+                  Error_Wait (Subprg, Callee);
+                  Has_Wait_Errors := True;
+               end if;
+            end if;
+
+            if Get_All_Sensitized_State (Callee) = Invalid_Signal then
+               case Kind is
+                  when K_Function | K_Procedure =>
+                     Set_All_Sensitized_State (Subprg, Invalid_Signal);
+                  when K_Process =>
+                     --  LRM08 11.3
+                     --
+                     --  It is an error if a process statement with the
+                     --  reserved word ALL as its process sensitivity list
+                     --  is the parent of a subprogram declared in a design
+                     --  unit other than that containing the process statement
+                     --  and the subprogram reads an explicitly declared
+                     --  signal that is not a formal signal parameter or
+                     --  member of a formal signal parameter of the
+                     --  subprogram or of any of its parents.  Similarly,
+                     --  it is an error if such subprogram reads an implicit
+                     --  signal whose explicit ancestor is not a formal signal
+                     --  parameter or member of a formal parameter of
+                     --  the subprogram or of any of its parents.
+                     Error_Msg_Sem
+                       (+Subprg, "all-sensitized %n can't call %n",
+                        (+Subprg, +Callee), Cont => True);
+                     Error_Msg_Sem
+                       (+Subprg,
+                        " (as this subprogram reads (indirectly) a signal)");
+               end case;
+            end if;
+
+            --  Keep in list.
+            if Callee_Bod = Null_Iir
+              or else
+              (Get_Kind (Callee) = Iir_Kind_Procedure_Declaration
+                 and then Get_Purity_State (Callee) = Unknown
+                 and then Depth /= Iir_Depth_Impure)
+              or else
+              (Get_Wait_State (Callee) = Unknown
+                 and then (Kind /= K_Procedure
+                             or else Get_Wait_State (Subprg) = Unknown))
+              or else
+              (Vhdl_Std >= Vhdl_08
+                 and then
+                 (Get_All_Sensitized_State (Callee) = Unknown
+                    or else Get_All_Sensitized_State (Callee) = Read_Signal))
+            then
+               Append_Element (New_List, Callee);
+            end if;
+            Next (Callees_It);
+         end loop;
+
+         --  End of callee loop.
+         if Is_Empty (New_List) then
+            Destroy_Iir_List (Callees_List);
+            Callees_List := Null_Iir_List;
+            Destroy_Iir_List (New_List);
+            if Kind = K_Procedure then
+               if Get_Purity_State (Subprg) = Unknown then
+                  Set_Purity_State (Subprg, Maybe_Impure);
+               end if;
+               if Get_Wait_State (Subprg) = Unknown then
+                  Set_Wait_State (Subprg, False);
+               end if;
+            end if;
+            if Kind = K_Procedure or Kind = K_Function then
+               if Get_All_Sensitized_State (Subprg) = Unknown then
+                  Set_All_Sensitized_State (Subprg, No_Signal);
+               end if;
+            end if;
+            Res := Update_Pure_Done;
+            exit;
+         else
+            Destroy_Iir_List (Callees_List);
+            Callees_List := New_List;
+         end if;
+      end loop;
+
+      Set_Callees_List (Callees_List_Holder, New_List);
+
+      return Res;
+   end Update_And_Check_Pure_Wait;
+
+   --  Check pure/wait/all-sensitized issues for SUBPRG (subprogram or
+   --  process).  Return False if the analysis is incomplete (and must
+   --  be deferred).
+   function Root_Update_And_Check_Pure_Wait (Subprg : Iir) return Boolean
+   is
+      Res : Update_Pure_Status;
+   begin
+      Res := Update_And_Check_Pure_Wait (Subprg);
+      case Res is
+         when Update_Pure_Done =>
+            return True;
+         when Update_Pure_Missing =>
+            return False;
+         when Update_Pure_Unknown =>
+            --  The purity/wait is unknown, but all callee were walked.
+            --  This means there are recursive calls but without violations.
+            if Get_Kind (Subprg) = Iir_Kind_Procedure_Declaration then
+               if Get_Purity_State (Subprg) = Unknown then
+                  Set_Purity_State (Subprg, Maybe_Impure);
+               end if;
+               if Get_Wait_State (Subprg) = Unknown then
+                  Set_Wait_State (Subprg, False);
+               end if;
+            end if;
+            if Get_Kind (Subprg) in Iir_Kinds_Subprogram_Declaration then
+               if Get_All_Sensitized_State (Subprg) = Unknown then
+                  Set_All_Sensitized_State (Subprg, No_Signal);
+               end if;
+            end if;
+            return True;
+      end case;
+   end Root_Update_And_Check_Pure_Wait;
+
+   procedure Sem_Analysis_Checks_List (Unit : Iir_Design_Unit;
+                                       Emit_Warnings : Boolean)
+   is
+      List : Iir_List;
+      El : Iir;
+      It : List_Iterator;
+      Keep : Boolean;
+      New_List : Iir_List;
+   begin
+      List := Get_Analysis_Checks_List (Unit);
+      if List = Null_Iir_List then
+         --  Return now if there is nothing to check.
+         return;
+      end if;
+
+      New_List := Create_Iir_List;
+      It := List_Iterate (List);
+      while Is_Valid (It) loop
+         El := Get_Element (It);
+         Keep := False;
+         case Get_Kind (El) is
+            when Iir_Kind_Function_Declaration =>
+               --  FIXME: remove from list if fully tested ?
+               if not Root_Update_And_Check_Pure_Wait (El) then
+                  Keep := True;
+                  if Emit_Warnings then
+                     declare
+                        Bod : constant Iir := Get_Subprogram_Body (El);
+                        Callees : constant Iir_List := Get_Callees_List (Bod);
+                        pragma Assert (Callees /= Null_Iir_List);
+                        Callee : constant Iir := Get_First_Element (Callees);
+                     begin
+                        Warning_Msg_Sem
+                          (Warnid_Delayed_Checks, +El,
+                           "can't assert that all calls in %n"
+                             & " are pure or have not wait;"
+                             & " will be checked at elaboration",
+                           +El, Cont => True);
+                        --  FIXME: could improve this message by displaying
+                        --  the chain of calls until the first subprograms in
+                        --  unknown state.
+                        Warning_Msg_Sem
+                          (Warnid_Delayed_Checks, +Callee,
+                           "(first such call is to %n)", +Callee);
+                     end;
+                  end if;
+               end if;
+            when Iir_Kind_Sensitized_Process_Statement =>
+               if not Root_Update_And_Check_Pure_Wait (El) then
+                  Keep := True;
+                  if Emit_Warnings then
+                     Warning_Msg_Sem
+                       (Warnid_Delayed_Checks, +El,
+                        "can't assert that %n has no wait; "
+                          & "will be checked at elaboration", +El);
+                  end if;
+               end if;
+            when others =>
+               Error_Kind ("sem_analysis_checks_list", El);
+         end case;
+         if Keep then
+            Append_Element (New_List, El);
+         end if;
+         Next (It);
+      end loop;
+      if Is_Empty (New_List) then
+         Destroy_Iir_List (New_List);
+         New_List := Null_Iir_List;  --  OK, redundant but clearer.
+      end if;
+      Destroy_Iir_List (List);
+      Set_Analysis_Checks_List (Unit, New_List);
+   end Sem_Analysis_Checks_List;
+
+   --  Return true if package declaration DECL needs a body.
+   --  Ie, it contains subprogram specification or deferred constants.
+   function Package_Need_Body_P (Decl: Iir_Package_Declaration)
+                                return Boolean
+   is
+      El: Iir;
+      Def : Iir;
+   begin
+      El := Get_Declaration_Chain (Decl);
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Function_Declaration
+              | Iir_Kind_Procedure_Declaration =>
+               if not Is_Implicit_Subprogram (El) then
+                  return True;
+               end if;
+            when Iir_Kind_Constant_Declaration =>
+               if Get_Default_Value (El) = Null_Iir then
+                  return True;
+               end if;
+            when Iir_Kind_Variable_Declaration
+              | Iir_Kind_File_Declaration
+              | Iir_Kind_Signal_Declaration
+              | Iir_Kind_Object_Alias_Declaration
+              | Iir_Kind_Non_Object_Alias_Declaration
+              | Iir_Kind_Group_Template_Declaration
+              | Iir_Kind_Group_Declaration =>
+               null;
+            when Iir_Kind_Type_Declaration =>
+               Def := Get_Type_Definition (El);
+               if Def /= Null_Iir
+                 and then Get_Kind (Def) = Iir_Kind_Protected_Type_Declaration
+               then
+                  return True;
+               end if;
+            when Iir_Kind_Anonymous_Type_Declaration
+              | Iir_Kind_Subtype_Declaration =>
+               null;
+            when Iir_Kind_Attribute_Declaration
+              | Iir_Kind_Attribute_Specification =>
+               null;
+            when Iir_Kind_Disconnection_Specification =>
+               null;
+            when Iir_Kind_Use_Clause =>
+               null;
+            when Iir_Kind_Component_Declaration =>
+               null;
+            when Iir_Kind_Protected_Type_Body =>
+               null;
+            when Iir_Kind_Package_Declaration =>
+               --  LRM08 4.8 Package bodies
+               --  A package body that is not a library unit shall appear
+               --  immediately within the same declarative region as the
+               --  corresponding package declaration and textually subsequent
+               --  to that package declaration.
+               if Get_Need_Body (El) then
+                  return True;
+               end if;
+            when Iir_Kind_Package_Body =>
+               null;
+            when Iir_Kind_Package_Instantiation_Declaration =>
+               null;
+            when Iir_Kind_Nature_Declaration
+              | Iir_Kind_Subnature_Declaration =>
+               null;
+            when Iir_Kind_Terminal_Declaration =>
+               null;
+            when others =>
+               pragma Assert (Flags.Flag_Force_Analysis);
+               null;
+         end case;
+         El := Get_Chain (El);
+      end loop;
+      return False;
+   end Package_Need_Body_P;
+
+   --  Return true if package declaration DECL contains at least one package
+   --  instantiation that needs a body.
+   function Package_Need_Instance_Bodies_P (Decl: Iir_Package_Declaration)
+                                           return Boolean
+   is
+      El: Iir;
+   begin
+      El := Get_Declaration_Chain (Decl);
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Package_Instantiation_Declaration =>
+               declare
+                  Pkg : constant Iir := Get_Uninstantiated_Package_Decl (El);
+               begin
+                  if not Is_Error (Pkg)
+                    and then Get_Need_Body (Pkg)
+                  then
+                     return True;
+                  end if;
+               end;
+            when others =>
+               null;
+         end case;
+         El := Get_Chain (El);
+      end loop;
+      return False;
+   end Package_Need_Instance_Bodies_P;
+
+   --  Return true if uninstantiated pckage DECL must be macro-expanded (at
+   --  least one interface type).
+   function Is_Package_Macro_Expanded
+     (Decl : Iir_Package_Declaration) return Boolean
+   is
+      Header : constant Iir := Get_Package_Header (Decl);
+      Inter : Iir;
+   begin
+      Inter := Get_Generic_Chain (Header);
+      while Is_Valid (Inter) loop
+         case Iir_Kinds_Interface_Declaration (Get_Kind (Inter)) is
+            when Iir_Kinds_Interface_Object_Declaration =>
+               null;
+            when Iir_Kind_Interface_Type_Declaration =>
+               return True;
+            when Iir_Kind_Interface_Package_Declaration =>
+               declare
+                  Pkg : constant Iir :=
+                    Get_Uninstantiated_Package_Decl (Inter);
+               begin
+                  if Get_Macro_Expanded_Flag (Pkg) then
+                     return True;
+                  end if;
+               end;
+            when Iir_Kinds_Interface_Subprogram_Declaration =>
+               return True;
+         end case;
+         Inter := Get_Chain (Inter);
+      end loop;
+      return False;
+   end Is_Package_Macro_Expanded;
+
+   --  LRM 2.5  Package Declarations.
+   procedure Sem_Package_Declaration (Pkg : Iir_Package_Declaration)
+   is
+      Unit : constant Iir_Design_Unit := Get_Design_Unit (Pkg);
+      Header : constant Iir := Get_Package_Header (Pkg);
+      Implicit : Implicit_Signal_Declaration_Type;
+   begin
+      Sem_Scopes.Add_Name (Pkg);
+      Set_Visible_Flag (Pkg, True);
+      Xref_Decl (Pkg);
+
+      Set_Is_Within_Flag (Pkg, True);
+
+      --  Identify IEEE.Std_Logic_1164 for VHDL08.
+      if Get_Identifier (Pkg) = Std_Names.Name_Std_Logic_1164
+        and then (Get_Identifier (Get_Library (Get_Design_File (Unit)))
+                    = Std_Names.Name_Ieee)
+      then
+         Ieee.Std_Logic_1164.Std_Logic_1164_Pkg := Pkg;
+      end if;
+
+      --  LRM93 10.1 Declarative Region
+      --  4. A package declaration, together with the corresponding
+      --     body (if any).
+      Open_Declarative_Region;
+
+      Push_Signals_Declarative_Part (Implicit, Pkg);
+
+      if Header /= Null_Iir then
+         declare
+            Generic_Chain : constant Iir := Get_Generic_Chain (Header);
+            Generic_Map : constant Iir :=
+              Get_Generic_Map_Aspect_Chain (Header);
+            Assoc_El : Iir;
+            Inter_El : Iir;
+            Inter : Iir;
+         begin
+            Sem_Interface_Chain (Generic_Chain, Generic_Interface_List);
+
+            if Generic_Map /= Null_Iir then
+               --  Generic-mapped packages are not macro-expanded.
+               Set_Macro_Expanded_Flag (Pkg, False);
+
+               if Sem_Generic_Association_Chain (Header, Header) then
+                  --  For generic-mapped packages, use the actual type for
+                  --  interface type.
+                  Assoc_El := Get_Generic_Map_Aspect_Chain (Header);
+                  Inter_El := Generic_Chain;
+                  while Is_Valid (Assoc_El) loop
+                     if Get_Kind (Assoc_El) = Iir_Kind_Association_Element_Type
+                     then
+                        Inter :=
+                          Get_Association_Interface (Assoc_El, Inter_El);
+                        Sem_Inst.Substitute_On_Chain
+                          (Generic_Chain,
+                           Get_Type (Inter),
+                           Get_Type (Get_Named_Entity
+                                       (Get_Actual (Assoc_El))));
+                     end if;
+                     Next_Association_Interface (Assoc_El, Inter_El);
+                  end loop;
+               end if;
+            else
+               --  Uninstantiated package.  Maybe macro expanded.
+               Set_Macro_Expanded_Flag
+                 (Pkg, Is_Package_Macro_Expanded (Pkg));
+            end if;
+         end;
+      else
+         --  Simple packages are never expanded.
+         Set_Macro_Expanded_Flag (Pkg, False);
+      end if;
+
+      Sem_Declaration_Chain (Pkg);
+      --  GHDL: subprogram bodies appear in package body.
+
+      Pop_Signals_Declarative_Part (Implicit);
+      Close_Declarative_Region;
+      Set_Is_Within_Flag (Pkg, False);
+
+      Set_Need_Body (Pkg, Package_Need_Body_P (Pkg));
+
+      if Vhdl_Std >= Vhdl_08 then
+         Set_Need_Instance_Bodies
+           (Pkg, Package_Need_Instance_Bodies_P (Pkg));
+      end if;
+   end Sem_Package_Declaration;
+
+   --  LRM 2.6  Package Bodies.
+   procedure Sem_Package_Body (Decl : Iir)
+   is
+      Package_Ident : constant Name_Id := Get_Identifier (Decl);
+      Package_Decl : Iir;
+   begin
+      -- First, find the package declaration.
+      if not Is_Nested_Package (Decl) then
+         declare
+            Design_Unit: Iir_Design_Unit;
+         begin
+            Design_Unit := Load_Primary_Unit
+              (Get_Library (Get_Design_File (Get_Current_Design_Unit)),
+               Package_Ident, Decl);
+            if Design_Unit = Null_Iir then
+               Error_Msg_Sem
+                 (+Decl, "package %i was not analysed", +Package_Ident);
+               return;
+            end if;
+
+            Package_Decl := Get_Library_Unit (Design_Unit);
+            if Get_Kind (Package_Decl) /= Iir_Kind_Package_Declaration then
+               Error_Msg_Sem
+                 (+Decl, "primary unit %i is not a package", +Package_Ident);
+               return;
+            end if;
+
+            --  LRM08 13.5 Order of analysis
+            --  In each case, the second unit depends on the first unit
+            Add_Dependence (Design_Unit);
+
+            Add_Name (Design_Unit);
+
+            --  Add the context clauses from the primary unit.
+            Add_Context_Clauses (Design_Unit);
+         end;
+      else
+         declare
+            Interp : Name_Interpretation_Type;
+         begin
+            Interp := Get_Interpretation (Get_Identifier (Decl));
+            if not Valid_Interpretation (Interp)
+              or else not Is_In_Current_Declarative_Region (Interp)
+              or else Is_Potentially_Visible (Interp)
+            then
+               Error_Msg_Sem
+                 (+Decl, "no corresponding package declaration for %i",
+                  +Package_Ident);
+               return;
+            end if;
+
+            Package_Decl := Get_Declaration (Interp);
+            if Get_Kind (Package_Decl) /= Iir_Kind_Package_Declaration then
+               Error_Msg_Sem
+                 (+Decl, "declaration %i is not a package", +Package_Ident);
+               return;
+            end if;
+         end;
+      end if;
+
+      --  Emit a warning is a body is not necessary.
+      if not Get_Need_Body (Package_Decl) then
+         Warning_Msg_Sem (Warnid_Body, +Decl,
+                          "%n does not require a body", +Package_Decl);
+      end if;
+
+      Set_Package (Decl, Package_Decl);
+      Xref_Body (Decl, Package_Decl);
+      Set_Package_Body (Package_Decl, Decl);
+      Set_Is_Within_Flag (Package_Decl, True);
+
+      --  LRM93 10.1 Declarative Region
+      --  4. A package declaration, together with the corresponding
+      --     body (if any).
+      Open_Declarative_Region;
+
+      Sem_Scopes.Add_Package_Declarations (Package_Decl);
+
+      Sem_Declaration_Chain (Decl);
+      Check_Full_Declaration (Decl, Decl);
+      Check_Full_Declaration (Package_Decl, Decl);
+
+      Close_Declarative_Region;
+      Set_Is_Within_Flag (Package_Decl, False);
+   end Sem_Package_Body;
+
+   function Sem_Uninstantiated_Package_Name (Decl : Iir) return Iir
+   is
+      Name : Iir;
+      Pkg : Iir;
+   begin
+      Name := Sem_Denoting_Name (Get_Uninstantiated_Package_Name (Decl));
+      Set_Uninstantiated_Package_Name (Decl, Name);
+      Pkg := Get_Named_Entity (Name);
+      if Is_Error (Pkg) then
+         null;
+      elsif Get_Kind (Pkg) /= Iir_Kind_Package_Declaration then
+         Error_Class_Match (Name, "package");
+         Pkg := Create_Error (Pkg);
+      elsif not Is_Uninstantiated_Package (Pkg) then
+         Error_Msg_Sem (+Name, "%n is not an uninstantiated package", +Pkg);
+         Pkg := Create_Error (Pkg);
+      end if;
+
+      Set_Uninstantiated_Package_Decl (Decl, Pkg);
+
+      return Pkg;
+   end Sem_Uninstantiated_Package_Name;
+
+   --  LRM08 4.9  Package Instantiation Declaration
+   procedure Sem_Package_Instantiation_Declaration (Decl : Iir)
+   is
+      Hdr : Iir;
+      Pkg : Iir;
+      Bod : Iir_Design_Unit;
+   begin
+      Sem_Scopes.Add_Name (Decl);
+      Set_Visible_Flag (Decl, True);
+      Xref_Decl (Decl);
+
+      --  LRM08 4.9
+      --  The uninstantiated package name shall denote an uninstantiated
+      --  package declared in a package declaration.
+      Pkg := Sem_Uninstantiated_Package_Name (Decl);
+      if Pkg = Null_Iir or Is_Error (Pkg) then
+         --  What could be done ?
+         return;
+      end if;
+
+      --  LRM08 4.9
+      --  The generic map aspect, if present, optionally associates a single
+      --  actual with each formal generic (or member thereof) in the
+      --  corresponding package declaration.  Each formal generic (or member
+      --  thereof) shall be associated at most once.
+
+      --  GHDL: the generics are first instantiated (ie copied) and then
+      --  the actuals are associated with the instantiated formal.
+      --  FIXME: do it in Instantiate_Package_Declaration ?
+      Hdr := Get_Package_Header (Pkg);
+      if not Sem_Generic_Association_Chain (Hdr, Decl) then
+         --  FIXME: stop analysis here ?
+         return;
+      end if;
+
+      --  FIXME: unless the parent is a package declaration library unit, the
+      --  design unit depends on the body.
+      if Get_Need_Body (Pkg) and then not Is_Nested_Package (Pkg) then
+         Bod := Get_Package_Body (Pkg);
+         if Is_Null (Bod) then
+            Bod := Load_Secondary_Unit
+              (Get_Design_Unit (Pkg), Null_Identifier, Decl);
+         else
+            Bod := Get_Design_Unit (Bod);
+         end if;
+         if Is_Null (Bod) then
+            Error_Msg_Sem (+Decl, "cannot find package body of %n", +Pkg);
+         else
+            Add_Dependence (Bod);
+         end if;
+      end if;
+
+      --  Instantiate the declaration after analyse of the body.  So that
+      --  the use_flag on the declaration can be propagated to the instance.
+      Sem_Inst.Instantiate_Package_Declaration (Decl, Pkg);
+   end Sem_Package_Instantiation_Declaration;
+
+   --  LRM 10.4  Use Clauses.
+   procedure Sem_Use_Clause_Name (Clause : Iir)
+   is
+      Name: Iir;
+      Prefix: Iir;
+      Name_Prefix : Iir;
+   begin
+      --  LRM93 10.4
+      --  A use clause achieves direct visibility of declarations that are
+      --  visible by selection.
+      --  Each selected name is a use clause identifies one or more
+      --  declarations that will potentialy become directly visible.
+
+      Name := Get_Selected_Name (Clause);
+      if Name = Null_Iir then
+         pragma Assert (Flags.Flag_Force_Analysis);
+         return;
+      end if;
+
+      case Get_Kind (Name) is
+         when Iir_Kind_Selected_By_All_Name
+           | Iir_Kind_Selected_Name =>
+            Name_Prefix := Get_Prefix (Name);
+         when others =>
+            Error_Msg_Sem (+Name, "use clause allows only selected name");
+            Set_Selected_Name (Clause, Create_Error_Name (Name));
+            return;
+      end case;
+
+      case Get_Kind (Name_Prefix) is
+         when Iir_Kind_Simple_Name
+           | Iir_Kind_Selected_Name =>
+            null;
+         when others =>
+            Error_Msg_Sem
+              (+Name_Prefix,
+               "use clause prefix must be a name or a selected name");
+            Set_Selected_Name (Clause, Create_Error_Name (Name));
+            return;
+      end case;
+
+      Name_Prefix := Sem_Denoting_Name (Name_Prefix);
+      Set_Prefix (Name, Name_Prefix);
+      Prefix := Get_Named_Entity (Name_Prefix);
+      if Is_Error (Prefix) then
+         Set_Selected_Name (Clause, Create_Error_Name (Name));
+         return;
+      end if;
+
+      --  LRM 10.4 Use Clauses
+      --
+      --  If the suffix of the selected name is [...], then the
+      --  selected name identifies only the declaration(s) of that
+      --  [...] contained within the package or library denoted by
+      --  the prefix of the selected name.
+      --
+      --  If the suffix is the reserved word ALL, then the selected name
+      --  identifies all declarations that are contained within the package
+      --  or library denoted by the prefix of the selected name.
+      --
+      --  GHDL: therefore, the suffix must be either a package or a library.
+      case Get_Kind (Prefix) is
+         when Iir_Kind_Library_Declaration =>
+            null;
+         when Iir_Kind_Package_Instantiation_Declaration
+           | Iir_Kind_Interface_Package_Declaration =>
+            null;
+         when Iir_Kind_Package_Declaration =>
+            --  LRM08 12.4 Use clauses
+            --  It is an error if the prefix of a selected name in a use
+            --  clause denotes an uninstantiated package.
+            if Is_Uninstantiated_Package (Prefix) then
+               Error_Msg_Sem
+                 (+Name_Prefix,
+                  "use of uninstantiated package is not allowed");
+               Set_Prefix (Name, Create_Error_Name (Name_Prefix));
+               return;
+            end if;
+         when others =>
+            Error_Msg_Sem
+              (+Prefix, "prefix must designate a package or a library");
+            Set_Prefix (Name, Create_Error_Name (Name_Prefix));
+            return;
+      end case;
+
+      case Get_Kind (Name) is
+         when Iir_Kind_Selected_Name =>
+            Sem_Name (Name, True);
+            case Get_Kind (Get_Named_Entity (Name)) is
+               when Iir_Kind_Error =>
+                  --  Continue in case of error.
+                  null;
+               when Iir_Kind_Overload_List =>
+                  --  Analyze is correct as is.
+                  null;
+               when others =>
+                  Name := Finish_Sem_Name (Name);
+                  Set_Selected_Name (Clause, Name);
+            end case;
+         when Iir_Kind_Selected_By_All_Name =>
+            null;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Sem_Use_Clause_Name;
+
+   --  LRM 10.4  Use Clauses.
+   procedure Sem_Use_Clause (Clauses: Iir_Use_Clause)
+   is
+      Clause : Iir_Use_Clause;
+   begin
+      Clause := Clauses;
+      loop
+         Sem_Use_Clause_Name (Clause);
+
+         Clause := Get_Use_Clause_Chain (Clause);
+         exit when Clause = Null_Iir;
+      end loop;
+
+      --  LRM 10.4
+      --  For each use clause, there is a certain region of text called the
+      --  scope of the use clause.  This region starts immediatly after the
+      --  use clause.
+      Sem_Scopes.Add_Use_Clause (Clauses);
+   end Sem_Use_Clause;
+
+   --  LRM 11.2  Design Libraries.
+   procedure Sem_Library_Clause (Decl: Iir_Library_Clause)
+   is
+      Ident : Name_Id;
+      Lib: Iir;
+   begin
+      --  GHDL: 'redeclaration' is handled in sem_scopes.
+
+      Ident := Get_Identifier (Decl);
+      Lib := Libraries.Get_Library (Ident, Get_Location (Decl));
+      if Lib = Null_Iir then
+         Error_Msg_Sem (+Decl, "no resource library %i", +Ident);
+      else
+         Set_Library_Declaration (Decl, Lib);
+         Sem_Scopes.Add_Name (Lib, Ident, False);
+         Set_Visible_Flag (Lib, True);
+         Xref_Ref (Decl, Lib);
+      end if;
+   end Sem_Library_Clause;
+
+   --  LRM08 13.4 Context clauses.
+   procedure Sem_One_Context_Reference (Ref : Iir)
+   is
+      Name : Iir;
+      Ent : Iir;
+   begin
+      Name := Get_Selected_Name (Ref);
+      if Get_Kind (Name) /= Iir_Kind_Selected_Name then
+         Error_Msg_Sem
+           (+Name, "context reference only allows selected names");
+         return;
+      end if;
+
+      Name := Sem_Denoting_Name (Name);
+      Set_Selected_Name (Ref, Name);
+      Ent := Get_Named_Entity (Name);
+      if Is_Error (Ent) then
+         return;
+      end if;
+
+      --  LRM08 13.4 Context clauses
+      --  It is an error if a selected name in a context reference does not
+      --  denote a context declaration.
+      if Get_Kind (Ent) /= Iir_Kind_Context_Declaration then
+         Error_Msg_Sem (+Name, "name must denote a context declaration");
+         Set_Named_Entity (Name, Null_Iir);
+         return;
+      end if;
+   end Sem_One_Context_Reference;
+
+   --  LRM08 13.4 Context clauses.
+   procedure Sem_Context_Reference (Ctxt : Iir)
+   is
+      Ref : Iir;
+   begin
+      Ref := Ctxt;
+      loop
+         Sem_One_Context_Reference (Ref);
+         Ref := Get_Context_Reference_Chain (Ref);
+         exit when Ref = Null_Iir;
+      end loop;
+
+      --  FIXME: must be done clause after clause ?
+      Add_Context_Reference (Ctxt);
+   end Sem_Context_Reference;
+
+   --  LRM 11.3  Context Clauses.
+   procedure Sem_Context_Clauses (Unit: Iir)
+   is
+      El: Iir;
+   begin
+      El := Get_Context_Items (Unit);
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Use_Clause =>
+               Sem_Use_Clause (El);
+            when Iir_Kind_Library_Clause =>
+               Sem_Library_Clause (El);
+            when Iir_Kind_Context_Reference =>
+               Sem_Context_Reference (El);
+            when others =>
+               Error_Kind ("sem_context_clauses", El);
+         end case;
+         El := Get_Chain (El);
+      end loop;
+   end Sem_Context_Clauses;
+
+   --  LRM08 13.3 Context declarations
+   procedure Sem_Context_Declaration (Decl: Iir)
+   is
+      --  Return TRUE iff the first prefix of NAME denotes library WORK.
+      function Has_Work_Library_Prefix (Name : Iir) return Boolean
+      is
+         Prefix : Iir;
+      begin
+         Prefix := Name;
+         while Get_Kind (Prefix) = Iir_Kind_Selected_Name
+           or else Get_Kind (Prefix) = Iir_Kind_Selected_By_All_Name
+         loop
+            Prefix := Get_Prefix (Prefix);
+         end loop;
+         return Get_Kind (Prefix) = Iir_Kind_Simple_Name
+           and then Get_Identifier (Prefix) = Std_Names.Name_Work
+           and then (Get_Kind (Get_Named_Entity (Prefix))
+                       = Iir_Kind_Library_Declaration);
+      end Has_Work_Library_Prefix;
+
+      procedure Error_Work_Prefix (Loc : Iir) is
+      begin
+         Error_Msg_Sem
+           (+Loc, "'work' not allowed as prefix in context declaration");
+      end Error_Work_Prefix;
+
+      El : Iir;
+      El1 : Iir;
+   begin
+      Sem_Scopes.Add_Name (Decl);
+      Xref_Decl (Decl);
+
+      Sem_Context_Clauses (Decl);
+
+      El := Get_Context_Items (Decl);
+      while El /= Null_Iir loop
+         case Get_Kind (El) is
+            when Iir_Kind_Library_Clause =>
+               --  LRM08 13.3 Context declarations
+               --  It is an error if a library clause in a context declaration
+               --  defines the library logical name WORK, [...]
+               if Get_Identifier (El) = Std_Names.Name_Work then
+                  Error_Msg_Sem
+                    (+El, "'library work' not allowed in context declaration");
+               end if;
+            when Iir_Kind_Use_Clause =>
+               --  LRM08 13.3 Context declarations
+               --  [...] or if a selected name in a use clause [or a context
+               --  reference] in a context declaration has the library logic
+               --  name WORK as a prefix.
+               El1 := El;
+               while El1 /= Null_Iir loop
+                  if Has_Work_Library_Prefix (Get_Selected_Name (El1)) then
+                     Error_Work_Prefix (El1);
+                     exit;
+                  end if;
+                  El1 := Get_Use_Clause_Chain (El1);
+               end loop;
+            when Iir_Kind_Context_Reference =>
+               --  LRM08 13.3 Context declarations
+               --  [...] or if a selected name in [a use clause or] a context
+               --  reference in a context declaration has the library logic
+               --  name WORK as a prefix.
+               El1 := El;
+               while El1 /= Null_Iir loop
+                  if Has_Work_Library_Prefix (Get_Selected_Name (El1)) then
+                     Error_Work_Prefix (El1);
+                     exit;
+                  end if;
+                  El1 := Get_Context_Reference_Chain (El1);
+               end loop;
+            when others =>
+               raise Internal_Error;
+         end case;
+         El := Get_Chain (El);
+      end loop;
+
+      --  GHDL: forbid self-reference by making declaration visible at the end.
+      --  This violates LRM08 12.3 Visibility:  A declaration is visible only
+      --  within a certain part of its scope; ...
+      Set_Visible_Flag (Decl, True);
+   end Sem_Context_Declaration;
+
+   -- Access to the current design unit.  This is set, saved, restored, cleared
+   -- by the procedure semantic.
+   Current_Design_Unit: Iir_Design_Unit := Null_Iir;
+
+   function Get_Current_Design_Unit return Iir_Design_Unit is
+   begin
+      return Current_Design_Unit;
+   end Get_Current_Design_Unit;
+
+   --  LRM 11.1  Design units.
+   procedure Semantic (Design_Unit : Iir_Design_Unit)
+   is
+      Library_Unit : constant Iir := Get_Library_Unit (Design_Unit);
+      Library : constant Iir := Get_Library (Get_Design_File (Design_Unit));
+      Prev_Unit : Iir;
+      Old_Design_Unit : Iir_Design_Unit;
+      Implicit : Implicit_Signal_Declaration_Type;
+   begin
+      --  Sanity check: can analyze either previously analyzed unit or just
+      --  parsed unit.
+      case Get_Date (Design_Unit) is
+         when Date_Parsed =>
+            Set_Date (Design_Unit, Date_Analyzing);
+         when Date_Valid =>
+            null;
+         when Date_Obsolete =>
+            --  This happens only when design files are added into the library
+            --  and keeping obsolete units (eg: to pretty print a file).
+            Set_Date (Design_Unit, Date_Analyzing);
+         when others =>
+            raise Internal_Error;
+      end case;
+
+      --  If there is already a unit with the same name, mark it as being
+      --  replaced.
+      if Library_Unit /= Null_Iir then
+         if Get_Kind (Library_Unit) in Iir_Kinds_Primary_Unit then
+            Prev_Unit := Libraries.Find_Primary_Unit
+              (Library, Get_Identifier (Library_Unit));
+            if Is_Valid (Prev_Unit) and then Prev_Unit /= Design_Unit then
+               Set_Date (Prev_Unit, Date_Replacing);
+            end if;
+         end if;
+      end if;
+
+      --  Save and set current_design_unit.
+      Old_Design_Unit := Current_Design_Unit;
+      Current_Design_Unit := Design_Unit;
+      Push_Signals_Declarative_Part (Implicit, Null_Iir);
+
+      --  Have a clean and empty state for scopes.
+      Push_Interpretations;
+
+      --  LRM02 10.1 Declarative Region.
+      --  In addition to the above declarative region, there is a root
+      --  declarative region, not associated with a portion of the text of the
+      --  description, but encompassing any given primary unit.  At the
+      --  beginning of the analysis of a given primary unit, there are no
+      --  declarations whose scopes (see 10.2) are within the root declarative
+      --  region.  Moreover, the root declarative region associated with any
+      --  given secondary unit is the root declarative region of the
+      --  corresponding primary unit.
+      --  GHDL: for any revision of VHDL, a root declarative region is created,
+      --    due to reasons given by LCS 3 (VHDL Issue # 1028).
+      Open_Declarative_Region;
+
+      --  LRM 11.2
+      --  Every design unit is assumed to contain the following implicit
+      --  context items as part of its context clause:
+      --    library STD, WORK; use STD.STANDARD.all;
+      Sem_Scopes.Add_Name (Libraries.Std_Library, Std_Names.Name_Std, False);
+      Sem_Scopes.Add_Name (Library, Std_Names.Name_Work, False);
+      Sem_Scopes.Use_All_Names (Standard_Package);
+      if Get_Dependence_List (Design_Unit) = Null_Iir_List then
+         Set_Dependence_List (Design_Unit, Create_Iir_List);
+      end if;
+      Add_Dependence (Std_Standard_Unit);
+
+      --  Analyze context clauses.
+      Sem_Context_Clauses (Design_Unit);
+
+      --  Analyze the library unit.
+      if Library_Unit /= Null_Iir then
+         --  Can be null_iir in case of parse error.
+         case Iir_Kinds_Library_Unit (Get_Kind (Library_Unit)) is
+            when Iir_Kind_Entity_Declaration =>
+               Sem_Entity_Declaration (Library_Unit);
+            when Iir_Kind_Architecture_Body =>
+               Sem_Architecture_Body (Library_Unit);
+            when Iir_Kind_Package_Declaration =>
+               Sem_Package_Declaration (Library_Unit);
+            when Iir_Kind_Package_Body =>
+               Sem_Package_Body (Library_Unit);
+            when Iir_Kind_Configuration_Declaration =>
+               Sem_Configuration_Declaration (Library_Unit);
+            when Iir_Kind_Package_Instantiation_Declaration =>
+               Sem_Package_Instantiation_Declaration (Library_Unit);
+            when Iir_Kind_Context_Declaration =>
+               Sem_Context_Declaration (Library_Unit);
+         end case;
+      end if;
+
+      Close_Declarative_Region;
+
+      Pop_Interpretations;
+
+      if Get_Date (Design_Unit) = Date_Analyzing then
+         Set_Date (Design_Unit, Date_Analyzed);
+      end if;
+
+      if Get_Analysis_Checks_List (Design_Unit) /= Null_Iir_List then
+         Sem_Analysis_Checks_List (Design_Unit, False);
+      end if;
+
+      --  Restore current_design_unit.
+      Current_Design_Unit := Old_Design_Unit;
+      Pop_Signals_Declarative_Part (Implicit);
+   end Semantic;
+end Vhdl.Sem;