vhdl08: preliminary work for package body instantiation.

13 files changed, 329 insertions, 136 deletions

diff --git a/src/vhdl/canon.adb b/src/vhdl/canon.adb
index a48606c0c..028a9819c 100644
--- a/src/vhdl/canon.adb
+++ b/src/vhdl/canon.adb
@@ -21,6 +21,7 @@ with Types; use Types;
 with Flags;
 with Name_Table;
 with Sem;
+with Sem_Inst;
 with Iir_Chains; use Iir_Chains;
 with PSL.Nodes;
 with PSL.Rewrites;
@@ -2563,6 +2564,36 @@ package body Canon is
       end if;
    end Canon_Package_Instantiation_Declaration;
 
+   function Create_Instantiation_Bodies (Decl : Iir_Package_Declaration)
+                                        return Iir
+   is
+      First, Last : Iir;
+      El : Iir;
+      Bod : Iir;
+   begin
+      First := Null_Iir;
+      Last := Null_Iir;  --  Kill the warning
+      El := Get_Declaration_Chain (Decl);
+      while Is_Valid (El) loop
+         if Get_Kind (El) = Iir_Kind_Package_Declaration
+           and then Get_Need_Body (El)
+           and then Get_Package_Origin (El) /= Null_Iir
+         then
+            Bod := Sem_Inst.Instantiate_Package_Body (El);
+
+            --  Append.
+            if First = Null_Iir then
+               First := Bod;
+            else
+               Set_Chain (Last, Bod);
+            end if;
+            Last := Bod;
+         end if;
+         El := Get_Chain (El);
+      end loop;
+      return First;
+   end Create_Instantiation_Bodies;
+
    function Canon_Declaration (Top : Iir_Design_Unit;
                                Decl : Iir;
                                Parent : Iir;
diff --git a/src/vhdl/canon.ads b/src/vhdl/canon.ads
index 7481fe029..97c36b2d3 100644
--- a/src/vhdl/canon.ads
+++ b/src/vhdl/canon.ads
@@ -52,6 +52,11 @@ package Canon is
      (Arch : Iir_Architecture_Body)
      return Iir_Design_Unit;
 
+   --  Macro-expand package bodies for instantiations in DECL.  Return the
+   --  chain of bodies.
+   function Create_Instantiation_Bodies (Decl : Iir_Package_Declaration)
+                                        return Iir;
+
    --  Canonicalize a subprogram call.
    procedure Canon_Subprogram_Call (Call : Iir);
 
diff --git a/src/vhdl/iirs.adb b/src/vhdl/iirs.adb
index b1d0fb2f4..5524ad66d 100644
--- a/src/vhdl/iirs.adb
+++ b/src/vhdl/iirs.adb
@@ -1717,6 +1717,23 @@ package body Iirs is
       Set_Field5 (Pkg, Decl);
    end Set_Package_Body;
 
+   function Get_Package_Instantiation_Bodies_Chain (Pkg : Iir) return Iir is
+   begin
+      pragma Assert (Pkg /= Null_Iir);
+      pragma Assert (Has_Package_Instantiation_Bodies_Chain (Get_Kind (Pkg)),
+                     "no field Package_Instantiation_Bodies_Chain");
+      return Get_Field8 (Pkg);
+   end Get_Package_Instantiation_Bodies_Chain;
+
+   procedure Set_Package_Instantiation_Bodies_Chain (Pkg : Iir; Chain : Iir)
+   is
+   begin
+      pragma Assert (Pkg /= Null_Iir);
+      pragma Assert (Has_Package_Instantiation_Bodies_Chain (Get_Kind (Pkg)),
+                     "no field Package_Instantiation_Bodies_Chain");
+      Set_Field8 (Pkg, Chain);
+   end Set_Package_Instantiation_Bodies_Chain;
+
    function Get_Need_Body (Decl : Iir_Package_Declaration) return Boolean is
    begin
       pragma Assert (Decl /= Null_Iir);
@@ -1749,6 +1766,22 @@ package body Iirs is
       Set_Flag2 (Decl, Flag);
    end Set_Macro_Expanded_Flag;
 
+   function Get_Need_Instance_Bodies (Decl : Iir) return Boolean is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Need_Instance_Bodies (Get_Kind (Decl)),
+                     "no field Need_Instance_Bodies");
+      return Get_Flag3 (Decl);
+   end Get_Need_Instance_Bodies;
+
+   procedure Set_Need_Instance_Bodies (Decl : Iir; Flag : Boolean) is
+   begin
+      pragma Assert (Decl /= Null_Iir);
+      pragma Assert (Has_Need_Instance_Bodies (Get_Kind (Decl)),
+                     "no field Need_Instance_Bodies");
+      Set_Flag3 (Decl, Flag);
+   end Set_Need_Instance_Bodies;
+
    function Get_Block_Configuration (Target : Iir) return Iir is
    begin
       pragma Assert (Target /= Null_Iir);
@@ -4462,22 +4495,6 @@ package body Iirs is
       Set_Field5 (Target, Atype);
    end Set_Actual_Type;
 
