MatCat.OpenSource/8sa1-gcc
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[Ada] Get rid of linear searches in Lib

Browse Source 
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
This commit is contained in:
Eric Botcazou 2019-08-20 09:48:33 +00:00 committed by Pierre-Marie de Rodat
parent a89a0dd3b7
commit 98cbc7e489
5 changed files with 116 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
gcc/ada/ChangeLog
View File

@ -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.

33
gcc/ada/lib-load.adb
View File

@ -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

1
gcc/ada/lib-writ.adb
View File

@ -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

44
gcc/ada/lib.adb
View File

@ -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 --
------------

41
gcc/ada/lib.ads
View File

@ -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