+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.
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);
-- 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
-- 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
-- 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;
--------------------------
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.
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
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
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;
------------------------------
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 --
----------------
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;
---------------
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;
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 --
------------
with Table;
with Types; use Types;
+with GNAT.HTable;
+
package Lib is
type Unit_Ref_Table is array (Pos range <>) of Unit_Number_Type;
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);
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
projects / gcc.git / commitdiff