simul: handle vhdl 2008.

10 files changed, 358 insertions, 164 deletions

diff --git a/src/vhdl/canon.adb b/src/vhdl/canon.adb
index 0e907835a..40af63e34 100644
--- a/src/vhdl/canon.adb
+++ b/src/vhdl/canon.adb
@@ -1026,7 +1026,7 @@ package body Canon is
          --  Create simple variable assignment.
          Asgn := Create_Iir (Iir_Kind_Variable_Assignment_Statement);
          Location_Copy (Asgn, Cond_Expr);
-         Set_Parent (Asgn, El);
+         Set_Parent (Asgn, Res);
          Set_Target (Asgn, Target);
          Expr := Get_Expression (Cond_Expr);
          if Canon_Flag_Expressions then
@@ -1058,27 +1058,36 @@ package body Canon is
    --  Inner loop if any; used to canonicalize exit/next statement.
    Cur_Loop : Iir;
 
-   procedure Canon_Sequential_Stmts (First : Iir)
+   function Canon_Sequential_Stmts (First : Iir) return Iir
    is
       Stmt: Iir;
-      Expr: Iir;
-      Prev_Loop : Iir;
+      N_Stmt : Iir;
+      Res, Last : Iir;
    begin
+      Sub_Chain_Init (Res, Last);
+
       Stmt := First;
       while Stmt /= Null_Iir loop
+
+         --  Keep the same statement by default.
+         N_Stmt := Stmt;
+
          case Get_Kind (Stmt) is
             when Iir_Kind_If_Statement =>
                declare
                   Cond: Iir;
-                  Clause: Iir := Stmt;
+                  Clause: Iir;
+                  Stmts : Iir;
                begin
+                  Clause := Stmt;
                   while Clause /= Null_Iir loop
                      Cond := Get_Condition (Clause);
                      if Cond /= Null_Iir then
                         Canon_Expression (Cond);
                      end if;
-                     Canon_Sequential_Stmts
-                       (Get_Sequential_Statement_Chain (Clause));
+                     Stmts := Get_Sequential_Statement_Chain (Clause);
+                     Stmts := Canon_Sequential_Stmts (Stmts);
+                     Set_Sequential_Statement_Chain (Clause, Stmts);
                      Clause := Get_Else_Clause (Clause);
                   end loop;
                end;
@@ -1087,10 +1096,17 @@ package body Canon is
                Canon_Expression (Get_Target (Stmt));
                Canon_Waveform_Chain (Get_Waveform_Chain (Stmt), Null_Iir_List);
 
+            when Iir_Kind_Conditional_Signal_Assignment_Statement =>
+               N_Stmt := Canon_Conditional_Signal_Assignment_Statement (Stmt);
+
             when Iir_Kind_Variable_Assignment_Statement =>
                Canon_Expression (Get_Target (Stmt));
                Canon_Expression (Get_Expression (Stmt));
 
+            when Iir_Kind_Conditional_Variable_Assignment_Statement =>
+               N_Stmt :=
+                 Canon_Conditional_Variable_Assignment_Statement (Stmt);
+
             when Iir_Kind_Wait_Statement =>
                declare
                   Expr: Iir;
@@ -1116,54 +1132,76 @@ package body Canon is
                Canon_Expression (Get_Expression (Stmt));
                declare
                   Choice: Iir;
+                  Stmts : Iir;
                begin
                   Choice := Get_Case_Statement_Alternative_Chain (Stmt);
                   while Choice /= Null_Iir loop
                      -- FIXME: canon choice expr.
-                     Canon_Sequential_Stmts (Get_Associated_Chain (Choice));
+                     Stmts := Get_Associated_Chain (Choice);
+                     Stmts := Canon_Sequential_Stmts (Stmts);
+                     Set_Associated_Chain (Choice, Stmts);
                      Choice := Get_Chain (Choice);
                   end loop;
                end;
 
             when Iir_Kind_Assertion_Statement
               | Iir_Kind_Report_Statement =>
-               if Get_Kind (Stmt) = Iir_Kind_Assertion_Statement then
-                  Canon_Expression (Get_Assertion_Condition (Stmt));
-               end if;
-               Expr := Get_Report_Expression (Stmt);
-               if Expr /= Null_Iir then
-                  Canon_Expression (Expr);
-               end if;
-               Expr := Get_Severity_Expression (Stmt);
-               if Expr /= Null_Iir then
-                  Canon_Expression (Expr);
-               end if;
+               declare
+                  Expr: Iir;
+               begin
+                  if Get_Kind (Stmt) = Iir_Kind_Assertion_Statement then
+                     Canon_Expression (Get_Assertion_Condition (Stmt));
+                  end if;
+                  Expr := Get_Report_Expression (Stmt);
+                  if Expr /= Null_Iir then
+                     Canon_Expression (Expr);
+                  end if;
+                  Expr := Get_Severity_Expression (Stmt);
+                  if Expr /= Null_Iir then
+                     Canon_Expression (Expr);
+                  end if;
+               end;
 
             when Iir_Kind_For_Loop_Statement =>
-               -- FIXME: decl.
-               Prev_Loop := Cur_Loop;
-               Cur_Loop := Stmt;
-               if Canon_Flag_Expressions then
-                  Canon_Discrete_Range
-                    (Get_Type (Get_Parameter_Specification (Stmt)));
-               end if;
-               Canon_Sequential_Stmts (Get_Sequential_Statement_Chain (Stmt));
-               Cur_Loop := Prev_Loop;
+               declare
+                  Prev_Loop : constant Iir := Cur_Loop;
+                  Stmts : Iir;
+               begin
+                  -- FIXME: decl.
+                  Cur_Loop := Stmt;
+                  if Canon_Flag_Expressions then
+                     Canon_Discrete_Range
+                       (Get_Type (Get_Parameter_Specification (Stmt)));
+                  end if;
+                  Stmts := Get_Sequential_Statement_Chain (Stmt);
+                  Stmts := Canon_Sequential_Stmts (Stmts);
+                  Set_Sequential_Statement_Chain (Stmt, Stmts);
+                  Cur_Loop := Prev_Loop;
+               end;
 
             when Iir_Kind_While_Loop_Statement =>