-   function Get_Associated_Interface (Assoc : Iir) return Iir is
-   begin
-      pragma Assert (Assoc /= Null_Iir);
-      pragma Assert (Has_Associated_Interface (Get_Kind (Assoc)),
-                     "no field Associated_Interface");
-      return Get_Field4 (Assoc);
-   end Get_Associated_Interface;
-
-   procedure Set_Associated_Interface (Assoc : Iir; Inter : Iir) is
-   begin
-      pragma Assert (Assoc /= Null_Iir);
-      pragma Assert (Has_Associated_Interface (Get_Kind (Assoc)),
-                     "no field Associated_Interface");
-      Set_Field4 (Assoc, Inter);
-   end Set_Associated_Interface;
-
    function Get_Association_Chain (Target : Iir) return Iir is
    begin
       pragma Assert (Target /= Null_Iir);
diff --git a/src/vhdl/iirs.ads b/src/vhdl/iirs.ads
index 114c240b0..c86b12ab3 100644
--- a/src/vhdl/iirs.ads
+++ b/src/vhdl/iirs.ads
@@ -406,10 +406,6 @@ package Iirs is
    -- Only for Iir_Kind_Association_Element_By_Individual:
    --   Get/Set_Individual_Association_Chain (Field4)
    --
-   -- Only for Iir_Kind_Association_Element_Package:
-   -- Only for Iir_Kind_Association_Element_Type:
-   --   Get/Set_Associated_Interface (Field4)
-   --
    --  A function call or a type conversion for the association.
    --  FIXME: should be a name ?
    -- Only for Iir_Kind_Association_Element_By_Expression:
@@ -849,10 +845,25 @@ package Iirs is
    --
    --   Get/Set_Package_Origin (Field7)
    --
+   --  Chain of bodies for package instantiation.  Present only in certain
+   --  conditions.
+   --   Get/Set_Package_Instantiation_Bodies_Chain (Field8)
+   --
+   --  If true, the package need a body.
    --   Get/Set_Need_Body (Flag1)
    --
+   --  True for uninstantiated package that will be macro-expanded for
+   --  simulation.  The macro-expansion is done by canon, so controlled by
+   --  back-end.  The reason of macro-expansion is presence of interface
+   --  type.
    --   Get/Set_Macro_Expanded_Flag (Flag2)
    --
+   --  True if the package declaration has the package has at least one
+   --  package instantiation declaration whose uninstantiated declaration
+   --  needs both a body and macro-expansion.  In that case, the instantiation
+   --  needs macro-expansion of their body.
+   --   Get/Set_Need_Instance_Bodies (Flag3)
+   --
    --   Get/Set_Visible_Flag (Flag4)
    --
    --   Get/Set_End_Has_Reserved_Id (Flag8)
@@ -5742,19 +5753,22 @@ package Iirs is
    function Get_Package_Body (Pkg : Iir) return Iir;
    procedure Set_Package_Body (Pkg : Iir; Decl : Iir);
 
-   --  If true, the package need a body.
+   --  Field: Field8 Chain
+   function Get_Package_Instantiation_Bodies_Chain (Pkg : Iir) return Iir;
+   procedure Set_Package_Instantiation_Bodies_Chain (Pkg : Iir; Chain : Iir);
+
    --  Field: Flag1
    function Get_Need_Body (Decl : Iir_Package_Declaration) return Boolean;
    procedure Set_Need_Body (Decl : Iir_Package_Declaration; Flag : Boolean);
 
-   --  True for uninstantiated package that will be macro-expanded for
-   --  simulation.  The macro-expansion is done by canon, so controlled by
-   --  back-end.  The reason of macro-expansion is presence of interface
-   --  type.
    --  Field: Flag2
    function Get_Macro_Expanded_Flag (Decl : Iir) return Boolean;
    procedure Set_Macro_Expanded_Flag (Decl : Iir; Flag : Boolean);
 
+   --  Field: Flag3
+   function Get_Need_Instance_Bodies (Decl : Iir) return Boolean;
+   procedure Set_Need_Instance_Bodies (Decl : Iir; Flag : Boolean);
+
    --  Field: Field5
    function Get_Block_Configuration (Target : Iir) return Iir;
    procedure Set_Block_Configuration (Target : Iir; Block : Iir);
@@ -6614,11 +6628,6 @@ package Iirs is
    function Get_Actual_Type (Target : Iir) return Iir;
    procedure Set_Actual_Type (Target : Iir; Atype : Iir);
 
-   --  Interface for a package association.
-   --  Field: Field4 Ref
-   function Get_Associated_Interface (Assoc : Iir) return Iir;
-   procedure Set_Associated_Interface (Assoc : Iir; Inter : Iir);
-
    --  List of individual associations for association_element_by_individual.
    --  Associations for parenthesis_name.
    --  Field: Field2 Chain
diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb
index 5a87de0b7..ac6a2dd06 100644
--- a/src/vhdl/iirs_utils.adb
+++ b/src/vhdl/iirs_utils.adb
@@ -390,6 +390,28 @@ package body Iirs_Utils is
       end loop;
    end Get_Association_Interface;
 
