Commit 98cbc7e4 by Eric Botcazou Committed by Pierre-Marie de Rodat

[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
parent a89a0dd3
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> 2019-08-20 Bob Duff <duff@adacore.com>
* sem_ch13.adb (Record_Hole_Check): Initialize After_Last. * sem_ch13.adb (Record_Hole_Check): Initialize After_Last.
......
...@@ -245,6 +245,8 @@ package body Lib.Load is ...@@ -245,6 +245,8 @@ package body Lib.Load is
Version => 0, Version => 0,
OA_Setting => 'O'); OA_Setting => 'O');
Init_Unit_Name (Unum, Spec_Name);
Set_Comes_From_Source_Default (Save_CS); Set_Comes_From_Source_Default (Save_CS);
Set_Error_Posted (Cunit_Entity); Set_Error_Posted (Cunit_Entity);
Set_Error_Posted (Cunit); Set_Error_Posted (Cunit);
...@@ -607,11 +609,10 @@ package body Lib.Load is ...@@ -607,11 +609,10 @@ package body Lib.Load is
-- See if we already have an entry for this unit -- See if we already have an entry for this unit
Unum := Main_Unit; Unum := Unit_Names.Get (Uname_Actual);
while Unum <= Units.Last loop if Unum = No_Unit then
exit when Uname_Actual = Units.Table (Unum).Unit_Name; Unum := Units.Last + 1;
Unum := Unum + 1; end if;
end loop;
-- Whether or not the entry was found, Unum is now the right value, -- 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 -- since it is one more than Units.Last (i.e. the index of the new
...@@ -727,7 +728,7 @@ package body Lib.Load is ...@@ -727,7 +728,7 @@ package body Lib.Load is
-- found case to print the dependency chain including the last entry -- found case to print the dependency chain including the last entry
Units.Increment_Last; Units.Increment_Last;
Units.Table (Unum).Unit_Name := Uname_Actual; Init_Unit_Name (Unum, Uname_Actual);
-- File was found -- File was found
...@@ -893,14 +894,14 @@ package body Lib.Load is ...@@ -893,14 +894,14 @@ package body Lib.Load is
-- subsequent missing files. -- subsequent missing files.
Load_Stack.Decrement_Last; Load_Stack.Decrement_Last;
Units.Decrement_Last; Remove_Unit (Unum);
-- If unit not required, remove load stack entry and the junk -- If unit not required, remove load stack entry and the junk
-- file table entry, and return No_Unit to indicate not found, -- file table entry, and return No_Unit to indicate not found,
else else
Load_Stack.Decrement_Last; Load_Stack.Decrement_Last;
Units.Decrement_Last; Remove_Unit (Unum);
end if; end if;
Unum := No_Unit; Unum := No_Unit;
...@@ -921,17 +922,17 @@ package body Lib.Load is ...@@ -921,17 +922,17 @@ package body Lib.Load is
-------------------------- --------------------------
procedure Make_Child_Decl_Unit (N : Node_Id) 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 begin
Units.Increment_Last; Units.Increment_Last;
Units.Table (Units.Last) := Units.Table (Get_Cunit_Unit_Number (N)); Units.Table (Units.Last) := Units.Table (Unit_Num);
Units.Table (Units.Last).Unit_Name :=
Get_Spec_Name (Unit_Name (Get_Cunit_Unit_Number (N)));
Units.Table (Units.Last).Cunit := Unit_Decl; Units.Table (Units.Last).Cunit := Unit_Decl;
Units.Table (Units.Last).Cunit_Entity := Units.Table (Units.Last).Cunit_Entity :=
Defining_Identifier Defining_Identifier
(Defining_Unit_Name (Specification (Unit (Unit_Decl)))); (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 -- The library unit created for of a child subprogram unit plays no
-- role in code generation and binding, so label it accordingly. -- role in code generation and binding, so label it accordingly.
...@@ -963,11 +964,13 @@ package body Lib.Load is ...@@ -963,11 +964,13 @@ package body Lib.Load is
Units.Table (Units.Last) := Units.Table (Main_Unit); Units.Table (Units.Last) := Units.Table (Main_Unit);
Units.Table (Units.Last).Cunit := Library_Unit (N); Units.Table (Units.Last).Cunit := Library_Unit (N);
Units.Table (Units.Last).Generate_Code := True; 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).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); 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 else
-- Duplicate information from instance unit, for the body. The unit -- Duplicate information from instance unit, for the body. The unit
......
...@@ -189,6 +189,7 @@ package body Lib.Writ is ...@@ -189,6 +189,7 @@ package body Lib.Writ is
Version => 0, Version => 0,
Error_Location => No_Location, Error_Location => No_Location,
OA_Setting => 'O'); OA_Setting => 'O');
Init_Unit_Name (Units.Last, System_Uname);
-- Parse system.ads so that the checksum is set right. Style checks are -- 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 -- not applied. The Ekind is set to ensure that this reference is always
......
...@@ -277,8 +277,24 @@ package body Lib is ...@@ -277,8 +277,24 @@ package body Lib is
end Set_OA_Setting; end Set_OA_Setting;
procedure Set_Unit_Name (U : Unit_Number_Type; N : Unit_Name_Type) is 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 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; 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; end Set_Unit_Name;
------------------------------ ------------------------------
...@@ -1068,6 +1084,16 @@ package body Lib is ...@@ -1068,6 +1084,16 @@ package body Lib is
return TSN; return TSN;
end Increment_Serial_Number; 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 -- -- Initialize --
---------------- ----------------
...@@ -1087,13 +1113,7 @@ package body Lib is ...@@ -1087,13 +1113,7 @@ package body Lib is
function Is_Loaded (Uname : Unit_Name_Type) return Boolean is function Is_Loaded (Uname : Unit_Name_Type) return Boolean is
begin begin
for Unum in Units.First .. Units.Last loop return Unit_Names.Get (Uname) /= No_Unit;
if Uname = Unit_Name (Unum) then
return True;
end if;
end loop;
return False;
end Is_Loaded; end Is_Loaded;
--------------- ---------------
...@@ -1141,6 +1161,7 @@ package body Lib is ...@@ -1141,6 +1161,7 @@ package body Lib is
procedure Remove_Unit (U : Unit_Number_Type) is procedure Remove_Unit (U : Unit_Number_Type) is
begin begin
if U = Units.Last then if U = Units.Last then
Unit_Names.Set (Unit_Name (U), No_Unit);
Units.Decrement_Last; Units.Decrement_Last;
end if; end if;
end Remove_Unit; end Remove_Unit;
...@@ -1277,6 +1298,15 @@ package body Lib is ...@@ -1277,6 +1298,15 @@ package body Lib is
end loop; end loop;
end Tree_Write; 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 -- -- Unlock --
------------ ------------
......
...@@ -37,6 +37,8 @@ with Namet; use Namet; ...@@ -37,6 +37,8 @@ with Namet; use Namet;
with Table; with Table;
with Types; use Types; with Types; use Types;
with GNAT.HTable;
package Lib is package Lib is
type Unit_Ref_Table is array (Pos range <>) of Unit_Number_Type; type Unit_Ref_Table is array (Pos range <>) of Unit_Number_Type;
...@@ -823,21 +825,22 @@ private ...@@ -823,21 +825,22 @@ private
pragma Inline (Increment_Primary_Stack_Count); pragma Inline (Increment_Primary_Stack_Count);
pragma Inline (Increment_Sec_Stack_Count); pragma Inline (Increment_Sec_Stack_Count);
pragma Inline (Increment_Serial_Number); 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 (Loading);
pragma Inline (Main_CPU); pragma Inline (Main_CPU);
pragma Inline (Main_Priority); pragma Inline (Main_Priority);
pragma Inline (Munit_Index); pragma Inline (Munit_Index);
pragma Inline (No_Elab_Code_All); pragma Inline (No_Elab_Code_All);
pragma Inline (OA_Setting); pragma Inline (OA_Setting);
pragma Inline (Primary_Stack_Count);
pragma Inline (Set_Cunit); pragma Inline (Set_Cunit);
pragma Inline (Set_Cunit_Entity); pragma Inline (Set_Cunit_Entity);
pragma Inline (Set_Fatal_Error); pragma Inline (Set_Fatal_Error);
pragma Inline (Set_Generate_Code); pragma Inline (Set_Generate_Code);
pragma Inline (Set_Has_RACW); 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 (Sec_Stack_Count);
pragma Inline (Set_Loading); pragma Inline (Set_Loading);
pragma Inline (Set_Main_CPU); pragma Inline (Set_Main_CPU);
...@@ -930,6 +933,36 @@ private ...@@ -930,6 +933,36 @@ private
Table_Increment => Alloc.Units_Increment, Table_Increment => Alloc.Units_Increment,
Table_Name => "Units"); 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 -- The following table stores strings from pragma Linker_Option lines
type Linker_Option_Entry is record type Linker_Option_Entry is record
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment