vhdl: generate and handle package_instantiation_body

5 files changed, 108 insertions, 11 deletions

diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb
index b95f0eee0..896c7b4e8 100644
--- a/src/vhdl/translate/trans-chap2.adb
+++ b/src/vhdl/translate/trans-chap2.adb
@@ -1614,16 +1614,15 @@ package body Trans.Chap2 is
          declare
             Bod : constant Iir := Get_Instance_Package_Body (Inst);
          begin
-            if Is_Valid (Bod) then
+            if Get_Immediate_Body_Flag (Inst) then
                Translate_Package_Body (Bod);
-            else
+            elsif not Get_Need_Body (Spec)
+              and then not Is_Nested_Package (Inst)
+              and then Global_Storage /= O_Storage_External
+            then
                --  As an elaboration subprogram for the body is always
                --  needed, generate it.
-               if Global_Storage /= O_Storage_External then
-                  if not Is_Nested_Package (Inst) then
-                     Elab_Package_Body (Inst, Null_Iir);
-                  end if;
-               end if;
+               Elab_Package_Body (Inst, Null_Iir);
             end if;
          end;
          return;
diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb
index ab1633eaf..07e3f9030 100644
--- a/src/vhdl/translate/trans-chap4.adb
+++ b/src/vhdl/translate/trans-chap4.adb
@@ -2026,6 +2026,8 @@ package body Trans.Chap4 is
             Chap2.Translate_Package_Body (Decl);
          when Iir_Kind_Package_Instantiation_Declaration =>
             Chap2.Translate_Package_Instantiation_Declaration (Decl);
+         when Iir_Kind_Package_Instantiation_Body =>
+            Chap2.Translate_Package_Body (Decl);
 
          when Iir_Kind_Group_Template_Declaration =>
             null;
@@ -2711,12 +2713,21 @@ package body Trans.Chap4 is
                      Translate_Declaration_Chain_Subprograms (El, What);
                      if Is_Valid (Bod)
                        and then Global_Storage /= O_Storage_External
+                       and then Get_Immediate_Body_Flag (El)
                      then
                         Translate_Declaration_Chain_Subprograms (Bod, What);
                      end if;
                      Pop_Identifier_Prefix (Mark);
                   end;
                end if;
+            when Iir_Kind_Package_Instantiation_Body =>
+               declare
+                  Mark  : Id_Mark_Type;
+               begin
+                  Push_Identifier_Prefix (Mark, Get_Identifier (El));
+                  Translate_Declaration_Chain_Subprograms (El, What);
+                  Pop_Identifier_Prefix (Mark);
+               end;
             when others =>
                null;
          end case;
@@ -2835,6 +2846,10 @@ package body Trans.Chap4 is
                --  FIXME: finalizers ?
                Chap2.Elab_Package_Instantiation_Declaration (Decl);
 
+            when Iir_Kind_Package_Instantiation_Body =>
+               --  No elaboration code for nested package.
+               null;
+
             when Iir_Kind_Psl_Default_Clock =>
                null;
             when Iir_Kind_Psl_Declaration =>
diff --git a/src/vhdl/translate/trans-rtis.adb b/src/vhdl/translate/trans-rtis.adb
index 8b3c2cd04..3a9dabbb6 100644
--- a/src/vhdl/translate/trans-rtis.adb
+++ b/src/vhdl/translate/trans-rtis.adb
@@ -2414,7 +2414,8 @@ package body Trans.Rtis is
                end if;
 
             when Iir_Kind_Package_Instantiation_Declaration
-              |  Iir_Kind_Interface_Package_Declaration =>
+              |  Iir_Kind_Interface_Package_Declaration
+              | Iir_Kind_Package_Instantiation_Body =>
                --  FIXME: todo
                null;
 
@@ -2909,6 +2910,9 @@ package body Trans.Rtis is
          when Iir_Kind_Configuration_Declaration =>
             --  No RTI for configurations.
             return;
+         when Iir_Kind_Package_Instantiation_Body =>
+            --  No RTI for instantiation bodies.
+            return;
          when Iir_Kind_Architecture_Body =>
             if Info.Block_Rti_Const /= O_Dnode_Null then
                return;
diff --git a/src/vhdl/vhdl-canon.adb b/src/vhdl/vhdl-canon.adb
index 2f58f2e23..0294d1c2e 100644
--- a/src/vhdl/vhdl-canon.adb
+++ b/src/vhdl/vhdl-canon.adb
@@ -3223,6 +3223,20 @@ package body Vhdl.Canon is
       end if;
    end Canon_Subtype_Indication_If_Owned;
 
+   function Instantiation_Needs_Immediate_Body_P (Decl : Iir) return Boolean
+   is
+      Parent : constant Iir := Get_Parent (Decl);
+   begin
+      if Get_Kind (Parent) /= Iir_Kind_Package_Declaration then
+         --  TODO: also package instantiation ?
+         return True;
+      end if;
+      if not Get_Need_Body (Parent) then
+         return True;
+      end if;
+      return False;
+   end Instantiation_Needs_Immediate_Body_P;
+
    --  Return the new package declaration (if any).
    procedure Canon_Package_Instantiation_Declaration (Decl : Iir)
    is
@@ -3243,13 +3257,70 @@ package body Vhdl.Canon is
       --  FIXME: generate only if generating code for this unit.
       if Get_Macro_Expanded_Flag (Pkg)
         and then Get_Need_Body (Pkg)
