Create a pseudo source file for instantiation.

4 files changed, 49 insertions, 19 deletions

diff --git a/src/vhdl/disp_tree.adb b/src/vhdl/disp_tree.adb
index d506ae23f..b840d4603 100644
--- a/src/vhdl/disp_tree.adb
+++ b/src/vhdl/disp_tree.adb
@@ -29,9 +29,6 @@ with Nodes_Meta;
 --  trees, which is annoying while debugging.
 
 package body Disp_Tree is
-   --  function Is_Anonymous_Type_Definition (Def : Iir) return Boolean
-   --    renames Iirs_Utils.Is_Anonymous_Type_Definition;
-
    --  Max depth for Disp_Iir.  Can be modified from a debugger.
    pragma Warnings (Off);
    Max_Depth : Natural := 10;
@@ -377,7 +374,18 @@ package body Disp_Tree is
       end if;
 
       Header ("location", Indent);
-      Put_Line (Image_Location_Type (Get_Location (N)));
+      declare
+         L : Location_Type;
+      begin
+         L := Get_Location (N);
+         loop
+            Put (Image_Location_Type (L));
+            L := Files_Map.Location_Instance_To_Location (L);
+            exit when L = No_Location;
+            Put (" instantiated at ");
+         end loop;
+         New_Line;
+      end;
 
       declare
          use Nodes_Meta;
diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb
index 711b2c7ee..8de3f149c 100644
--- a/src/vhdl/sem.adb
+++ b/src/vhdl/sem.adb
@@ -2854,11 +2854,9 @@ package body Sem is
       --  the actuals are associated with the instantiated formal.
       --  FIXME: do it in Instantiate_Package_Declaration ?
       Hdr := Get_Package_Header (Pkg);
-      if Sem_Generic_Association_Chain (Hdr, Decl) then
-         Sem_Inst.Instantiate_Package_Declaration (Decl, Pkg);
-      else
+      if not Sem_Generic_Association_Chain (Hdr, Decl) then
          --  FIXME: stop analysis here ?
-         null;
+         return;
       end if;
 
       --  FIXME: unless the parent is a package declaration library unit, the
@@ -2872,6 +2870,10 @@ package body Sem is
             Add_Dependence (Bod);
          end if;
       end if;
+
+      --  Instantiate the declaration after analyse of the body.  So that
+      --  the use_flag on the declaration can be propagated to the instance.
+      Sem_Inst.Instantiate_Package_Declaration (Decl, Pkg);
    end Sem_Package_Instantiation_Declaration;
 
    --  LRM 10.4  Use Clauses.
diff --git a/src/vhdl/sem_decls.adb b/src/vhdl/sem_decls.adb
index 99523232f..aaafcf023 100644
--- a/src/vhdl/sem_decls.adb
+++ b/src/vhdl/sem_decls.adb
@@ -1178,11 +1178,14 @@ package body Sem_Decls is
             begin
                Deallocate_Proc :=
                  Create_Iir (Iir_Kind_Procedure_Declaration);
+               Location_Copy (Deallocate_Proc, Decl);
                Set_Identifier (Deallocate_Proc, Std_Names.Name_Deallocate);
                Set_Implicit_Definition
                  (Deallocate_Proc, Iir_Predefined_Deallocate);
+
                Var_Interface :=
                  Create_Iir (Iir_Kind_Interface_Variable_Declaration);
+               Location_Copy (Var_Interface, Decl);
                Set_Identifier (Var_Interface, Std_Names.Name_P);
                Set_Type (Var_Interface, Type_Definition);
                Set_Mode (Var_Interface, Iir_Inout_Mode);
diff --git a/src/vhdl/sem_inst.adb b/src/vhdl/sem_inst.adb
index 80a7fe2f4..996eb06f2 100644
--- a/src/vhdl/sem_inst.adb
+++ b/src/vhdl/sem_inst.adb
@@ -18,6 +18,7 @@ with Tables;
 with Nodes;
 with Nodes_Meta;
 with Types; use Types;
+with Files_Map; use Files_Map;
 with Iirs_Utils; use Iirs_Utils;
 with Errorout; use Errorout;
 
@@ -143,8 +144,8 @@ package body Sem_Inst is
       Prev_Instance_Table.Set_Last (Mark);
    end Restore_Origin;
 
