vhdl08: handle very simple nested packages.

6 files changed, 148 insertions, 119 deletions

diff --git a/src/vhdl/canon.adb b/src/vhdl/canon.adb
index 74b271f80..13f61fb48 100644
--- a/src/vhdl/canon.adb
+++ b/src/vhdl/canon.adb
@@ -30,9 +30,9 @@ with PSL.NFAs.Utils;
 with Canon_PSL;
 
 package body Canon is
-   --  Canonicalize a list of declarations.  LIST can be null.
-   --  PARENT must be the parent of the current statements chain for LIST,
-   --  or NULL_IIR if LIST has no corresponding current statments.
+   --  Canonicalize the chain of declarations in Declaration_Chain of
+   --  DECL_PARENT. PARENT must be the parent of the current statements chain,
+   --  or NULL_IIR if DECL_PARENT has no corresponding current statments.
    procedure Canon_Declarations (Top : Iir_Design_Unit;
                                  Decl_Parent : Iir;
                                  Parent : Iir);
@@ -2647,44 +2647,14 @@ package body Canon is
             Canon_Component_Specification (Decl, Parent);
             Canon_Component_Configuration (Top, Decl);
 
+         when Iir_Kind_Package_Declaration =>
+            Canon_Declarations (Top, Decl, Parent);
+         when Iir_Kind_Package_Body =>
+            Canon_Declarations (Top, Decl, Parent);
+
          when Iir_Kind_Package_Instantiation_Declaration =>
             Canon_Package_Instantiation_Declaration (Decl);
 
---             declare
---                List : Iir_List;
---                Binding : Iir_Binding_Indication;
---                Component : Iir_Component_Declaration;
---                Aspect : Iir;
---                Entity : Iir;
---             begin
---                Binding := Get_Binding_Indication (Decl);
---                Component := Get_Component_Name (Decl);
---                Aspect := Get_Entity_Aspect (Binding);
---                case Get_Kind (Aspect) is
---                   when Iir_Kind_Entity_Aspect_Entity =>
---                      Entity := Get_Entity (Aspect);
---                   when others =>
---                      Error_Kind ("configuration_specification", Aspect);
---                end case;
---                Entity := Get_Library_Unit (Entity);
---                List := Get_Generic_Map_Aspect_List (Binding);
---                if List = Null_Iir_List then
---                   Set_Generic_Map_Aspect_List
---                     (Binding,
---                      Canon_Default_Map_Association_List
---                    (Get_Generic_List (Entity), Get_Generic_List (Component),
---                       Get_Location (Decl)));
---                end if;
---                List := Get_Port_Map_Aspect_List (Binding);
---                if List = Null_Iir_List then
---                   Set_Port_Map_Aspect_List
---                     (Binding,
---                      Canon_Default_Map_Association_List
---                      (Get_Port_List (Entity), Get_Port_List (Component),
---                       Get_Location (Decl)));
---                end if;
---             end;
-
          when Iir_Kinds_Signal_Attribute =>
             null;
 
diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb
index 14dc0a2c4..a74e9380b 100644
--- a/src/vhdl/iirs_utils.adb
+++ b/src/vhdl/iirs_utils.adb
@@ -1258,6 +1258,11 @@ package body Iirs_Utils is
       end case;
    end Get_Entity_From_Entity_Aspect;
 
+   function Is_Nested_Package (Pkg : Iir) return Boolean is
+   begin
+      return Get_Kind (Get_Parent (Pkg)) /= Iir_Kind_Design_Unit;
+   end Is_Nested_Package;
+
    --  LRM08 4.7 Package declarations
    --  If the package header is empty, the package declared by a package
    --  declaration is called a simple package.
diff --git a/src/vhdl/iirs_utils.ads b/src/vhdl/iirs_utils.ads
index 11ee628c3..a9944f6e1 100644
--- a/src/vhdl/iirs_utils.ads
+++ b/src/vhdl/iirs_utils.ads
@@ -273,6 +273,11 @@ package Iirs_Utils is
    --        if ASPECT is open, return Null_Iir;
    function Get_Entity_From_Entity_Aspect (Aspect : Iir) return Iir;
 
+   --  Definition from LRM08 4.8 Package bodies
+   --  True if PKG (a package declaration or a package body) is not a library
+   --  unit.  Can be true only for vhdl08.
+   function Is_Nested_Package (Pkg : Iir) return Boolean;
+
    --  Definitions from LRM08 4.7 Package declarations.
    --  PKG must denote a package declaration.
    function Is_Simple_Package (Pkg : Iir) return Boolean;
diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb
index 5ff3ee3c7..d5837d304 100644
--- a/src/vhdl/translate/trans-chap2.adb
+++ b/src/vhdl/translate/trans-chap2.adb
@@ -754,13 +754,19 @@ package body Trans.Chap2 is
 
    procedure Translate_Package_Declaration (Decl : Iir_Package_Declaration)
    is
-      Header               : constant Iir := Get_Package_Header (Decl);
+      Is_Nested            : constant Boolean := Is_Nested_Package (Decl);
+      Header               : constant Iir     := Get_Package_Header (Decl);
+      Mark                 : Id_Mark_Type;
       Info                 : Ortho_Info_Acc;
       Interface_List       : O_Inter_List;
       Prev_Subprg_Instance : Subprgs.Subprg_Instance_Stack;
    begin
       Info := Add_Info (Decl, Kind_Package);
 
+      if Is_Nested then
+         Push_Identifier_Prefix (Mark, Get_Identifier (Decl));
+      end if;
+
       --  Translate declarations.
       if Is_Uninstantiated_Package (Decl) then
          --  Create an instance for the spec.
@@ -788,20 +794,24 @@ package body Trans.Chap2 is
             Wki_Instance, Prev_Subprg_Instance);
       else
          Chap4.Translate_Declaration_Chain (Decl);
-         Info.Package_Elab_Var := Create_Var
-           (Create_Var_Identifier ("ELABORATED"), Ghdl_Bool_Type);
+         if not Is_Nested then
+            Info.Package_Elab_Var := Create_Var
+              (Create_Var_Identifier ("ELABORATED"), Ghdl_Bool_Type);
+         end if;
       end if;
 
       --  Translate subprograms declarations.
       Chap4.Translate_Declaration_Chain_Subprograms (Decl);
 
       --  Declare elaborator for the body.
-      Start_Procedure_Decl
-        (Interface_List, Create_Identifier ("ELAB_BODY"), Global_Storage);
-      Subprgs.Add_Subprg_Instance_Interfaces
-        (Interface_List, Info.Package_Elab_Body_Instance);
-      Finish_Subprogram_Decl
-        (Interface_List, Info.Package_Elab_Body_Subprg);
+      if not Is_Nested then
+         Start_Procedure_Decl
+           (Interface_List, Create_Identifier ("ELAB_BODY"), Global_Storage);
+         Subprgs.Add_Subprg_Instance_Interfaces
+           (Interface_List, Info.Package_Elab_Body_Instance);
+         Finish_Subprogram_Decl
+           (Interface_List, Info.Package_Elab_Body_Subprg);
+      end if;
 
       if Is_Uninstantiated_Package (Decl) then
          Subprgs.Pop_Subprg_Instance (Wki_Instance, Prev_Subprg_Instance);
@@ -812,21 +822,24 @@ package body Trans.Chap2 is
             Wki_Instance, Prev_Subprg_Instance);
       end if;
 
-      Start_Procedure_Decl
-        (Interface_List, Create_Identifier ("ELAB_SPEC"), Global_Storage);
-      Subprgs.Add_Subprg_Instance_Interfaces
-        (Interface_List, Info.Package_Elab_Spec_Instance);
-      Finish_Subprogram_Decl
-        (Interface_List, Info.Package_Elab_Spec_Subprg);
-
-      if Flag_Rti then
-         --  Generate RTI.
-         Rtis.Generate_Unit (Decl);
-      end if;
+      --  Declare elaborator for the spec.
+      if not Is_Nested then
+         Start_Procedure_Decl
+           (Interface_List, Create_Identifier ("ELAB_SPEC"), Global_Storage);
+         Subprgs.Add_Subprg_Instance_Interfaces
+           (Interface_List, Info.Package_Elab_Spec_Instance);
+         Finish_Subprogram_Decl
+           (Interface_List, Info.Package_Elab_Spec_Subprg);
+
+         if Flag_Rti then
+            --  Generate RTI.
+            Rtis.Generate_Unit (Decl);
+         end if;
 
-      if Global_Storage = O_Storage_Public then
-         --  Create elaboration procedure for the spec
-         Elab_Package (Decl);
+         if Global_Storage = O_Storage_Public then
+            --  Create elaboration procedure for the spec
+            Elab_Package (Decl);
+         end if;
       end if;
 
       if Is_Uninstantiated_Package (Decl) then
@@ -843,6 +856,11 @@ package body Trans.Chap2 is
          Push_Package_Instance_Factory (Decl);
          Pop_Package_Instance_Factory (Decl);
       end if;