+   function Get_Association_Interface (Assoc : Iir; Inter : Iir) return Iir is
+   begin
+      if Get_Formal (Assoc) /= Null_Iir then
+         return Get_Association_Interface (Assoc);
+      else
+         return Inter;
+      end if;
+   end Get_Association_Interface;
+
+   procedure Next_Association_Interface
+     (Assoc : in out Iir; Inter : in out Iir) is
+   begin
+      if Get_Formal (Assoc) /= Null_Iir then
+         --  Association by name.  Next one will also be associated by name
+         --  so no need to track interface.
+         Inter := Null_Iir;
+      else
+         Inter := Get_Chain (Inter);
+      end if;
+      Assoc := Get_Chain (Assoc);
+   end Next_Association_Interface;
+
    function Find_Name_In_List (List: Iir_List; Lit: Name_Id) return Iir is
       El: Iir;
       Ident: Name_Id;
diff --git a/src/vhdl/iirs_utils.ads b/src/vhdl/iirs_utils.ads
index a9944f6e1..de420b5cb 100644
--- a/src/vhdl/iirs_utils.ads
+++ b/src/vhdl/iirs_utils.ads
@@ -80,6 +80,15 @@ package Iirs_Utils is
    --  an interface, even if the formal is a name.
    function Get_Association_Interface (Assoc : Iir) return Iir;
 
+   --  Get the corresponding interface of an association while walking on
+   --  associations.  ASSOC and INTER are the current association and
+   --  interface (initialized to the association chain and interface chain).
+   --  The function Get_Association_Interface return the interface associated
+   --  to ASSOC,and Next_Association_Interface updates ASSOC and INTER.
+   function Get_Association_Interface (Assoc : Iir; Inter : Iir) return Iir;
+   procedure Next_Association_Interface
+     (Assoc : in out Iir; Inter : in out Iir);
+
    --  Duplicate enumeration literal LIT.
    function Copy_Enumeration_Literal (Lit : Iir) return Iir;
 
diff --git a/src/vhdl/nodes_meta.adb b/src/vhdl/nodes_meta.adb
index 867b14f8d..2c1856613 100644
--- a/src/vhdl/nodes_meta.adb
+++ b/src/vhdl/nodes_meta.adb
@@ -93,8 +93,10 @@ package body Nodes_Meta is
       Field_Entity_Name => Type_Iir,
       Field_Package => Type_Iir,
       Field_Package_Body => Type_Iir,
+      Field_Package_Instantiation_Bodies_Chain => Type_Iir,
       Field_Need_Body => Type_Boolean,
       Field_Macro_Expanded_Flag => Type_Boolean,
+      Field_Need_Instance_Bodies => Type_Boolean,
       Field_Block_Configuration => Type_Iir,
       Field_Concurrent_Statement_Chain => Type_Iir,
       Field_Chain => Type_Iir,
@@ -264,7 +266,6 @@ package body Nodes_Meta is
       Field_Index_Subtype => Type_Iir,
       Field_Parameter => Type_Iir,
       Field_Actual_Type => Type_Iir,
-      Field_Associated_Interface => Type_Iir,
       Field_Association_Chain => Type_Iir,
       Field_Individual_Association_Chain => Type_Iir,
       Field_Aggregate_Info => Type_Iir,
@@ -485,10 +486,14 @@ package body Nodes_Meta is
             return "package";
          when Field_Package_Body =>
             return "package_body";
+         when Field_Package_Instantiation_Bodies_Chain =>
+            return "package_instantiation_bodies_chain";
          when Field_Need_Body =>
             return "need_body";
          when Field_Macro_Expanded_Flag =>
             return "macro_expanded_flag";
+         when Field_Need_Instance_Bodies =>
+            return "need_instance_bodies";
          when Field_Block_Configuration =>
             return "block_configuration";
          when Field_Concurrent_Statement_Chain =>
@@ -827,8 +832,6 @@ package body Nodes_Meta is
             return "parameter";
          when Field_Actual_Type =>
             return "actual_type";
-         when Field_Associated_Interface =>
-            return "associated_interface";
          when Field_Association_Chain =>
             return "association_chain";
          when Field_Individual_Association_Chain =>
@@ -1631,10 +1634,14 @@ package body Nodes_Meta is
             return Attr_Ref;
          when Field_Package_Body =>
             return Attr_Ref;
+         when Field_Package_Instantiation_Bodies_Chain =>
+            return Attr_Chain;
          when Field_Need_Body =>
             return Attr_None;
          when Field_Macro_Expanded_Flag =>
             return Attr_None;
+         when Field_Need_Instance_Bodies =>
+            return Attr_None;
          when Field_Block_Configuration =>
             return Attr_None;
          when Field_Concurrent_Statement_Chain =>
@@ -1973,8 +1980,6 @@ package body Nodes_Meta is
             return Attr_None;
          when Field_Actual_Type =>
             return Attr_None;
-         when Field_Associated_Interface =>
-            return Attr_Ref;
          when Field_Association_Chain =>
             return Attr_Chain;
          when Field_Individual_Association_Chain =>
@@ -2245,7 +2250,6 @@ package body Nodes_Meta is
       Field_Formal,
       Field_Chain,
       Field_Actual,
-      Field_Associated_Interface,
       --  Iir_Kind_Association_Element_Type
       Field_Whole_Association_Flag,
       Field_Collapse_Signal_Flag,
@@ -2253,7 +2257,6 @@ package body Nodes_Meta is
       Field_Chain,
       Field_Actual,
       Field_Actual_Type,
