diff options
| author | Bob Duff <duff@adacore.com> | 2020-02-28 13:50:49 -0500 |
|---|---|---|
| committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-06-09 04:09:03 -0400 |
| commit | 7bf5f4d985c59e4c5a64e8d7b263af92c9ec6339 (patch) | |
| tree | 8e0635948d445b39151c068a1d156d6a2ea15ae5 /gcc/ada | |
| parent | b97813ab96391d0c7bd518d31855a9db4960c770 (diff) | |
| download | gcc-7bf5f4d985c59e4c5a64e8d7b263af92c9ec6339.zip gcc-7bf5f4d985c59e4c5a64e8d7b263af92c9ec6339.tar.gz gcc-7bf5f4d985c59e4c5a64e8d7b263af92c9ec6339.tar.bz2 | |
[Ada] Write_Invocation_Graph_Vertex: include lib item name
2020-06-09 Bob Duff <duff@adacore.com>
gcc/ada/
* bindo-graphs.adb, bindo-graphs.ads: For each invocation graph,
record the corresponding library graph.
* bindo-writers.adb (Write_Invocation_Graph_Vertex): Print the
lib item name. Remove library graph parameters.
* bindo-augmentors.adb, bindo-augmentors.ads,
bindo-builders.adb, bindo-diagnostics.adb,
bindo-diagnostics.ads, bindo-elaborators.adb: Remove library
graph parameters.
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/bindo-augmentors.adb | 38 | ||||
| -rw-r--r-- | gcc/ada/bindo-augmentors.ads | 8 | ||||
| -rw-r--r-- | gcc/ada/bindo-builders.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/bindo-diagnostics.adb | 70 | ||||
| -rw-r--r-- | gcc/ada/bindo-diagnostics.ads | 8 | ||||
| -rw-r--r-- | gcc/ada/bindo-elaborators.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/bindo-graphs.adb | 1736 | ||||
| -rw-r--r-- | gcc/ada/bindo-graphs.ads | 954 | ||||
| -rw-r--r-- | gcc/ada/bindo-writers.adb | 14 |
9 files changed, 1415 insertions, 1420 deletions
diff --git a/gcc/ada/bindo-augmentors.adb b/gcc/ada/bindo-augmentors.adb index b7ea130..a2a1de0 100644 --- a/gcc/ada/bindo-augmentors.adb +++ b/gcc/ada/bindo-augmentors.adb @@ -57,7 +57,6 @@ package body Bindo.Augmentors is procedure Visit_Elaboration_Root (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Root : Invocation_Graph_Vertex_Id); pragma Inline (Visit_Elaboration_Root); -- Start a DFS traversal from elaboration root Root to: @@ -67,9 +66,7 @@ package body Bindo.Augmentors is -- * Create invocation edges for each such transition where the -- successor is Root. - procedure Visit_Elaboration_Roots - (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph); + procedure Visit_Elaboration_Roots (Inv_Graph : Invocation_Graph); pragma Inline (Visit_Elaboration_Roots); -- Start a DFS traversal from all elaboration roots to: -- @@ -80,7 +77,6 @@ package body Bindo.Augmentors is procedure Visit_Vertex (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Invoker : Invocation_Graph_Vertex_Id; Last_Vertex : Library_Graph_Vertex_Id; Root_Vertex : Library_Graph_Vertex_Id; @@ -113,10 +109,8 @@ package body Bindo.Augmentors is -- Augment_Library_Graph -- --------------------------- - procedure Augment_Library_Graph - (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph) - is + procedure Augment_Library_Graph (Inv_Graph : Invocation_Graph) is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph); begin pragma Assert (Present (Lib_Graph)); @@ -133,7 +127,7 @@ package body Bindo.Augmentors is Longest_Path := 0; Total_Visited := 0; - Visit_Elaboration_Roots (Inv_Graph, Lib_Graph); + Visit_Elaboration_Roots (Inv_Graph); Write_Statistics; End_Phase (Library_Graph_Augmentation); @@ -145,9 +139,9 @@ package body Bindo.Augmentors is procedure Visit_Elaboration_Root (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Root : Invocation_Graph_Vertex_Id) is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph); pragma Assert (Present (Inv_Graph)); pragma Assert (Present (Lib_Graph)); pragma Assert (Present (Root)); @@ -173,7 +167,6 @@ package body Bindo.Augmentors is Visit_Vertex (Inv_Graph => Inv_Graph, - Lib_Graph => Lib_Graph, Invoker => Root, Last_Vertex => Root_Vertex, Root_Vertex => Root_Vertex, @@ -189,25 +182,20 @@ package body Bindo.Augmentors is -- Visit_Elaboration_Roots -- ----------------------------- - procedure Visit_Elaboration_Roots - (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph) - is + procedure Visit_Elaboration_Roots (Inv_Graph : Invocation_Graph) is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph); + pragma Assert (Present (Inv_Graph)); + pragma Assert (Present (Lib_Graph)); + Iter : Elaboration_Root_Iterator; Root : Invocation_Graph_Vertex_Id; begin - pragma Assert (Present (Inv_Graph)); - pragma Assert (Present (Lib_Graph)); - Iter := Iterate_Elaboration_Roots (Inv_Graph); while Has_Next (Iter) loop Next (Iter, Root); - Visit_Elaboration_Root - (Inv_Graph => Inv_Graph, - Lib_Graph => Lib_Graph, - Root => Root); + Visit_Elaboration_Root (Inv_Graph => Inv_Graph, Root => Root); end loop; end Visit_Elaboration_Roots; @@ -217,7 +205,6 @@ package body Bindo.Augmentors is procedure Visit_Vertex (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Invoker : Invocation_Graph_Vertex_Id; Last_Vertex : Library_Graph_Vertex_Id; Root_Vertex : Library_Graph_Vertex_Id; @@ -226,6 +213,8 @@ package body Bindo.Augmentors is Internal_Controlled_Action : Boolean; Path : Natural) is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph); + New_Path : constant Natural := Path + 1; Edge : Invocation_Graph_Edge_Id; @@ -300,7 +289,6 @@ package body Bindo.Augmentors is Visit_Vertex (Inv_Graph => Inv_Graph, - Lib_Graph => Lib_Graph, Invoker => Target (Inv_Graph, Edge), Last_Vertex => Invoker_Vertex, Root_Vertex => Root_Vertex, diff --git a/gcc/ada/bindo-augmentors.ads b/gcc/ada/bindo-augmentors.ads index 534c027..a8fa158 100644 --- a/gcc/ada/bindo-augmentors.ads +++ b/gcc/ada/bindo-augmentors.ads @@ -42,11 +42,9 @@ package Bindo.Augmentors is ------------------------------ package Library_Graph_Augmentors is - procedure Augment_Library_Graph - (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph); - -- Augment library graph Lib_Graph with information from invocation - -- graph Inv_Graph as follows: + procedure Augment_Library_Graph (Inv_Graph : Invocation_Graph); + -- Augment the library graph of Inv_Graph with information from + -- invocation graph Inv_Graph as follows: -- -- 1) Traverse the invocation graph starting from each elaboration -- procedure of unit Root. diff --git a/gcc/ada/bindo-builders.adb b/gcc/ada/bindo-builders.adb index a0e771b..66801f4 100644 --- a/gcc/ada/bindo-builders.adb +++ b/gcc/ada/bindo-builders.adb @@ -110,7 +110,8 @@ package body Bindo.Builders is Inv_Graph := Create (Initial_Vertices => Number_Of_Elaborable_Units, - Initial_Edges => Number_Of_Elaborable_Units); + Initial_Edges => Number_Of_Elaborable_Units, + Lib_Graph => Lib_G); Lib_Graph := Lib_G; For_Each_Elaborable_Unit (Create_Vertices'Access); diff --git a/gcc/ada/bindo-diagnostics.adb b/gcc/ada/bindo-diagnostics.adb index 444bc1d..c2ffe44 100644 --- a/gcc/ada/bindo-diagnostics.adb +++ b/gcc/ada/bindo-diagnostics.adb @@ -44,22 +44,18 @@ package body Bindo.Diagnostics is -- Local subprograms -- ----------------------- - procedure Diagnose_All_Cycles - (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph); + procedure Diagnose_All_Cycles (Inv_Graph : Invocation_Graph); pragma Inline (Diagnose_All_Cycles); -- Emit diagnostics for all cycles of library graph G procedure Diagnose_Cycle (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Cycle : Library_Graph_Cycle_Id); pragma Inline (Diagnose_Cycle); -- Emit diagnostics for cycle Cycle of library graph G procedure Find_And_Output_Invocation_Paths (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Source : Library_Graph_Vertex_Id; Destination : Library_Graph_Vertex_Id); pragma Inline (Find_And_Output_Invocation_Paths); @@ -69,7 +65,6 @@ package body Bindo.Diagnostics is function Find_Elaboration_Root (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Vertex : Library_Graph_Vertex_Id) return Invocation_Graph_Vertex_Id; pragma Inline (Find_Elaboration_Root); -- Find the elaboration root in invocation graph Inv_Graph that corresponds @@ -171,7 +166,6 @@ package body Bindo.Diagnostics is procedure Output_Invocation_Path (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Elaborated_Vertex : Library_Graph_Vertex_Id; Path : IGE_Lists.Doubly_Linked_List; Path_Id : in out Nat); @@ -182,11 +176,10 @@ package body Bindo.Diagnostics is procedure Output_Invocation_Path_Transition (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Edge : Invocation_Graph_Edge_Id); pragma Inline (Output_Invocation_Path_Transition); -- Output a transition through edge Edge of invocation graph G, which is - -- part of an invocation path. Lib_Graph is the related library graph. + -- part of an invocation path. procedure Output_Invocation_Related_Suggestions (G : Library_Graph; @@ -197,7 +190,6 @@ package body Bindo.Diagnostics is procedure Output_Invocation_Transition (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Source : Library_Graph_Vertex_Id; Destination : Library_Graph_Vertex_Id); pragma Inline (Output_Invocation_Transition); @@ -222,7 +214,6 @@ package body Bindo.Diagnostics is procedure Output_Transition (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Current_Edge : Library_Graph_Edge_Id; Next_Edge : Library_Graph_Edge_Id; Elaborate_All_Active : Boolean); @@ -247,7 +238,6 @@ package body Bindo.Diagnostics is procedure Visit_Vertex (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Invoker : Invocation_Graph_Vertex_Id; Invoker_Vertex : Library_Graph_Vertex_Id; Last_Vertex : Library_Graph_Vertex_Id; @@ -269,10 +259,9 @@ package body Bindo.Diagnostics is -- Diagnose_All_Cycles -- ------------------------- - procedure Diagnose_All_Cycles - (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph) - is + procedure Diagnose_All_Cycles (Inv_Graph : Invocation_Graph) is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph); + Cycle : Library_Graph_Cycle_Id; Iter : All_Cycle_Iterator; @@ -284,10 +273,7 @@ package body Bindo.Diagnostics is while Has_Next (Iter) loop Next (Iter, Cycle); - Diagnose_Cycle - (Inv_Graph => Inv_Graph, - Lib_Graph => Lib_Graph, - Cycle => Cycle); + Diagnose_Cycle (Inv_Graph => Inv_Graph, Cycle => Cycle); end loop; end Diagnose_All_Cycles; @@ -295,10 +281,8 @@ package body Bindo.Diagnostics is -- Diagnose_Circularities -- ---------------------------- - procedure Diagnose_Circularities - (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph) - is + procedure Diagnose_Circularities (Inv_Graph : Invocation_Graph) is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph); begin pragma Assert (Present (Inv_Graph)); pragma Assert (Present (Lib_Graph)); @@ -313,14 +297,13 @@ package body Bindo.Diagnostics is -- switch -d_C (diagnose all cycles) is in effect. if Debug_Flag_Underscore_CC then - Diagnose_All_Cycles (Inv_Graph, Lib_Graph); + Diagnose_All_Cycles (Inv_Graph); -- Otherwise diagnose the most important cycle in the graph else Diagnose_Cycle (Inv_Graph => Inv_Graph, - Lib_Graph => Lib_Graph, Cycle => Highest_Precedence_Cycle (Lib_Graph)); end if; end Diagnose_Circularities; @@ -331,9 +314,10 @@ package body Bindo.Diagnostics is procedure Diagnose_Cycle (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Cycle : Library_Graph_Cycle_Id) is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph); + pragma Assert (Present (Inv_Graph)); pragma Assert (Present (Lib_Graph)); pragma Assert (Present (Cycle)); @@ -382,7 +366,6 @@ package body Bindo.Diagnostics is Output_Transition (Inv_Graph => Inv_Graph, - Lib_Graph => Lib_Graph, Current_Edge => Current_Edge, Next_Edge => Next_Edge, Elaborate_All_Active => Elaborate_All_Active); @@ -394,7 +377,6 @@ package body Bindo.Diagnostics is Output_Transition (Inv_Graph => Inv_Graph, - Lib_Graph => Lib_Graph, Current_Edge => Current_Edge, Next_Edge => First_Edge, Elaborate_All_Active => Elaborate_All_Active); @@ -415,10 +397,11 @@ package body Bindo.Diagnostics is procedure Find_And_Output_Invocation_Paths (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Source : Library_Graph_Vertex_Id; Destination : Library_Graph_Vertex_Id) is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph); + Path : IGE_Lists.Doubly_Linked_List; Path_Id : Nat; Visited : IGV_Sets.Membership_Set; @@ -449,11 +432,9 @@ package body Bindo.Diagnostics is Visit_Vertex (Inv_Graph => Inv_Graph, - Lib_Graph => Lib_Graph, Invoker => Find_Elaboration_Root (Inv_Graph => Inv_Graph, - Lib_Graph => Lib_Graph, Vertex => Source), Invoker_Vertex => Source, Last_Vertex => Source, @@ -473,9 +454,10 @@ package body Bindo.Diagnostics is function Find_Elaboration_Root (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Vertex : Library_Graph_Vertex_Id) return Invocation_Graph_Vertex_Id is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph); + Current_Vertex : Invocation_Graph_Vertex_Id; Iter : Elaboration_Root_Iterator; Root_Vertex : Invocation_Graph_Vertex_Id; @@ -982,11 +964,12 @@ package body Bindo.Diagnostics is procedure Output_Invocation_Path (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Elaborated_Vertex : Library_Graph_Vertex_Id; Path : IGE_Lists.Doubly_Linked_List; Path_Id : in out Nat) is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph); + Edge : Invocation_Graph_Edge_Id; Iter : IGE_Lists.Iterator; @@ -1007,9 +990,7 @@ package body Bindo.Diagnostics is IGE_Lists.Next (Iter, Edge); Output_Invocation_Path_Transition - (Inv_Graph => Inv_Graph, - Lib_Graph => Lib_Graph, - Edge => Edge); + (Inv_Graph => Inv_Graph, Edge => Edge); end loop; Path_Id := Path_Id + 1; @@ -1021,9 +1002,10 @@ package body Bindo.Diagnostics is procedure Output_Invocation_Path_Transition (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Edge : Invocation_Graph_Edge_Id) is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph); + pragma Assert (Present (Inv_Graph)); pragma Assert (Present (Lib_Graph)); pragma Assert (Present (Edge)); @@ -1186,10 +1168,10 @@ package body Bindo.Diagnostics is procedure Output_Invocation_Transition (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Source : Library_Graph_Vertex_Id; Destination : Library_Graph_Vertex_Id) is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph); begin pragma Assert (Present (Inv_Graph)); pragma Assert (Present (Lib_Graph)); @@ -1203,7 +1185,6 @@ package body Bindo.Diagnostics is Find_And_Output_Invocation_Paths (Inv_Graph => Inv_Graph, - Lib_Graph => Lib_Graph, Source => Source, Destination => Destination); end Output_Invocation_Transition; @@ -1302,11 +1283,12 @@ package body Bindo.Diagnostics is procedure Output_Transition (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Current_Edge : Library_Graph_Edge_Id; Next_Edge : Library_Graph_Edge_Id; Elaborate_All_Active : Boolean) is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph); + pragma Assert (Present (Inv_Graph)); pragma Assert (Present (Lib_Graph)); pragma Assert (Present (Current_Edge)); @@ -1353,7 +1335,6 @@ package body Bindo.Diagnostics is elsif Is_Invocation_Edge (Lib_Graph, Current_Edge) then Output_Invocation_Transition (Inv_Graph => Inv_Graph, - Lib_Graph => Lib_Graph, Source => Source, Destination => Expected_Destination); @@ -1466,7 +1447,6 @@ package body Bindo.Diagnostics is procedure Visit_Vertex (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Invoker : Invocation_Graph_Vertex_Id; Invoker_Vertex : Library_Graph_Vertex_Id; Last_Vertex : Library_Graph_Vertex_Id; @@ -1476,6 +1456,8 @@ package body Bindo.Diagnostics is Path : IGE_Lists.Doubly_Linked_List; Path_Id : in out Nat) is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph); + Edge : Invocation_Graph_Edge_Id; Iter : Edges_To_Targets_Iterator; Targ : Invocation_Graph_Vertex_Id; @@ -1500,7 +1482,6 @@ package body Bindo.Diagnostics is then Output_Invocation_Path (Inv_Graph => Inv_Graph, - Lib_Graph => Lib_Graph, Elaborated_Vertex => Elaborated_Vertex, Path => Path, Path_Id => Path_Id); @@ -1531,7 +1512,6 @@ package body Bindo.Diagnostics is Visit_Vertex (Inv_Graph => Inv_Graph, - Lib_Graph => Lib_Graph, Invoker => Targ, Invoker_Vertex => Body_Vertex (Inv_Graph, Targ), Last_Vertex => Invoker_Vertex, diff --git a/gcc/ada/bindo-diagnostics.ads b/gcc/ada/bindo-diagnostics.ads index 9c24c14..24f4f52 100644 --- a/gcc/ada/bindo-diagnostics.ads +++ b/gcc/ada/bindo-diagnostics.ads @@ -51,11 +51,9 @@ package Bindo.Diagnostics is -- API -- --------- - procedure Diagnose_Circularities - (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph); + procedure Diagnose_Circularities (Inv_Graph : Invocation_Graph); pragma Inline (Diagnose_Circularities); - -- Diagnose all cycles of library graph Lib_Graph with matching invocation - -- graph Inv_Graph. + -- Diagnose all cycles of the library graph of Inv_Graph with matching + -- invocation graph Inv_Graph. end Bindo.Diagnostics; diff --git a/gcc/ada/bindo-elaborators.adb b/gcc/ada/bindo-elaborators.adb index d5459d1..f36b915 100644 --- a/gcc/ada/bindo-elaborators.adb +++ b/gcc/ada/bindo-elaborators.adb @@ -733,7 +733,7 @@ package body Bindo.Elaborators is -- order to discover transitions of the execution flow from a unit -- to a unit that result in extra edges within the library graph. - Augment_Library_Graph (Inv_Graph, Lib_Graph); + Augment_Library_Graph (Inv_Graph); -- Create the component graph by collapsing all library items into -- library units and traversing the library graph. @@ -780,7 +780,7 @@ package body Bindo.Elaborators is -- Otherwise the library graph contains at least one circularity else - Diagnose_Circularities (Inv_Graph, Lib_Graph); + Diagnose_Circularities (Inv_Graph); end if; Destroy (Inv_Graph); diff --git a/gcc/ada/bindo-graphs.adb b/gcc/ada/bindo-graphs.adb index c6a091f..3b2b753 100644 --- a/gcc/ada/bindo-graphs.adb +++ b/gcc/ada/bindo-graphs.adb @@ -172,867 +172,6 @@ package body Bindo.Graphs is return Bucket_Range_Type (Vertex); end Hash_Library_Graph_Vertex; - ----------------------- - -- Invocation_Graphs -- - ----------------------- - - package body Invocation_Graphs is - - ----------------------- - -- Local subprograms -- - ----------------------- - - procedure Free is - new Ada.Unchecked_Deallocation - (Invocation_Graph_Attributes, Invocation_Graph); - - function Get_IGE_Attributes - (G : Invocation_Graph; - Edge : Invocation_Graph_Edge_Id) - return Invocation_Graph_Edge_Attributes; - pragma Inline (Get_IGE_Attributes); - -- Obtain the attributes of edge Edge of invocation graph G - - function Get_IGV_Attributes - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) - return Invocation_Graph_Vertex_Attributes; - pragma Inline (Get_IGV_Attributes); - -- Obtain the attributes of vertex Vertex of invocation graph G - - procedure Increment_Invocation_Graph_Edge_Count - (G : Invocation_Graph; - Kind : Invocation_Kind); - pragma Inline (Increment_Invocation_Graph_Edge_Count); - -- Increment the number of edges of king Kind in invocation graph G by - -- one. - - function Is_Elaboration_Root - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Boolean; - pragma Inline (Is_Elaboration_Root); - -- Determine whether vertex Vertex of invocation graph denotes the - -- elaboration procedure of a spec or a body. - - function Is_Existing_Source_Target_Relation - (G : Invocation_Graph; - Rel : Source_Target_Relation) return Boolean; - pragma Inline (Is_Existing_Source_Target_Relation); - -- Determine whether a source vertex and a target vertex described by - -- relation Rel are already related in invocation graph G. - - procedure Save_Elaboration_Root - (G : Invocation_Graph; - Root : Invocation_Graph_Vertex_Id); - pragma Inline (Save_Elaboration_Root); - -- Save elaboration root Root of invocation graph G - - procedure Set_Corresponding_Vertex - (G : Invocation_Graph; - IS_Id : Invocation_Signature_Id; - Vertex : Invocation_Graph_Vertex_Id); - pragma Inline (Set_Corresponding_Vertex); - -- Associate vertex Vertex of invocation graph G with signature IS_Id - - procedure Set_Is_Existing_Source_Target_Relation - (G : Invocation_Graph; - Rel : Source_Target_Relation; - Val : Boolean := True); - pragma Inline (Set_Is_Existing_Source_Target_Relation); - -- Mark a source vertex and a target vertex described by relation Rel as - -- already related in invocation graph G depending on value Val. - - procedure Set_IGE_Attributes - (G : Invocation_Graph; - Edge : Invocation_Graph_Edge_Id; - Val : Invocation_Graph_Edge_Attributes); - pragma Inline (Set_IGE_Attributes); - -- Set the attributes of edge Edge of invocation graph G to value Val - - procedure Set_IGV_Attributes - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id; - Val : Invocation_Graph_Vertex_Attributes); - pragma Inline (Set_IGV_Attributes); - -- Set the attributes of vertex Vertex of invocation graph G to value - -- Val. - - -------------- - -- Add_Edge -- - -------------- - - procedure Add_Edge - (G : Invocation_Graph; - Source : Invocation_Graph_Vertex_Id; - Target : Invocation_Graph_Vertex_Id; - IR_Id : Invocation_Relation_Id) - is - pragma Assert (Present (G)); - pragma Assert (Present (Source)); - pragma Assert (Present (Target)); - pragma Assert (Present (IR_Id)); - - Rel : constant Source_Target_Relation := - (Source => Source, - Target => Target); - - Edge : Invocation_Graph_Edge_Id; - - begin - -- Nothing to do when the source and target are already related by an - -- edge. - - if Is_Existing_Source_Target_Relation (G, Rel) then - return; - end if; - - Edge := Sequence_Next_Edge; - - -- Add the edge to the underlying graph - - DG.Add_Edge - (G => G.Graph, - E => Edge, - Source => Source, - Destination => Target); - - -- Build and save the attributes of the edge - - Set_IGE_Attributes - (G => G, - Edge => Edge, - Val => (Relation => IR_Id)); - - -- Mark the source and target as related by the new edge. This - -- prevents all further attempts to link the same source and target. - - Set_Is_Existing_Source_Target_Relation (G, Rel); - - -- Update the edge statistics - - Increment_Invocation_Graph_Edge_Count (G, Kind (IR_Id)); - end Add_Edge; - - ---------------- - -- Add_Vertex -- - ---------------- - - procedure Add_Vertex - (G : Invocation_Graph; - IC_Id : Invocation_Construct_Id; - Body_Vertex : Library_Graph_Vertex_Id; - Spec_Vertex : Library_Graph_Vertex_Id) - is - pragma Assert (Present (G)); - pragma Assert (Present (IC_Id)); - pragma Assert (Present (Body_Vertex)); - pragma Assert (Present (Spec_Vertex)); - - Construct_Signature : constant Invocation_Signature_Id := - Signature (IC_Id); - Vertex : Invocation_Graph_Vertex_Id; - - begin - -- Nothing to do when the construct already has a vertex - - if Present (Corresponding_Vertex (G, Construct_Signature)) then - return; - end if; - - Vertex := Sequence_Next_Vertex; - - -- Add the vertex to the underlying graph - - DG.Add_Vertex (G.Graph, Vertex); - - -- Build and save the attributes of the vertex - - Set_IGV_Attributes - (G => G, - Vertex => Vertex, - Val => (Body_Vertex => Body_Vertex, - Construct => IC_Id, - Spec_Vertex => Spec_Vertex)); - - -- Associate the construct with its corresponding vertex - - Set_Corresponding_Vertex (G, Construct_Signature, Vertex); - - -- Save the vertex for later processing when it denotes a spec or - -- body elaboration procedure. - - if Is_Elaboration_Root (G, Vertex) then - Save_Elaboration_Root (G, Vertex); - end if; - end Add_Vertex; - - ----------------- - -- Body_Vertex -- - ----------------- - - function Body_Vertex - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); - - return Get_IGV_Attributes (G, Vertex).Body_Vertex; - end Body_Vertex; - - ------------ - -- Column -- - ------------ - - function Column - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Nat - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); - - return Column (Signature (Construct (G, Vertex))); - end Column; - - --------------- - -- Construct -- - --------------- - - function Construct - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Invocation_Construct_Id - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); - - return Get_IGV_Attributes (G, Vertex).Construct; - end Construct; - - -------------------------- - -- Corresponding_Vertex -- - -------------------------- - - function Corresponding_Vertex - (G : Invocation_Graph; - IS_Id : Invocation_Signature_Id) return Invocation_Graph_Vertex_Id - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (IS_Id)); - - return Signature_Tables.Get (G.Signature_To_Vertex, IS_Id); - end Corresponding_Vertex; - - ------------ - -- Create -- - ------------ - - function Create - (Initial_Vertices : Positive; - Initial_Edges : Positive) return Invocation_Graph - is - G : constant Invocation_Graph := new Invocation_Graph_Attributes; - - begin - G.Edge_Attributes := IGE_Tables.Create (Initial_Edges); - G.Graph := - DG.Create - (Initial_Vertices => Initial_Vertices, - Initial_Edges => Initial_Edges); - G.Relations := Relation_Sets.Create (Initial_Edges); - G.Roots := IGV_Sets.Create (Initial_Vertices); - G.Signature_To_Vertex := Signature_Tables.Create (Initial_Vertices); - G.Vertex_Attributes := IGV_Tables.Create (Initial_Vertices); - - return G; - end Create; - - ------------- - -- Destroy -- - ------------- - - procedure Destroy (G : in out Invocation_Graph) is - begin - pragma Assert (Present (G)); - - IGE_Tables.Destroy (G.Edge_Attributes); - DG.Destroy (G.Graph); - Relation_Sets.Destroy (G.Relations); - IGV_Sets.Destroy (G.Roots); - Signature_Tables.Destroy (G.Signature_To_Vertex); - IGV_Tables.Destroy (G.Vertex_Attributes); - - Free (G); - end Destroy; - - ----------------------------------- - -- Destroy_Invocation_Graph_Edge -- - ----------------------------------- - - procedure Destroy_Invocation_Graph_Edge - (Edge : in out Invocation_Graph_Edge_Id) - is - pragma Unreferenced (Edge); - begin - null; - end Destroy_Invocation_Graph_Edge; - - ---------------------------------------------- - -- Destroy_Invocation_Graph_Edge_Attributes -- - ---------------------------------------------- - - procedure Destroy_Invocation_Graph_Edge_Attributes - (Attrs : in out Invocation_Graph_Edge_Attributes) - is - pragma Unreferenced (Attrs); - begin - null; - end Destroy_Invocation_Graph_Edge_Attributes; - - ------------------------------------- - -- Destroy_Invocation_Graph_Vertex -- - ------------------------------------- - - procedure Destroy_Invocation_Graph_Vertex - (Vertex : in out Invocation_Graph_Vertex_Id) - is - pragma Unreferenced (Vertex); - begin - null; - end Destroy_Invocation_Graph_Vertex; - - ------------------------------------------------ - -- Destroy_Invocation_Graph_Vertex_Attributes -- - ------------------------------------------------ - - procedure Destroy_Invocation_Graph_Vertex_Attributes - (Attrs : in out Invocation_Graph_Vertex_Attributes) - is - pragma Unreferenced (Attrs); - begin - null; - end Destroy_Invocation_Graph_Vertex_Attributes; - - ----------- - -- Extra -- - ----------- - - function Extra - (G : Invocation_Graph; - Edge : Invocation_Graph_Edge_Id) return Name_Id - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Edge)); - - return Extra (Relation (G, Edge)); - end Extra; - - ------------------------ - -- Get_IGE_Attributes -- - ------------------------ - - function Get_IGE_Attributes - (G : Invocation_Graph; - Edge : Invocation_Graph_Edge_Id) - return Invocation_Graph_Edge_Attributes - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Edge)); - - return IGE_Tables.Get (G.Edge_Attributes, Edge); - end Get_IGE_Attributes; - - ------------------------ - -- Get_IGV_Attributes -- - ------------------------ - - function Get_IGV_Attributes - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) - return Invocation_Graph_Vertex_Attributes - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); - - return IGV_Tables.Get (G.Vertex_Attributes, Vertex); - end Get_IGV_Attributes; - - -------------- - -- Has_Next -- - -------------- - - function Has_Next (Iter : All_Edge_Iterator) return Boolean is - begin - return DG.Has_Next (DG.All_Edge_Iterator (Iter)); - end Has_Next; - - -------------- - -- Has_Next -- - -------------- - - function Has_Next (Iter : All_Vertex_Iterator) return Boolean is - begin - return DG.Has_Next (DG.All_Vertex_Iterator (Iter)); - end Has_Next; - - -------------- - -- Has_Next -- - -------------- - - function Has_Next (Iter : Edges_To_Targets_Iterator) return Boolean is - begin - return DG.Has_Next (DG.Outgoing_Edge_Iterator (Iter)); - end Has_Next; - - -------------- - -- Has_Next -- - -------------- - - function Has_Next (Iter : Elaboration_Root_Iterator) return Boolean is - begin - return IGV_Sets.Has_Next (IGV_Sets.Iterator (Iter)); - end Has_Next; - - ------------------------------- - -- Hash_Invocation_Signature -- - ------------------------------- - - function Hash_Invocation_Signature - (IS_Id : Invocation_Signature_Id) return Bucket_Range_Type - is - begin - pragma Assert (Present (IS_Id)); - - return Bucket_Range_Type (IS_Id); - end Hash_Invocation_Signature; - - --------------------------------- - -- Hash_Source_Target_Relation -- - --------------------------------- - - function Hash_Source_Target_Relation - (Rel : Source_Target_Relation) return Bucket_Range_Type - is - begin - pragma Assert (Present (Rel.Source)); - pragma Assert (Present (Rel.Target)); - - return - Hash_Two_Keys - (Bucket_Range_Type (Rel.Source), - Bucket_Range_Type (Rel.Target)); - end Hash_Source_Target_Relation; - - ------------------------------------------- - -- Increment_Invocation_Graph_Edge_Count -- - ------------------------------------------- - - procedure Increment_Invocation_Graph_Edge_Count - (G : Invocation_Graph; - Kind : Invocation_Kind) - is - pragma Assert (Present (G)); - - Count : Natural renames G.Counts (Kind); - - begin - Count := Count + 1; - end Increment_Invocation_Graph_Edge_Count; - - --------------------------------- - -- Invocation_Graph_Edge_Count -- - --------------------------------- - - function Invocation_Graph_Edge_Count - (G : Invocation_Graph; - Kind : Invocation_Kind) return Natural - is - begin - pragma Assert (Present (G)); - - return G.Counts (Kind); - end Invocation_Graph_Edge_Count; - - ------------------------- - -- Is_Elaboration_Root -- - ------------------------- - - function Is_Elaboration_Root - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Boolean - is - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); - - Vertex_Kind : constant Invocation_Construct_Kind := - Kind (Construct (G, Vertex)); - - begin - return - Vertex_Kind = Elaborate_Body_Procedure - or else - Vertex_Kind = Elaborate_Spec_Procedure; - end Is_Elaboration_Root; - - ---------------------------------------- - -- Is_Existing_Source_Target_Relation -- - ---------------------------------------- - - function Is_Existing_Source_Target_Relation - (G : Invocation_Graph; - Rel : Source_Target_Relation) return Boolean - is - begin - pragma Assert (Present (G)); - - return Relation_Sets.Contains (G.Relations, Rel); - end Is_Existing_Source_Target_Relation; - - ----------------------- - -- Iterate_All_Edges -- - ----------------------- - - function Iterate_All_Edges - (G : Invocation_Graph) return All_Edge_Iterator - is - begin - pragma Assert (Present (G)); - - return All_Edge_Iterator (DG.Iterate_All_Edges (G.Graph)); - end Iterate_All_Edges; - - -------------------------- - -- Iterate_All_Vertices -- - -------------------------- - - function Iterate_All_Vertices - (G : Invocation_Graph) return All_Vertex_Iterator - is - begin - pragma Assert (Present (G)); - - return All_Vertex_Iterator (DG.Iterate_All_Vertices (G.Graph)); - end Iterate_All_Vertices; - - ------------------------------ - -- Iterate_Edges_To_Targets -- - ------------------------------ - - function Iterate_Edges_To_Targets - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Edges_To_Targets_Iterator - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); - - return - Edges_To_Targets_Iterator - (DG.Iterate_Outgoing_Edges (G.Graph, Vertex)); - end Iterate_Edges_To_Targets; - - ------------------------------- - -- Iterate_Elaboration_Roots -- - ------------------------------- - - function Iterate_Elaboration_Roots - (G : Invocation_Graph) return Elaboration_Root_Iterator - is - begin - pragma Assert (Present (G)); - - return Elaboration_Root_Iterator (IGV_Sets.Iterate (G.Roots)); - end Iterate_Elaboration_Roots; - - ---------- - -- Kind -- - ---------- - - function Kind - (G : Invocation_Graph; - Edge : Invocation_Graph_Edge_Id) return Invocation_Kind - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Edge)); - - return Kind (Relation (G, Edge)); - end Kind; - - ---------- - -- Line -- - ---------- - - function Line - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Nat - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); - - return Line (Signature (Construct (G, Vertex))); - end Line; - - ---------- - -- Name -- - ---------- - - function Name - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Name_Id - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); - - return Name (Signature (Construct (G, Vertex))); - end Name; - - ---------- - -- Next -- - ---------- - - procedure Next - (Iter : in out All_Edge_Iterator; - Edge : out Invocation_Graph_Edge_Id) - is - begin - DG.Next (DG.All_Edge_Iterator (Iter), Edge); - end Next; - - ---------- - -- Next -- - ---------- - - procedure Next - (Iter : in out All_Vertex_Iterator; - Vertex : out Invocation_Graph_Vertex_Id) - is - begin - DG.Next (DG.All_Vertex_Iterator (Iter), Vertex); - end Next; - - ---------- - -- Next -- - ---------- - - procedure Next - (Iter : in out Edges_To_Targets_Iterator; - Edge : out Invocation_Graph_Edge_Id) - is - begin - DG.Next (DG.Outgoing_Edge_Iterator (Iter), Edge); - end Next; - - ---------- - -- Next -- - ---------- - - procedure Next - (Iter : in out Elaboration_Root_Iterator; - Root : out Invocation_Graph_Vertex_Id) - is - begin - IGV_Sets.Next (IGV_Sets.Iterator (Iter), Root); - end Next; - - --------------------- - -- Number_Of_Edges -- - --------------------- - - function Number_Of_Edges (G : Invocation_Graph) return Natural is - begin - pragma Assert (Present (G)); - - return DG.Number_Of_Edges (G.Graph); - end Number_Of_Edges; - - -------------------------------- - -- Number_Of_Edges_To_Targets -- - -------------------------------- - - function Number_Of_Edges_To_Targets - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Natural - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); - - return DG.Number_Of_Outgoing_Edges (G.Graph, Vertex); - end Number_Of_Edges_To_Targets; - - --------------------------------- - -- Number_Of_Elaboration_Roots -- - --------------------------------- - - function Number_Of_Elaboration_Roots - (G : Invocation_Graph) return Natural - is - begin - pragma Assert (Present (G)); - - return IGV_Sets.Size (G.Roots); - end Number_Of_Elaboration_Roots; - - ------------------------ - -- Number_Of_Vertices -- - ------------------------ - - function Number_Of_Vertices (G : Invocation_Graph) return Natural is - begin - pragma Assert (Present (G)); - - return DG.Number_Of_Vertices (G.Graph); - end Number_Of_Vertices; - - ------------- - -- Present -- - ------------- - - function Present (G : Invocation_Graph) return Boolean is - begin - return G /= Nil; - end Present; - - -------------- - -- Relation -- - -------------- - - function Relation - (G : Invocation_Graph; - Edge : Invocation_Graph_Edge_Id) return Invocation_Relation_Id - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Edge)); - - return Get_IGE_Attributes (G, Edge).Relation; - end Relation; - - --------------------------- - -- Save_Elaboration_Root -- - --------------------------- - - procedure Save_Elaboration_Root - (G : Invocation_Graph; - Root : Invocation_Graph_Vertex_Id) - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Root)); - - IGV_Sets.Insert (G.Roots, Root); - end Save_Elaboration_Root; - - ------------------------------ - -- Set_Corresponding_Vertex -- - ------------------------------ - - procedure Set_Corresponding_Vertex - (G : Invocation_Graph; - IS_Id : Invocation_Signature_Id; - Vertex : Invocation_Graph_Vertex_Id) - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (IS_Id)); - pragma Assert (Present (Vertex)); - - Signature_Tables.Put (G.Signature_To_Vertex, IS_Id, Vertex); - end Set_Corresponding_Vertex; - - -------------------------------------------- - -- Set_Is_Existing_Source_Target_Relation -- - -------------------------------------------- - - procedure Set_Is_Existing_Source_Target_Relation - (G : Invocation_Graph; - Rel : Source_Target_Relation; - Val : Boolean := True) - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Rel.Source)); - pragma Assert (Present (Rel.Target)); - - if Val then - Relation_Sets.Insert (G.Relations, Rel); - else - Relation_Sets.Delete (G.Relations, Rel); - end if; - end Set_Is_Existing_Source_Target_Relation; - - ------------------------ - -- Set_IGE_Attributes -- - ------------------------ - - procedure Set_IGE_Attributes - (G : Invocation_Graph; - Edge : Invocation_Graph_Edge_Id; - Val : Invocation_Graph_Edge_Attributes) - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Edge)); - - IGE_Tables.Put (G.Edge_Attributes, Edge, Val); - end Set_IGE_Attributes; - - ------------------------ - -- Set_IGV_Attributes -- - ------------------------ - - procedure Set_IGV_Attributes - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id; - Val : Invocation_Graph_Vertex_Attributes) - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); - - IGV_Tables.Put (G.Vertex_Attributes, Vertex, Val); - end Set_IGV_Attributes; - - ----------------- - -- Spec_Vertex -- - ----------------- - - function Spec_Vertex - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); - - return Get_IGV_Attributes (G, Vertex).Spec_Vertex; - end Spec_Vertex; - - ------------ - -- Target -- - ------------ - - function Target - (G : Invocation_Graph; - Edge : Invocation_Graph_Edge_Id) return Invocation_Graph_Vertex_Id - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Edge)); - - return DG.Destination_Vertex (G.Graph, Edge); - end Target; - end Invocation_Graphs; - -------------------- -- Library_Graphs -- -------------------- @@ -5700,6 +4839,881 @@ package body Bindo.Graphs is end Visit; end Library_Graphs; + ----------------------- + -- Invocation_Graphs -- + ----------------------- + + package body Invocation_Graphs is + + ----------------------- + -- Local subprograms -- + ----------------------- + + procedure Free is + new Ada.Unchecked_Deallocation + (Invocation_Graph_Attributes, Invocation_Graph); + + function Get_IGE_Attributes + (G : Invocation_Graph; + Edge : Invocation_Graph_Edge_Id) + return Invocation_Graph_Edge_Attributes; + pragma Inline (Get_IGE_Attributes); + -- Obtain the attributes of edge Edge of invocation graph G + + function Get_IGV_Attributes + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) + return Invocation_Graph_Vertex_Attributes; + pragma Inline (Get_IGV_Attributes); + -- Obtain the attributes of vertex Vertex of invocation graph G + + procedure Increment_Invocation_Graph_Edge_Count + (G : Invocation_Graph; + Kind : Invocation_Kind); + pragma Inline (Increment_Invocation_Graph_Edge_Count); + -- Increment the number of edges of king Kind in invocation graph G by + -- one. + + function Is_Elaboration_Root + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Boolean; + pragma Inline (Is_Elaboration_Root); + -- Determine whether vertex Vertex of invocation graph denotes the + -- elaboration procedure of a spec or a body. + + function Is_Existing_Source_Target_Relation + (G : Invocation_Graph; + Rel : Source_Target_Relation) return Boolean; + pragma Inline (Is_Existing_Source_Target_Relation); + -- Determine whether a source vertex and a target vertex described by + -- relation Rel are already related in invocation graph G. + + procedure Save_Elaboration_Root + (G : Invocation_Graph; + Root : Invocation_Graph_Vertex_Id); + pragma Inline (Save_Elaboration_Root); + -- Save elaboration root Root of invocation graph G + + procedure Set_Corresponding_Vertex + (G : Invocation_Graph; + IS_Id : Invocation_Signature_Id; + Vertex : Invocation_Graph_Vertex_Id); + pragma Inline (Set_Corresponding_Vertex); + -- Associate vertex Vertex of invocation graph G with signature IS_Id + + procedure Set_Is_Existing_Source_Target_Relation + (G : Invocation_Graph; + Rel : Source_Target_Relation; + Val : Boolean := True); + pragma Inline (Set_Is_Existing_Source_Target_Relation); + -- Mark a source vertex and a target vertex described by relation Rel as + -- already related in invocation graph G depending on value Val. + + procedure Set_IGE_Attributes + (G : Invocation_Graph; + Edge : Invocation_Graph_Edge_Id; + Val : Invocation_Graph_Edge_Attributes); + pragma Inline (Set_IGE_Attributes); + -- Set the attributes of edge Edge of invocation graph G to value Val + + procedure Set_IGV_Attributes + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id; + Val : Invocation_Graph_Vertex_Attributes); + pragma Inline (Set_IGV_Attributes); + -- Set the attributes of vertex Vertex of invocation graph G to value + -- Val. + + -------------- + -- Add_Edge -- + -------------- + + procedure Add_Edge + (G : Invocation_Graph; + Source : Invocation_Graph_Vertex_Id; + Target : Invocation_Graph_Vertex_Id; + IR_Id : Invocation_Relation_Id) + is + pragma Assert (Present (G)); + pragma Assert (Present (Source)); + pragma Assert (Present (Target)); + pragma Assert (Present (IR_Id)); + + Rel : constant Source_Target_Relation := + (Source => Source, + Target => Target); + + Edge : Invocation_Graph_Edge_Id; + + begin + -- Nothing to do when the source and target are already related by an + -- edge. + + if Is_Existing_Source_Target_Relation (G, Rel) then + return; + end if; + + Edge := Sequence_Next_Edge; + + -- Add the edge to the underlying graph + + DG.Add_Edge + (G => G.Graph, + E => Edge, + Source => Source, + Destination => Target); + + -- Build and save the attributes of the edge + + Set_IGE_Attributes + (G => G, + Edge => Edge, + Val => (Relation => IR_Id)); + + -- Mark the source and target as related by the new edge. This + -- prevents all further attempts to link the same source and target. + + Set_Is_Existing_Source_Target_Relation (G, Rel); + + -- Update the edge statistics + + Increment_Invocation_Graph_Edge_Count (G, Kind (IR_Id)); + end Add_Edge; + + ---------------- + -- Add_Vertex -- + ---------------- + + procedure Add_Vertex + (G : Invocation_Graph; + IC_Id : Invocation_Construct_Id; + Body_Vertex : Library_Graph_Vertex_Id; + Spec_Vertex : Library_Graph_Vertex_Id) + is + pragma Assert (Present (G)); + pragma Assert (Present (IC_Id)); + pragma Assert (Present (Body_Vertex)); + pragma Assert (Present (Spec_Vertex)); + + Construct_Signature : constant Invocation_Signature_Id := + Signature (IC_Id); + Vertex : Invocation_Graph_Vertex_Id; + + begin + -- Nothing to do when the construct already has a vertex + + if Present (Corresponding_Vertex (G, Construct_Signature)) then + return; + end if; + + Vertex := Sequence_Next_Vertex; + + -- Add the vertex to the underlying graph + + DG.Add_Vertex (G.Graph, Vertex); + + -- Build and save the attributes of the vertex + + Set_IGV_Attributes + (G => G, + Vertex => Vertex, + Val => (Body_Vertex => Body_Vertex, + Construct => IC_Id, + Spec_Vertex => Spec_Vertex)); + + -- Associate the construct with its corresponding vertex + + Set_Corresponding_Vertex (G, Construct_Signature, Vertex); + + -- Save the vertex for later processing when it denotes a spec or + -- body elaboration procedure. + + if Is_Elaboration_Root (G, Vertex) then + Save_Elaboration_Root (G, Vertex); + end if; + end Add_Vertex; + + ----------------- + -- Body_Vertex -- + ----------------- + + function Body_Vertex + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + return Get_IGV_Attributes (G, Vertex).Body_Vertex; + end Body_Vertex; + + ------------ + -- Column -- + ------------ + + function Column + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Nat + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + return Column (Signature (Construct (G, Vertex))); + end Column; + + --------------- + -- Construct -- + --------------- + + function Construct + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Invocation_Construct_Id + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + return Get_IGV_Attributes (G, Vertex).Construct; + end Construct; + + -------------------------- + -- Corresponding_Vertex -- + -------------------------- + + function Corresponding_Vertex + (G : Invocation_Graph; + IS_Id : Invocation_Signature_Id) return Invocation_Graph_Vertex_Id + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (IS_Id)); + + return Signature_Tables.Get (G.Signature_To_Vertex, IS_Id); + end Corresponding_Vertex; + + ------------ + -- Create -- + ------------ + + function Create + (Initial_Vertices : Positive; + Initial_Edges : Positive; + Lib_Graph : Library_Graphs.Library_Graph) + return Invocation_Graph + is + G : constant Invocation_Graph := new Invocation_Graph_Attributes' + (Counts => <>, + Edge_Attributes => IGE_Tables.Create (Initial_Edges), + Graph => + DG.Create + (Initial_Vertices => Initial_Vertices, + Initial_Edges => Initial_Edges), + Relations => Relation_Sets.Create (Initial_Edges), + Roots => IGV_Sets.Create (Initial_Vertices), + Signature_To_Vertex => Signature_Tables.Create (Initial_Vertices), + Vertex_Attributes => IGV_Tables.Create (Initial_Vertices), + Lib_Graph => Lib_Graph); + begin + return G; + end Create; + + ------------- + -- Destroy -- + ------------- + + procedure Destroy (G : in out Invocation_Graph) is + begin + pragma Assert (Present (G)); + + IGE_Tables.Destroy (G.Edge_Attributes); + DG.Destroy (G.Graph); + Relation_Sets.Destroy (G.Relations); + IGV_Sets.Destroy (G.Roots); + Signature_Tables.Destroy (G.Signature_To_Vertex); + IGV_Tables.Destroy (G.Vertex_Attributes); + + Free (G); + end Destroy; + + ----------------------------------- + -- Destroy_Invocation_Graph_Edge -- + ----------------------------------- + + procedure Destroy_Invocation_Graph_Edge + (Edge : in out Invocation_Graph_Edge_Id) + is + pragma Unreferenced (Edge); + begin + null; + end Destroy_Invocation_Graph_Edge; + + ---------------------------------------------- + -- Destroy_Invocation_Graph_Edge_Attributes -- + ---------------------------------------------- + + procedure Destroy_Invocation_Graph_Edge_Attributes + (Attrs : in out Invocation_Graph_Edge_Attributes) + is + pragma Unreferenced (Attrs); + begin + null; + end Destroy_Invocation_Graph_Edge_Attributes; + + ------------------------------------- + -- Destroy_Invocation_Graph_Vertex -- + ------------------------------------- + + procedure Destroy_Invocation_Graph_Vertex + (Vertex : in out Invocation_Graph_Vertex_Id) + is + pragma Unreferenced (Vertex); + begin + null; + end Destroy_Invocation_Graph_Vertex; + + ------------------------------------------------ + -- Destroy_Invocation_Graph_Vertex_Attributes -- + ------------------------------------------------ + + procedure Destroy_Invocation_Graph_Vertex_Attributes + (Attrs : in out Invocation_Graph_Vertex_Attributes) + is + pragma Unreferenced (Attrs); + begin + null; + end Destroy_Invocation_Graph_Vertex_Attributes; + + ----------- + -- Extra -- + ----------- + + function Extra + (G : Invocation_Graph; + Edge : Invocation_Graph_Edge_Id) return Name_Id + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); + + return Extra (Relation (G, Edge)); + end Extra; + + ------------------------ + -- Get_IGE_Attributes -- + ------------------------ + + function Get_IGE_Attributes + (G : Invocation_Graph; + Edge : Invocation_Graph_Edge_Id) + return Invocation_Graph_Edge_Attributes + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); + + return IGE_Tables.Get (G.Edge_Attributes, Edge); + end Get_IGE_Attributes; + + ------------------------ + -- Get_IGV_Attributes -- + ------------------------ + + function Get_IGV_Attributes + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) + return Invocation_Graph_Vertex_Attributes + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + return IGV_Tables.Get (G.Vertex_Attributes, Vertex); + end Get_IGV_Attributes; + + -------------- + -- Has_Next -- + -------------- + + function Has_Next (Iter : All_Edge_Iterator) return Boolean is + begin + return DG.Has_Next (DG.All_Edge_Iterator (Iter)); + end Has_Next; + + -------------- + -- Has_Next -- + -------------- + + function Has_Next (Iter : All_Vertex_Iterator) return Boolean is + begin + return DG.Has_Next (DG.All_Vertex_Iterator (Iter)); + end Has_Next; + + -------------- + -- Has_Next -- + -------------- + + function Has_Next (Iter : Edges_To_Targets_Iterator) return Boolean is + begin + return DG.Has_Next (DG.Outgoing_Edge_Iterator (Iter)); + end Has_Next; + + -------------- + -- Has_Next -- + -------------- + + function Has_Next (Iter : Elaboration_Root_Iterator) return Boolean is + begin + return IGV_Sets.Has_Next (IGV_Sets.Iterator (Iter)); + end Has_Next; + + ------------------------------- + -- Hash_Invocation_Signature -- + ------------------------------- + + function Hash_Invocation_Signature + (IS_Id : Invocation_Signature_Id) return Bucket_Range_Type + is + begin + pragma Assert (Present (IS_Id)); + + return Bucket_Range_Type (IS_Id); + end Hash_Invocation_Signature; + + --------------------------------- + -- Hash_Source_Target_Relation -- + --------------------------------- + + function Hash_Source_Target_Relation + (Rel : Source_Target_Relation) return Bucket_Range_Type + is + begin + pragma Assert (Present (Rel.Source)); + pragma Assert (Present (Rel.Target)); + + return + Hash_Two_Keys + (Bucket_Range_Type (Rel.Source), + Bucket_Range_Type (Rel.Target)); + end Hash_Source_Target_Relation; + + ------------------------------------------- + -- Increment_Invocation_Graph_Edge_Count -- + ------------------------------------------- + + procedure Increment_Invocation_Graph_Edge_Count + (G : Invocation_Graph; + Kind : Invocation_Kind) + is + pragma Assert (Present (G)); + + Count : Natural renames G.Counts (Kind); + + begin + Count := Count + 1; + end Increment_Invocation_Graph_Edge_Count; + + --------------------------------- + -- Invocation_Graph_Edge_Count -- + --------------------------------- + + function Invocation_Graph_Edge_Count + (G : Invocation_Graph; + Kind : Invocation_Kind) return Natural + is + begin + pragma Assert (Present (G)); + + return G.Counts (Kind); + end Invocation_Graph_Edge_Count; + + ------------------------- + -- Is_Elaboration_Root -- + ------------------------- + + function Is_Elaboration_Root + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Boolean + is + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + Vertex_Kind : constant Invocation_Construct_Kind := + Kind (Construct (G, Vertex)); + + begin + return + Vertex_Kind = Elaborate_Body_Procedure + or else + Vertex_Kind = Elaborate_Spec_Procedure; + end Is_Elaboration_Root; + + ---------------------------------------- + -- Is_Existing_Source_Target_Relation -- + ---------------------------------------- + + function Is_Existing_Source_Target_Relation + (G : Invocation_Graph; + Rel : Source_Target_Relation) return Boolean + is + begin + pragma Assert (Present (G)); + + return Relation_Sets.Contains (G.Relations, Rel); + end Is_Existing_Source_Target_Relation; + + ----------------------- + -- Iterate_All_Edges -- + ----------------------- + + function Iterate_All_Edges + (G : Invocation_Graph) return All_Edge_Iterator + is + begin + pragma Assert (Present (G)); + + return All_Edge_Iterator (DG.Iterate_All_Edges (G.Graph)); + end Iterate_All_Edges; + + -------------------------- + -- Iterate_All_Vertices -- + -------------------------- + + function Iterate_All_Vertices + (G : Invocation_Graph) return All_Vertex_Iterator + is + begin + pragma Assert (Present (G)); + + return All_Vertex_Iterator (DG.Iterate_All_Vertices (G.Graph)); + end Iterate_All_Vertices; + + ------------------------------ + -- Iterate_Edges_To_Targets -- + ------------------------------ + + function Iterate_Edges_To_Targets + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Edges_To_Targets_Iterator + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + return + Edges_To_Targets_Iterator + (DG.Iterate_Outgoing_Edges (G.Graph, Vertex)); + end Iterate_Edges_To_Targets; + + ------------------------------- + -- Iterate_Elaboration_Roots -- + ------------------------------- + + function Iterate_Elaboration_Roots + (G : Invocation_Graph) return Elaboration_Root_Iterator + is + begin + pragma Assert (Present (G)); + + return Elaboration_Root_Iterator (IGV_Sets.Iterate (G.Roots)); + end Iterate_Elaboration_Roots; + + ---------- + -- Kind -- + ---------- + + function Kind + (G : Invocation_Graph; + Edge : Invocation_Graph_Edge_Id) return Invocation_Kind + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); + + return Kind (Relation (G, Edge)); + end Kind; + + ------------------- + -- Get_Lib_Graph -- + ------------------- + + function Get_Lib_Graph + (G : Invocation_Graph) return Library_Graphs.Library_Graph + is + pragma Assert (Present (G)); + begin + return G.Lib_Graph; + end Get_Lib_Graph; + + ---------- + -- Line -- + ---------- + + function Line + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Nat + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + return Line (Signature (Construct (G, Vertex))); + end Line; + + ---------- + -- Name -- + ---------- + + function Name + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Name_Id + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + return Name (Signature (Construct (G, Vertex))); + end Name; + + ---------- + -- Next -- + ---------- + + procedure Next + (Iter : in out All_Edge_Iterator; + Edge : out Invocation_Graph_Edge_Id) + is + begin + DG.Next (DG.All_Edge_Iterator (Iter), Edge); + end Next; + + ---------- + -- Next -- + ---------- + + procedure Next + (Iter : in out All_Vertex_Iterator; + Vertex : out Invocation_Graph_Vertex_Id) + is + begin + DG.Next (DG.All_Vertex_Iterator (Iter), Vertex); + end Next; + + ---------- + -- Next -- + ---------- + + procedure Next + (Iter : in out Edges_To_Targets_Iterator; + Edge : out Invocation_Graph_Edge_Id) + is + begin + DG.Next (DG.Outgoing_Edge_Iterator (Iter), Edge); + end Next; + + ---------- + -- Next -- + ---------- + + procedure Next + (Iter : in out Elaboration_Root_Iterator; + Root : out Invocation_Graph_Vertex_Id) + is + begin + IGV_Sets.Next (IGV_Sets.Iterator (Iter), Root); + end Next; + + --------------------- + -- Number_Of_Edges -- + --------------------- + + function Number_Of_Edges (G : Invocation_Graph) return Natural is + begin + pragma Assert (Present (G)); + + return DG.Number_Of_Edges (G.Graph); + end Number_Of_Edges; + + -------------------------------- + -- Number_Of_Edges_To_Targets -- + -------------------------------- + + function Number_Of_Edges_To_Targets + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Natural + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + return DG.Number_Of_Outgoing_Edges (G.Graph, Vertex); + end Number_Of_Edges_To_Targets; + + --------------------------------- + -- Number_Of_Elaboration_Roots -- + --------------------------------- + + function Number_Of_Elaboration_Roots + (G : Invocation_Graph) return Natural + is + begin + pragma Assert (Present (G)); + + return IGV_Sets.Size (G.Roots); + end Number_Of_Elaboration_Roots; + + ------------------------ + -- Number_Of_Vertices -- + ------------------------ + + function Number_Of_Vertices (G : Invocation_Graph) return Natural is + begin + pragma Assert (Present (G)); + + return DG.Number_Of_Vertices (G.Graph); + end Number_Of_Vertices; + + ------------- + -- Present -- + ------------- + + function Present (G : Invocation_Graph) return Boolean is + begin + return G /= Nil; + end Present; + + -------------- + -- Relation -- + -------------- + + function Relation + (G : Invocation_Graph; + Edge : Invocation_Graph_Edge_Id) return Invocation_Relation_Id + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); + + return Get_IGE_Attributes (G, Edge).Relation; + end Relation; + + --------------------------- + -- Save_Elaboration_Root -- + --------------------------- + + procedure Save_Elaboration_Root + (G : Invocation_Graph; + Root : Invocation_Graph_Vertex_Id) + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Root)); + + IGV_Sets.Insert (G.Roots, Root); + end Save_Elaboration_Root; + + ------------------------------ + -- Set_Corresponding_Vertex -- + ------------------------------ + + procedure Set_Corresponding_Vertex + (G : Invocation_Graph; + IS_Id : Invocation_Signature_Id; + Vertex : Invocation_Graph_Vertex_Id) + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (IS_Id)); + pragma Assert (Present (Vertex)); + + Signature_Tables.Put (G.Signature_To_Vertex, IS_Id, Vertex); + end Set_Corresponding_Vertex; + + -------------------------------------------- + -- Set_Is_Existing_Source_Target_Relation -- + -------------------------------------------- + + procedure Set_Is_Existing_Source_Target_Relation + (G : Invocation_Graph; + Rel : Source_Target_Relation; + Val : Boolean := True) + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Rel.Source)); + pragma Assert (Present (Rel.Target)); + + if Val then + Relation_Sets.Insert (G.Relations, Rel); + else + Relation_Sets.Delete (G.Relations, Rel); + end if; + end Set_Is_Existing_Source_Target_Relation; + + ------------------------ + -- Set_IGE_Attributes -- + ------------------------ + + procedure Set_IGE_Attributes + (G : Invocation_Graph; + Edge : Invocation_Graph_Edge_Id; + Val : Invocation_Graph_Edge_Attributes) + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); + + IGE_Tables.Put (G.Edge_Attributes, Edge, Val); + end Set_IGE_Attributes; + + ------------------------ + -- Set_IGV_Attributes -- + ------------------------ + + procedure Set_IGV_Attributes + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id; + Val : Invocation_Graph_Vertex_Attributes) + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + IGV_Tables.Put (G.Vertex_Attributes, Vertex, Val); + end Set_IGV_Attributes; + + ----------------- + -- Spec_Vertex -- + ----------------- + + function Spec_Vertex + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + return Get_IGV_Attributes (G, Vertex).Spec_Vertex; + end Spec_Vertex; + + ------------ + -- Target -- + ------------ + + function Target + (G : Invocation_Graph; + Edge : Invocation_Graph_Edge_Id) return Invocation_Graph_Vertex_Id + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); + + return DG.Destination_Vertex (G.Graph, Edge); + end Target; + end Invocation_Graphs; + ------------- -- Present -- ------------- diff --git a/gcc/ada/bindo-graphs.ads b/gcc/ada/bindo-graphs.ads index 73846bd..e284369 100644 --- a/gcc/ada/bindo-graphs.ads +++ b/gcc/ada/bindo-graphs.ads @@ -198,478 +198,6 @@ package Bindo.Graphs is "=" => "=", Hash => Hash_Library_Graph_Vertex); - ----------------------- - -- Invocation_Graphs -- - ----------------------- - - package Invocation_Graphs is - - ----------- - -- Graph -- - ----------- - - -- The following type denotes an invocation graph handle. Each instance - -- must be created using routine Create. - - type Invocation_Graph is private; - Nil : constant Invocation_Graph; - - ---------------------- - -- Graph operations -- - ---------------------- - - procedure Add_Edge - (G : Invocation_Graph; - Source : Invocation_Graph_Vertex_Id; - Target : Invocation_Graph_Vertex_Id; - IR_Id : Invocation_Relation_Id); - pragma Inline (Add_Edge); - -- Create a new edge in invocation graph G with source vertex Source and - -- destination vertex Target. IR_Id is the invocation relation the edge - -- describes. - - procedure Add_Vertex - (G : Invocation_Graph; - IC_Id : Invocation_Construct_Id; - Body_Vertex : Library_Graph_Vertex_Id; - Spec_Vertex : Library_Graph_Vertex_Id); - pragma Inline (Add_Vertex); - -- Create a new vertex in invocation graph G. IC_Id is the invocation - -- construct the vertex describes. Body_Vertex denotes the library graph - -- vertex where the invocation construct's body is declared. Spec_Vertex - -- is the library graph vertex where the invocation construct's spec is - -- declared. - - function Create - (Initial_Vertices : Positive; - Initial_Edges : Positive) return Invocation_Graph; - pragma Inline (Create); - -- Create a new empty graph with vertex capacity Initial_Vertices and - -- edge capacity Initial_Edges. - - procedure Destroy (G : in out Invocation_Graph); - pragma Inline (Destroy); - -- Destroy the contents of invocation graph G, rendering it unusable - - function Present (G : Invocation_Graph) return Boolean; - pragma Inline (Present); - -- Determine whether invocation graph G exists - - ----------------------- - -- Vertex attributes -- - ----------------------- - - function Body_Vertex - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id; - pragma Inline (Body_Vertex); - -- Obtain the library graph vertex where the body of the invocation - -- construct represented by vertex Vertex of invocation graph G is - -- declared. - - function Column - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Nat; - pragma Inline (Column); - -- Obtain the column number where the invocation construct vertex Vertex - -- of invocation graph G describes. - - function Construct - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Invocation_Construct_Id; - pragma Inline (Construct); - -- Obtain the invocation construct vertex Vertex of invocation graph G - -- describes. - - function Corresponding_Vertex - (G : Invocation_Graph; - IS_Id : Invocation_Signature_Id) return Invocation_Graph_Vertex_Id; - pragma Inline (Corresponding_Vertex); - -- Obtain the vertex of invocation graph G that corresponds to signature - -- IS_Id. - - function Line - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Nat; - pragma Inline (Line); - -- Obtain the line number where the invocation construct vertex Vertex - -- of invocation graph G describes. - - function Name - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Name_Id; - pragma Inline (Name); - -- Obtain the name of the construct vertex Vertex of invocation graph G - -- describes. - - function Spec_Vertex - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id; - pragma Inline (Spec_Vertex); - -- Obtain the library graph vertex where the spec of the invocation - -- construct represented by vertex Vertex of invocation graph G is - -- declared. - - --------------------- - -- Edge attributes -- - --------------------- - - function Extra - (G : Invocation_Graph; - Edge : Invocation_Graph_Edge_Id) return Name_Id; - pragma Inline (Extra); - -- Obtain the extra name used in error diagnostics of edge Edge of - -- invocation graph G. - - function Kind - (G : Invocation_Graph; - Edge : Invocation_Graph_Edge_Id) return Invocation_Kind; - pragma Inline (Kind); - -- Obtain the nature of edge Edge of invocation graph G - - function Relation - (G : Invocation_Graph; - Edge : Invocation_Graph_Edge_Id) return Invocation_Relation_Id; - pragma Inline (Relation); - -- Obtain the relation edge Edge of invocation graph G describes - - function Target - (G : Invocation_Graph; - Edge : Invocation_Graph_Edge_Id) return Invocation_Graph_Vertex_Id; - pragma Inline (Target); - -- Obtain the target vertex edge Edge of invocation graph G designates - - ---------------- - -- Statistics -- - ---------------- - - function Invocation_Graph_Edge_Count - (G : Invocation_Graph; - Kind : Invocation_Kind) return Natural; - pragma Inline (Invocation_Graph_Edge_Count); - -- Obtain the total number of edges of kind Kind in invocation graph G - - function Number_Of_Edges (G : Invocation_Graph) return Natural; - pragma Inline (Number_Of_Edges); - -- Obtain the total number of edges in invocation graph G - - function Number_Of_Edges_To_Targets - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Natural; - pragma Inline (Number_Of_Edges_To_Targets); - -- Obtain the total number of edges to targets vertex Vertex of - -- invocation graph G has. - - function Number_Of_Elaboration_Roots - (G : Invocation_Graph) return Natural; - pragma Inline (Number_Of_Elaboration_Roots); - -- Obtain the total number of elaboration roots in invocation graph G - - function Number_Of_Vertices (G : Invocation_Graph) return Natural; - pragma Inline (Number_Of_Vertices); - -- Obtain the total number of vertices in invocation graph G - - --------------- - -- Iterators -- - --------------- - - -- The following type represents an iterator over all edges of an - -- invocation graph. - - type All_Edge_Iterator is private; - - function Has_Next (Iter : All_Edge_Iterator) return Boolean; - pragma Inline (Has_Next); - -- Determine whether iterator Iter has more edges to examine - - function Iterate_All_Edges - (G : Invocation_Graph) return All_Edge_Iterator; - pragma Inline (Iterate_All_Edges); - -- Obtain an iterator over all edges of invocation graph G - - procedure Next - (Iter : in out All_Edge_Iterator; - Edge : out Invocation_Graph_Edge_Id); - pragma Inline (Next); - -- Return the current edge referenced by iterator Iter and advance to - -- the next available edge. - - -- The following type represents an iterator over all vertices of an - -- invocation graph. - - type All_Vertex_Iterator is private; - - function Has_Next (Iter : All_Vertex_Iterator) return Boolean; - pragma Inline (Has_Next); - -- Determine whether iterator Iter has more vertices to examine - - function Iterate_All_Vertices - (G : Invocation_Graph) return All_Vertex_Iterator; - pragma Inline (Iterate_All_Vertices); - -- Obtain an iterator over all vertices of invocation graph G - - procedure Next - (Iter : in out All_Vertex_Iterator; - Vertex : out Invocation_Graph_Vertex_Id); - pragma Inline (Next); - -- Return the current vertex referenced by iterator Iter and advance - -- to the next available vertex. - - -- The following type represents an iterator over all edges that reach - -- targets starting from a particular source vertex. - - type Edges_To_Targets_Iterator is private; - - function Has_Next (Iter : Edges_To_Targets_Iterator) return Boolean; - pragma Inline (Has_Next); - -- Determine whether iterator Iter has more edges to examine - - function Iterate_Edges_To_Targets - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Edges_To_Targets_Iterator; - pragma Inline (Iterate_Edges_To_Targets); - -- Obtain an iterator over all edges to targets with source vertex - -- Vertex of invocation graph G. - - procedure Next - (Iter : in out Edges_To_Targets_Iterator; - Edge : out Invocation_Graph_Edge_Id); - pragma Inline (Next); - -- Return the current edge referenced by iterator Iter and advance to - -- the next available edge. - - -- The following type represents an iterator over all vertices of an - -- invocation graph that denote the elaboration procedure or a spec or - -- a body, referred to as elaboration root. - - type Elaboration_Root_Iterator is private; - - function Has_Next (Iter : Elaboration_Root_Iterator) return Boolean; - pragma Inline (Has_Next); - -- Determine whether iterator Iter has more elaboration roots to examine - - function Iterate_Elaboration_Roots - (G : Invocation_Graph) return Elaboration_Root_Iterator; - pragma Inline (Iterate_Elaboration_Roots); - -- Obtain an iterator over all elaboration roots of invocation graph G - - procedure Next - (Iter : in out Elaboration_Root_Iterator; - Root : out Invocation_Graph_Vertex_Id); - pragma Inline (Next); - -- Return the current elaboration root referenced by iterator Iter and - -- advance to the next available elaboration root. - - private - - -------------- - -- Vertices -- - -------------- - - procedure Destroy_Invocation_Graph_Vertex - (Vertex : in out Invocation_Graph_Vertex_Id); - pragma Inline (Destroy_Invocation_Graph_Vertex); - -- Destroy invocation graph vertex Vertex - - -- The following type represents the attributes of an invocation graph - -- vertex. - - type Invocation_Graph_Vertex_Attributes is record - Body_Vertex : Library_Graph_Vertex_Id := No_Library_Graph_Vertex; - -- Reference to the library graph vertex where the body of this - -- vertex resides. - - Construct : Invocation_Construct_Id := No_Invocation_Construct; - -- Reference to the invocation construct this vertex represents - - Spec_Vertex : Library_Graph_Vertex_Id := No_Library_Graph_Vertex; - -- Reference to the library graph vertex where the spec of this - -- vertex resides. - end record; - - No_Invocation_Graph_Vertex_Attributes : - constant Invocation_Graph_Vertex_Attributes := - (Body_Vertex => No_Library_Graph_Vertex, - Construct => No_Invocation_Construct, - Spec_Vertex => No_Library_Graph_Vertex); - - procedure Destroy_Invocation_Graph_Vertex_Attributes - (Attrs : in out Invocation_Graph_Vertex_Attributes); - pragma Inline (Destroy_Invocation_Graph_Vertex_Attributes); - -- Destroy the contents of attributes Attrs - - package IGV_Tables is new Dynamic_Hash_Tables - (Key_Type => Invocation_Graph_Vertex_Id, - Value_Type => Invocation_Graph_Vertex_Attributes, - No_Value => No_Invocation_Graph_Vertex_Attributes, - Expansion_Threshold => 1.5, - Expansion_Factor => 2, - Compression_Threshold => 0.3, - Compression_Factor => 2, - "=" => "=", - Destroy_Value => Destroy_Invocation_Graph_Vertex_Attributes, - Hash => Hash_Invocation_Graph_Vertex); - - ----------- - -- Edges -- - ----------- - - procedure Destroy_Invocation_Graph_Edge - (Edge : in out Invocation_Graph_Edge_Id); - pragma Inline (Destroy_Invocation_Graph_Edge); - -- Destroy invocation graph edge Edge - - -- The following type represents the attributes of an invocation graph - -- edge. - - type Invocation_Graph_Edge_Attributes is record - Relation : Invocation_Relation_Id := No_Invocation_Relation; - -- Reference to the invocation relation this edge represents - end record; - - No_Invocation_Graph_Edge_Attributes : - constant Invocation_Graph_Edge_Attributes := - (Relation => No_Invocation_Relation); - - procedure Destroy_Invocation_Graph_Edge_Attributes - (Attrs : in out Invocation_Graph_Edge_Attributes); - pragma Inline (Destroy_Invocation_Graph_Edge_Attributes); - -- Destroy the contents of attributes Attrs - - package IGE_Tables is new Dynamic_Hash_Tables - (Key_Type => Invocation_Graph_Edge_Id, - Value_Type => Invocation_Graph_Edge_Attributes, - No_Value => No_Invocation_Graph_Edge_Attributes, - Expansion_Threshold => 1.5, - Expansion_Factor => 2, - Compression_Threshold => 0.3, - Compression_Factor => 2, - "=" => "=", - Destroy_Value => Destroy_Invocation_Graph_Edge_Attributes, - Hash => Hash_Invocation_Graph_Edge); - - --------------- - -- Relations -- - --------------- - - -- The following type represents a relation between a source and target - -- vertices. - - type Source_Target_Relation is record - Source : Invocation_Graph_Vertex_Id := No_Invocation_Graph_Vertex; - -- The source vertex - - Target : Invocation_Graph_Vertex_Id := No_Invocation_Graph_Vertex; - -- The destination vertex - end record; - - No_Source_Target_Relation : - constant Source_Target_Relation := - (Source => No_Invocation_Graph_Vertex, - Target => No_Invocation_Graph_Vertex); - - function Hash_Source_Target_Relation - (Rel : Source_Target_Relation) return Bucket_Range_Type; - pragma Inline (Hash_Source_Target_Relation); - -- Obtain the hash value of key Rel - - package Relation_Sets is new Membership_Sets - (Element_Type => Source_Target_Relation, - "=" => "=", - Hash => Hash_Source_Target_Relation); - - ---------------- - -- Statistics -- - ---------------- - - type Invocation_Graph_Edge_Counts is array (Invocation_Kind) of Natural; - - ---------------- - -- Signatures -- - ---------------- - - function Hash_Invocation_Signature - (IS_Id : Invocation_Signature_Id) return Bucket_Range_Type; - pragma Inline (Hash_Invocation_Signature); - -- Obtain the hash value of key IS_Id - - package Signature_Tables is new Dynamic_Hash_Tables - (Key_Type => Invocation_Signature_Id, - Value_Type => Invocation_Graph_Vertex_Id, - No_Value => No_Invocation_Graph_Vertex, - Expansion_Threshold => 1.5, - Expansion_Factor => 2, - Compression_Threshold => 0.3, - Compression_Factor => 2, - "=" => "=", - Destroy_Value => Destroy_Invocation_Graph_Vertex, - Hash => Hash_Invocation_Signature); - - ----------------------- - -- Elaboration roots -- - ----------------------- - - package IGV_Sets is new Membership_Sets - (Element_Type => Invocation_Graph_Vertex_Id, - "=" => "=", - Hash => Hash_Invocation_Graph_Vertex); - - ----------- - -- Graph -- - ----------- - - package DG is new Directed_Graphs - (Vertex_Id => Invocation_Graph_Vertex_Id, - No_Vertex => No_Invocation_Graph_Vertex, - Hash_Vertex => Hash_Invocation_Graph_Vertex, - Same_Vertex => "=", - Edge_id => Invocation_Graph_Edge_Id, - No_Edge => No_Invocation_Graph_Edge, - Hash_Edge => Hash_Invocation_Graph_Edge, - Same_Edge => "="); - - -- The following type represents the attributes of an invocation graph - - type Invocation_Graph_Attributes is record - Counts : Invocation_Graph_Edge_Counts := (others => 0); - -- Edge statistics - - Edge_Attributes : IGE_Tables.Dynamic_Hash_Table := IGE_Tables.Nil; - -- The map of edge -> edge attributes for all edges in the graph - - Graph : DG.Directed_Graph := DG.Nil; - -- The underlying graph describing the relations between edges and - -- vertices. - - Relations : Relation_Sets.Membership_Set := Relation_Sets.Nil; - -- The set of relations between source and targets, used to prevent - -- duplicate edges in the graph. - - Roots : IGV_Sets.Membership_Set := IGV_Sets.Nil; - -- The set of elaboration root vertices - - Signature_To_Vertex : Signature_Tables.Dynamic_Hash_Table := - Signature_Tables.Nil; - -- The map of signature -> vertex - - Vertex_Attributes : IGV_Tables.Dynamic_Hash_Table := IGV_Tables.Nil; - -- The map of vertex -> vertex attributes for all vertices in the - -- graph. - end record; - - type Invocation_Graph is access Invocation_Graph_Attributes; - Nil : constant Invocation_Graph := null; - - --------------- - -- Iterators -- - --------------- - - type All_Edge_Iterator is new DG.All_Edge_Iterator; - type All_Vertex_Iterator is new DG.All_Vertex_Iterator; - type Edges_To_Targets_Iterator is new DG.Outgoing_Edge_Iterator; - type Elaboration_Root_Iterator is new IGV_Sets.Iterator; - end Invocation_Graphs; - -------------------- -- Library_Graphs -- -------------------- @@ -1731,4 +1259,486 @@ package Bindo.Graphs is type Edges_To_Successors_Iterator is new DG.Outgoing_Edge_Iterator; end Library_Graphs; + ----------------------- + -- Invocation_Graphs -- + ----------------------- + + package Invocation_Graphs is + + ----------- + -- Graph -- + ----------- + + -- The following type denotes an invocation graph handle. Each instance + -- must be created using routine Create. + + type Invocation_Graph is private; + Nil : constant Invocation_Graph; + + ---------------------- + -- Graph operations -- + ---------------------- + + procedure Add_Edge + (G : Invocation_Graph; + Source : Invocation_Graph_Vertex_Id; + Target : Invocation_Graph_Vertex_Id; + IR_Id : Invocation_Relation_Id); + pragma Inline (Add_Edge); + -- Create a new edge in invocation graph G with source vertex Source and + -- destination vertex Target. IR_Id is the invocation relation the edge + -- describes. + + procedure Add_Vertex + (G : Invocation_Graph; + IC_Id : Invocation_Construct_Id; + Body_Vertex : Library_Graph_Vertex_Id; + Spec_Vertex : Library_Graph_Vertex_Id); + pragma Inline (Add_Vertex); + -- Create a new vertex in invocation graph G. IC_Id is the invocation + -- construct the vertex describes. Body_Vertex denotes the library graph + -- vertex where the invocation construct's body is declared. Spec_Vertex + -- is the library graph vertex where the invocation construct's spec is + -- declared. + + function Create + (Initial_Vertices : Positive; + Initial_Edges : Positive; + Lib_Graph : Library_Graphs.Library_Graph) + return Invocation_Graph; + pragma Inline (Create); + -- Create a new empty graph with vertex capacity Initial_Vertices + -- and edge capacity Initial_Edges. Lib_Graph is the library graph + -- corresponding to this invocation graph. + + function Get_Lib_Graph + (G : Invocation_Graph) return Library_Graphs.Library_Graph; + pragma Inline (Get_Lib_Graph); + -- Return the library graph corresponding to this invocation graph + + procedure Destroy (G : in out Invocation_Graph); + pragma Inline (Destroy); + -- Destroy the contents of invocation graph G, rendering it unusable + + function Present (G : Invocation_Graph) return Boolean; + pragma Inline (Present); + -- Determine whether invocation graph G exists + + ----------------------- + -- Vertex attributes -- + ----------------------- + + function Body_Vertex + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id; + pragma Inline (Body_Vertex); + -- Obtain the library graph vertex where the body of the invocation + -- construct represented by vertex Vertex of invocation graph G is + -- declared. + + function Column + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Nat; + pragma Inline (Column); + -- Obtain the column number where the invocation construct vertex Vertex + -- of invocation graph G describes. + + function Construct + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Invocation_Construct_Id; + pragma Inline (Construct); + -- Obtain the invocation construct vertex Vertex of invocation graph G + -- describes. + + function Corresponding_Vertex + (G : Invocation_Graph; + IS_Id : Invocation_Signature_Id) return Invocation_Graph_Vertex_Id; + pragma Inline (Corresponding_Vertex); + -- Obtain the vertex of invocation graph G that corresponds to signature + -- IS_Id. + + function Line + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Nat; + pragma Inline (Line); + -- Obtain the line number where the invocation construct vertex Vertex + -- of invocation graph G describes. + + function Name + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Name_Id; + pragma Inline (Name); + -- Obtain the name of the construct vertex Vertex of invocation graph G + -- describes. + + function Spec_Vertex + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id; + pragma Inline (Spec_Vertex); + -- Obtain the library graph vertex where the spec of the invocation + -- construct represented by vertex Vertex of invocation graph G is + -- declared. + + --------------------- + -- Edge attributes -- + --------------------- + + function Extra + (G : Invocation_Graph; + Edge : Invocation_Graph_Edge_Id) return Name_Id; + pragma Inline (Extra); + -- Obtain the extra name used in error diagnostics of edge Edge of + -- invocation graph G. + + function Kind + (G : Invocation_Graph; + Edge : Invocation_Graph_Edge_Id) return Invocation_Kind; + pragma Inline (Kind); + -- Obtain the nature of edge Edge of invocation graph G + + function Relation + (G : Invocation_Graph; + Edge : Invocation_Graph_Edge_Id) return Invocation_Relation_Id; + pragma Inline (Relation); + -- Obtain the relation edge Edge of invocation graph G describes + + function Target + (G : Invocation_Graph; + Edge : Invocation_Graph_Edge_Id) return Invocation_Graph_Vertex_Id; + pragma Inline (Target); + -- Obtain the target vertex edge Edge of invocation graph G designates + + ---------------- + -- Statistics -- + ---------------- + + function Invocation_Graph_Edge_Count + (G : Invocation_Graph; + Kind : Invocation_Kind) return Natural; + pragma Inline (Invocation_Graph_Edge_Count); + -- Obtain the total number of edges of kind Kind in invocation graph G + + function Number_Of_Edges (G : Invocation_Graph) return Natural; + pragma Inline (Number_Of_Edges); + -- Obtain the total number of edges in invocation graph G + + function Number_Of_Edges_To_Targets + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Natural; + pragma Inline (Number_Of_Edges_To_Targets); + -- Obtain the total number of edges to targets vertex Vertex of + -- invocation graph G has. + + function Number_Of_Elaboration_Roots + (G : Invocation_Graph) return Natural; + pragma Inline (Number_Of_Elaboration_Roots); + -- Obtain the total number of elaboration roots in invocation graph G + + function Number_Of_Vertices (G : Invocation_Graph) return Natural; + pragma Inline (Number_Of_Vertices); + -- Obtain the total number of vertices in invocation graph G + + --------------- + -- Iterators -- + --------------- + + -- The following type represents an iterator over all edges of an + -- invocation graph. + + type All_Edge_Iterator is private; + + function Has_Next (Iter : All_Edge_Iterator) return Boolean; + pragma Inline (Has_Next); + -- Determine whether iterator Iter has more edges to examine + + function Iterate_All_Edges + (G : Invocation_Graph) return All_Edge_Iterator; + pragma Inline (Iterate_All_Edges); + -- Obtain an iterator over all edges of invocation graph G + + procedure Next + (Iter : in out All_Edge_Iterator; + Edge : out Invocation_Graph_Edge_Id); + pragma Inline (Next); + -- Return the current edge referenced by iterator Iter and advance to + -- the next available edge. + + -- The following type represents an iterator over all vertices of an + -- invocation graph. + + type All_Vertex_Iterator is private; + + function Has_Next (Iter : All_Vertex_Iterator) return Boolean; + pragma Inline (Has_Next); + -- Determine whether iterator Iter has more vertices to examine + + function Iterate_All_Vertices + (G : Invocation_Graph) return All_Vertex_Iterator; + pragma Inline (Iterate_All_Vertices); + -- Obtain an iterator over all vertices of invocation graph G + + procedure Next + (Iter : in out All_Vertex_Iterator; + Vertex : out Invocation_Graph_Vertex_Id); + pragma Inline (Next); + -- Return the current vertex referenced by iterator Iter and advance + -- to the next available vertex. + + -- The following type represents an iterator over all edges that reach + -- targets starting from a particular source vertex. + + type Edges_To_Targets_Iterator is private; + + function Has_Next (Iter : Edges_To_Targets_Iterator) return Boolean; + pragma Inline (Has_Next); + -- Determine whether iterator Iter has more edges to examine + + function Iterate_Edges_To_Targets + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Edges_To_Targets_Iterator; + pragma Inline (Iterate_Edges_To_Targets); + -- Obtain an iterator over all edges to targets with source vertex + -- Vertex of invocation graph G. + + procedure Next + (Iter : in out Edges_To_Targets_Iterator; + Edge : out Invocation_Graph_Edge_Id); + pragma Inline (Next); + -- Return the current edge referenced by iterator Iter and advance to + -- the next available edge. + + -- The following type represents an iterator over all vertices of an + -- invocation graph that denote the elaboration procedure or a spec or + -- a body, referred to as elaboration root. + + type Elaboration_Root_Iterator is private; + + function Has_Next (Iter : Elaboration_Root_Iterator) return Boolean; + pragma Inline (Has_Next); + -- Determine whether iterator Iter has more elaboration roots to examine + + function Iterate_Elaboration_Roots + (G : Invocation_Graph) return Elaboration_Root_Iterator; + pragma Inline (Iterate_Elaboration_Roots); + -- Obtain an iterator over all elaboration roots of invocation graph G + + procedure Next + (Iter : in out Elaboration_Root_Iterator; + Root : out Invocation_Graph_Vertex_Id); + pragma Inline (Next); + -- Return the current elaboration root referenced by iterator Iter and + -- advance to the next available elaboration root. + + private + + -------------- + -- Vertices -- + -------------- + + procedure Destroy_Invocation_Graph_Vertex + (Vertex : in out Invocation_Graph_Vertex_Id); + pragma Inline (Destroy_Invocation_Graph_Vertex); + -- Destroy invocation graph vertex Vertex + + -- The following type represents the attributes of an invocation graph + -- vertex. + + type Invocation_Graph_Vertex_Attributes is record + Body_Vertex : Library_Graph_Vertex_Id := No_Library_Graph_Vertex; + -- Reference to the library graph vertex where the body of this + -- vertex resides. + + Construct : Invocation_Construct_Id := No_Invocation_Construct; + -- Reference to the invocation construct this vertex represents + + Spec_Vertex : Library_Graph_Vertex_Id := No_Library_Graph_Vertex; + -- Reference to the library graph vertex where the spec of this + -- vertex resides. + end record; + + No_Invocation_Graph_Vertex_Attributes : + constant Invocation_Graph_Vertex_Attributes := + (Body_Vertex => No_Library_Graph_Vertex, + Construct => No_Invocation_Construct, + Spec_Vertex => No_Library_Graph_Vertex); + + procedure Destroy_Invocation_Graph_Vertex_Attributes + (Attrs : in out Invocation_Graph_Vertex_Attributes); + pragma Inline (Destroy_Invocation_Graph_Vertex_Attributes); + -- Destroy the contents of attributes Attrs + + package IGV_Tables is new Dynamic_Hash_Tables + (Key_Type => Invocation_Graph_Vertex_Id, + Value_Type => Invocation_Graph_Vertex_Attributes, + No_Value => No_Invocation_Graph_Vertex_Attributes, + Expansion_Threshold => 1.5, + Expansion_Factor => 2, + Compression_Threshold => 0.3, + Compression_Factor => 2, + "=" => "=", + Destroy_Value => Destroy_Invocation_Graph_Vertex_Attributes, + Hash => Hash_Invocation_Graph_Vertex); + + ----------- + -- Edges -- + ----------- + + procedure Destroy_Invocation_Graph_Edge + (Edge : in out Invocation_Graph_Edge_Id); + pragma Inline (Destroy_Invocation_Graph_Edge); + -- Destroy invocation graph edge Edge + + -- The following type represents the attributes of an invocation graph + -- edge. + + type Invocation_Graph_Edge_Attributes is record + Relation : Invocation_Relation_Id := No_Invocation_Relation; + -- Reference to the invocation relation this edge represents + end record; + + No_Invocation_Graph_Edge_Attributes : + constant Invocation_Graph_Edge_Attributes := + (Relation => No_Invocation_Relation); + + procedure Destroy_Invocation_Graph_Edge_Attributes + (Attrs : in out Invocation_Graph_Edge_Attributes); + pragma Inline (Destroy_Invocation_Graph_Edge_Attributes); + -- Destroy the contents of attributes Attrs + + package IGE_Tables is new Dynamic_Hash_Tables + (Key_Type => Invocation_Graph_Edge_Id, + Value_Type => Invocation_Graph_Edge_Attributes, + No_Value => No_Invocation_Graph_Edge_Attributes, + Expansion_Threshold => 1.5, + Expansion_Factor => 2, + Compression_Threshold => 0.3, + Compression_Factor => 2, + "=" => "=", + Destroy_Value => Destroy_Invocation_Graph_Edge_Attributes, + Hash => Hash_Invocation_Graph_Edge); + + --------------- + -- Relations -- + --------------- + + -- The following type represents a relation between a source and target + -- vertices. + + type Source_Target_Relation is record + Source : Invocation_Graph_Vertex_Id := No_Invocation_Graph_Vertex; + -- The source vertex + + Target : Invocation_Graph_Vertex_Id := No_Invocation_Graph_Vertex; + -- The destination vertex + end record; + + No_Source_Target_Relation : + constant Source_Target_Relation := + (Source => No_Invocation_Graph_Vertex, + Target => No_Invocation_Graph_Vertex); + + function Hash_Source_Target_Relation + (Rel : Source_Target_Relation) return Bucket_Range_Type; + pragma Inline (Hash_Source_Target_Relation); + -- Obtain the hash value of key Rel + + package Relation_Sets is new Membership_Sets + (Element_Type => Source_Target_Relation, + "=" => "=", + Hash => Hash_Source_Target_Relation); + + ---------------- + -- Statistics -- + ---------------- + + type Invocation_Graph_Edge_Counts is array (Invocation_Kind) of Natural; + + ---------------- + -- Signatures -- + ---------------- + + function Hash_Invocation_Signature + (IS_Id : Invocation_Signature_Id) return Bucket_Range_Type; + pragma Inline (Hash_Invocation_Signature); + -- Obtain the hash value of key IS_Id + + package Signature_Tables is new Dynamic_Hash_Tables + (Key_Type => Invocation_Signature_Id, + Value_Type => Invocation_Graph_Vertex_Id, + No_Value => No_Invocation_Graph_Vertex, + Expansion_Threshold => 1.5, + Expansion_Factor => 2, + Compression_Threshold => 0.3, + Compression_Factor => 2, + "=" => "=", + Destroy_Value => Destroy_Invocation_Graph_Vertex, + Hash => Hash_Invocation_Signature); + + ----------------------- + -- Elaboration roots -- + ----------------------- + + package IGV_Sets is new Membership_Sets + (Element_Type => Invocation_Graph_Vertex_Id, + "=" => "=", + Hash => Hash_Invocation_Graph_Vertex); + + ----------- + -- Graph -- + ----------- + + package DG is new Directed_Graphs + (Vertex_Id => Invocation_Graph_Vertex_Id, + No_Vertex => No_Invocation_Graph_Vertex, + Hash_Vertex => Hash_Invocation_Graph_Vertex, + Same_Vertex => "=", + Edge_id => Invocation_Graph_Edge_Id, + No_Edge => No_Invocation_Graph_Edge, + Hash_Edge => Hash_Invocation_Graph_Edge, + Same_Edge => "="); + + -- The following type represents the attributes of an invocation graph + + type Invocation_Graph_Attributes is record + Counts : Invocation_Graph_Edge_Counts := (others => 0); + -- Edge statistics + + Edge_Attributes : IGE_Tables.Dynamic_Hash_Table := IGE_Tables.Nil; + -- The map of edge -> edge attributes for all edges in the graph + + Graph : DG.Directed_Graph := DG.Nil; + -- The underlying graph describing the relations between edges and + -- vertices. + + Relations : Relation_Sets.Membership_Set := Relation_Sets.Nil; + -- The set of relations between source and targets, used to prevent + -- duplicate edges in the graph. + + Roots : IGV_Sets.Membership_Set := IGV_Sets.Nil; + -- The set of elaboration root vertices + + Signature_To_Vertex : Signature_Tables.Dynamic_Hash_Table := + Signature_Tables.Nil; + -- The map of signature -> vertex + + Vertex_Attributes : IGV_Tables.Dynamic_Hash_Table := IGV_Tables.Nil; + -- The map of vertex -> vertex attributes for all vertices in the + -- graph. + + Lib_Graph : Library_Graphs.Library_Graph; + end record; + + type Invocation_Graph is access Invocation_Graph_Attributes; + Nil : constant Invocation_Graph := null; + + --------------- + -- Iterators -- + --------------- + + type All_Edge_Iterator is new DG.All_Edge_Iterator; + type All_Vertex_Iterator is new DG.All_Vertex_Iterator; + type Edges_To_Targets_Iterator is new DG.Outgoing_Edge_Iterator; + type Elaboration_Root_Iterator is new IGV_Sets.Iterator; + end Invocation_Graphs; + end Bindo.Graphs; diff --git a/gcc/ada/bindo-writers.adb b/gcc/ada/bindo-writers.adb index b2656b3..298118e 100644 --- a/gcc/ada/bindo-writers.adb +++ b/gcc/ada/bindo-writers.adb @@ -927,6 +927,10 @@ package body Bindo.Writers is (G : Invocation_Graph; Vertex : Invocation_Graph_Vertex_Id) is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (G); + + B : constant Library_Graph_Vertex_Id := Body_Vertex (G, Vertex); + S : constant Library_Graph_Vertex_Id := Spec_Vertex (G, Vertex); begin pragma Assert (Present (G)); pragma Assert (Present (Vertex)); @@ -938,8 +942,9 @@ package body Bindo.Writers is Write_Eol; Write_Str (" Body_Vertex (LGV_Id_"); - Write_Int (Int (Body_Vertex (G, Vertex))); - Write_Str (")"); + Write_Int (Int (B)); + Write_Str (") name = "); + Write_Name (Name (Lib_Graph, B)); Write_Eol; Write_Str (" Construct (IC_Id_"); @@ -948,8 +953,9 @@ package body Bindo.Writers is Write_Eol; Write_Str (" Spec_Vertex (LGV_Id_"); - Write_Int (Int (Spec_Vertex (G, Vertex))); - Write_Str (")"); + Write_Int (Int (S)); + Write_Str (") name = "); + Write_Name (Name (Lib_Graph, S)); Write_Eol; Write_Invocation_Graph_Edges (G, Vertex); |