+
+      if Is_Nested then
+         Pop_Identifier_Prefix (Mark);
+      end if;
+
    end Translate_Package_Declaration;
 
    procedure Translate_Package_Body (Bod : Iir_Package_Body)
diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb
index 40abae61d..0f78919a3 100644
--- a/src/vhdl/translate/trans-chap4.adb
+++ b/src/vhdl/translate/trans-chap4.adb
@@ -1728,6 +1728,11 @@ package body Trans.Chap4 is
          when Iir_Kind_Guard_Signal_Declaration =>
             Create_Signal (Decl);
 
+         when Iir_Kind_Package_Declaration =>
+            Chap2.Translate_Package_Declaration (Decl);
+         when Iir_Kind_Package_Body =>
+            Chap2.Translate_Package_Body (Decl);
+
          when Iir_Kind_Group_Template_Declaration =>
             null;
          when Iir_Kind_Group_Declaration =>
@@ -2448,6 +2453,14 @@ package body Trans.Chap4 is
                | Iir_Kind_Group_Declaration =>
                null;
 
+            when Iir_Kind_Package_Declaration =>
+               declare
+                  Nested_Final : Boolean;
+               begin
+                  Elab_Declaration_Chain (Decl, Nested_Final);
+                  Need_Final := Need_Final or Nested_Final;
+               end;
+
             when others =>
                Error_Kind ("elab_declaration_chain", Decl);
          end case;
diff --git a/src/vhdl/translate/trans-rtis.adb b/src/vhdl/translate/trans-rtis.adb
index 297edaf8c..da69bd9b3 100644
--- a/src/vhdl/translate/trans-rtis.adb
+++ b/src/vhdl/translate/trans-rtis.adb
@@ -23,6 +23,7 @@ with Iirs_Utils; use Iirs_Utils;
 with Configuration;
 with Libraries;
 with Trans.Chap7;
+with Trans; use Trans.Helpers;
 with Trans.Helpers2; use Trans.Helpers2;
 
 package body Trans.Rtis is
@@ -2038,7 +2039,7 @@ package body Trans.Rtis is
    procedure Generate_If_Case_Generate_Statement
      (Blk : Iir; Parent_Rti : O_Dnode);
    procedure Generate_For_Generate_Statement (Blk : Iir; Parent_Rti : O_Dnode);
-   procedure Generate_Declaration_Chain (Chain : Iir);
+   procedure Generate_Declaration_Chain (Chain : Iir; Parent_Rti : O_Dnode);
 
    procedure Generate_Component_Declaration (Comp : Iir)
    is
@@ -2059,8 +2060,10 @@ package body Trans.Rtis is
       if Global_Storage /= O_Storage_External then
          Push_Rti_Node (Prev);
 
-         Generate_Declaration_Chain (Get_Generic_Chain (Comp));
-         Generate_Declaration_Chain (Get_Port_Chain (Comp));
+         Generate_Declaration_Chain
+           (Get_Generic_Chain (Comp), Info.Comp_Rti_Const);
+         Generate_Declaration_Chain
+           (Get_Port_Chain (Comp), Info.Comp_Rti_Const);
 
          Name := Generate_Name (Comp);
 
@@ -2206,7 +2209,7 @@ package body Trans.Rtis is
       Add_Rti_Node (Info.Block_Rti_Const);
    end Generate_Instance;
 
-   procedure Generate_Declaration_Chain (Chain : Iir)
+   procedure Generate_Declaration_Chain (Chain : Iir; Parent_Rti : O_Dnode)
    is
       Decl : Iir;
    begin
@@ -2287,6 +2290,15 @@ package body Trans.Rtis is
             when Iir_Kind_Group_Template_Declaration
                | Iir_Kind_Group_Declaration =>
                null;
+            when Iir_Kind_Package_Declaration =>
+               declare
+                  Mark : Id_Mark_Type;
+               begin
+                  Push_Identifier_Prefix (Mark, Get_Identifier (Decl));
+                  Generate_Block (Decl, Parent_Rti);
+                  Pop_Identifier_Prefix (Mark);
+               end;
+
             when others =>
                Error_Kind ("rti.generate_declaration_chain", Decl);
          end case;
@@ -2546,29 +2558,32 @@ package body Trans.Rtis is
 
       Field_Off : O_Cnode;
    begin