-      Field_Associated_Interface,
       --  Iir_Kind_Choice_By_Others
       Field_Same_Alternative_Flag,
       Field_Chain,
@@ -2637,6 +2640,7 @@ package body Nodes_Meta is
       Field_Identifier,
       Field_Need_Body,
       Field_Macro_Expanded_Flag,
+      Field_Need_Instance_Bodies,
       Field_Visible_Flag,
       Field_End_Has_Reserved_Id,
       Field_End_Has_Identifier,
@@ -2645,6 +2649,7 @@ package body Nodes_Meta is
       Field_Attribute_Value_Chain,
       Field_Package_Header,
       Field_Package_Origin,
+      Field_Package_Instantiation_Bodies_Chain,
       Field_Parent,
       Field_Package_Body,
       --  Iir_Kind_Package_Instantiation_Declaration
@@ -4170,61 +4175,61 @@ package body Nodes_Meta is
       Iir_Kind_Association_Element_By_Expression => 101,
       Iir_Kind_Association_Element_By_Individual => 108,
       Iir_Kind_Association_Element_Open => 113,
-      Iir_Kind_Association_Element_Package => 119,
-      Iir_Kind_Association_Element_Type => 126,
-      Iir_Kind_Choice_By_Others => 131,
-      Iir_Kind_Choice_By_Expression => 138,
-      Iir_Kind_Choice_By_Range => 145,
-      Iir_Kind_Choice_By_None => 150,
-      Iir_Kind_Choice_By_Name => 156,
-      Iir_Kind_Entity_Aspect_Entity => 158,
-      Iir_Kind_Entity_Aspect_Configuration => 159,
-      Iir_Kind_Entity_Aspect_Open => 159,
-      Iir_Kind_Block_Configuration => 165,
-      Iir_Kind_Block_Header => 169,
-      Iir_Kind_Component_Configuration => 175,
-      Iir_Kind_Binding_Indication => 181,
-      Iir_Kind_Entity_Class => 183,
-      Iir_Kind_Attribute_Value => 191,
-      Iir_Kind_Signature => 194,
-      Iir_Kind_Aggregate_Info => 201,
-      Iir_Kind_Procedure_Call => 205,
-      Iir_Kind_Record_Element_Constraint => 211,
-      Iir_Kind_Array_Element_Resolution => 212,
-      Iir_Kind_Record_Resolution => 213,
-      Iir_Kind_Record_Element_Resolution => 216,
-      Iir_Kind_Attribute_Specification => 225,
-      Iir_Kind_Disconnection_Specification => 230,
-      Iir_Kind_Configuration_Specification => 235,
-      Iir_Kind_Access_Type_Definition => 242,
-      Iir_Kind_Incomplete_Type_Definition => 249,
-      Iir_Kind_Interface_Type_Definition => 255,
-      Iir_Kind_File_Type_Definition => 262,
-      Iir_Kind_Protected_Type_Declaration => 271,
-      Iir_Kind_Record_Type_Definition => 281,
-      Iir_Kind_Array_Type_Definition => 293,
-      Iir_Kind_Array_Subtype_Definition => 308,
-      Iir_Kind_Record_Subtype_Definition => 319,
-      Iir_Kind_Access_Subtype_Definition => 327,
-      Iir_Kind_Physical_Subtype_Definition => 336,
-      Iir_Kind_Floating_Subtype_Definition => 346,
-      Iir_Kind_Integer_Subtype_Definition => 355,
-      Iir_Kind_Enumeration_Subtype_Definition => 364,
-      Iir_Kind_Enumeration_Type_Definition => 373,
-      Iir_Kind_Integer_Type_Definition => 379,
-      Iir_Kind_Floating_Type_Definition => 385,
-      Iir_Kind_Physical_Type_Definition => 394,
-      Iir_Kind_Range_Expression => 400,
-      Iir_Kind_Protected_Type_Body => 407,
-      Iir_Kind_Wildcard_Type_Definition => 412,
-      Iir_Kind_Subtype_Definition => 416,
-      Iir_Kind_Scalar_Nature_Definition => 420,
-      Iir_Kind_Overload_List => 421,
-      Iir_Kind_Type_Declaration => 427,
-      Iir_Kind_Anonymous_Type_Declaration => 432,
-      Iir_Kind_Subtype_Declaration => 440,
-      Iir_Kind_Nature_Declaration => 446,
-      Iir_Kind_Subnature_Declaration => 452,
+      Iir_Kind_Association_Element_Package => 118,
+      Iir_Kind_Association_Element_Type => 124,
+      Iir_Kind_Choice_By_Others => 129,
+      Iir_Kind_Choice_By_Expression => 136,
+      Iir_Kind_Choice_By_Range => 143,
+      Iir_Kind_Choice_By_None => 148,
+      Iir_Kind_Choice_By_Name => 154,
+      Iir_Kind_Entity_Aspect_Entity => 156,
+      Iir_Kind_Entity_Aspect_Configuration => 157,
+      Iir_Kind_Entity_Aspect_Open => 157,
+      Iir_Kind_Block_Configuration => 163,
+      Iir_Kind_Block_Header => 167,
+      Iir_Kind_Component_Configuration => 173,
+      Iir_Kind_Binding_Indication => 179,
+      Iir_Kind_Entity_Class => 181,
+      Iir_Kind_Attribute_Value => 189,
+      Iir_Kind_Signature => 192,
+      Iir_Kind_Aggregate_Info => 199,
+      Iir_Kind_Procedure_Call => 203,
+      Iir_Kind_Record_Element_Constraint => 209,
+      Iir_Kind_Array_Element_Resolution => 210,
+      Iir_Kind_Record_Resolution => 211,
+      Iir_Kind_Record_Element_Resolution => 214,
+      Iir_Kind_Attribute_Specification => 223,
+      Iir_Kind_Disconnection_Specification => 228,
+      Iir_Kind_Configuration_Specification => 233,
+      Iir_Kind_Access_Type_Definition => 240,
+      Iir_Kind_Incomplete_Type_Definition => 247,
+      Iir_Kind_Interface_Type_Definition => 253,
+      Iir_Kind_File_Type_Definition => 260,
+      Iir_Kind_Protected_Type_Declaration => 269,
+      Iir_Kind_Record_Type_Definition => 279,
+      Iir_Kind_Array_Type_Definition => 291,
+      Iir_Kind_Array_Subtype_Definition => 306,
+      Iir_Kind_Record_Subtype_Definition => 317,
+      Iir_Kind_Access_Subtype_Definition => 325,
+      Iir_Kind_Physical_Subtype_Definition => 334,
+      Iir_Kind_Floating_Subtype_Definition => 344,
+      Iir_Kind_Integer_Subtype_Definition => 353,
+      Iir_Kind_Enumeration_Subtype_Definition => 362,
+      Iir_Kind_Enumeration_Type_Definition => 371,
+      Iir_Kind_Integer_Type_Definition => 377,
+      Iir_Kind_Floating_Type_Definition => 383,
+      Iir_Kind_Physical_Type_Definition => 392,
+      Iir_Kind_Range_Expression => 398,
+      Iir_Kind_Protected_Type_Body => 405,
+      Iir_Kind_Wildcard_Type_Definition => 410,
+      Iir_Kind_Subtype_Definition => 414,
+      Iir_Kind_Scalar_Nature_Definition => 418,
+      Iir_Kind_Overload_List => 419,
+      Iir_Kind_Type_Declaration => 425,
+      Iir_Kind_Anonymous_Type_Declaration => 430,
+      Iir_Kind_Subtype_Declaration => 438,
+      Iir_Kind_Nature_Declaration => 444,
+      Iir_Kind_Subnature_Declaration => 450,
       Iir_Kind_Package_Declaration => 465,
       Iir_Kind_Package_Instantiation_Declaration => 477,
       Iir_Kind_Package_Body => 485,