-               Expr := Get_Condition (Stmt);
-               if Expr /= Null_Iir then
-                  Canon_Expression (Expr);
-               end if;
-               Prev_Loop := Cur_Loop;
-               Cur_Loop := Stmt;
-               Canon_Sequential_Stmts (Get_Sequential_Statement_Chain (Stmt));
-               Cur_Loop := Prev_Loop;
+               declare
+                  Expr : Iir;
+                  Stmts : Iir;
+                  Prev_Loop : Iir;
+               begin
+                  Expr := Get_Condition (Stmt);
+                  if Expr /= Null_Iir then
+                     Canon_Expression (Expr);
+                  end if;
+                  Prev_Loop := Cur_Loop;
+                  Cur_Loop := Stmt;
+                  Stmts := Get_Sequential_Statement_Chain (Stmt);
+                  Stmts := Canon_Sequential_Stmts (Stmts);
+                  Set_Sequential_Statement_Chain (Stmt, Stmts);
+                  Cur_Loop := Prev_Loop;
+               end;
 
             when Iir_Kind_Next_Statement
               | Iir_Kind_Exit_Statement =>
                declare
                   Loop_Label : Iir;
+                  Expr: Iir;
                begin
                   Expr := Get_Condition (Stmt);
                   if Expr /= Null_Iir then
@@ -1187,8 +1225,13 @@ package body Canon is
             when others =>
                Error_Kind ("canon_sequential_stmts", Stmt);
          end case;
+
+         Sub_Chain_Append (Res, Last, N_Stmt);
+
          Stmt := Get_Chain (Stmt);
       end loop;
+
+      return Res;
    end Canon_Sequential_Stmts;
 
    -- Create a statement transform from concurrent_signal_assignment
@@ -1456,12 +1499,23 @@ package body Canon is
 
       while Cond_Wf /= Null_Iir loop
          Expr := Get_Condition (Cond_Wf);
+
+         --  Canon waveform.
          Wf := Get_Waveform_Chain (Cond_Wf);
          Wf := Canon_Wave_Transform (Conc_Stmt, Wf, Proc);
-         Set_Parent (Wf, Parent);
+
          if Expr = Null_Iir and Cond_Wf = Cond_Wf_Chain then
+            --  A conditional assignment that is in fact a simple one.  Usual
+            --  case for concurrent signal assignment in vhdl 93.
+            pragma Assert (Get_Chain (Cond_Wf) = Null_Iir);
+
+            Set_Parent (Wf, Parent);
             Res1 := Wf;
+            Stmt := Res1;
          else
+            --  A real conditional signal assignment.
+
+            --  Canon condition (if any).
             if Expr /= Null_Iir then
                if Canon_Flag_Expressions then
                   Canon_Expression (Expr);
@@ -1474,19 +1528,17 @@ package body Canon is
             if Stmt = Null_Iir then
                Res1 := Create_Iir (Iir_Kind_If_Statement);
                Set_Parent (Res1, Parent);
+               Stmt := Res1;
             else
                Res1 := Create_Iir (Iir_Kind_Elsif);
+               Set_Else_Clause (Last_Res, Res1);
             end if;
             Location_Copy (Res1, Cond_Wf);
             Set_Condition (Res1, Expr);
             Set_Sequential_Statement_Chain (Res1, Wf);
+            Set_Parent (Wf, Stmt);
+            Last_Res := Res1;
          end if;
-         if Stmt = Null_Iir then
-            Stmt := Res1;
-         else
-            Set_Else_Clause (Last_Res, Res1);
-         end if;
-         Last_Res := Res1;
          Cond_Wf := Get_Chain (Cond_Wf);
       end loop;
       return Stmt;
@@ -1679,7 +1731,13 @@ package body Canon is
               | Iir_Kind_Process_Statement =>
                Canon_Declarations (Top, El, Null_Iir);
                if Canon_Flag_Sequentials_Stmts then
-                  Canon_Sequential_Stmts (Get_Sequential_Statement_Chain (El));
+                  declare
+                     Stmts : Iir;
+                  begin
+                     Stmts := Get_Sequential_Statement_Chain (El);
+                     Stmts := Canon_Sequential_Stmts (Stmts);
+                     Set_Sequential_Statement_Chain (El, Stmts);
+                  end;
                end if;
                if Canon_Flag_All_Sensitivity
                  and then Canon_Flag_Sequentials_Stmts
@@ -2357,13 +2415,16 @@ package body Canon is
                                 Parent : Iir;
                                 Decl_Parent : Iir)
    is
+      Stmts : Iir;
    begin
       case Get_Kind (Decl) is
          when Iir_Kind_Procedure_Body
            | Iir_Kind_Function_Body =>
             Canon_Declarations (Top, Decl, Null_Iir);
             if Canon_Flag_Sequentials_Stmts then
-               Canon_Sequential_Stmts (Get_Sequential_Statement_Chain (Decl));
+               Stmts := Get_Sequential_Statement_Chain (Decl);
+               Stmts := Canon_Sequential_Stmts (Stmts);
+               Set_Sequential_Statement_Chain (Decl, Stmts);
             end if;
 
          when Iir_Kind_Procedure_Declaration
