From 38886eafc52f3c792c6693784d69748d4bedf12d Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Mon, 13 Feb 2017 06:50:25 +0100
Subject: Library: unload library file after parsing it.

---
 src/files_map.adb | 55 ++++++++++++++++++++++++++++++++++---------------------
 src/files_map.ads |  4 ++++
 src/libraries.adb | 38 +++++++++++++++++---------------------
 3 files changed, 55 insertions(+), 42 deletions(-)

diff --git a/src/files_map.adb b/src/files_map.adb
index e78741de9..4d75a35d2 100644
--- a/src/files_map.adb
+++ b/src/files_map.adb
@@ -821,9 +821,39 @@ package body Files_Map is
       return Res;
    end Load_Source_File;
 
+   procedure Free_Source_File (File : Source_File_Entry)
+   is
+      procedure free (Ptr : Lines_Table_Ptr);
+      pragma Import (C, free);
+
+      procedure Free is new Ada.Unchecked_Deallocation
+        (File_Buffer, File_Buffer_Acc);
+
+      F : Source_File_Record renames Source_Files.Table (File);
+   begin
+      case F.Kind is
+         when Source_File_File =>
+            free (F.Lines_Table);
+            Free (F.Source);
+         when Source_File_String =>
+            Free (F.Source);
+         when Source_File_Instance =>
+            null;
+      end case;
+   end Free_Source_File;
+
+   procedure Unload_Last_Source_File (File : Source_File_Entry) is
+   begin
+      pragma Assert (File = Source_Files.Last);
+      Free_Source_File (File);
+      Source_Files.Decrement_Last;
+      Next_Location :=
+        Source_Files.Table (Source_Files.Last).Last_Location + 1;
+   end Unload_Last_Source_File;
+
    --  Check validity of FILE.
    --  Raise an exception in case of error.
-   procedure Check_File (File: in Source_File_Entry) is
+   procedure Check_File (File : Source_File_Entry) is
    begin
       pragma Assert (File <= Source_Files.Last);
       null;
@@ -1027,30 +1057,13 @@ package body Files_Map is
       end loop;
    end Debug_Source_File;
 
-   procedure Initialize
-   is
-      procedure free (Ptr : Lines_Table_Ptr);
-      pragma Import (C, free);
-
-      procedure Free is new Ada.Unchecked_Deallocation
-        (File_Buffer, File_Buffer_Acc);
+   procedure Initialize is
    begin
       for I in Source_Files.First .. Source_Files.Last loop
-         declare
-            F : Source_File_Record renames Source_Files.Table (I);
-         begin
-            case F.Kind is
-               when Source_File_File =>
-                  free (F.Lines_Table);
-                  Free (F.Source);
-               when Source_File_String =>
-                  Free (F.Source);
-               when Source_File_Instance =>
-                  null;
-            end case;
-         end;
+         Free_Source_File (I);
       end loop;
       Source_Files.Free;
       Source_Files.Init;
+      Next_Location := Location_Nil + 1;
    end Initialize;
 end Files_Map;
diff --git a/src/files_map.ads b/src/files_map.ads
index d36442419..d06805948 100644
--- a/src/files_map.ads
+++ b/src/files_map.ads
@@ -62,6 +62,10 @@ package Files_Map is
      (Ref : Source_File_Entry; Loc : Location_Type; Inst : Nodes.Node_Type)
      return Source_File_Entry;
 
+   --  Unload last source file.  Works only with the last one.  Must be
+   --  carefully used as the corresponding locations will be reused.
+   procedure Unload_Last_Source_File (File : Source_File_Entry);
+
    --  Relocate location LOC (which must be in the reference of INST_FILE)
    --  for instrnace INST_FILE.
    function Instance_Relocate
diff --git a/src/libraries.adb b/src/libraries.adb
index a49931071..20a303c66 100644
--- a/src/libraries.adb
+++ b/src/libraries.adb
@@ -196,22 +196,6 @@ package body Libraries is
       end if;
    end Set_Work_Library_Path;
 
-   --  Open LIBRARY map file, return TRUE if successful.
-   function Set_Library_File_Name (Dir : Name_Id;
-                                   Library: Iir_Library_Declaration)
-     return Boolean
-   is
-      File_Name : constant String := Library_To_File_Name (Library);
-      Fe : Source_File_Entry;
-   begin
-      Fe := Files_Map.Load_Source_File (Dir, Get_Identifier (File_Name));
-      if Fe = No_Source_File_Entry then
-         return False;
-      end if;
-      Scanner.Set_File (Fe);
-      return True;
-   end Set_Library_File_Name;
-
    --  Every design unit is put in this hash table to be quickly found by
    --  its (primary) identifier.
    Unit_Hash_Length : constant Name_Id := 127;
@@ -448,14 +432,21 @@ package body Libraries is
          Search_Library_In_Path (Library);
          Dir := Get_Library_Directory (Library);
       end if;
-      if Dir = Null_Identifier
-        or else not Set_Library_File_Name (Dir, Library)
-      then
+      if Dir = Null_Identifier then
          --  Not found.
          Set_Date (Library, Date_Valid'First);
          return False;
       end if;
-      File := Get_Current_Source_File;
+
+      File := Files_Map.Load_Source_File
+        (Dir, Get_Identifier (Library_To_File_Name (Library)));
+      if File = No_Source_File_Entry then
+         --  Not found.
+         Set_Date (Library, Date_Valid'First);
+         return False;
+      end if;
+
+      Scanner.Set_File (File);
 
       --  Parse header.
       Scan;
@@ -641,7 +632,12 @@ package body Libraries is
          << Next_Line >> null;
       end loop;
       Set_Date (Library, Max_Date);
-      Close_File;
+
+      Scanner.Close_File;
+
+      --  Don't need the library file anymore.
+      Files_Map.Unload_Last_Source_File (File);
+
       return True;
    end Load_Library;
 
-- 
cgit v1.2.3