[Ada] Get rid of linear searches in Lib

This change is aimed at removing a couple of linear searches in the
units management code that can become problematic performance-wise when
the number of loaded units is in the several hundreds, which can happen
for large files even at -O0 without any inlining.

It introduces an auxiliary hash table to record a mapping between the
name of units and their entry in the units table, and then replaces the
linear searches by lookups in this names table.  This can save up to 2%
of the compilation time spent in the front-end in some cases.

There should be no functional changes, except in the error message
issued for circular unit dependencies in very peculiar and convoluted
cases.

2019-08-20  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* lib.ads: Add with clause for GNAT.HTable.
	Add pragma Inline for Is_Loaded and alphabetize the list.
	(Unit_Name_Table_Size): New constant.
	(Unit_Name_Header_Num): New subtype.
	(Unit_Name_Hash): New function declaration.
	(Unit_Names): New simple hash table.
	(Init_Unit_Name): New procedure declaration.
	* lib.adb (Set_Unit_Name): Unregister the old name in the table,
	if any, and then register the new name.
	(Init_Unit_Name): New procedure.
	(Is_Loaded): Reimplement using a lookup in the names table.
	(Remove_Unit): Unregister the name.
	(Unit_Name_Hash): New function.
	* lib-load.adb (Create_Dummy_Package_Unit): Call Init_Unit_Name.
	(Load_Unit): Use a lookup in the names table to find out whether
	the unit has already been loaded.  Call Init_Unit_Name and then
	Remove_Unit if the loading has failed.
	(Make_Child_Decl_Unit): Call Init_Unit_Name.
	(Make_Instance_Unit): Likewise.
	* lib-writ.adb (Ensure_System_Dependency): Likewise.

From-SVN: r274720

5 files changed, 116 insertions, 26 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 9c22681..a91b8f5 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,26 @@
+2019-08-20  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* lib.ads: Add with clause for GNAT.HTable.
+	Add pragma Inline for Is_Loaded and alphabetize the list.
+	(Unit_Name_Table_Size): New constant.
+	(Unit_Name_Header_Num): New subtype.
+	(Unit_Name_Hash): New function declaration.
+	(Unit_Names): New simple hash table.
+	(Init_Unit_Name): New procedure declaration.
+	* lib.adb (Set_Unit_Name): Unregister the old name in the table,
+	if any, and then register the new name.
+	(Init_Unit_Name): New procedure.
+	(Is_Loaded): Reimplement using a lookup in the names table.
+	(Remove_Unit): Unregister the name.
+	(Unit_Name_Hash): New function.
+	* lib-load.adb (Create_Dummy_Package_Unit): Call Init_Unit_Name.
+	(Load_Unit): Use a lookup in the names table to find out whether
+	the unit has already been loaded.  Call Init_Unit_Name and then
+	Remove_Unit if the loading has failed.
+	(Make_Child_Decl_Unit): Call Init_Unit_Name.
+	(Make_Instance_Unit): Likewise.
+	* lib-writ.adb (Ensure_System_Dependency): Likewise.
+
 2019-08-20  Bob Duff  <duff@adacore.com>
 
 	* sem_ch13.adb (Record_Hole_Check): Initialize After_Last.
diff --git a/gcc/ada/lib-load.adb b/gcc/ada/lib-load.adb
index 4b7b995..25c8794 100644
--- a/gcc/ada/lib-load.adb
+++ b/gcc/ada/lib-load.adb
@@ -245,6 +245,8 @@ package body Lib.Load is
          Version                => 0,
          OA_Setting             => 'O');
 
+      Init_Unit_Name (Unum, Spec_Name);
+
       Set_Comes_From_Source_Default (Save_CS);
       Set_Error_Posted (Cunit_Entity);
       Set_Error_Posted (Cunit);
@@ -607,11 +609,10 @@ package body Lib.Load is
 
       --  See if we already have an entry for this unit
 