@@ -4475,6 +4480,8 @@ package body Nodes_Meta is
             return Get_Need_Body (N);
          when Field_Macro_Expanded_Flag =>
             return Get_Macro_Expanded_Flag (N);
+         when Field_Need_Instance_Bodies =>
+            return Get_Need_Instance_Bodies (N);
          when Field_Guarded_Signal_Flag =>
             return Get_Guarded_Signal_Flag (N);
          when Field_Deferred_Declaration_Flag =>
@@ -4593,6 +4600,8 @@ package body Nodes_Meta is
             Set_Need_Body (N, V);
          when Field_Macro_Expanded_Flag =>
             Set_Macro_Expanded_Flag (N, V);
+         when Field_Need_Instance_Bodies =>
+            Set_Need_Instance_Bodies (N, V);
          when Field_Guarded_Signal_Flag =>
             Set_Guarded_Signal_Flag (N, V);
          when Field_Deferred_Declaration_Flag =>
@@ -4843,6 +4852,8 @@ package body Nodes_Meta is
             return Get_Package (N);
          when Field_Package_Body =>
             return Get_Package_Body (N);
+         when Field_Package_Instantiation_Bodies_Chain =>
+            return Get_Package_Instantiation_Bodies_Chain (N);
          when Field_Block_Configuration =>
             return Get_Block_Configuration (N);
          when Field_Concurrent_Statement_Chain =>
@@ -5079,8 +5090,6 @@ package body Nodes_Meta is
             return Get_Parameter (N);
          when Field_Actual_Type =>
             return Get_Actual_Type (N);
-         when Field_Associated_Interface =>
-            return Get_Associated_Interface (N);
          when Field_Association_Chain =>
             return Get_Association_Chain (N);
          when Field_Individual_Association_Chain =>
@@ -5217,6 +5226,8 @@ package body Nodes_Meta is
             Set_Package (N, V);
          when Field_Package_Body =>
             Set_Package_Body (N, V);
+         when Field_Package_Instantiation_Bodies_Chain =>
+            Set_Package_Instantiation_Bodies_Chain (N, V);
          when Field_Block_Configuration =>
             Set_Block_Configuration (N, V);
          when Field_Concurrent_Statement_Chain =>
@@ -5453,8 +5464,6 @@ package body Nodes_Meta is
             Set_Parameter (N, V);
          when Field_Actual_Type =>
             Set_Actual_Type (N, V);
-         when Field_Associated_Interface =>
-            Set_Associated_Interface (N, V);
          when Field_Association_Chain =>
             Set_Association_Chain (N, V);
          when Field_Individual_Association_Chain =>
