simul: support of package instantiation.

4 files changed, 85 insertions, 11 deletions

diff --git a/src/vhdl/simulate/annotations.adb b/src/vhdl/simulate/annotations.adb
index 47aa0e87f..17c9e4fd9 100644
--- a/src/vhdl/simulate/annotations.adb
+++ b/src/vhdl/simulate/annotations.adb
@@ -93,7 +93,16 @@ package body Annotations is
             Info := new Sim_Info_Type'(Kind => Kind_Quantity,
                                        Obj_Scope => Current_Scope,
                                        Slot => Block_Info.Nbr_Objects);
-         when others =>
+         when Kind_Environment =>
+            Info := new Sim_Info_Type'(Kind => Kind_Environment,
+                                       Obj_Scope => Current_Scope,
+                                       Slot => Block_Info.Nbr_Objects);
+         when Kind_Block
+           | Kind_Process
+           | Kind_Frame
+           | Kind_Range
+           | Kind_Scalar_Type
+           | Kind_File_Type =>
             raise Internal_Error;
       end case;
       Set_Info (Obj, Info);
@@ -667,6 +676,9 @@ 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;
@@ -999,7 +1011,9 @@ package body Annotations is
 
    procedure Annotate_Package (Decl: Iir_Package_Declaration)
    is
+      Prev_Scope : constant Scope_Type := Current_Scope;
       Package_Info: Sim_Info_Acc;
+      Header : Iir;
    begin
       pragma Assert (Current_Scope.Kind = Scope_Kind_None);
 
@@ -1015,10 +1029,20 @@ package body Annotations is
 
       Set_Info (Decl, Package_Info);
 
+      if Get_Kind (Decl) = Iir_Kind_Package_Instantiation_Declaration then
+         Annotate_Create_Interface_List
+           (Package_Info, Get_Generic_Chain (Decl), True);
+      else
+         Header := Get_Package_Header (Decl);
+         if Header /= Null_Iir then
+            Annotate_Create_Interface_List
+              (Package_Info, Get_Generic_Chain (Header), True);
+         end if;
+      end if;
       -- declarations
       Annotate_Declaration_List (Package_Info, Get_Declaration_Chain (Decl));
 
-      Current_Scope := (Kind => Scope_Kind_None);
+      Current_Scope := Prev_Scope;
    end Annotate_Package;
 
    procedure Annotate_Package_Body (Decl: Iir)
@@ -1147,6 +1171,8 @@ package body Annotations is
             Annotate_Package_Body (El);
          when Iir_Kind_Configuration_Declaration =>
             Annotate_Configuration_Declaration (El);
+         when Iir_Kind_Package_Instantiation_Declaration =>
+            Annotate_Package (El);
          when others =>
             Error_Kind ("annotate2", El);
       end case;
@@ -1188,7 +1214,9 @@ package body Annotations is
               ("-- nbr objects:" & Object_Slot_Type'Image (Info.Nbr_Objects));
 
          when Kind_Object | Kind_Signal | Kind_File
-           | Kind_Terminal | Kind_Quantity =>
+           | Kind_Terminal
+           | Kind_Quantity
+           | Kind_Environment =>
             Put_Line ("-- slot:" & Object_Slot_Type'Image (Info.Slot)
                       & ", scope:" & Image (Info.Obj_Scope));
          when Kind_Scalar_Type
@@ -1225,7 +1253,7 @@ package body Annotations is
             Put_Line ("nbr instance:"
                       & Instance_Slot_Type'Image (Info.Nbr_Instances));
          when Kind_Object | Kind_Signal | Kind_File
-           | Kind_Terminal | Kind_Quantity =>
+           | Kind_Terminal | Kind_Quantity | Kind_Environment =>
             Put_Line ("slot:" & Object_Slot_Type'Image (Info.Slot)
                       & ", scope:" & Image (Info.Obj_Scope));
          when Kind_Range =>
diff --git a/src/vhdl/simulate/annotations.ads b/src/vhdl/simulate/annotations.ads
index 7401c606c..a307e5394 100644
--- a/src/vhdl/simulate/annotations.ads
+++ b/src/vhdl/simulate/annotations.ads
@@ -74,7 +74,8 @@ package Annotations is
       Kind_Scalar_Type, Kind_File_Type,
       Kind_Object, Kind_Signal, Kind_Range,
       Kind_File,
-      Kind_Terminal, Kind_Quantity);
+      Kind_Terminal, Kind_Quantity,
+      Kind_Environment);
 
    type Sim_Info_Type (Kind: Sim_Info_Kind);
    type Sim_Info_Acc is access all Sim_Info_Type;
@@ -102,7 +103,8 @@ package Annotations is
            | Kind_Range
            | Kind_File
            | Kind_Terminal
-           | Kind_Quantity =>
+           | Kind_Quantity
+           | Kind_Environment =>
             --  Block in which this object is declared in.
             Obj_Scope : Scope_Type;
 
diff --git a/src/vhdl/simulate/elaboration.adb b/src/vhdl/simulate/elaboration.adb
index 1ad2e02b5..5c634caf8 100644
--- a/src/vhdl/simulate/elaboration.adb
+++ b/src/vhdl/simulate/elaboration.adb
@@ -46,6 +46,13 @@ package body Elaboration is
      (Instance : Block_Instance_Acc; Decl : Iir)
      return Iir_Value_Literal_Acc;
 
