From: Arnaud Charlet <charlet@adacore.com>
To: gcc-patches@gcc.gnu.org
Cc: Bob Duff <duff@adacore.com>
Subject: [Ada] Improve xref speed for many tagged types
Date: Fri, 02 Sep 2011 07:15:00 -0000 [thread overview]
Message-ID: <20110902071527.GA29478@adacore.com> (raw)
[-- Attachment #1: Type: text/plain, Size: 896 bytes --]
This patch improves compilation speed (in particular, speed of generating cross
reference information) when compiling packages with huge numbers of tagged
types and interfaces, with complicated inheritance patterns. No test is
available -- the problem only occurred for enormous packages.
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-09-02 Bob Duff <duff@adacore.com>
* einfo.adb: (Has_Xref_Entry): Do not call
Implementation_Base_Type. Lib.Xref has been
rewritten to avoid the need for it, and it was costly.
* s-htable.ads,s-htable.adb: (Present,Set_If_Not_Present): New
functions in support of efficient xref.
* lib-xref-alfa.adb: Misc changes related to Key component of
type Xref_Entry.
* lib-xref.adb: (Add_Entry,etc): Speed improvement.
(New_Entry): Call Implementation_Base_Type, because Has_Xref_Entry
no longer does. This is the one place where it is needed.
[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 44613 bytes --]
Index: einfo.adb
===================================================================
--- einfo.adb (revision 178381)
+++ einfo.adb (working copy)
@@ -1599,7 +1599,7 @@
function Has_Xref_Entry (Id : E) return B is
begin
- return Flag182 (Implementation_Base_Type (Id));
+ return Flag182 (Id);
end Has_Xref_Entry;
function Hiding_Loop_Variable (Id : E) return E is
Index: s-htable.adb
===================================================================
--- s-htable.adb (revision 178381)
+++ s-htable.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1995-2010, AdaCore --
+-- Copyright (C) 1995-2011, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -121,6 +121,15 @@
return Iterator_Ptr;
end Get_Non_Null;
+ -------------
+ -- Present --
+ -------------
+
+ function Present (K : Key) return Boolean is
+ begin
+ return Get (K) /= Null_Ptr;
+ end Present;
+
------------
-- Remove --
------------
@@ -181,6 +190,32 @@
Table (Index) := E;
end Set;
+ ------------------------
+ -- Set_If_Not_Present --
+ ------------------------
+
+ function Set_If_Not_Present (E : Elmt_Ptr) return Boolean is
+ K : constant Key := Get_Key (E);
+ Index : constant Header_Num := Hash (K);
+ Elmt : Elmt_Ptr := Table (Index);
+
+ begin
+ loop
+ if Elmt = Null_Ptr then
+ Set_Next (E, Table (Index));
+ Table (Index) := E;
+
+ return True;
+
+ elsif Equal (Get_Key (Elmt), K) then
+ return False;
+
+ else
+ Elmt := Next (Elmt);
+ end if;
+ end loop;
+ end Set_If_Not_Present;
+
end Static_HTable;
-------------------
Index: s-htable.ads
===================================================================
--- s-htable.ads (revision 178381)
+++ s-htable.ads (working copy)
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1995-2010, AdaCore --
+-- Copyright (C) 1995-2011, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -183,6 +183,14 @@
-- Returns the latest inserted element pointer with the given Key
-- or null if none.
+ function Present (K : Key) return Boolean;
+ -- True if an element whose Get_Key is K is in the table
+
+ function Set_If_Not_Present (E : Elmt_Ptr) return Boolean;
+ -- If Present (Get_Key (E)), returns False. Otherwise, does Set (E), and
+ -- then returns True. Present (Get_Key (E)) is always True afterward,
+ -- and the result True indicates E is newly Set.
+
procedure Remove (K : Key);
-- Removes the latest inserted element pointer associated with the
-- given key if any, does nothing if none.
Index: lib-xref-alfa.adb
===================================================================
--- lib-xref-alfa.adb (revision 178381)
+++ lib-xref-alfa.adb (working copy)
@@ -456,10 +456,11 @@
-- Second test: within same unit, sort by location of the scope of
-- the entity definition.
- elsif Get_Scope_Num (T1.Ent_Scope) /=
- Get_Scope_Num (T2.Ent_Scope)
+ elsif Get_Scope_Num (T1.Key.Ent_Scope) /=
+ Get_Scope_Num (T2.Key.Ent_Scope)
then
- return Get_Scope_Num (T1.Ent_Scope) < Get_Scope_Num (T2.Ent_Scope);
+ return Get_Scope_Num (T1.Key.Ent_Scope) <
+ Get_Scope_Num (T2.Key.Ent_Scope);
-- Third test: within same unit and scope, sort by location of
-- entity definition.
@@ -470,41 +471,47 @@
-- Fourth test: if reference is in same unit as entity definition,
-- sort first.
- elsif T1.Lun /= T2.Lun and then T1.Ent_Scope_File = T1.Lun then
+ elsif
+ T1.Key.Lun /= T2.Key.Lun and then T1.Ent_Scope_File = T1.Key.Lun
+ then
return True;
- elsif T1.Lun /= T2.Lun and then T2.Ent_Scope_File = T2.Lun then
+
+ elsif
+ T1.Key.Lun /= T2.Key.Lun and then T2.Ent_Scope_File = T2.Key.Lun
+ then
return False;
-- Fifth test: if reference is in same unit and same scope as entity
-- definition, sort first.
- elsif T1.Ent_Scope_File = T1.Lun
- and then T1.Ref_Scope /= T2.Ref_Scope
- and then T1.Ent_Scope = T1.Ref_Scope
+ elsif T1.Ent_Scope_File = T1.Key.Lun
+ and then T1.Key.Ref_Scope /= T2.Key.Ref_Scope
+ and then T1.Key.Ent_Scope = T1.Key.Ref_Scope
then
return True;
- elsif T1.Ent_Scope_File = T1.Lun
- and then T1.Ref_Scope /= T2.Ref_Scope
- and then T2.Ent_Scope = T2.Ref_Scope
+ elsif T1.Ent_Scope_File = T1.Key.Lun
+ and then T1.Key.Ref_Scope /= T2.Key.Ref_Scope
+ and then T2.Key.Ent_Scope = T2.Key.Ref_Scope
then
return False;
-- Sixth test: for same entity, sort by reference location unit
- elsif T1.Lun /= T2.Lun then
- return Dependency_Num (T1.Lun) < Dependency_Num (T2.Lun);
+ elsif T1.Key.Lun /= T2.Key.Lun then
+ return Dependency_Num (T1.Key.Lun) < Dependency_Num (T2.Key.Lun);
-- Seventh test: for same entity, sort by reference location scope
- elsif Get_Scope_Num (T1.Ref_Scope) /=
- Get_Scope_Num (T2.Ref_Scope)
+ elsif Get_Scope_Num (T1.Key.Ref_Scope) /=
+ Get_Scope_Num (T2.Key.Ref_Scope)
then
- return Get_Scope_Num (T1.Ref_Scope) < Get_Scope_Num (T2.Ref_Scope);
+ return Get_Scope_Num (T1.Key.Ref_Scope) <
+ Get_Scope_Num (T2.Key.Ref_Scope);
-- Eighth test: order of location within referencing unit
- elsif T1.Loc /= T2.Loc then
- return T1.Loc < T2.Loc;
+ elsif T1.Key.Loc /= T2.Key.Loc then
+ return T1.Key.Loc < T2.Key.Loc;
-- Finally, for two locations at the same address prefer the one that
-- does NOT have the type 'r', so that a modification or extension
@@ -513,7 +520,7 @@
-- in-out actuals, the read reference follows the modify reference.
else
- return T2.Typ = 'r';
+ return T2.Key.Typ = 'r';
end if;
end Lt;
@@ -563,7 +570,7 @@
-- Set entity at this point with newly created "Heap" variable
- Xrefs.Table (Xrefs.Last).Ent := Heap;
+ Xrefs.Table (Xrefs.Last).Key.Ent := Heap;
Nrefs := Nrefs + 1;
Rnums (Nrefs) := Xrefs.Last;
@@ -637,13 +644,13 @@
Nrefs := 0;
for J in 1 .. NR loop
- if Alfa_Entities (Ekind (Xrefs.Table (Rnums (J)).Ent))
- and then Alfa_References (Xrefs.Table (Rnums (J)).Typ)
- and then Is_Alfa_Scope (Xrefs.Table (Rnums (J)).Ent_Scope)
- and then Is_Alfa_Scope (Xrefs.Table (Rnums (J)).Ref_Scope)
- and then not Is_Global_Constant (Xrefs.Table (Rnums (J)).Ent)
- and then Is_Alfa_Reference (Xrefs.Table (Rnums (J)).Ent,
- Xrefs.Table (Rnums (J)).Typ)
+ if Alfa_Entities (Ekind (Xrefs.Table (Rnums (J)).Key.Ent))
+ and then Alfa_References (Xrefs.Table (Rnums (J)).Key.Typ)
+ and then Is_Alfa_Scope (Xrefs.Table (Rnums (J)).Key.Ent_Scope)
+ and then Is_Alfa_Scope (Xrefs.Table (Rnums (J)).Key.Ref_Scope)
+ and then not Is_Global_Constant (Xrefs.Table (Rnums (J)).Key.Ent)
+ and then Is_Alfa_Reference (Xrefs.Table (Rnums (J)).Key.Ent,
+ Xrefs.Table (Rnums (J)).Key.Typ)
then
Nrefs := Nrefs + 1;
Rnums (Nrefs) := Rnums (J);
@@ -695,12 +702,12 @@
Prevt := 'm';
for J in 1 .. NR loop
- if Xrefs.Table (Rnums (J)).Loc /= Crloc
+ if Xrefs.Table (Rnums (J)).Key.Loc /= Crloc
or else (Prevt = 'm'
- and then Xrefs.Table (Rnums (J)).Typ = 'r')
+ and then Xrefs.Table (Rnums (J)).Key.Typ = 'r')
then
- Crloc := Xrefs.Table (Rnums (J)).Loc;
- Prevt := Xrefs.Table (Rnums (J)).Typ;
+ Crloc := Xrefs.Table (Rnums (J)).Key.Loc;
+ Prevt := Xrefs.Table (Rnums (J)).Key.Typ;
Nrefs := Nrefs + 1;
Rnums (Nrefs) := Rnums (J);
end if;
@@ -814,13 +821,13 @@
-- construction of the scope table, or an erroneous scope for the
-- current cross-reference.
- pragma Assert (Is_Future_Scope_Entity (XE.Ent_Scope));
+ pragma Assert (Is_Future_Scope_Entity (XE.Key.Ent_Scope));
-- Update the range of cross references to which the current scope
-- refers to. This may be the empty range only for the first scope
-- considered.
- if XE.Ent_Scope /= Cur_Scope then
+ if XE.Key.Ent_Scope /= Cur_Scope then
Alfa_Scope_Table.Table (Cur_Scope_Idx).From_Xref :=
From_Xref_Idx;
Alfa_Scope_Table.Table (Cur_Scope_Idx).To_Xref :=
@@ -828,39 +835,39 @@
From_Xref_Idx := Alfa_Xref_Table.Last + 1;
end if;
- while XE.Ent_Scope /= Cur_Scope loop
+ while XE.Key.Ent_Scope /= Cur_Scope loop
Cur_Scope_Idx := Cur_Scope_Idx + 1;
pragma Assert (Cur_Scope_Idx <= Alfa_Scope_Table.Last);
end loop;
- if XE.Ent /= Cur_Entity then
+ if XE.Key.Ent /= Cur_Entity then
Cur_Entity_Name :=
- new String'(Unique_Name (XE.Ent));
+ new String'(Unique_Name (XE.Key.Ent));
end if;
- if XE.Ent = Heap then
+ if XE.Key.Ent = Heap then
Alfa_Xref_Table.Append (
(Entity_Name => Cur_Entity_Name,
Entity_Line => 0,
- Etype => Get_Entity_Type (XE.Ent),
+ Etype => Get_Entity_Type (XE.Key.Ent),
Entity_Col => 0,
- File_Num => Dependency_Num (XE.Lun),
- Scope_Num => Get_Scope_Num (XE.Ref_Scope),
- Line => Int (Get_Logical_Line_Number (XE.Loc)),
- Rtype => XE.Typ,
- Col => Int (Get_Column_Number (XE.Loc))));
+ File_Num => Dependency_Num (XE.Key.Lun),
+ Scope_Num => Get_Scope_Num (XE.Key.Ref_Scope),
+ Line => Int (Get_Logical_Line_Number (XE.Key.Loc)),
+ Rtype => XE.Key.Typ,
+ Col => Int (Get_Column_Number (XE.Key.Loc))));
else
Alfa_Xref_Table.Append (
(Entity_Name => Cur_Entity_Name,
Entity_Line => Int (Get_Logical_Line_Number (XE.Def)),
- Etype => Get_Entity_Type (XE.Ent),
+ Etype => Get_Entity_Type (XE.Key.Ent),
Entity_Col => Int (Get_Column_Number (XE.Def)),
- File_Num => Dependency_Num (XE.Lun),
- Scope_Num => Get_Scope_Num (XE.Ref_Scope),
- Line => Int (Get_Logical_Line_Number (XE.Loc)),
- Rtype => XE.Typ,
- Col => Int (Get_Column_Number (XE.Loc))));
+ File_Num => Dependency_Num (XE.Key.Lun),
+ Scope_Num => Get_Scope_Num (XE.Key.Ref_Scope),
+ Line => Int (Get_Logical_Line_Number (XE.Key.Loc)),
+ Rtype => XE.Key.Typ,
+ Col => Int (Get_Column_Number (XE.Key.Loc))));
end if;
end Add_One_Xref;
end loop;
@@ -1071,20 +1078,20 @@
-- Entity is filled later on with the special "Heap" variable
- Drefs.Table (Indx).Ent := Empty;
+ Drefs.Table (Indx).Key.Ent := Empty;
Drefs.Table (Indx).Def := No_Location;
- Drefs.Table (Indx).Loc := Ref;
- Drefs.Table (Indx).Typ := Typ;
+ Drefs.Table (Indx).Key.Loc := Ref;
+ Drefs.Table (Indx).Key.Typ := Typ;
-- It is as if the special "Heap" was defined in every scope where it
-- is referenced.
- Drefs.Table (Indx).Eun := Get_Source_Unit (Ref);
- Drefs.Table (Indx).Lun := Get_Source_Unit (Ref);
+ Drefs.Table (Indx).Key.Eun := Get_Source_Unit (Ref);
+ Drefs.Table (Indx).Key.Lun := Get_Source_Unit (Ref);
- Drefs.Table (Indx).Ref_Scope := Ref_Scope;
- Drefs.Table (Indx).Ent_Scope := Ref_Scope;
+ Drefs.Table (Indx).Key.Ref_Scope := Ref_Scope;
+ Drefs.Table (Indx).Key.Ent_Scope := Ref_Scope;
Drefs.Table (Indx).Ent_Scope_File := Get_Source_Unit (Ref_Scope);
end if;
end Generate_Dereference;
Index: lib-xref.adb
===================================================================
--- lib-xref.adb (revision 178381)
+++ lib-xref.adb (working copy)
@@ -44,6 +44,7 @@
with Table; use Table;
with GNAT.Heap_Sort_G;
+with GNAT.HTable;
package body Lib.Xref is
@@ -56,16 +57,13 @@
subtype Xref_Entry_Number is Int;
- type Xref_Entry is record
+ type Xref_Key is record
+ -- These are the components of Xref_Entry that participate in hash
+ -- lookups.
+
Ent : Entity_Id;
-- Entity referenced (E parameter to Generate_Reference)
- Def : Source_Ptr;
- -- Original source location for entity being referenced. Note that these
- -- values are used only during the output process, they are not set when
- -- the entries are originally built. This is because private entities
- -- can be swapped when the initial call is made.
-
Loc : Source_Ptr;
-- Location of reference (Original_Location (Sloc field of N parameter
-- to Generate_Reference). Set to No_Location for the case of a
@@ -89,9 +87,22 @@
Ent_Scope : Entity_Id;
-- Entity of the closest subprogram or package enclosing the definition,
-- which should be located in the same file as the definition itself.
+ end record;
+ type Xref_Entry is record
+ Key : Xref_Key;
+
Ent_Scope_File : Unit_Number_Type;
-- File for entity Ent_Scope
+
+ Def : Source_Ptr;
+ -- Original source location for entity being referenced. Note that these
+ -- values are used only during the output process, they are not set when
+ -- the entries are originally built. This is because private entities
+ -- can be swapped when the initial call is made.
+
+ HTable_Next : Xref_Entry_Number;
+ -- For use only by Static_HTable
end record;
package Xrefs is new Table.Table (
@@ -102,6 +113,44 @@
Table_Increment => Alloc.Xrefs_Increment,
Table_Name => "Xrefs");
+ --------------
+ -- Xref_Set --
+ --------------
+
+ -- We keep a set of xref entries, in order to avoid inserting duplicate
+ -- entries into the above Xrefs table. An entry is in Xref_Set if and only
+ -- if it is in Xrefs.
+
+ Num_Buckets : constant := 2**16;
+
+ subtype Header_Num is Integer range 0 .. Num_Buckets - 1;
+ type Null_Type is null record;
+ pragma Unreferenced (Null_Type);
+
+ function Hash (F : Xref_Entry_Number) return Header_Num;
+
+ function Equal (F1, F2 : Xref_Entry_Number) return Boolean;
+
+ procedure HT_Set_Next (E : Xref_Entry_Number; Next : Xref_Entry_Number);
+
+ function HT_Next (E : Xref_Entry_Number) return Xref_Entry_Number;
+
+ function Get_Key (E : Xref_Entry_Number) return Xref_Entry_Number;
+
+ pragma Inline (Hash, Equal, HT_Set_Next, HT_Next, Get_Key);
+
+ package Xref_Set is new GNAT.HTable.Static_HTable (
+ Header_Num,
+ Element => Xref_Entry,
+ Elmt_Ptr => Xref_Entry_Number,
+ Null_Ptr => 0,
+ Set_Next => HT_Set_Next,
+ Next => HT_Next,
+ Key => Xref_Entry_Number,
+ Get_Key => Get_Key,
+ Hash => Hash,
+ Equal => Equal);
+
----------------------
-- Alfa Information --
----------------------
@@ -121,14 +170,51 @@
function Lt (T1, T2 : Xref_Entry) return Boolean;
-- Order cross-references
+ procedure Add_Entry (Key : Xref_Key; Ent_Scope_File : Unit_Number_Type);
+ -- Add an entry to the tables of Xref_Entries, avoiding duplicates
+
+ ---------------
+ -- Add_Entry --
+ ---------------
+
+ procedure Add_Entry (Key : Xref_Key; Ent_Scope_File : Unit_Number_Type) is
+ begin
+ Xrefs.Increment_Last; -- tentative
+ Xrefs.Table (Xrefs.Last).Key := Key;
+
+ -- Set the entry in Xref_Set, and if newly set, keep the above
+ -- tentative increment.
+
+ if Xref_Set.Set_If_Not_Present (Xrefs.Last) then
+ Xrefs.Table (Xrefs.Last).Ent_Scope_File := Ent_Scope_File;
+ -- Leave Def and HTable_Next uninitialized
+
+ Set_Has_Xref_Entry (Key.Ent);
+
+ -- It was already in Xref_Set, so throw away the tentatively-added
+ -- entry
+
+ else
+ Xrefs.Decrement_Last;
+ end if;
+ end Add_Entry;
+
+ -----------
+ -- Equal --
+ -----------
+
+ function Equal (F1, F2 : Xref_Entry_Number) return Boolean is
+ Result : constant Boolean :=
+ Xrefs.Table (F1).Key = Xrefs.Table (F2).Key;
+ begin
+ return Result;
+ end Equal;
+
-------------------------
-- Generate_Definition --
-------------------------
procedure Generate_Definition (E : Entity_Id) is
- Loc : Source_Ptr;
- Indx : Nat;
-
begin
pragma Assert (Nkind (E) in N_Entity);
@@ -159,23 +245,16 @@
and then In_Extended_Main_Source_Unit (E)
and then not Is_Internal_Name (Chars (E))
then
- Xrefs.Increment_Last;
- Indx := Xrefs.Last;
- Loc := Original_Location (Sloc (E));
+ Add_Entry
+ ((Ent => E,
+ Loc => No_Location,
+ Typ => ' ',
+ Eun => Get_Source_Unit (Original_Location (Sloc (E))),
+ Lun => No_Unit,
+ Ref_Scope => Empty,
+ Ent_Scope => Empty),
+ Ent_Scope_File => No_Unit);
- Xrefs.Table (Indx).Ent := E;
- Xrefs.Table (Indx).Typ := ' ';
- Xrefs.Table (Indx).Def := No_Location;
- Xrefs.Table (Indx).Loc := No_Location;
-
- Xrefs.Table (Indx).Eun := Get_Source_Unit (Loc);
-
- Xrefs.Table (Indx).Ref_Scope := Empty;
- Xrefs.Table (Indx).Ent_Scope := Empty;
- Xrefs.Table (Indx).Ent_Scope_File := No_Unit;
-
- Set_Has_Xref_Entry (E);
-
if In_Inlined_Body then
Set_Referenced (E);
end if;
@@ -294,15 +373,17 @@
Set_Ref : Boolean := True;
Force : Boolean := False)
is
- Indx : Nat;
Nod : Node_Id;
Ref : Source_Ptr;
Def : Source_Ptr;
Ent : Entity_Id;
- Ref_Scope : Entity_Id;
- Ent_Scope : Entity_Id;
+ Actual_Typ : Character := Typ;
+ Ref_Scope : Entity_Id;
+ Ent_Scope : Entity_Id;
+ Ent_Scope_File : Unit_Number_Type;
+
Call : Node_Id;
Formal : Entity_Id;
-- Used for call to Find_Actual
@@ -865,34 +946,33 @@
Ref := Original_Location (Sloc (Nod));
Def := Original_Location (Sloc (Ent));
- Ref_Scope := Alfa.Enclosing_Subprogram_Or_Package (N);
- Ent_Scope := Alfa.Enclosing_Subprogram_Or_Package (Ent);
-
- Xrefs.Increment_Last;
- Indx := Xrefs.Last;
-
- Xrefs.Table (Indx).Loc := Ref;
-
- -- Overriding operations are marked with 'P'
-
- if Typ = 'p'
+ if Actual_Typ = 'p'
and then Is_Subprogram (N)
and then Present (Overridden_Operation (N))
then
- Xrefs.Table (Indx).Typ := 'P';
- else
- Xrefs.Table (Indx).Typ := Typ;
+ Actual_Typ := 'P';
end if;
- Xrefs.Table (Indx).Eun := Get_Source_Unit (Def);
- Xrefs.Table (Indx).Lun := Get_Source_Unit (Ref);
- Xrefs.Table (Indx).Ent := Ent;
+ if Alfa_Mode then
+ Ref_Scope := Alfa.Enclosing_Subprogram_Or_Package (N);
+ Ent_Scope := Alfa.Enclosing_Subprogram_Or_Package (Ent);
+ Ent_Scope_File := Get_Source_Unit (Ent_Scope);
- Xrefs.Table (Indx).Ref_Scope := Ref_Scope;
- Xrefs.Table (Indx).Ent_Scope := Ent_Scope;
- Xrefs.Table (Indx).Ent_Scope_File := Get_Source_Unit (Ent_Scope);
+ else
+ Ref_Scope := Empty;
+ Ent_Scope := Empty;
+ Ent_Scope_File := No_Unit;
+ end if;
- Set_Has_Xref_Entry (Ent);
+ Add_Entry
+ ((Ent => Ent,
+ Loc => Ref,
+ Typ => Actual_Typ,
+ Eun => Get_Source_Unit (Def),
+ Lun => Get_Source_Unit (Ref),
+ Ref_Scope => Ref_Scope,
+ Ent_Scope => Ent_Scope),
+ Ent_Scope_File => Ent_Scope_File);
end if;
end Generate_Reference;
@@ -957,6 +1037,49 @@
end loop;
end Generate_Reference_To_Generic_Formals;
+ -------------
+ -- Get_Key --
+ -------------
+
+ function Get_Key (E : Xref_Entry_Number) return Xref_Entry_Number is
+ begin
+ return E;
+ end Get_Key;
+
+ ----------
+ -- Hash --
+ ----------
+
+ function Hash (F : Xref_Entry_Number) return Header_Num is
+ -- It is unlikely to have two references to the same entity at the same
+ -- source location, so the hash function depends only on the Ent and Loc
+ -- fields.
+
+ XE : Xref_Entry renames Xrefs.Table (F);
+ type M is mod 2**32;
+ H : constant M := M'Mod (XE.Key.Ent) + 2**7 * M'Mod (XE.Key.Loc);
+ begin
+ return Header_Num (H mod Num_Buckets);
+ end Hash;
+
+ -----------------
+ -- HT_Set_Next --
+ -----------------
+
+ procedure HT_Set_Next (E : Xref_Entry_Number; Next : Xref_Entry_Number) is
+ begin
+ Xrefs.Table (E).HTable_Next := Next;
+ end HT_Set_Next;
+
+ -------------
+ -- HT_Next --
+ -------------
+
+ function HT_Next (E : Xref_Entry_Number) return Xref_Entry_Number is
+ begin
+ return Xrefs.Table (E).HTable_Next;
+ end HT_Next;
+
----------------
-- Initialize --
----------------
@@ -974,8 +1097,8 @@
begin
-- First test: if entity is in different unit, sort by unit
- if T1.Eun /= T2.Eun then
- return Dependency_Num (T1.Eun) < Dependency_Num (T2.Eun);
+ if T1.Key.Eun /= T2.Key.Eun then
+ return Dependency_Num (T1.Key.Eun) < Dependency_Num (T2.Key.Eun);
-- Second test: within same unit, sort by entity Sloc
@@ -984,21 +1107,21 @@
-- Third test: sort definitions ahead of references
- elsif T1.Loc = No_Location then
+ elsif T1.Key.Loc = No_Location then
return True;
- elsif T2.Loc = No_Location then
+ elsif T2.Key.Loc = No_Location then
return False;
-- Fourth test: for same entity, sort by reference location unit
- elsif T1.Lun /= T2.Lun then
- return Dependency_Num (T1.Lun) < Dependency_Num (T2.Lun);
+ elsif T1.Key.Lun /= T2.Key.Lun then
+ return Dependency_Num (T1.Key.Lun) < Dependency_Num (T2.Key.Lun);
-- Fifth test: order of location within referencing unit
- elsif T1.Loc /= T2.Loc then
- return T1.Loc < T2.Loc;
+ elsif T1.Key.Loc /= T2.Key.Loc then
+ return T1.Key.Loc < T2.Key.Loc;
-- Finally, for two locations at the same address, we prefer
-- the one that does NOT have the type 'r' so that a modification
@@ -1008,7 +1131,7 @@
-- the modify reference.
else
- return T2.Typ = 'r';
+ return T2.Key.Typ = 'r';
end if;
end Lt;
@@ -1245,7 +1368,7 @@
begin
for J in 1 .. Xrefs.Last loop
- Ent := Xrefs.Table (J).Ent;
+ Ent := Xrefs.Table (J).Key.Ent;
if Is_Type (Ent)
and then Is_Tagged_Type (Ent)
@@ -1283,9 +1406,7 @@
Handle_Orphan_Type_References : declare
J : Nat;
Tref : Entity_Id;
- Indx : Nat;
Ent : Entity_Id;
- Loc : Source_Ptr;
L, R : Character;
pragma Warnings (Off, L);
@@ -1302,18 +1423,20 @@
procedure New_Entry (E : Entity_Id) is
begin
- if Present (E)
- and then not Has_Xref_Entry (E)
+ pragma Assert (Present (E));
+
+ if not Has_Xref_Entry (Implementation_Base_Type (E))
and then Sloc (E) > No_Location
then
- Xrefs.Increment_Last;
- Indx := Xrefs.Last;
- Loc := Original_Location (Sloc (E));
- Xrefs.Table (Indx).Ent := E;
- Xrefs.Table (Indx).Loc := No_Location;
- Xrefs.Table (Indx).Eun := Get_Source_Unit (Loc);
- Xrefs.Table (Indx).Lun := No_Unit;
- Set_Has_Xref_Entry (E);
+ Add_Entry
+ ((Ent => E,
+ Loc => No_Location,
+ Typ => Character'First,
+ Eun => Get_Source_Unit (Original_Location (Sloc (E))),
+ Lun => No_Unit,
+ Ref_Scope => Empty,
+ Ent_Scope => Empty),
+ Ent_Scope_File => No_Unit);
end if;
end New_Entry;
@@ -1326,7 +1449,7 @@
J := 1;
while J <= Xrefs.Last loop
- Ent := Xrefs.Table (J).Ent;
+ Ent := Xrefs.Table (J).Key.Ent;
Get_Type_Reference (Ent, Tref, L, R);
if Present (Tref)
@@ -1393,15 +1516,15 @@
Prim := Parent_Op (Node (Op));
if Present (Prim) then
- Xrefs.Increment_Last;
- Indx := Xrefs.Last;
- Loc := Original_Location (Sloc (Prim));
- Xrefs.Table (Indx).Ent := Prim;
- Xrefs.Table (Indx).Loc := No_Location;
- Xrefs.Table (Indx).Eun :=
- Get_Source_Unit (Sloc (Prim));
- Xrefs.Table (Indx).Lun := No_Unit;
- Set_Has_Xref_Entry (Prim);
+ Add_Entry
+ ((Ent => Prim,
+ Loc => No_Location,
+ Typ => Character'First,
+ Eun => Get_Source_Unit (Sloc (Prim)),
+ Lun => No_Unit,
+ Ref_Scope => Empty,
+ Ent_Scope => Empty),
+ Ent_Scope_File => No_Unit);
end if;
Next_Elmt (Op);
@@ -1418,9 +1541,8 @@
Output_Refs : declare
- Nrefs : Nat := Xrefs.Last;
- -- Number of references in table. This value may get reset (reduced)
- -- when we eliminate duplicate reference entries.
+ Nrefs : constant Nat := Xrefs.Last;
+ -- Number of references in table
Rnums : array (0 .. Nrefs) of Nat;
-- This array contains numbers of references in the Xrefs table.
@@ -1523,37 +1645,13 @@
for J in 1 .. Nrefs loop
Rnums (J) := J;
Xrefs.Table (J).Def :=
- Original_Location (Sloc (Xrefs.Table (J).Ent));
+ Original_Location (Sloc (Xrefs.Table (J).Key.Ent));
end loop;
-- Sort the references
Sorting.Sort (Integer (Nrefs));
- -- Eliminate duplicate entries
-
- declare
- NR : constant Nat := Nrefs;
-
- begin
- -- We need this test for NR because if we force ALI file
- -- generation in case of errors detected, it may be the case
- -- that Nrefs is 0, so we should not reset it here
-
- if NR >= 2 then
- Nrefs := 1;
-
- for J in 2 .. NR loop
- if Xrefs.Table (Rnums (J)) /=
- Xrefs.Table (Rnums (Nrefs))
- then
- Nrefs := Nrefs + 1;
- Rnums (Nrefs) := Rnums (J);
- end if;
- end loop;
- end if;
- end;
-
-- Initialize loop through references
Curxu := No_Unit;
@@ -1773,7 +1871,7 @@
-- Start of processing for Output_One_Ref
begin
- Ent := XE.Ent;
+ Ent := XE.Key.Ent;
Ctyp := Xref_Entity_Letters (Ekind (Ent));
-- Skip reference if it is the only reference to an entity,
@@ -1782,10 +1880,10 @@
-- consisting only of packages with END lines, where no
-- entity from the package is actually referenced.
- if XE.Typ = 'e'
+ if XE.Key.Typ = 'e'
and then Ent /= Curent
and then (Refno = Nrefs or else
- Ent /= Xrefs.Table (Rnums (Refno + 1)).Ent)
+ Ent /= Xrefs.Table (Rnums (Refno + 1)).Key.Ent)
and then
not In_Extended_Main_Source_Unit (Ent)
then
@@ -1795,7 +1893,7 @@
-- For private type, get full view type
if Ctyp = '+'
- and then Present (Full_View (XE.Ent))
+ and then Present (Full_View (XE.Key.Ent))
then
Ent := Underlying_Type (Ent);
@@ -1813,15 +1911,15 @@
-- For variable reference, get corresponding type
if Ctyp = '*' then
- Ent := Etype (XE.Ent);
+ Ent := Etype (XE.Key.Ent);
Ctyp := Fold_Lower (Xref_Entity_Letters (Ekind (Ent)));
-- If variable is private type, get full view type
if Ctyp = '+'
- and then Present (Full_View (Etype (XE.Ent)))
+ and then Present (Full_View (Etype (XE.Key.Ent)))
then
- Ent := Underlying_Type (Etype (XE.Ent));
+ Ent := Underlying_Type (Etype (XE.Key.Ent));
if Present (Ent) then
Ctyp := Fold_Lower (Xref_Entity_Letters (Ekind (Ent)));
@@ -1839,13 +1937,13 @@
-- Special handling for access parameters and objects of
-- an anonymous access type.
- if Ekind_In (Etype (XE.Ent),
+ if Ekind_In (Etype (XE.Key.Ent),
E_Anonymous_Access_Type,
E_Anonymous_Access_Subprogram_Type,
E_Anonymous_Access_Protected_Subprogram_Type)
then
- if Is_Formal (XE.Ent)
- or else Ekind_In (XE.Ent, E_Variable, E_Constant)
+ if Is_Formal (XE.Key.Ent)
+ or else Ekind_In (XE.Key.Ent, E_Variable, E_Constant)
then
Ctyp := 'p';
end if;
@@ -1859,8 +1957,8 @@
-- Special handling for abstract types and operations
- if Is_Overloadable (XE.Ent)
- and then Is_Abstract_Subprogram (XE.Ent)
+ if Is_Overloadable (XE.Key.Ent)
+ and then Is_Abstract_Subprogram (XE.Key.Ent)
then
if Ctyp = 'U' then
Ctyp := 'x'; -- Abstract procedure
@@ -1869,10 +1967,10 @@
Ctyp := 'y'; -- Abstract function
end if;
- elsif Is_Type (XE.Ent)
- and then Is_Abstract_Type (XE.Ent)
+ elsif Is_Type (XE.Key.Ent)
+ and then Is_Abstract_Type (XE.Key.Ent)
then
- if Is_Interface (XE.Ent) then
+ if Is_Interface (XE.Key.Ent) then
Ctyp := 'h';
elsif Ctyp = 'R' then
@@ -1887,41 +1985,42 @@
-- Suppress references to object definitions, used for local
-- references.
- or else XE.Typ = 'D'
- or else XE.Typ = 'I'
+ or else XE.Key.Typ = 'D'
+ or else XE.Key.Typ = 'I'
-- Suppress self references, except for bodies that act as
-- specs.
- or else (XE.Loc = XE.Def
+ or else (XE.Key.Loc = XE.Def
and then
- (XE.Typ /= 'b'
- or else not Is_Subprogram (XE.Ent)))
+ (XE.Key.Typ /= 'b'
+ or else not Is_Subprogram (XE.Key.Ent)))
-- Also suppress definitions of body formals (we only
-- treat these as references, and the references were
-- separately recorded).
- or else (Is_Formal (XE.Ent)
- and then Present (Spec_Entity (XE.Ent)))
+ or else (Is_Formal (XE.Key.Ent)
+ and then Present (Spec_Entity (XE.Key.Ent)))
then
null;
else
-- Start new Xref section if new xref unit
- if XE.Eun /= Curxu then
+ if XE.Key.Eun /= Curxu then
if Write_Info_Col > 1 then
Write_Info_EOL;
end if;
- Curxu := XE.Eun;
+ Curxu := XE.Key.Eun;
Write_Info_Initiate ('X');
Write_Info_Char (' ');
- Write_Info_Nat (Dependency_Num (XE.Eun));
+ Write_Info_Nat (Dependency_Num (XE.Key.Eun));
Write_Info_Char (' ');
- Write_Info_Name (Reference_Name (Source_Index (XE.Eun)));
+ Write_Info_Name
+ (Reference_Name (Source_Index (XE.Key.Eun)));
end if;
-- Start new Entity line if new entity. Note that we
@@ -1932,14 +2031,14 @@
if No (Curent)
or else
- (XE.Ent /= Curent
+ (XE.Key.Ent /= Curent
and then
- (Name_Change (XE.Ent) or else XE.Def /= Curdef))
+ (Name_Change (XE.Key.Ent) or else XE.Def /= Curdef))
then
- Curent := XE.Ent;
+ Curent := XE.Key.Ent;
Curdef := XE.Def;
- Get_Unqualified_Name_String (Chars (XE.Ent));
+ Get_Unqualified_Name_String (Chars (XE.Key.Ent));
Curlen := Name_Len;
Curnam (1 .. Curlen) := Name_Buffer (1 .. Curlen);
@@ -2051,7 +2150,7 @@
declare
Ent_Name : constant String :=
- Exact_Source_Name (Sloc (XE.Ent));
+ Exact_Source_Name (Sloc (XE.Key.Ent));
begin
for C in Ent_Name'Range loop
Write_Info_Char (Ent_Name (C));
@@ -2060,22 +2159,22 @@
-- See if we have a renaming reference
- if Is_Object (XE.Ent)
- and then Present (Renamed_Object (XE.Ent))
+ if Is_Object (XE.Key.Ent)
+ and then Present (Renamed_Object (XE.Key.Ent))
then
- Rref := Renamed_Object (XE.Ent);
+ Rref := Renamed_Object (XE.Key.Ent);
- elsif Is_Overloadable (XE.Ent)
- and then Nkind (Parent (Declaration_Node (XE.Ent))) =
- N_Subprogram_Renaming_Declaration
+ elsif Is_Overloadable (XE.Key.Ent)
+ and then Nkind (Parent (Declaration_Node (XE.Key.Ent)))
+ = N_Subprogram_Renaming_Declaration
then
- Rref := Name (Parent (Declaration_Node (XE.Ent)));
+ Rref := Name (Parent (Declaration_Node (XE.Key.Ent)));
- elsif Ekind (XE.Ent) = E_Package
- and then Nkind (Declaration_Node (XE.Ent)) =
+ elsif Ekind (XE.Key.Ent) = E_Package
+ and then Nkind (Declaration_Node (XE.Key.Ent)) =
N_Package_Renaming_Declaration
then
- Rref := Name (Declaration_Node (XE.Ent));
+ Rref := Name (Declaration_Node (XE.Key.Ent));
else
Rref := Empty;
@@ -2128,12 +2227,13 @@
-- Write out information about generic parent, if entity
-- is an instance.
- if Is_Generic_Instance (XE.Ent) then
+ if Is_Generic_Instance (XE.Key.Ent) then
declare
Gen_Par : constant Entity_Id :=
Generic_Parent
(Specification
- (Unit_Declaration_Node (XE.Ent)));
+ (Unit_Declaration_Node
+ (XE.Key.Ent)));
Loc : constant Source_Ptr := Sloc (Gen_Par);
Gen_U : constant Unit_Number_Type :=
Get_Source_Unit (Loc);
@@ -2154,15 +2254,16 @@
-- See if we have a type reference and if so output
- Check_Type_Reference (XE.Ent, False);
+ Check_Type_Reference (XE.Key.Ent, False);
-- Additional information for types with progenitors
- if Is_Record_Type (XE.Ent)
- and then Present (Interfaces (XE.Ent))
+ if Is_Record_Type (XE.Key.Ent)
+ and then Present (Interfaces (XE.Key.Ent))
then
declare
- Elmt : Elmt_Id := First_Elmt (Interfaces (XE.Ent));
+ Elmt : Elmt_Id :=
+ First_Elmt (Interfaces (XE.Key.Ent));
begin
while Present (Elmt) loop
Check_Type_Reference (Node (Elmt), True);
@@ -2173,11 +2274,11 @@
-- For array types, list index types as well. (This is
-- not C, indexes have distinct types).
- elsif Is_Array_Type (XE.Ent) then
+ elsif Is_Array_Type (XE.Key.Ent) then
declare
Indx : Node_Id;
begin
- Indx := First_Index (XE.Ent);
+ Indx := First_Index (XE.Key.Ent);
while Present (Indx) loop
Check_Type_Reference
(First_Subtype (Etype (Indx)), True);
@@ -2189,10 +2290,11 @@
-- If the entity is an overriding operation, write info
-- on operation that was overridden.
- if Is_Subprogram (XE.Ent)
- and then Present (Overridden_Operation (XE.Ent))
+ if Is_Subprogram (XE.Key.Ent)
+ and then Present (Overridden_Operation (XE.Key.Ent))
then
- Output_Overridden_Op (Overridden_Operation (XE.Ent));
+ Output_Overridden_Op
+ (Overridden_Operation (XE.Key.Ent));
end if;
-- End of processing for entity output
@@ -2204,13 +2306,13 @@
-- as the previous one, or it is a read-reference that
-- indicates that the entity is an in-out actual in a call.
- if XE.Loc /= No_Location
+ if XE.Key.Loc /= No_Location
and then
- (XE.Loc /= Crloc
- or else (Prevt = 'm' and then XE.Typ = 'r'))
+ (XE.Key.Loc /= Crloc
+ or else (Prevt = 'm' and then XE.Key.Typ = 'r'))
then
- Crloc := XE.Loc;
- Prevt := XE.Typ;
+ Crloc := XE.Key.Loc;
+ Prevt := XE.Key.Typ;
-- Start continuation if line full, else blank
@@ -2223,25 +2325,26 @@
-- Output file number if changed
- if XE.Lun /= Curru then
- Curru := XE.Lun;
+ if XE.Key.Lun /= Curru then
+ Curru := XE.Key.Lun;
Write_Info_Nat (Dependency_Num (Curru));
Write_Info_Char ('|');
end if;
- Write_Info_Nat (Int (Get_Logical_Line_Number (XE.Loc)));
- Write_Info_Char (XE.Typ);
+ Write_Info_Nat
+ (Int (Get_Logical_Line_Number (XE.Key.Loc)));
+ Write_Info_Char (XE.Key.Typ);
- if Is_Overloadable (XE.Ent)
- and then Is_Imported (XE.Ent)
- and then XE.Typ = 'b'
+ if Is_Overloadable (XE.Key.Ent)
+ and then Is_Imported (XE.Key.Ent)
+ and then XE.Key.Typ = 'b'
then
- Output_Import_Export_Info (XE.Ent);
+ Output_Import_Export_Info (XE.Key.Ent);
end if;
- Write_Info_Nat (Int (Get_Column_Number (XE.Loc)));
+ Write_Info_Nat (Int (Get_Column_Number (XE.Key.Loc)));
- Output_Instantiation_Refs (Sloc (XE.Ent));
+ Output_Instantiation_Refs (Sloc (XE.Key.Ent));
end if;
end if;
end Output_One_Ref;
@@ -2254,4 +2357,9 @@
end Output_Refs;
end Output_References;
+begin
+ -- Reset is necessary because Elmt_Ptr does not default to Null_Ptr,
+ -- because it's not an access type.
+
+ Xref_Set.Reset;
end Lib.Xref;
reply other threads:[~2011-09-02 7:15 UTC|newest]
Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20110902071527.GA29478@adacore.com \
--to=charlet@adacore.com \
--cc=duff@adacore.com \
--cc=gcc-patches@gcc.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).