@@ -6795,6 +6804,12 @@ package body Nodes_Meta is
       end case;
    end Has_Package_Body;
 
+   function Has_Package_Instantiation_Bodies_Chain (K : Iir_Kind)
+      return Boolean is
+   begin
+      return K = Iir_Kind_Package_Declaration;
+   end Has_Package_Instantiation_Bodies_Chain;
+
    function Has_Need_Body (K : Iir_Kind) return Boolean is
    begin
       return K = Iir_Kind_Package_Declaration;
@@ -6805,6 +6820,11 @@ package body Nodes_Meta is
       return K = Iir_Kind_Package_Declaration;
    end Has_Macro_Expanded_Flag;
 
+   function Has_Need_Instance_Bodies (K : Iir_Kind) return Boolean is
+   begin
+      return K = Iir_Kind_Package_Declaration;
+   end Has_Need_Instance_Bodies;
+
    function Has_Block_Configuration (K : Iir_Kind) return Boolean is
    begin
       case K is
@@ -9399,17 +9419,6 @@ package body Nodes_Meta is
       end case;
    end Has_Actual_Type;
 
-   function Has_Associated_Interface (K : Iir_Kind) return Boolean is
-   begin
-      case K is
-         when Iir_Kind_Association_Element_Package
-           | Iir_Kind_Association_Element_Type =>
-            return True;
-         when others =>
-            return False;
-      end case;
-   end Has_Associated_Interface;
-
    function Has_Association_Chain (K : Iir_Kind) return Boolean is
    begin
       return K = Iir_Kind_Parenthesis_Name;
diff --git a/src/vhdl/nodes_meta.ads b/src/vhdl/nodes_meta.ads
index f3a2c274b..867a96c23 100644
--- a/src/vhdl/nodes_meta.ads
+++ b/src/vhdl/nodes_meta.ads
@@ -133,8 +133,10 @@ package Nodes_Meta is
       Field_Entity_Name,
       Field_Package,
       Field_Package_Body,
+      Field_Package_Instantiation_Bodies_Chain,
       Field_Need_Body,
       Field_Macro_Expanded_Flag,
+      Field_Need_Instance_Bodies,
       Field_Block_Configuration,
       Field_Concurrent_Statement_Chain,
       Field_Chain,
@@ -304,7 +306,6 @@ package Nodes_Meta is
       Field_Index_Subtype,
       Field_Parameter,
       Field_Actual_Type,
-      Field_Associated_Interface,
       Field_Association_Chain,
       Field_Individual_Association_Chain,
       Field_Aggregate_Info,
@@ -623,8 +624,11 @@ package Nodes_Meta is
    function Has_Entity_Name (K : Iir_Kind) return Boolean;
    function Has_Package (K : Iir_Kind) return Boolean;
    function Has_Package_Body (K : Iir_Kind) return Boolean;
+   function Has_Package_Instantiation_Bodies_Chain (K : Iir_Kind)
+      return Boolean;
    function Has_Need_Body (K : Iir_Kind) return Boolean;
    function Has_Macro_Expanded_Flag (K : Iir_Kind) return Boolean;
+   function Has_Need_Instance_Bodies (K : Iir_Kind) return Boolean;
    function Has_Block_Configuration (K : Iir_Kind) return Boolean;
    function Has_Concurrent_Statement_Chain (K : Iir_Kind) return Boolean;
    function Has_Chain (K : Iir_Kind) return Boolean;
@@ -800,7 +804,6 @@ package Nodes_Meta is
    function Has_Index_Subtype (K : Iir_Kind) return Boolean;
    function Has_Parameter (K : Iir_Kind) return Boolean;
    function Has_Actual_Type (K : Iir_Kind) return Boolean;
-   function Has_Associated_Interface (K : Iir_Kind) return Boolean;
    function Has_Association_Chain (K : Iir_Kind) return Boolean;
    function Has_Individual_Association_Chain (K : Iir_Kind) return Boolean;
    function Has_Aggregate_Info (K : Iir_Kind) return Boolean;
diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb
index 8c31a1e53..711b2c7ee 100644
--- a/src/vhdl/sem.adb
+++ b/src/vhdl/sem.adb
@@ -2501,8 +2501,8 @@ package body Sem is
       end if;
    end Sem_Analysis_Checks_List;
 
-   -- Return true if package declaration DECL needs a body.
-   -- Ie, it contains subprogram specification or deferred constants.
+   --  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
@@ -2576,6 +2576,33 @@ package body Sem is
       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_Named_Entity (Get_Uninstantiated_Package_Name (El));
+               begin
+                  if 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
@@ -2638,7 +2665,9 @@ package body Sem is
             Generic_Chain : constant Iir := Get_Generic_Chain (Header);
             Generic_Map : constant Iir :=
               Get_Generic_Map_Aspect_Chain (Header);
-            El : Iir;
+            Assoc_El : Iir;
+            Inter_El : Iir;
+            Inter : Iir;
          begin
             Sem_Interface_Chain (Generic_Chain, Generic_Interface_List);
 
@@ -2649,15 +2678,20 @@ package body Sem is
                if Sem_Generic_Association_Chain (Header, Header) then
                   --  For generic-mapped packages, use the actual type for
                   --  interface type.
