synth: handle package instantiation. Fix #1159

4 files changed, 90 insertions, 6 deletions

diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb
index b192994ab..adcafec27 100644
--- a/src/synth/synth-context.adb
+++ b/src/synth/synth-context.adb
@@ -66,6 +66,7 @@ package body Synth.Context is
                                       Name => No_Sname,
                                       Block_Scope => Global_Info,
                                       Up_Block => null,
+                                      Uninst_Scope => null,
                                       Source_Scope => Null_Node,
                                       Elab_Objects => 0,
                                       Objects => (others => null));
@@ -102,12 +103,19 @@ package body Synth.Context is
                                       Name => Name,
                                       Block_Scope => Scope,
                                       Up_Block => Parent,
+                                      Uninst_Scope => null,
                                       Source_Scope => Blk,
                                       Elab_Objects => 0,
                                       Objects => (others => null));
       return Res;
    end Make_Instance;
 
+   procedure Set_Instance_Base (Inst : Synth_Instance_Acc;
+                                Base : Synth_Instance_Acc) is
+   begin
+      Inst.Base := Base.Base;
+   end Set_Instance_Base;
+
    procedure Free_Instance (Synth_Inst : in out Synth_Instance_Acc)
    is
       procedure Deallocate is new Ada.Unchecked_Deallocation
@@ -278,6 +286,12 @@ package body Synth.Context is
       return Get_Package_Object (Syn_Inst, Get_Info (Pkg));
    end Get_Package_Object;
 
+   procedure Set_Uninstantiated_Scope
+     (Syn_Inst : Synth_Instance_Acc; Bod : Node) is
+   begin
+      Syn_Inst.Uninst_Scope := Get_Info (Bod);
+   end Set_Uninstantiated_Scope;
+
    procedure Destroy_Object
      (Syn_Inst : Synth_Instance_Acc; Decl : Node)
    is
@@ -335,7 +349,18 @@ package body Synth.Context is
          when Kind_Package =>
             if Scope.Pkg_Parent = null then
                --  This is a scope for an uninstantiated package.
-               raise Internal_Error;
+               declare
+                  Current : Synth_Instance_Acc;
+               begin
+                  Current := Syn_Inst;
+                  while Current /= null loop
+                     if Current.Uninst_Scope = Scope then
+                        return Current;
+                     end if;
+                  Current := Current.Up_Block;
+                  end loop;
+                  raise Internal_Error;
+               end;
             else
                --  Instantiated package.
                declare
@@ -350,6 +375,18 @@ package body Synth.Context is
       end case;
    end Get_Instance_By_Scope;
 
+   function Get_Parent_Scope (Blk : Node) return Sim_Info_Acc
+   is
+      Parent : Node;
+   begin
+      Parent := Get_Parent (Blk);
+      if Get_Kind (Parent) = Iir_Kind_Architecture_Body then
+         Parent := Vhdl.Utils.Get_Entity (Parent);
+      end if;
+      return Get_Info (Parent);
+   end Get_Parent_Scope;
+
+
    function Get_Value (Syn_Inst: Synth_Instance_Acc; Obj : Node)
                       return Value_Acc
    is
diff --git a/src/synth/synth-context.ads b/src/synth/synth-context.ads
index b5c1619f1..85962988b 100644
--- a/src/synth/synth-context.ads
+++ b/src/synth/synth-context.ads
@@ -50,6 +50,12 @@ package Synth.Context is
                            Blk : Node;
                            Name : Sname := No_Sname)
                           return Synth_Instance_Acc;
+
+   --  Only useful for subprograms: set the base (which can be different from
+   --  the parent).  Ideally it should be part of Make_Instance, but in most
+   --  cases they are the same (except sometimes for subprograms).
+   procedure Set_Instance_Base (Inst : Synth_Instance_Acc;
+                                Base : Synth_Instance_Acc);
    procedure Free_Instance (Synth_Inst : in out Synth_Instance_Acc);
 
    function Is_Error (Inst : Synth_Instance_Acc) return Boolean;
@@ -121,6 +127,12 @@ package Synth.Context is
 
    function Get_Package_Object
      (Syn_Inst : Synth_Instance_Acc; Pkg : Node) return Value_Acc;
+
+   --  Return the scope of the parent of BLK.  Deals with architecture bodies.
+   function Get_Parent_Scope (Blk : Node) return Sim_Info_Acc;
+
+   procedure Set_Uninstantiated_Scope
+     (Syn_Inst : Synth_Instance_Acc; Bod : Node);
 private
    type Objects_Array is array (Object_Slot_Type range <>) of Value_Acc;
 
@@ -147,9 +159,17 @@ private
       --  Name prefix for declarations.
       Name : Sname;
 
-      --  The corresponding info for this instance.  This is used for lookup.
+      --  The corresponding info for this instance.
+      --  This is used for lookup.
       Block_Scope : Sim_Info_Acc;
 