+        and then Instantiation_Needs_Immediate_Body_P (Decl)
       then
+         Set_Immediate_Body_Flag (Decl, True);
          Bod := Sem_Inst.Instantiate_Package_Body (Decl);
          Set_Parent (Bod, Get_Parent (Decl));
          Set_Instance_Package_Body (Decl, Bod);
       end if;
    end Canon_Package_Instantiation_Declaration;
 
+   procedure Canon_Package_Body (Bod : Iir)
+   is
+      Decl : Iir;
+      Prev_Decl : Iir;
+   begin
+      Decl := Get_Declaration_Chain (Bod);
+      Prev_Decl := Null_Iir;
+      while Decl /= Null_Iir loop
+         Canon_Declaration (Null_Iir, Decl, Null_Iir);
+         Prev_Decl := Decl;
+         Decl := Get_Chain (Prev_Decl);
+      end loop;
+
+      --  Add bodies of package instantiations.
+      if Vhdl_Std >= Vhdl_08 then
+         declare
+            Pkg : constant Iir := Get_Package (Bod);
+            Pkg_Decl : Iir;
+            Pkg_Spec : Iir;
+            Inst_Bod : Iir;
+         begin
+            --  For each declaration of the package
+            Pkg_Decl := Get_Declaration_Chain (Pkg);
+            while Pkg_Decl /= Null_Iir loop
+               if (Get_Kind (Pkg_Decl)
+                     = Iir_Kind_Package_Instantiation_Declaration)
+               then
+                  --  This is a package instantiation...
+                  Pkg_Spec := Get_Uninstantiated_Package_Decl (Pkg_Decl);
+                  if Get_Need_Body (Pkg_Spec)
+                    and then Get_Macro_Expanded_Flag (Pkg_Spec)
+                  then
+                     --  ... that needs a body.  Create the body.
+                     Inst_Bod := Sem_Inst.Instantiate_Package_Body (Pkg_Decl);
+                     Set_Parent (Inst_Bod, Bod);
+                     pragma Assert
+                       (Get_Instance_Package_Body (Pkg_Decl) = Null_Iir);
+                     Set_Instance_Package_Body (Pkg_Decl, Inst_Bod);
+
+                     --  Append.
+                     if Prev_Decl = Null_Iir then
+                        Set_Declaration_Chain (Bod, Inst_Bod);
+                     else
+                        Set_Chain (Prev_Decl, Inst_Bod);
+                     end if;
+                     Prev_Decl := Inst_Bod;
+                  end if;
+               end if;
+
+               Pkg_Decl := Get_Chain (Pkg_Decl);
+            end loop;
+         end;
+      end if;
+   end Canon_Package_Body;
+
    procedure Canon_Declaration
      (Top : Iir_Design_Unit; Decl : Iir; Parent : Iir)
    is
@@ -3351,7 +3422,7 @@ package body Vhdl.Canon is
          when Iir_Kind_Package_Declaration =>
             Canon_Declarations (Top, Decl, Null_Iir);
          when Iir_Kind_Package_Body =>
-            Canon_Declarations (Top, Decl, Parent);
+            Canon_Package_Body (Decl);
 
          when Iir_Kind_Package_Instantiation_Declaration =>
             Canon_Package_Instantiation_Declaration (Decl);
@@ -3795,7 +3866,7 @@ package body Vhdl.Canon is
          when Iir_Kind_Package_Declaration =>
             Canon_Declarations (Unit, El, Null_Iir);
          when Iir_Kind_Package_Body =>
-            Canon_Declarations (Unit, El, Null_Iir);
+            Canon_Package_Body (El);
          when Iir_Kind_Configuration_Declaration =>
             Canon_Declarations (Unit, El, Null_Iir);
             if Canon_Flag_Configurations then
diff --git a/src/vhdl/vhdl-sem_inst.adb b/src/vhdl/vhdl-sem_inst.adb
index 57225e2ae..66754d91d 100644
--- a/src/vhdl/vhdl-sem_inst.adb
+++ b/src/vhdl/vhdl-sem_inst.adb
@@ -1219,6 +1219,7 @@ package body Vhdl.Sem_Inst is
       Pkg : constant Iir := Get_Uninstantiated_Package_Decl (Inst);
       Prev_Instance_File : constant Source_File_Entry := Instance_File;
       Mark : constant Instance_Index_Type := Prev_Instance_Table.Last;
+      Bod : constant Iir := Get_Package_Body (Pkg);
       Res : Iir;
    begin
       Create_Relocation (Inst, Pkg);
@@ -1302,7 +1303,14 @@ package body Vhdl.Sem_Inst is
         (Get_Declaration_Chain (Pkg), Get_Declaration_Chain (Inst));
 
       --  Instantiate the body.
-      Res := Instantiate_Iir (Get_Package_Body (Pkg), False);
+
+      Res := Create_Iir (Iir_Kind_Package_Instantiation_Body);
+      Location_Copy (Res, Inst);
+      Set_Declaration_Chain
+        (Res, Instantiate_Iir_Chain (Get_Declaration_Chain (Bod)));
+      Set_Attribute_Value_Chain
+        (Res, Instantiate_Iir_Chain (Get_Attribute_Value_Chain (Bod)));
+      Set_Package (Res, Inst);
       Set_Identifier (Res, Get_Identifier (Inst));
 
       --  Restore.