-                  El := Get_Generic_Map_Aspect_Chain (Header);
-                  while Is_Valid (El) loop
-                     if Get_Kind (El) = Iir_Kind_Association_Element_Type then
+                  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 (Get_Associated_Interface (El)),
-                           Get_Type (Get_Named_Entity (Get_Actual (El))));
+                           Get_Type (Inter),
+                           Get_Type (Get_Named_Entity
+                                       (Get_Actual (Assoc_El))));
                      end if;
-                     El := Get_Chain (El);
+                     Next_Association_Interface (Assoc_El, Inter_El);
                   end loop;
                end if;
             else
@@ -2677,6 +2711,10 @@ package body Sem is
       Pop_Signals_Declarative_Part (Implicit);
       Close_Declarative_Region;
       Set_Need_Body (Decl, Package_Need_Body_P (Decl));
+      if Vhdl_Std >= Vhdl_08 then
+         Set_Need_Instance_Bodies
+           (Decl, Package_Need_Instance_Bodies_P (Decl));
+      end if;
    end Sem_Package_Declaration;
 
    --  LRM 2.6  Package Bodies.
diff --git a/src/vhdl/sem_assocs.adb b/src/vhdl/sem_assocs.adb
index 441329234..f5dc048b9 100644
--- a/src/vhdl/sem_assocs.adb
+++ b/src/vhdl/sem_assocs.adb
@@ -43,7 +43,6 @@ package body Sem_Assocs is
       Set_Formal (N_Assoc, Get_Formal (Assoc));
       Set_Actual (N_Assoc, Get_Actual (Assoc));
       Set_Chain (N_Assoc, Get_Chain (Assoc));
-      Set_Associated_Interface (N_Assoc, Inter);
       Set_Whole_Association_Flag (N_Assoc, True);
       Free_Iir (Assoc);
       return N_Assoc;
@@ -1347,13 +1346,21 @@ package body Sem_Assocs is
    procedure Sem_Association_Package_Type_Not_Finish
      (Assoc : Iir;
       Inter : Iir;
-      Match : out Compatibility_Level) is
+      Match : out Compatibility_Level)
+   is
+      Formal : constant Iir := Get_Formal (Assoc);
    begin
-      --  Can be associated only once
-      if Get_Associated_Interface (Assoc) = Inter then
+      if Formal = Null_Iir then
+         --  Can be associated only once
          Match := Fully_Compatible;
       else
-         Match := Not_Compatible;
+         if Get_Kind (Formal) = Iir_Kind_Simple_Name
+           and then Get_Identifier (Formal) = Get_Identifier (Inter)
+         then
+            Match := Fully_Compatible;
+         else
+            Match := Not_Compatible;
+         end if;
       end if;
    end Sem_Association_Package_Type_Not_Finish;
 
@@ -1361,10 +1368,6 @@ package body Sem_Assocs is
    is
       Formal : constant Iir := Get_Formal (Assoc);
    begin
-      --  Always match (as this is a generic association, there is no
-      --  need to resolve overload).
-      pragma Assert (Get_Associated_Interface (Assoc) = Inter);
-
       if Formal /= Null_Iir then
          pragma Assert (Get_Kind (Formal) = Iir_Kind_Simple_Name);
          pragma Assert (Get_Identifier (Formal) = Get_Identifier (Inter));
diff --git a/src/vhdl/sem_assocs.ads b/src/vhdl/sem_assocs.ads
index 8157f8c34..e40258915 100644
--- a/src/vhdl/sem_assocs.ads
+++ b/src/vhdl/sem_assocs.ads
@@ -19,8 +19,10 @@ with Iirs; use Iirs;
 with Sem_Expr; use Sem_Expr;
 
 package Sem_Assocs is
-   --  Change the kind of association corresponding to non-object interfaces.
-   --  Such an association mustn't be handled an like association for object.
+   --  Rewrite the association chain by changing the kind of assocation
+   --  corresponding to non-object interfaces.  Such an association mustn't be
+   --  handled an like association for object as the actual is not an
+   --  expression.
    function Extract_Non_Object_Association
      (Assoc_Chain : Iir; Inter_Chain : Iir) return Iir;
 
diff --git a/src/vhdl/sem_inst.adb b/src/vhdl/sem_inst.adb
index f5d7fb017..5f9b04c92 100644
--- a/src/vhdl/sem_inst.adb
+++ b/src/vhdl/sem_inst.adb
@@ -48,9 +48,8 @@ package body Sem_Inst is
    is
       use Nodes;
       Last : constant Iir := Iirs.Get_Last_Node;
-      El: Iir;
+      El : constant Iir := Origin_Table.Last;
    begin
-      El := Origin_Table.Last;
       if El < Last then
          Origin_Table.Set_Last (Last);
          Origin_Table.Table (El + 1 .. Last) := (others => Null_Iir);
@@ -102,7 +101,7 @@ package body Sem_Inst is
 
    --  Table of previous values in Origin_Table.  The first purpose of this
    --  table is to be able to revert the calls to Set_Instance, so that a unit