-      Unum := Main_Unit;
-      while Unum <= Units.Last loop
-         exit when Uname_Actual = Units.Table (Unum).Unit_Name;
-         Unum := Unum + 1;
-      end loop;
+      Unum := Unit_Names.Get (Uname_Actual);
+      if Unum = No_Unit then
+         Unum := Units.Last + 1;
+      end if;
 
       --  Whether or not the entry was found, Unum is now the right value,
       --  since it is one more than Units.Last (i.e. the index of the new
@@ -727,7 +728,7 @@ package body Lib.Load is
          --  found case to print the dependency chain including the last entry
 
          Units.Increment_Last;
-         Units.Table (Unum).Unit_Name := Uname_Actual;
+         Init_Unit_Name (Unum, Uname_Actual);
 
          --  File was found
 
@@ -893,14 +894,14 @@ package body Lib.Load is
                --  subsequent missing files.
 
                Load_Stack.Decrement_Last;
-               Units.Decrement_Last;
+               Remove_Unit (Unum);
 
             --  If unit not required, remove load stack entry and the junk
             --  file table entry, and return No_Unit to indicate not found,
 
             else
                Load_Stack.Decrement_Last;
-               Units.Decrement_Last;
+               Remove_Unit (Unum);
             end if;
 
             Unum := No_Unit;
@@ -921,17 +922,17 @@ package body Lib.Load is
    --------------------------
 
    procedure Make_Child_Decl_Unit (N : Node_Id) is
-      Unit_Decl : constant Node_Id := Library_Unit (N);
+      Unit_Decl : constant Node_Id          := Library_Unit (N);
+      Unit_Num  : constant Unit_Number_Type := Get_Cunit_Unit_Number (N);
 
    begin
       Units.Increment_Last;
-      Units.Table (Units.Last) := Units.Table (Get_Cunit_Unit_Number (N));
-      Units.Table (Units.Last).Unit_Name :=
-        Get_Spec_Name (Unit_Name (Get_Cunit_Unit_Number (N)));
+      Units.Table (Units.Last) := Units.Table (Unit_Num);
       Units.Table (Units.Last).Cunit := Unit_Decl;
       Units.Table (Units.Last).Cunit_Entity  :=
         Defining_Identifier
           (Defining_Unit_Name (Specification (Unit (Unit_Decl))));
+      Init_Unit_Name (Units.Last, Get_Spec_Name (Unit_Name (Unit_Num)));
 
       --  The library unit created for of a child subprogram unit plays no
       --  role in code generation and binding, so label it accordingly.
@@ -963,11 +964,13 @@ package body Lib.Load is
          Units.Table (Units.Last)               := Units.Table (Main_Unit);
          Units.Table (Units.Last).Cunit         := Library_Unit (N);
          Units.Table (Units.Last).Generate_Code := True;
+         Init_Unit_Name (Units.Last, Unit_Name (Main_Unit));
+
          Units.Table (Main_Unit).Cunit          := N;
-         Units.Table (Main_Unit).Unit_Name      :=
-           Get_Body_Name
-             (Unit_Name (Get_Cunit_Unit_Number (Library_Unit (N))));
          Units.Table (Main_Unit).Version        := Source_Checksum (Sind);
+         Init_Unit_Name (Main_Unit,
+           Get_Body_Name
+             (Unit_Name (Get_Cunit_Unit_Number (Library_Unit (N)))));
 
       else
          --  Duplicate information from instance unit, for the body. The unit
diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb
index 987afcb..d877e7b 100644
--- a/gcc/ada/lib-writ.adb
+++ b/gcc/ada/lib-writ.adb
@@ -189,6 +189,7 @@ package body Lib.Writ is
          Version                => 0,
          Error_Location         => No_Location,
          OA_Setting             => 'O');
+      Init_Unit_Name (Units.Last, System_Uname);
 
       --  Parse system.ads so that the checksum is set right. Style checks are
       --  not applied. The Ekind is set to ensure that this reference is always
diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb
index 901ca3b..d04f0a4 100644
--- a/gcc/ada/lib.adb
+++ b/gcc/ada/lib.adb
@@ -277,8 +277,24 @@ package body Lib is
    end Set_OA_Setting;
 
    procedure Set_Unit_Name (U : Unit_Number_Type; N : Unit_Name_Type) is
+      Old_N : constant Unit_Name_Type := Units.Table (U).Unit_Name;
+
    begin
+      --  First unregister the old name, if any
+
+      if Old_N /= No_Unit_Name and then Unit_Names.Get (Old_N) = U then
+         Unit_Names.Set (Old_N, No_Unit);
+      end if;
+
+      --  Then set the new name
+
       Units.Table (U).Unit_Name := N;
+
+      --  Finally register the new name
+
+      if Unit_Names.Get (N) = No_Unit then
+         Unit_Names.Set (N, U);
+      end if;
    end Set_Unit_Name;
 
    ------------------------------
@@ -1068,6 +1084,16 @@ package body Lib is
       return TSN;
    end Increment_Serial_Number;
 
+   ----------------------
+   --  Init_Unit_Name  --
+   ----------------------
+
+   procedure Init_Unit_Name (U : Unit_Number_Type; N : Unit_Name_Type) is
+   begin
+      Units.Table (U).Unit_Name := N;
+      Unit_Names.Set (N, U);
+   end Init_Unit_Name;
+
    ----------------
    -- Initialize --
    ----------------