-   --  The location to be used while instantiated nodes.
-   Instantiate_Loc : Location_Type;
+   --  The virtual file for the instance.
+   Instance_File : Source_File_Entry;
 
    function Instantiate_Iir (N : Iir; Is_Ref : Boolean) return Iir;
 
@@ -286,7 +287,9 @@ package body Sem_Inst is
          when Type_Iir_Direction =>
             Set_Iir_Direction (Res, F, Get_Iir_Direction (N, F));
          when Type_Location_Type =>
-            Set_Location_Type (Res, F, Instantiate_Loc);
+            Set_Location_Type
+              (Res, F, Instance_Relocate (Instance_File,
+                                          Get_Location_Type (N, F)));
          when Type_Iir_Int32 =>
             Set_Iir_Int32 (Res, F, Get_Iir_Int32 (N, F));
          when Type_Int32 =>
@@ -349,7 +352,8 @@ package body Sem_Inst is
          --  And the instance of N is RES.
          Set_Instance (N, Res);
 
-         Set_Location (Res, Instantiate_Loc);
+         Set_Location
+           (Res, Instance_Relocate (Instance_File, Get_Location (N)));
 
          for I in Fields'Range loop
             F := Fields (I);
@@ -420,7 +424,9 @@ package body Sem_Inst is
       while Inter /= Null_Iir loop
          --  Create a copy of the interface.  FIXME: is it really needed ?
          Res := Create_Iir (Get_Kind (Inter));
-         Set_Location (Res, Instantiate_Loc);
+         Set_Location
+           (Res, Instance_Relocate (Instance_File, Get_Location (Inter)));
+
          Set_Parent (Res, Inst);
          Set_Identifier (Res, Get_Identifier (Inter));
          Set_Visible_Flag (Res, Get_Visible_Flag (Inter));
@@ -655,13 +661,23 @@ package body Sem_Inst is
       end loop;
    end Instantiate_Generic_Map_Chain;
 
+   procedure Create_Relocation (Inst : Iir; Orig : Iir)
+   is
+      Orig_File : Source_File_Entry;
+      Pos : Source_Ptr;
+   begin
+      Location_To_File_Pos (Get_Location (Orig), Orig_File, Pos);
+      Instance_File := Create_Instance_Source_File
+        (Orig_File, Get_Location (Inst), Inst);
+   end Create_Relocation;
+
    procedure Instantiate_Package_Declaration (Inst : Iir; Pkg : Iir)
    is
       Header : constant Iir := Get_Package_Header (Pkg);
-      Prev_Loc : constant Location_Type := Instantiate_Loc;
+      Prev_Instance_File : constant Source_File_Entry := Instance_File;
       Mark : constant Instance_Index_Type := Prev_Instance_Table.Last;
    begin
-      Instantiate_Loc := Get_Location (Inst);
+      Create_Relocation (Inst, Pkg);
 
       --  Be sure Get_Origin_Priv can be called on existing nodes.
       Expand_Origin_Table;
@@ -677,7 +693,7 @@ package body Sem_Inst is
 
       Set_Origin (Pkg, Null_Iir);
 
-      Instantiate_Loc := Prev_Loc;
+      Instance_File := Prev_Instance_File;
       Restore_Origin (Mark);
    end Instantiate_Package_Declaration;
 
@@ -686,11 +702,11 @@ package body Sem_Inst is
       Inst_Decl : constant Iir := Get_Package_Origin (Inst);
       Pkg : constant Iir :=
         Get_Named_Entity (Get_Uninstantiated_Package_Name (Inst_Decl));
-      Prev_Loc : constant Location_Type := Instantiate_Loc;
+      Prev_Instance_File : constant Source_File_Entry := Instance_File;
       Mark : constant Instance_Index_Type := Prev_Instance_Table.Last;
       Res : Iir;
    begin
-      Instantiate_Loc := Get_Location (Inst);
+      Create_Relocation (Inst, Pkg);
 
       --  Be sure Get_Origin_Priv can be called on existing nodes.
       Expand_Origin_Table;
@@ -742,9 +758,10 @@ package body Sem_Inst is
 
       --  Instantiate the body.
       Res := Instantiate_Iir (Get_Package_Body (Pkg), False);
+      Set_Identifier (Res, Get_Identifier (Inst));
 
       --  Restore.
-      Instantiate_Loc := Prev_Loc;
+      Instance_File := Prev_Instance_File;
       Restore_Origin (Mark);
 
       return Res;