-   --  can be instantiated several times.  Keep the nodes that have been
+   --  can be instantiated several times.  Keeping the nodes that have been
    --  instantiated is cheaper than walking the tree a second time.
    --  The second purpose of this table is not yet implemented: being able to
    --  have uninstantiated packages in instantiated packages.  In that case,
@@ -114,6 +113,9 @@ package body Sem_Inst is
       Table_Low_Bound => 1,
       Table_Initial => 256);
 
+   --  The instance of ORIG is now N.  So during instantiation, a reference
+   --  to ORIG will be replaced by a reference to N.  The previous instance
+   --  of ORIG is saved.
    procedure Set_Instance (Orig : Iir; N : Iir)
    is
       use Nodes;
@@ -586,9 +588,11 @@ package body Sem_Inst is
    is
       pragma Unreferenced (Pkg);
       Assoc : Iir;
+      Inter : Iir;
    begin
       Assoc := Get_Generic_Map_Aspect_Chain (Inst);
-      while Assoc /= Null_Iir loop
+      Inter := Get_Generic_Chain (Inst);
+      while Is_Valid (Assoc) loop
          --  Replace formal reference to the instance.
          --  Cf Get_association_Interface
          declare
@@ -622,8 +626,12 @@ package body Sem_Inst is
                declare
                   Sub_Inst : constant Iir :=
                     Get_Named_Entity (Get_Actual (Assoc));
-                  Sub_Pkg : constant Iir := Get_Associated_Interface (Assoc);
+                  Sub_Pkg_Inter : constant Iir :=
+                    Get_Association_Interface (Assoc, Inter);
+                  Sub_Pkg : constant Iir := Get_Origin (Sub_Pkg_Inter);
                begin
+                  --  Replace references of interface package to references
+                  --  to the actual package.
                   Set_Instance (Sub_Pkg, Sub_Inst);
                   Set_Instance_On_Chain (Get_Generic_Chain (Sub_Pkg),
                                          Get_Generic_Chain (Sub_Inst));
@@ -635,7 +643,7 @@ package body Sem_Inst is
                --  indication.
                declare
                   Inter_Type_Def : constant Iir :=
-                    Get_Type (Get_Associated_Interface (Assoc));
+                    Get_Type (Get_Association_Interface (Assoc, Inter));
                   Actual_Type : constant Iir := Get_Actual_Type (Assoc);
                begin
                   Set_Instance (Inter_Type_Def, Actual_Type);
@@ -643,7 +651,7 @@ package body Sem_Inst is
             when others =>
                Error_Kind ("instantiate_generic_map_chain", Assoc);
          end case;
-         Assoc := Get_Chain (Assoc);
+         Next_Association_Interface (Assoc, Inter);
       end loop;
    end Instantiate_Generic_Map_Chain;
 
@@ -673,6 +681,39 @@ package body Sem_Inst is
       Restore_Origin (Mark);
    end Instantiate_Package_Declaration;
 
+   function Instantiate_Package_Body (Inst : Iir) return Iir
+   is
+      Inst_Decl : constant Iir := Get_Package_Origin (Inst);
+      Pkg : constant Iir :=
+        Get_Named_Entity (Get_Uninstantiated_Package_Name (Inst_Decl));
+      Prev_Loc : constant Location_Type := Instantiate_Loc;
+      Mark : constant Instance_Index_Type := Prev_Instance_Table.Last;
+      Res : Iir;
+   begin
+      Instantiate_Loc := Get_Location (Inst);
+
+      --  Be sure Get_Origin_Priv can be called on existing nodes.
+      Expand_Origin_Table;
+
+      --  References to package specification (and its declarations) will
+      --  be redirected to the package instantiation.
+      Set_Instance (Pkg, Inst);
+      Set_Instance_On_Chain
+        (Get_Generic_Chain (Get_Package_Header (Pkg)),
+         Get_Generic_Chain (Get_Package_Header (Inst)));
+      Set_Instance_On_Chain
+        (Get_Declaration_Chain (Pkg), Get_Declaration_Chain (Inst));
+
+      --  Instantiate the body.
+      Res := Instantiate_Iir (Get_Package_Body (Pkg), False);
+
+      --  Restore.
+      Instantiate_Loc := Prev_Loc;
+      Restore_Origin (Mark);
+
+      return Res;
+   end Instantiate_Package_Body;
+
    procedure Substitute_On_Iir_List (L : Iir_List; E : Iir; Rep : Iir);
 
    procedure Substitute_On_Iir (N : Iir; E : Iir; Rep : Iir) is
diff --git a/src/vhdl/sem_inst.ads b/src/vhdl/sem_inst.ads
index 5da4a8d09..919d6b0f1 100644
--- a/src/vhdl/sem_inst.ads
+++ b/src/vhdl/sem_inst.ads
@@ -24,6 +24,10 @@ package Sem_Inst is
    --  Create declaration chain and generic declarations for INST from PKG.
    procedure Instantiate_Package_Declaration (Inst : Iir; Pkg : Iir);
 
+   --  Return the instantiation of the body for INST, ie macro-expand the
+   --  body.  INST has the form of a generic-mapped package.
+   function Instantiate_Package_Body (Inst : Iir) return Iir;
+
    --  In CHAIN, substitute all references to E by REP.
    procedure Substitute_On_Chain (Chain : Iir; E : Iir; Rep : Iir);