+   procedure Elaborate_Generic_Clause
+     (Instance : Block_Instance_Acc; Generic_Chain : Iir);
+   procedure Elaborate_Generic_Map_Aspect
+     (Target_Instance : Block_Instance_Acc;
+      Local_Instance : Block_Instance_Acc;
+      Map : Iir);
+
    --  CONF is the block_configuration for components of ARCH.
    function Elaborate_Architecture (Arch : Iir_Architecture_Body;
                                     Conf : Iir_Block_Configuration;
@@ -299,6 +306,12 @@ package body Elaboration is
          Ada.Text_IO.Put_Line ("elaborating " & Disp_Node (Decl));
       end if;
 
+      if Get_Kind (Decl) = Iir_Kind_Package_Instantiation_Declaration then
+         Elaborate_Generic_Clause (Instance, Get_Generic_Chain (Decl));
+         Elaborate_Generic_Map_Aspect
+           (Instance, Instance, Get_Generic_Map_Aspect_Chain (Decl));
+      end if;
+
       -- Elaborate objects declarations.
       Elaborate_Declarative_Part (Instance, Get_Declaration_Chain (Decl));
    end Elaborate_Package;
@@ -378,6 +391,7 @@ package body Elaboration is
                   Body_Design: Iir_Design_Unit;
                begin
                   if Package_Instances (Info.Frame_Scope.Pkg_Index) = null
+                    and then not Is_Uninstantiated_Package (Library_Unit)
                   then
                      --  Package not yet elaborated.
 
@@ -408,10 +422,28 @@ package body Elaboration is
                      end if;
                   end if;
                end;
+            when Iir_Kind_Package_Instantiation_Declaration =>
+               declare
+                  Info : constant Sim_Info_Acc := Get_Info (Library_Unit);
+               begin
+                  if Package_Instances (Info.Frame_Scope.Pkg_Index) = null
+                  then
+                     --  Package not yet elaborated.
+
+                     --  First the packages on which DESIGN depends.
+                     Elaborate_Dependence (Design);
+
+                     --  Then the declaration.
+                     Elaborate_Package (Library_Unit);
+                  end if;
+               end;
             when Iir_Kind_Entity_Declaration
               | Iir_Kind_Configuration_Declaration
               | Iir_Kind_Architecture_Body =>
                Elaborate_Dependence (Design);
+            when Iir_Kind_Package_Body =>
+               --  For package instantiation.
+               null;
             when others =>
                Error_Kind ("elaborate_dependence", Library_Unit);
          end case;
@@ -933,7 +965,7 @@ package body Elaboration is
       end case;
    end Elaborate_Nature_Definition;
 
-   --  LRM93 §12.2.1  The Generic Clause
+   --  LRM93 12.2.1  The Generic Clause
    procedure Elaborate_Generic_Clause
      (Instance : Block_Instance_Acc; Generic_Chain : Iir)
    is
@@ -989,6 +1021,7 @@ package body Elaboration is
       Value : Iir;
       Val : Iir_Value_Literal_Acc;
       Last_Individual : Iir_Value_Literal_Acc;
+      Marker : Mark_Type;
    begin
       --  Elaboration of a generic map aspect consists of elaborating the
       --  generic association list.
@@ -997,6 +1030,7 @@ package body Elaboration is
       --  elaboration of each generic association element in the
       --  association list.
       Assoc := Map;
+      Mark (Marker, Expr_Pool);
       while Assoc /= Null_Iir loop
          --  Elaboration of a generic association element consists of the
          --  elaboration of the formal part and the evaluation of the actual
@@ -1067,6 +1101,7 @@ package body Elaboration is
          end if;
 
          <<Continue>> null;
+         Release (Marker, Expr_Pool);
          Assoc := Get_Chain (Assoc);
       end loop;
    end Elaborate_Generic_Map_Aspect;
@@ -2601,6 +2636,8 @@ package body Elaboration is
       --  Use a 'fake' process to execute code during elaboration.
       Current_Process := No_Process;
 
+      pragma Assert (Is_Empty (Expr_Pool));
+
       --  Find architecture and configuration for the top unit
       case Get_Kind (Unit) is
          when Iir_Kind_Architecture_Body =>
@@ -2619,12 +2656,12 @@ package body Elaboration is
       Arch_Unit := Get_Design_Unit (Arch);
       Entity := Get_Entity (Arch);
 
+      pragma Assert (Is_Empty (Expr_Pool));
+
       Elaborate_Dependence (Arch_Unit);
 
       --  Sanity check: memory area for expressions must be empty.
-      if not Is_Empty (Expr_Pool) then
-         raise Internal_Error;
-      end if;
+      pragma Assert (Is_Empty (Expr_Pool));
 
       --  Use default values for top entity generics and ports.
       Generic_Map := Create_Default_Association
diff --git a/src/vhdl/simulate/execution.adb b/src/vhdl/simulate/execution.adb
index b299d648e..25774f1e9 100644
--- a/src/vhdl/simulate/execution.adb
+++ b/src/vhdl/simulate/execution.adb
@@ -42,6 +42,7 @@ with Grt_Interface;
 with Grt.Values;
 with Grt.Errors;
 with Grt.Std_Logic_1164;
+with Sem_Inst;
 
 package body Execution is
 
@@ -3274,9 +3275,15 @@ package body Execution is
    function Execute_Function_Body (Instance : Block_Instance_Acc; Func : Iir)
                                   return Iir_Value_Literal_Acc
    is
-      Subprg_Body : constant Iir := Get_Subprogram_Body (Func);
+      Subprg_Body : Iir;
       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