-      if Get_Kind (Get_Parent (Blk)) = Iir_Kind_Design_Unit then
-         --  Also include filename for units.
-         Rti_Type := Ghdl_Rtin_Block_File;
-      else
-         Rti_Type := Ghdl_Rtin_Block;
+      if Global_Storage /= O_Storage_External then
+         if Get_Kind (Get_Parent (Blk)) = Iir_Kind_Design_Unit then
+            --  Also include filename for units.
+            Rti_Type := Ghdl_Rtin_Block_File;
+         else
+            Rti_Type := Ghdl_Rtin_Block;
+         end if;
+
+         New_Const_Decl (Rti, Create_Identifier ("RTI"),
+                         Global_Storage, Rti_Type);
       end if;
 
-      New_Const_Decl (Rti, Create_Identifier ("RTI"),
-                      O_Storage_Public, Rti_Type);
       Push_Rti_Node (Prev);
 
       Field_Off := O_Cnode_Null;
       case Get_Kind (Blk) is
          when Iir_Kind_Package_Declaration =>
             Kind := Ghdl_Rtik_Package;
-            Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
+            Generate_Declaration_Chain (Get_Declaration_Chain (Blk), Rti);
          when Iir_Kind_Package_Body =>
             Kind := Ghdl_Rtik_Package_Body;
             --  Required at least for 'image
-            Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
+            Generate_Declaration_Chain (Get_Declaration_Chain (Blk), Rti);
          when Iir_Kind_Architecture_Body =>
             Kind := Ghdl_Rtik_Architecture;
-            Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
+            Generate_Declaration_Chain (Get_Declaration_Chain (Blk), Rti);
             Generate_Concurrent_Statement_Chain
               (Get_Concurrent_Statement_Chain (Blk), Rti);
             Field_Off := New_Offsetof
@@ -2576,15 +2591,15 @@ package body Trans.Rtis is
                Info.Block_Parent_Field, Ghdl_Ptr_Type);
          when Iir_Kind_Entity_Declaration =>
             Kind := Ghdl_Rtik_Entity;
-            Generate_Declaration_Chain (Get_Generic_Chain (Blk));
-            Generate_Declaration_Chain (Get_Port_Chain (Blk));
-            Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
+            Generate_Declaration_Chain (Get_Generic_Chain (Blk), Rti);
+            Generate_Declaration_Chain (Get_Port_Chain (Blk), Rti);
+            Generate_Declaration_Chain (Get_Declaration_Chain (Blk), Rti);
             Generate_Concurrent_Statement_Chain
               (Get_Concurrent_Statement_Chain (Blk), Rti);
          when Iir_Kind_Process_Statement
             | Iir_Kind_Sensitized_Process_Statement =>
             Kind := Ghdl_Rtik_Process;
-            Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
+            Generate_Declaration_Chain (Get_Declaration_Chain (Blk), Rti);
             Field_Off :=
               Get_Scope_Offset (Info.Process_Scope, Ghdl_Ptr_Type);
          when Iir_Kind_Block_Statement =>
@@ -2600,11 +2615,11 @@ package body Trans.Rtis is
                   Add_Rti_Node (Guard_Info.Signal_Rti);
                end if;
                if Header /= Null_Iir then
-                  Generate_Declaration_Chain (Get_Generic_Chain (Header));
-                  Generate_Declaration_Chain (Get_Port_Chain (Header));
+                  Generate_Declaration_Chain (Get_Generic_Chain (Header), Rti);
+                  Generate_Declaration_Chain (Get_Port_Chain (Header), Rti);
                end if;
             end;
-            Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
+            Generate_Declaration_Chain (Get_Declaration_Chain (Blk), Rti);
             Generate_Concurrent_Statement_Chain
               (Get_Concurrent_Statement_Chain (Blk), Rti);
             Field_Off := Get_Scope_Offset (Info.Block_Scope, Ghdl_Ptr_Type);
@@ -2623,58 +2638,59 @@ package body Trans.Rtis is
                   Add_Rti_Node (Param_Rti);
                end if;
             end;
-            Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
+            Generate_Declaration_Chain (Get_Declaration_Chain (Blk), Rti);
             Generate_Concurrent_Statement_Chain
               (Get_Concurrent_Statement_Chain (Blk), Rti);
          when others =>
             Error_Kind ("rti.generate_block", Blk);
       end case;
 
-      Name := Generate_Name (Blk);
+      if Global_Storage /= O_Storage_External then
+         Name := Generate_Name (Blk);
 
-      Arr := Generate_Rti_Array (Create_Identifier ("RTIARRAY"));
+         Arr := Generate_Rti_Array (Create_Identifier ("RTIARRAY"));
 