+      --  The corresponding info the the uninstantiated specification of
+      --  an instantiated package.  When an object is looked for from the
+      --  uninstantiated body, the scope of the uninstantiated specification
+      --  is used.  And it is different from Block_Scope.
+      --  This is used for lookup of uninstantiated specification.
+      Uninst_Scope : Sim_Info_Acc;
+
       --  Instance of the parent scope.
       Up_Block : Synth_Instance_Acc;
 
diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb
index 63710b065..24e7e2a41 100644
--- a/src/synth/synth-decls.adb
+++ b/src/synth/synth-decls.adb
@@ -679,6 +679,7 @@ package body Synth.Decls is
    procedure Synth_Package_Instantiation
      (Parent_Inst : Synth_Instance_Acc; Pkg : Node)
    is
+      Bod : constant Node := Get_Instance_Package_Body (Pkg);
       Sub_Inst : Synth_Instance_Acc;
    begin
       Sub_Inst := Create_Package_Instance (Parent_Inst, Pkg);
@@ -688,6 +689,24 @@ package body Synth.Decls is
          Get_Generic_Chain (Pkg), Get_Generic_Map_Aspect_Chain (Pkg));
 
       Synth_Declarations (Sub_Inst, Get_Declaration_Chain (Pkg));
+
+      if Bod /= Null_Node then
+         --  Macro expended package instantiation.
+         raise Internal_Error;
+      else
+         --  Shared body
+         declare
+            Uninst : constant Node := Get_Uninstantiated_Package_Decl (Pkg);
+            Uninst_Bod : constant Node := Get_Package_Body (Uninst);
+         begin
+            Set_Uninstantiated_Scope (Sub_Inst, Uninst);
+            --  Synth declarations of (optional) body.
+            if Uninst_Bod /= Null_Node then
+               Synth_Declarations
+                 (Sub_Inst, Get_Declaration_Chain (Uninst_Bod));
+            end if;
+         end;
+      end if;
    end Synth_Package_Instantiation;
 
    procedure Synth_Variable
diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb
index fc7f70806..6831ea898 100644
--- a/src/synth/synth-stmts.adb
+++ b/src/synth/synth-stmts.adb
@@ -31,6 +31,7 @@ with Simple_IO;
 with Vhdl.Errors; use Vhdl.Errors;
 with Vhdl.Types;
 with Vhdl.Sem_Expr;
+with Vhdl.Sem_Inst;
 with Vhdl.Utils; use Vhdl.Utils;
 with Vhdl.Std_Package;
 with Vhdl.Evaluation;
@@ -1676,7 +1677,7 @@ package body Synth.Stmts is
    is
       Imp  : constant Node := Get_Implementation (Call);
       Is_Func : constant Boolean := Is_Function_Declaration (Imp);
-      Bod : constant Node := Get_Subprogram_Body (Imp);
+      Bod : constant Node := Vhdl.Sem_Inst.Get_Subprogram_Body_Origin (Imp);
       Res : Value_Acc;
       C : Seq_Context (Mode_Dynamic);
       Wire_Mark : Wire_Id;
@@ -1826,16 +1827,21 @@ package body Synth.Stmts is
    is
       Imp  : constant Node := Get_Implementation (Call);
       Is_Func : constant Boolean := Is_Function_Declaration (Imp);
-      Bod : constant Node := Get_Subprogram_Body (Imp);
+      Bod : constant Node := Vhdl.Sem_Inst.Get_Subprogram_Body_Origin (Imp);
       Nbr_Inout : constant Natural := Count_Associations (Init);
       Infos : Target_Info_Array (1 .. Nbr_Inout);
       Area_Mark : Areapools.Mark_Type;
       Res : Value_Acc;
       Sub_Inst : Synth_Instance_Acc;
+      Up_Inst : Synth_Instance_Acc;
    begin
       Areapools.Mark (Area_Mark, Instance_Pool.all);
-      Sub_Inst := Make_Instance (Syn_Inst, Bod,
+
+      Up_Inst := Get_Instance_By_Scope (Syn_Inst, Get_Parent_Scope (Imp));
+      Sub_Inst := Make_Instance (Up_Inst, Bod,
                                  New_Internal_Name (Build_Context));
+      Set_Instance_Base (Sub_Inst, Syn_Inst);
+
       Synth_Subprogram_Association (Sub_Inst, Syn_Inst, Init, Infos);
 
       if Is_Error (Sub_Inst) then
@@ -2618,7 +2624,9 @@ package body Synth.Stmts is
          Unit : Node;
          Lib : Node;
       begin
-         if Get_Kind (Pkg) = Iir_Kind_Package_Declaration then
+         if Get_Kind (Pkg) = Iir_Kind_Package_Declaration
+           and then not Is_Uninstantiated_Package (Pkg)
+         then
             Unit := Get_Parent (Pkg);
             if Get_Kind (Unit) = Iir_Kind_Design_Unit then
                Lib := Get_Library (Get_Design_File (Unit));