diff --git a/src/vhdl/simulate/annotations.adb b/src/vhdl/simulate/annotations.adb
index 17c9e4fd9..b5dcef417 100644
--- a/src/vhdl/simulate/annotations.adb
+++ b/src/vhdl/simulate/annotations.adb
@@ -39,6 +39,8 @@ package body Annotations is
      (Block_Info : Sim_Info_Acc; Subprg: Iir);
    procedure Annotate_Subprogram_Specification
      (Block_Info : Sim_Info_Acc; Subprg: Iir);
+   procedure Annotate_Interface_List
+     (Block_Info: Sim_Info_Acc; Decl_Chain: Iir; With_Types : Boolean);
 
    procedure Annotate_Type_Definition (Block_Info: Sim_Info_Acc; Def: Iir);
 
@@ -95,8 +97,9 @@ package body Annotations is
                                        Slot => Block_Info.Nbr_Objects);
          when Kind_Environment =>
             Info := new Sim_Info_Type'(Kind => Kind_Environment,
-                                       Obj_Scope => Current_Scope,
-                                       Slot => Block_Info.Nbr_Objects);
+                                       Env_Slot => Block_Info.Nbr_Objects,
+                                       Frame_Scope => Current_Scope,
+                                       Nbr_Objects => 0);
          when Kind_Block
            | Kind_Process
            | Kind_Frame
@@ -248,10 +251,8 @@ package body Annotations is
 
       Prot_Info :=
         new Sim_Info_Type'(Kind => Kind_Frame,
-                           Inst_Slot => Invalid_Instance_Slot,
                            Frame_Scope => Current_Scope,
-                           Nbr_Objects => 0,
-                           Nbr_Instances => 0);
+                           Nbr_Objects => 0);
       Set_Info (Prot, Prot_Info);
 
       Decl := Get_Declaration_Chain (Prot);
@@ -449,15 +450,36 @@ package body Annotations is
       end loop;
    end Annotate_Interface_List_Subtype;
 
-   procedure Annotate_Create_Interface_List
+   procedure Annotate_Interface_Package_Declaration
+     (Block_Info: Sim_Info_Acc; Inter : Iir)
+   is
+      Prev_Scope : constant Scope_Type := Current_Scope;
+      Package_Info : Sim_Info_Acc;
+   begin
+      Create_Object_Info (Block_Info, Inter, Kind_Environment);
+      Package_Info := Get_Info (Inter);
+
+      Current_Scope := (Kind => Scope_Kind_Pkg_Inst,
+                        Pkg_Param => 0,
+                        Pkg_Parent => Package_Info);
+
+      Annotate_Interface_List
+        (Package_Info, Get_Generic_Chain (Inter), True);
+      Annotate_Declaration_List (Package_Info, Get_Declaration_Chain (Inter));
+
+      Current_Scope := Prev_Scope;
+   end Annotate_Interface_Package_Declaration;
+
+   procedure Annotate_Interface_List
      (Block_Info: Sim_Info_Acc; Decl_Chain: Iir; With_Types : Boolean)
    is
       Decl : Iir;
-      N : Object_Slot_Type;
    begin
       Decl := Decl_Chain;
       while Decl /= Null_Iir loop
-         if With_Types then
+         if With_Types
+           and then Get_Kind (Decl) in Iir_Kinds_Interface_Object_Declaration
+         then
             Annotate_Anonymous_Type_Definition (Block_Info, Get_Type (Decl));
          end if;
          case Get_Kind (Decl) is
@@ -467,18 +489,14 @@ package body Annotations is
               | Iir_Kind_Interface_Constant_Declaration
               | Iir_Kind_Interface_File_Declaration =>
                Create_Object_Info (Block_Info, Decl);
+            when Iir_Kind_Interface_Package_Declaration =>
+               Annotate_Interface_Package_Declaration (Block_Info, Decl);
             when others =>
-               Error_Kind ("annotate_create_interface_list", Decl);
+               Error_Kind ("annotate_interface_list", Decl);
          end case;
-         N := Block_Info.Nbr_Objects;
-         --  Annotation of the default value must not create objects.
-         --  FIXME: Is it true ???
-         if Block_Info.Nbr_Objects /= N then
-            raise Internal_Error;
-         end if;
          Decl := Get_Chain (Decl);
       end loop;
-   end Annotate_Create_Interface_List;
+   end Annotate_Interface_List;
 
    procedure Annotate_Subprogram_Interfaces_Type
      (Block_Info : Sim_Info_Acc; Subprg: Iir)
@@ -508,13 +526,11 @@ package body Annotations is
 
       Subprg_Info :=
         new Sim_Info_Type'(Kind => Kind_Frame,
-                           Inst_Slot => Invalid_Instance_Slot,
                            Frame_Scope => Current_Scope,
-                           Nbr_Objects => 0,
-                           Nbr_Instances => 0);
+                           Nbr_Objects => 0);
       Set_Info (Subprg, Subprg_Info);
 
-      Annotate_Create_Interface_List (Subprg_Info, Interfaces, False);
+      Annotate_Interface_List (Subprg_Info, Interfaces, False);
 
       Current_Scope := Prev_Scope;
    end Annotate_Subprogram_Specification;
@@ -553,15 +569,15 @@ package body Annotations is
    begin
       Current_Scope := (Kind => Scope_Kind_Component);
 
-      Info := new Sim_Info_Type'(Kind => Kind_Frame,
-                                 Inst_Slot => Invalid_Instance_Slot,
+      Info := new Sim_Info_Type'(Kind => Kind_Block,
                                  Frame_Scope => Current_Scope,
+                                 Inst_Slot => Invalid_Instance_Slot,
                                  Nbr_Objects => 0,
                                  Nbr_Instances => 1); --  For the instance.
       Set_Info (Comp, Info);
 