-      Start_Init_Value (Rti);
+         Start_Init_Value (Rti);
 
-      if Rti_Type = Ghdl_Rtin_Block_File then
-         Start_Record_Aggr (List_File, Rti_Type);
-      end if;
+         if Rti_Type = Ghdl_Rtin_Block_File then
+            Start_Record_Aggr (List_File, Rti_Type);
+         end if;
 
-      Start_Record_Aggr (List, Ghdl_Rtin_Block);
-      New_Record_Aggr_El (List, Generate_Common (Kind));
-      New_Record_Aggr_El (List, New_Global_Address (Name, Char_Ptr_Type));
+         Start_Record_Aggr (List, Ghdl_Rtin_Block);
+         New_Record_Aggr_El (List, Generate_Common (Kind));
+         New_Record_Aggr_El (List, New_Global_Address (Name, Char_Ptr_Type));
 
-      --  Field Loc: offset in the instance of the entity.
-      if Field_Off = O_Cnode_Null then
-         Field_Off := Get_Null_Loc;
-      end if;
-      New_Record_Aggr_El (List, Field_Off);
+         --  Field Loc: offset in the instance of the entity.
+         if Field_Off = O_Cnode_Null then
+            Field_Off := Get_Null_Loc;
+         end if;
+         New_Record_Aggr_El (List, Field_Off);
 
-      New_Record_Aggr_El (List, Generate_Linecol (Blk));
+         New_Record_Aggr_El (List, Generate_Linecol (Blk));
 
       --  Field Parent: RTI of the parent.
-      if Parent_Rti = O_Dnode_Null then
-         Res := New_Null_Access (Ghdl_Rti_Access);
-      else
-         Res := New_Rti_Address (Parent_Rti);
-      end if;
-      New_Record_Aggr_El (List, Res);
+         if Parent_Rti = O_Dnode_Null then
+            Res := New_Null_Access (Ghdl_Rti_Access);
+         else
+            Res := New_Rti_Address (Parent_Rti);
+         end if;
+         New_Record_Aggr_El (List, Res);
 
-      --  Fields Nbr_Child and Children.
-      New_Record_Aggr_El
-        (List, New_Unsigned_Literal (Ghdl_Index_Type, Get_Rti_Array_Length));
-      New_Record_Aggr_El (List, New_Global_Address (Arr, Ghdl_Rti_Arr_Acc));
-      Finish_Record_Aggr (List, Res);
+         --  Fields Nbr_Child and Children.
+         New_Record_Aggr_El (List, New_Index_Lit (Get_Rti_Array_Length));
+         New_Record_Aggr_El (List, New_Global_Address (Arr, Ghdl_Rti_Arr_Acc));
+         Finish_Record_Aggr (List, Res);
 
-      if Rti_Type = Ghdl_Rtin_Block_File then
-         New_Record_Aggr_El (List_File, Res);
-         New_Record_Aggr_El (List_File,
-                             New_Global_Address (Current_Filename_Node,
-                                                 Char_Ptr_Type));
-         Finish_Record_Aggr (List_File, Res);
-      end if;
+         if Rti_Type = Ghdl_Rtin_Block_File then
+            New_Record_Aggr_El (List_File, Res);
+            New_Record_Aggr_El (List_File,
+                                New_Global_Address (Current_Filename_Node,
+                                                    Char_Ptr_Type));
+            Finish_Record_Aggr (List_File, Res);
+         end if;
 
-      Finish_Init_Value (Rti, Res);
+         Finish_Init_Value (Rti, Res);
+      end if;
 
       Pop_Rti_Node (Prev);
 
@@ -2781,15 +2797,17 @@ package body Trans.Rtis is
       if Global_Storage = O_Storage_External then
          New_Const_Decl (Rti, Create_Identifier ("RTI"),
                          O_Storage_External, Ghdl_Rtin_Block);
+         --  Declare inner declarations of entities and packages as they can
+         --  be referenced from architectures and package bodies.
          case Get_Kind (Lib_Unit) is
             when Iir_Kind_Entity_Declaration
-               | Iir_Kind_Package_Declaration =>
+              | Iir_Kind_Package_Declaration =>
                declare
                   Prev : Rti_Block;
                begin
                   Push_Rti_Node (Prev);
                   Generate_Declaration_Chain
-                    (Get_Declaration_Chain (Lib_Unit));
+                    (Get_Declaration_Chain (Lib_Unit), Rti);
                   Pop_Rti_Node (Prev);
                end;
             when others =>