@@ -1087,13 +1113,7 @@ package body Lib is
 
    function Is_Loaded (Uname : Unit_Name_Type) return Boolean is
    begin
-      for Unum in Units.First .. Units.Last loop
-         if Uname = Unit_Name (Unum) then
-            return True;
-         end if;
-      end loop;
-
-      return False;
+      return Unit_Names.Get (Uname) /= No_Unit;
    end Is_Loaded;
 
    ---------------
@@ -1141,6 +1161,7 @@ package body Lib is
    procedure Remove_Unit (U : Unit_Number_Type) is
    begin
       if U = Units.Last then
+         Unit_Names.Set (Unit_Name (U), No_Unit);
          Units.Decrement_Last;
       end if;
    end Remove_Unit;
@@ -1277,6 +1298,15 @@ package body Lib is
       end loop;
    end Tree_Write;
 
+   --------------------
+   -- Unit_Name_Hash --
+   --------------------
+
+   function Unit_Name_Hash (Id : Unit_Name_Type) return Unit_Name_Header_Num is
+   begin
+      return Unit_Name_Header_Num (Id mod Unit_Name_Table_Size);
+   end Unit_Name_Hash;
+
    ------------
    -- Unlock --
    ------------
diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads
index 504120e..7665f86 100644
--- a/gcc/ada/lib.ads
+++ b/gcc/ada/lib.ads
@@ -37,6 +37,8 @@ with Namet; use Namet;
 with Table;
 with Types; use Types;
 
+with GNAT.HTable;
+
 package Lib is
 
    type Unit_Ref_Table is array (Pos range <>) of Unit_Number_Type;
@@ -823,21 +825,22 @@ private
    pragma Inline (Increment_Primary_Stack_Count);
    pragma Inline (Increment_Sec_Stack_Count);
    pragma Inline (Increment_Serial_Number);
+   pragma Inline (Is_Internal_Unit);
+   pragma Inline (Is_Loaded);
+   pragma Inline (Is_Predefined_Renaming);
+   pragma Inline (Is_Predefined_Unit);
    pragma Inline (Loading);
    pragma Inline (Main_CPU);
    pragma Inline (Main_Priority);
    pragma Inline (Munit_Index);
    pragma Inline (No_Elab_Code_All);
    pragma Inline (OA_Setting);
+   pragma Inline (Primary_Stack_Count);
    pragma Inline (Set_Cunit);
    pragma Inline (Set_Cunit_Entity);
    pragma Inline (Set_Fatal_Error);
    pragma Inline (Set_Generate_Code);
    pragma Inline (Set_Has_RACW);
-   pragma Inline (Is_Predefined_Renaming);
-   pragma Inline (Is_Internal_Unit);
-   pragma Inline (Is_Predefined_Unit);
-   pragma Inline (Primary_Stack_Count);
    pragma Inline (Sec_Stack_Count);
    pragma Inline (Set_Loading);
    pragma Inline (Set_Main_CPU);
@@ -930,6 +933,36 @@ private
      Table_Increment      => Alloc.Units_Increment,
      Table_Name           => "Units");
 
+   --  The following table records a mapping between a name and the entry in
+   --  the units table whose Unit_Name is this name. It is used to speed up
+   --  the Is_Loaded function, whose original implementation (linear search)
+   --  could account for 2% of the time spent in the front end. Note that, in
+   --  the case of source files containing multiple units, the units table may
+   --  temporarily contain two entries with the same Unit_Name during parsing,
+   --  which means that the mapping must be to the first entry in the table.
+
+   Unit_Name_Table_Size : constant := 257;
+   --  Number of headers in hash table
+
+   subtype Unit_Name_Header_Num is Integer range 0 .. Unit_Name_Table_Size - 1;
+   --  Range of headers in hash table
+
+   function Unit_Name_Hash (Id : Unit_Name_Type) return Unit_Name_Header_Num;
+   --  Simple hash function for Unit_Name_Types
+
+   package Unit_Names is new GNAT.Htable.Simple_HTable
+     (Header_Num => Unit_Name_Header_Num,
+      Element    => Unit_Number_Type,
+      No_Element => No_Unit,
+      Key        => Unit_Name_Type,
+      Hash       => Unit_Name_Hash,
+      Equal      => "=");
+
+   procedure Init_Unit_Name (U : Unit_Number_Type; N : Unit_Name_Type);
+   pragma Inline (Init_Unit_Name);
+   --  Both set the Unit_Name for the given units table entry and register a
+   --  mapping between this name and the entry.
+
    --  The following table stores strings from pragma Linker_Option lines
 
    type Linker_Option_Entry is record