-      Annotate_Create_Interface_List (Info, Get_Generic_Chain (Comp), True);
-      Annotate_Create_Interface_List (Info, Get_Port_Chain (Comp), True);
+      Annotate_Interface_List (Info, Get_Generic_Chain (Comp), True);
+      Annotate_Interface_List (Info, Get_Port_Chain (Comp), True);
 
       Current_Scope := Prev_Scope;
    end Annotate_Component_Declaration;
@@ -676,9 +692,6 @@ package body Annotations is
          when Iir_Kind_Nature_Declaration =>
             null;
 
-         when Iir_Kind_Package_Instantiation_Declaration =>
-            Create_Object_Info (Block_Info, Decl, Kind_Environment);
-
          when others =>
             Error_Kind ("annotate_declaration", Decl);
       end case;
@@ -811,10 +824,8 @@ package body Annotations is
       end if;
       Header := Get_Block_Header (Block);
       if Header /= Null_Iir then
-         Annotate_Create_Interface_List
-           (Info, Get_Generic_Chain (Header), True);
-         Annotate_Create_Interface_List
-           (Info, Get_Port_Chain (Header), True);
+         Annotate_Interface_List (Info, Get_Generic_Chain (Header), True);
+         Annotate_Interface_List (Info, Get_Port_Chain (Header), True);
       end if;
       Annotate_Declaration_List (Info, Get_Declaration_Chain (Block));
       Annotate_Concurrent_Statements_List
@@ -901,10 +912,8 @@ package body Annotations is
       Increment_Current_Scope;
 
       Info := new Sim_Info_Type'(Kind => Kind_Process,
-                                 Inst_Slot => Invalid_Instance_Slot,
                                  Frame_Scope => Current_Scope,
-                                 Nbr_Objects => 0,
-                                 Nbr_Instances => 0);
+                                 Nbr_Objects => 0);
       Set_Info (Stmt, Info);
 
       Annotate_Declaration_List
@@ -964,12 +973,10 @@ package body Annotations is
       Set_Info (Decl, Entity_Info);
 
       -- generic list.
-      Annotate_Create_Interface_List
-        (Entity_Info, Get_Generic_Chain (Decl), True);
+      Annotate_Interface_List (Entity_Info, Get_Generic_Chain (Decl), True);
 
       -- Port list.
-      Annotate_Create_Interface_List
-        (Entity_Info, Get_Port_Chain (Decl), True);
+      Annotate_Interface_List (Entity_Info, Get_Port_Chain (Decl), True);
 
       -- declarations
       Annotate_Declaration_List (Entity_Info, Get_Declaration_Chain (Decl));
@@ -989,6 +996,9 @@ package body Annotations is
       pragma Assert (Current_Scope.Kind = Scope_Kind_None);
       Current_Scope := Entity_Info.Frame_Scope;
 
+      --  No blocks nor instantiation in entities.
+      pragma Assert (Entity_Info.Nbr_Instances = 0);
+
       Arch_Info := new Sim_Info_Type'
         (Kind => Kind_Block,
          Inst_Slot => 0, --  Slot for a component
@@ -1017,8 +1027,14 @@ package body Annotations is
    begin
       pragma Assert (Current_Scope.Kind = Scope_Kind_None);
 
-      Nbr_Packages := Nbr_Packages + 1;
-      Current_Scope := (Scope_Kind_Package, Nbr_Packages);
+      if Get_Kind (Decl) = Iir_Kind_Package_Instantiation_Declaration
+        or else not Is_Uninstantiated_Package (Decl)
+      then
+         Nbr_Packages := Nbr_Packages + 1;
+         Current_Scope := (Scope_Kind_Package, Nbr_Packages);
+      else
+         Increment_Current_Scope;
+      end if;
 
       Package_Info := new Sim_Info_Type'
         (Kind => Kind_Block,
@@ -1030,18 +1046,30 @@ package body Annotations is
       Set_Info (Decl, Package_Info);
 
       if Get_Kind (Decl) = Iir_Kind_Package_Instantiation_Declaration then
-         Annotate_Create_Interface_List
+         Annotate_Interface_List
            (Package_Info, Get_Generic_Chain (Decl), True);
       else
          Header := Get_Package_Header (Decl);
          if Header /= Null_Iir then
-            Annotate_Create_Interface_List
+            Annotate_Interface_List
               (Package_Info, Get_Generic_Chain (Header), True);
          end if;
       end if;
       -- declarations
       Annotate_Declaration_List (Package_Info, Get_Declaration_Chain (Decl));
 
+      if Get_Kind (Decl) = Iir_Kind_Package_Instantiation_Declaration then
+         declare
+            Uninst : constant Iir :=
+              Get_Named_Entity (Get_Uninstantiated_Package_Name (Decl));
+            Uninst_Info : constant Sim_Info_Acc := Get_Info (Uninst);
+         begin
+            --  There is not corresponding body for an instantiation, so
+            --  also add objects for the shared body.
+            Package_Info.Nbr_Objects := Uninst_Info.Nbr_Objects;
+         end;
+      end if;
+
       Current_Scope := Prev_Scope;
    end Annotate_Package;
 
@@ -1173,6 +1201,8 @@ package body Annotations is
             Annotate_Configuration_Declaration (El);
          when Iir_Kind_Package_Instantiation_Declaration =>
             Annotate_Package (El);
+         when Iir_Kind_Context_Declaration =>
+            null;
          when others =>
             Error_Kind ("annotate2", El);
       end case;
@@ -1190,7 +1220,7 @@ package body Annotations is
          when Scope_Kind_Package =>
             return "package" & Pkg_Index_Type'Image (Scope.Pkg_Index);
          when Scope_Kind_Pkg_Inst =>
-            return "pkg inst" & Parameter_Slot_Type'Image (Scope.Pkg_Inst);
+            return "pkg inst" & Parameter_Slot_Type'Image (Scope.Pkg_Param);
       end case;
    end Image;
 
diff --git a/src/vhdl/simulate/annotations.ads b/src/vhdl/simulate/annotations.ads
index a307e5394..3c605373a 100644
--- a/src/vhdl/simulate/annotations.ads
+++ b/src/vhdl/simulate/annotations.ads
@@ -39,6 +39,18 @@ package Annotations is
    -- Annotations are used to collect informations for elaboration and to
    -- locate iir_value_literal for signals, variables or constants.
 
+   -- The annotation depends on the kind of the node.
+   type Sim_Info_Kind is
+     (Kind_Block, Kind_Process, Kind_Frame,
+      Kind_Scalar_Type, Kind_File_Type,
+      Kind_Object, Kind_Signal, Kind_Range,
+      Kind_File,
+      Kind_Terminal, Kind_Quantity,
+      Kind_Environment);
+
+   type Sim_Info_Type (Kind: Sim_Info_Kind);
+   type Sim_Info_Acc is access all Sim_Info_Type;
+
    -- Scope corresponding to an object.
    type Scope_Kind_Type is
      (
@@ -59,7 +71,8 @@ package Annotations is
          when Scope_Kind_Frame =>
             Depth : Scope_Depth_Type;
          when Scope_Kind_Pkg_Inst =>
-            Pkg_Inst : Parameter_Slot_Type;
+            Pkg_Param : Parameter_Slot_Type;
+            Pkg_Parent : Sim_Info_Acc;
          when Scope_Kind_None =>
             null;
       end case;
@@ -68,43 +81,40 @@ package Annotations is
    type Instance_Slot_Type is new Integer;
    Invalid_Instance_Slot : constant Instance_Slot_Type := -1;
 
-   -- The annotation depends on the kind of the node.
-   type Sim_Info_Kind is
-     (Kind_Block, Kind_Process, Kind_Frame,
-      Kind_Scalar_Type, Kind_File_Type,
-      Kind_Object, Kind_Signal, Kind_Range,
-      Kind_File,
-      Kind_Terminal, Kind_Quantity,
-      Kind_Environment);
-
-   type Sim_Info_Type (Kind: Sim_Info_Kind);
-   type Sim_Info_Acc is access all Sim_Info_Type;
-
    -- Annotation for an iir node in order to be able to simulate it.
    type Sim_Info_Type (Kind: Sim_Info_Kind) is record
       case Kind is
          when Kind_Block
            | Kind_Frame
-           | Kind_Process =>
-            --  Slot number in the parent (for blocks).
-            Inst_Slot : Instance_Slot_Type;
-
+           | Kind_Process
+           | Kind_Environment =>
             --  Scope level for this frame.
             Frame_Scope : Scope_Type;
 
             --  Number of objects/signals.
             Nbr_Objects : Object_Slot_Type;
 
-            --  Number of children (blocks, generate, instantiation).
-            Nbr_Instances : Instance_Slot_Type;
+            case Kind is
+               when Kind_Block =>
+                  --  Slot number in the parent (for blocks).
+                  Inst_Slot : Instance_Slot_Type;
+
+                  --  Number of children (blocks, generate, instantiation).
+                  Nbr_Instances : Instance_Slot_Type;
+
+               when Kind_Environment =>
+                  Env_Slot : Object_Slot_Type;
+
+               when others =>
+                  null;
+            end case;
 
          when Kind_Object
            | Kind_Signal
            | Kind_Range
            | Kind_File
            | Kind_Terminal
-           | Kind_Quantity
-           | Kind_Environment =>
+           | Kind_Quantity =>
             --  Block in which this object is declared in.
             Obj_Scope : Scope_Type;
 
diff --git a/src/vhdl/simulate/debugger.adb b/src/vhdl/simulate/debugger.adb
index a08f87fcb..9155d8556 100644
--- a/src/vhdl/simulate/debugger.adb
+++ b/src/vhdl/simulate/debugger.adb
@@ -192,6 +192,9 @@ package body Debugger is
            | Iir_Kinds_Process_Statement
            | Iir_Kind_Package_Declaration =>
             return Image_Identifier (Name);
+         when Iir_Kind_Generate_Statement_Body =>
+            return Image_Identifier (Get_Parent (Name))
+              & '(' & Image_Identifier (Name) & ')';
          when Iir_Kind_Iterator_Declaration =>
             return Image_Identifier (Get_Parent (Name)) & '('
               & Execute_Image_Attribute
@@ -248,7 +251,8 @@ package body Debugger is
          when Iir_Kind_Block_Statement =>
             Put ("[block]");
          when Iir_Kind_If_Generate_Statement
-           | Iir_Kind_For_Generate_Statement =>
+           | Iir_Kind_For_Generate_Statement
+           | Iir_Kind_Generate_Statement_Body =>
             Put ("[generate]");
          when Iir_Kind_Iterator_Declaration =>
             Put ("[iterator]");
diff --git a/src/vhdl/simulate/elaboration.adb b/src/vhdl/simulate/elaboration.adb
index 5c634caf8..184d187df 100644
--- a/src/vhdl/simulate/elaboration.adb
+++ b/src/vhdl/simulate/elaboration.adb
@@ -285,7 +285,7 @@ package body Elaboration is
          Actuals_Ref => null,
          Result => null);
 
-      if Father /= null then
+      if Father /= null and then Obj_Info.Kind = Kind_Block then
          Res.Brother := Father.Children;
          Father.Children := Res;
       end if;
@@ -314,6 +314,17 @@ package body Elaboration is
 
       -- Elaborate objects declarations.
       Elaborate_Declarative_Part (Instance, Get_Declaration_Chain (Decl));
+
+      if Get_Kind (Decl) = Iir_Kind_Package_Instantiation_Declaration then
+         --  Elaborate the body now.
+         declare
+            Uninst : constant Iir :=
+              Get_Named_Entity (Get_Uninstantiated_Package_Name (Decl));
+         begin
+            Elaborate_Declarative_Part
+              (Instance, Get_Declaration_Chain (Get_Package_Body (Uninst)));
+         end;
+      end if;
    end Elaborate_Package;
 
    procedure Elaborate_Package_Body (Decl: Iir)
@@ -390,8 +401,9 @@ package body Elaboration is
                   Info : constant Sim_Info_Acc := Get_Info (Library_Unit);
                   Body_Design: Iir_Design_Unit;
                begin
-                  if Package_Instances (Info.Frame_Scope.Pkg_Index) = null
-                    and then not Is_Uninstantiated_Package (Library_Unit)
+                  if not Is_Uninstantiated_Package (Library_Unit)
+                    and then
+                    Package_Instances (Info.Frame_Scope.Pkg_Index) = null
                   then
                      --  Package not yet elaborated.
 
@@ -443,7 +455,9 @@ package body Elaboration is
                Elaborate_Dependence (Design);
             when Iir_Kind_Package_Body =>
                --  For package instantiation.
-               null;
+               Elaborate_Dependence (Design);
+            when Iir_Kind_Context_Declaration =>
+               Elaborate_Dependence (Design);
             when others =>
                Error_Kind ("elaborate_dependence", Library_Unit);
          end case;
@@ -606,9 +620,8 @@ package body Elaboration is
       end case;
    end Init_To_Default;
 
-   procedure Create_Object (Instance : Block_Instance_Acc; Decl : Iir)
-   is
-      Slot : constant Object_Slot_Type := Get_Info (Decl).Slot;
+   procedure Create_Object
+     (Instance : Block_Instance_Acc; Slot : Object_Slot_Type) is
    begin
       --  Check elaboration order.
       --  Note: this is not done for package since objects from package are
@@ -623,6 +636,13 @@ package body Elaboration is
       Instance.Elab_Objects := Slot;
    end Create_Object;
 
+   procedure Create_Object (Instance : Block_Instance_Acc; Decl : Iir)
+   is
+      Slot : constant Object_Slot_Type := Get_Info (Decl).Slot;
+   begin
+      Create_Object (Instance, Slot);
+   end Create_Object;
+
    procedure Destroy_Object (Instance : Block_Instance_Acc; Decl : Iir)
    is
       Info : constant Sim_Info_Acc := Get_Info (Decl);
@@ -966,26 +986,37 @@ package body Elaboration is
    end Elaborate_Nature_Definition;
 
    --  LRM93 12.2.1  The Generic Clause
+   --  LRM08 14.3.2  Generic clause
    procedure Elaborate_Generic_Clause
      (Instance : Block_Instance_Acc; Generic_Chain : Iir)
    is
       Decl : Iir_Interface_Constant_Declaration;
    begin
+      --  LRM08 14.3.2 Generic clause
       --  Elaboration of a generic clause consists of the elaboration of each
       --  of the equivalent single generic declarations contained in the
       --  clause, in the order given.
       Decl := Generic_Chain;
       while Decl /= Null_Iir loop
-         --  The elaboration of a generic declaration consists of elaborating
-         --  the subtype indication and then creating a generic constant of
-         --  that subtype.
-         Elaborate_Subtype_Indication_If_Anonymous (Instance, Get_Type (Decl));
-         Create_Object (Instance, Decl);
-         --  The value of a generic constant is not defined until a subsequent
-         --  generic map aspect is evaluated, or in the absence of a generic
-         --  map aspect, until the default expression associated with the
-         --  generic constant is evaluated to determine the value of the
-         --  constant.
+         case Get_Kind (Decl) is
+            when Iir_Kind_Interface_Constant_Declaration =>
+               --  LRM93 12.2.2 The generic clause
+               --  The elaboration of a generic declaration consists of
+               --  elaborating the subtype indication and then creating a
+               --  generic constant of that subtype.
+               Elaborate_Subtype_Indication_If_Anonymous
+                 (Instance, Get_Type (Decl));
+               Create_Object (Instance, Decl);
+               --  The value of a generic constant is not defined until a
+               --  subsequent generic map aspect is evaluated, or in the
+               --  absence of a generic map aspect, until the default
+               --  expression associated with the generic constant is evaluated
+               --  to determine the value of the constant.
+            when Iir_Kind_Interface_Package_Declaration =>
+               Create_Object (Instance, Get_Info (Decl).Env_Slot);
+            when others =>
+               Error_Kind ("elaborate_generic_clause", Decl);
+         end case;
          Decl := Get_Chain (Decl);
       end loop;
    end Elaborate_Generic_Clause;
@@ -1065,6 +1096,22 @@ package body Elaboration is
                Target_Instance.Objects (Get_Info (Inter).Slot) :=
                  Last_Individual;
                goto Continue;
+            when Iir_Kind_Association_Element_Package =>
+               declare
+                  Actual : constant Iir :=
+                    Strip_Denoting_Name (Get_Actual (Assoc));
+                  Info : constant Sim_Info_Acc := Get_Info (Actual);
+                  Pkg_Block : Block_Instance_Acc;
+               begin
+                  Pkg_Block := Get_Instance_By_Scope
+                    (Local_Instance, Info.Frame_Scope);
+                  Environment_Table.Append (Pkg_Block);
+                  Val := Create_Environment_Value (Environment_Table.Last);
+                  Target_Instance.Objects (Get_Info (Inter).Env_Slot) :=
+                    Unshare (Val, Instance_Pool);
+               end;
+
+               goto Continue;
             when others =>
                Error_Kind ("elaborate_generic_map_aspect", Assoc);
          end case;
diff --git a/src/vhdl/simulate/elaboration.ads b/src/vhdl/simulate/elaboration.ads
index d28751f96..dd2da32be 100644
--- a/src/vhdl/simulate/elaboration.ads
+++ b/src/vhdl/simulate/elaboration.ads
@@ -215,4 +215,10 @@ package Elaboration is
       Table_Index_Type => Protected_Index_Type,
       Table_Low_Bound => 1,
       Table_Initial => 2);
+
+   package Environment_Table is new Tables
+     (Table_Component_Type => Block_Instance_Acc,
+      Table_Index_Type => Environment_Index_Type,
+      Table_Low_Bound => 1,
+      Table_Initial => 2);
 end Elaboration;
diff --git a/src/vhdl/simulate/execution.adb b/src/vhdl/simulate/execution.adb
index 25774f1e9..e2af70587 100644
--- a/src/vhdl/simulate/execution.adb
+++ b/src/vhdl/simulate/execution.adb
@@ -63,19 +63,30 @@ package body Execution is
 
    function Get_Instance_By_Scope
      (Instance: Block_Instance_Acc; Scope: Scope_Type)
-      return Block_Instance_Acc
-   is
-      Current: Block_Instance_Acc := Instance;
+     return Block_Instance_Acc is
    begin
       case Scope.Kind is
          when Scope_Kind_Frame =>
-            while Current /= null loop
-               if Current.Block_Scope = Scope then
-                  return Current;
+            declare
+               Current : Block_Instance_Acc;
+               Last : Block_Instance_Acc;
+            begin
+               Current := Instance;
+               while Current /= null loop
+                  if Current.Block_Scope = Scope then
+                     return Current;
+                  end if;
+                  Last := Current;
+                  Current := Current.Up_Block;
+               end loop;
+               if Scope.Depth = 0
+                 and then Last.Block_Scope.Kind = Scope_Kind_Package
+               then
+                  --  For instantiated packages.
+                  return Last;
                end if;
-               Current := Current.Up_Block;
-            end loop;
-            raise Internal_Error;
+               raise Internal_Error;
+            end;
          when Scope_Kind_Package =>
             --  Global scope (packages)
             return Package_Instances (Scope.Pkg_Index);
@@ -3223,9 +3234,8 @@ package body Execution is
    end Execute_Monadic_Association;
 
    --  Create a block instance for subprogram IMP.
-   function Create_Subprogram_Instance (Instance : Block_Instance_Acc;
-                                        Imp : Iir)
-                                       return Block_Instance_Acc
+   function Create_Subprogram_Instance
+     (Instance : Block_Instance_Acc; Imp : Iir) return Block_Instance_Acc
    is
       Func_Info : constant Sim_Info_Acc := Get_Info (Imp);
 
@@ -3236,20 +3246,36 @@ package body Execution is
         Alloc_On_Pool_Addr (Block_Type);
 
       Up_Block: Block_Instance_Acc;
+      Up_Info : Sim_Info_Acc;
       Res : Block_Instance_Acc;
+
+      Origin : Iir;
+      Label : Iir;
    begin
       pragma Assert (Get_Kind (Imp) in Iir_Kinds_Subprogram_Declaration
-                    or else Get_Kind (Imp) = Iir_Kind_Protected_Type_Body);
-      Up_Block := Get_Instance_By_Scope
-        (Instance, Get_Info (Get_Parent (Imp)).Frame_Scope);
+                       or else Get_Kind (Imp) = Iir_Kind_Protected_Type_Body);
+
+      Up_Info := Get_Info (Get_Parent (Imp));
+      Up_Block := Get_Instance_By_Scope (Instance, Up_Info.Frame_Scope);
+
+      Origin := Sem_Inst.Get_Origin (Imp);
+      if Origin /= Null_Iir then
+         Label := Origin;
+         if Up_Info.Kind = Kind_Environment then
+            Up_Block := Environment_Table.Table
+              (Up_Block.Objects (Up_Info.Env_Slot).Environment);
+         end if;
+      else
+         Label := Imp;
+      end if;
 
       Res := To_Block_Instance_Acc
         (Alloc_Block_Instance
            (Instance_Pool,
             Block_Instance_Type'(Max_Objs => Func_Info.Nbr_Objects,
-                                 Block_Scope => Func_Info.Frame_Scope,
+                                 Block_Scope => Get_Info (Label).Frame_Scope,
                                  Up_Block => Up_Block,
-                                 Label => Imp,
+                                 Label => Label,
                                  Stmt => Null_Iir,
                                  Parent => Instance,
                                  Children => null,
@@ -3272,18 +3298,12 @@ package body Execution is
         (Instance, Get_Declaration_Chain (Subprg_Body));
    end Execute_Subprogram_Call_Final;
 
-   function Execute_Function_Body (Instance : Block_Instance_Acc; Func : Iir)
+   function Execute_Function_Body (Instance : Block_Instance_Acc)
                                   return Iir_Value_Literal_Acc
    is
-      Subprg_Body : Iir;
+      Subprg_Body : constant Iir := Get_Subprogram_Body (Instance.Label);
       Res : Iir_Value_Literal_Acc;
    begin
-      Subprg_Body := Get_Subprogram_Body (Func);
-      if Subprg_Body = Null_Iir then
-         pragma Assert (Sem_Inst.Get_Origin (Func) /= Null_Iir);
-         Subprg_Body := Get_Subprogram_Body (Sem_Inst.Get_Origin (Func));
-      end if;
-
       Current_Process.Instance := Instance;
 
       Elaborate_Declarative_Part
@@ -3296,7 +3316,8 @@ package body Execution is
 
       if Instance.Result = null then
          Error_Msg_Exec
-           ("function scope exited without a return statement", Func);
+           ("function scope exited without a return statement",
+            Instance.Label);
       end if;
 
       -- Free variables, slots...
@@ -3329,7 +3350,7 @@ package body Execution is
       --  FIXME: implicit conversion
       Instance.Objects (Get_Info (Inter).Slot) := Val;
 
-      Res := Execute_Function_Body (Instance, Func);
+      Res := Execute_Function_Body (Instance);
       Res := Unshare (Res, Expr_Pool'Access);
       Release (Marker, Instance_Pool.all);
       return Res;
@@ -3691,7 +3712,7 @@ package body Execution is
       if Get_Foreign_Flag (Imp) then
          Res := Execute_Foreign_Function_Call (Subprg_Block, Expr, Imp);
       else
-         Res := Execute_Function_Body (Subprg_Block, Imp);
+         Res := Execute_Function_Body (Subprg_Block);
       end if;
 
       --  Unfortunately, we don't know where the result has been allocated,
@@ -3902,7 +3923,7 @@ package body Execution is
       Elaboration.Create_Object (Instance, Inter);
       Instance.Objects (Get_Info (Inter).Slot) := Arr;
 
-      return Execute_Function_Body (Instance, Imp);
+      return Execute_Function_Body (Instance);
    end Execute_Resolution_Function;
 
    procedure Execute_Signal_Assignment
diff --git a/src/vhdl/simulate/execution.ads b/src/vhdl/simulate/execution.ads
index 033e48854..17d05f4a0 100644
--- a/src/vhdl/simulate/execution.ads
+++ b/src/vhdl/simulate/execution.ads
@@ -20,6 +20,7 @@ with Types; use Types;
 with Iirs; use Iirs;
 with Iir_Values; use Iir_Values;
 with Elaboration; use Elaboration;
+with Annotations;
 with Areapools; use Areapools;
 
 package Execution is
@@ -111,6 +112,10 @@ package Execution is
    function Execute_Low_Limit (Bounds : Iir_Value_Literal_Acc)
                               return Iir_Value_Literal_Acc;
 
+   function Get_Instance_By_Scope
+     (Instance: Block_Instance_Acc; Scope: Annotations.Scope_Type)
+     return Block_Instance_Acc;
+
    function Get_Instance_For_Slot (Instance: Block_Instance_Acc; Decl: Iir)
                                    return Block_Instance_Acc;
 
@@ -167,9 +172,6 @@ package Execution is
                                         Imp : Iir)
                                        return Block_Instance_Acc;
 
-   function Execute_Function_Body (Instance : Block_Instance_Acc; Func : Iir)
-                                  return Iir_Value_Literal_Acc;
-
    function Execute_Image_Attribute (Val : Iir_Value_Literal_Acc;
                                      Expr_Type : Iir)
                                     return String;
diff --git a/src/vhdl/simulate/iir_values.adb b/src/vhdl/simulate/iir_values.adb
index ab9ad5215..3d308e7f6 100644
--- a/src/vhdl/simulate/iir_values.adb
+++ b/src/vhdl/simulate/iir_values.adb
@@ -362,6 +362,17 @@ package body Iir_Values is
                 (Kind => Iir_Value_Quantity, Quantity => Quantity)));
    end Create_Quantity_Value;
 
+   function Create_Environment_Value (Env : Environment_Index_Type)
+                                     return Iir_Value_Literal_Acc
+   is
+      subtype Environment_Value is Iir_Value_Literal (Iir_Value_Environment);
+      function Alloc is new Alloc_On_Pool_Addr (Environment_Value);
+   begin
+      return To_Iir_Value_Literal_Acc
+        (Alloc (Global_Pool'Access,
+                (Kind => Iir_Value_Environment, Environment => Env)));
+   end Create_Environment_Value;
+
    function Create_Protected_Value (Prot : Protected_Index_Type)
                                   return Iir_Value_Literal_Acc
    is
@@ -639,9 +650,11 @@ package body Iir_Values is
             pragma Assert (Src.Sig = null);
             return Create_Signal_Value (Src.Sig);
 
+         when Iir_Value_Environment =>
+            return Create_Environment_Value (Src.Environment);
+
          when Iir_Value_Quantity
-           | Iir_Value_Terminal
-           | Iir_Value_Environment =>
+           | Iir_Value_Terminal =>
             raise Internal_Error;
       end case;
    end Copy;
diff --git a/src/vhdl/simulate/iir_values.ads b/src/vhdl/simulate/iir_values.ads
index 92f8cefd4..aeb9b4f49 100644
--- a/src/vhdl/simulate/iir_values.ads
+++ b/src/vhdl/simulate/iir_values.ads
@@ -202,13 +202,13 @@ package Iir_Values is
    Instance_Pool : Areapool_Acc;
 
    function Create_Signal_Value (Sig : Ghdl_Signal_Ptr)
-     return Iir_Value_Literal_Acc;
-
+                                return Iir_Value_Literal_Acc;
    function Create_Terminal_Value (Terminal : Terminal_Index_Type)
                                   return Iir_Value_Literal_Acc;
-
    function Create_Quantity_Value (Quantity : Quantity_Index_Type)
                                   return Iir_Value_Literal_Acc;
+   function Create_Environment_Value (Env : Environment_Index_Type)
+                                     return Iir_Value_Literal_Acc;
 
    function Create_B1_Value (Val : Ghdl_B1) return Iir_Value_Literal_Acc;