Skip to content

R
riscv-gcc-1
Commit 9098d477 by Hristian Kirtchev Committed by Pierre-Marie de Rodat
Options

[Ada] Elaboration order v4.0 and cycle detection 

This patch introduces a new cycle detection algorithm which is based on
Tarjan's "Enumeration of the Elementary Circuits of a Directed Graph"
algorithm, with several ideas borrowed from Jonson's "Finding all the
Elementary Circuits of a Directed Graph" algorithm.

No need for a test because the new algorithm improves the performance of
cycle detection only.

2019-07-10  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* bindo.adb: Update the section on switches.
	* bindo-graphs.adb
	(Add_Cycle, Add_Vertex_And_Complement): Remove.
	(Create): The graph no longer needs a set of recorded cycles
	because the cycles are not rediscovered in permuted forms.
	(Cycle_End_Vertices): New routine.
	(Destroy): The graph no longer needs a set of recorded cycles
	because the cycles are not rediscovered in permuted forms.
	(Destroy_Library_Graph_Vertex): Move to the library level.
	(Find_All_Cycles_Through_Vertex, Find_All_Cycles_With_Edge):
	Remove.
	(Find_Cycles_From_Successor, Find_Cycles_From_Vertex,
	Find_Cycles_In_Component, Has_Elaborate_All_Edge): New routines.
	(Insert_And_Sort): Remove.
	(Is_Elaborate_Body_Edge): Use predicate
	Is_Vertex_With_Elaborate_Body.
	(Is_Recorded_Cycle): Remove.
	(Is_Vertex_With_Elaborate_Body): New routine.
	(Normalize_And_Add_Cycle): Remove.
	(Precedence): Rename to xxx_Precedence, where xxx relates to the
	input.  These versions better reflect the desired input
	precedence.
	(Record_Cycle): New routine.
	(Remove_Vertex_And_Complement, Set_Is_Recorded_Cycle): Remove.
	(Trace_xxx): Update all versions to use debug switch -d_t.
	(Trace_Component): New routine.
	(Trace_Eol): Removed.
	(Trace_Vertex): Do not output the component as this information
	is already available when the component is traced.
	(Unvisit, Visit): New routine.
	* bindo-graphs.ads: Add new instance LGV_Lists.  Remove instance
	RC_Sets.  Update the structure of type Library_Graph_Attributes
	to remove the set of recorded cycles.
	(Destroy_Library_Graph_Vertex): Move to the library level.
	* bindo-writers.adb (Write_Component_Vertices): Output
	information about the number of vertices.
	* debug.adb: Document the use of binder switch -d_t.  Update the
	use of binder switch -d_T.

From-SVN: r273330
parent 74b96685
Showing with 1402 additions and 885 deletions
gcc/ada/ChangeLog
2019-07-10 Hristian Kirtchev <kirtchev@adacore.com>
* bindo.adb: Update the section on switches.
* bindo-graphs.adb
(Add_Cycle, Add_Vertex_And_Complement): Remove.
(Create): The graph no longer needs a set of recorded cycles
because the cycles are not rediscovered in permuted forms.
(Cycle_End_Vertices): New routine.
(Destroy): The graph no longer needs a set of recorded cycles
because the cycles are not rediscovered in permuted forms.
(Destroy_Library_Graph_Vertex): Move to the library level.
(Find_All_Cycles_Through_Vertex, Find_All_Cycles_With_Edge):
Remove.
(Find_Cycles_From_Successor, Find_Cycles_From_Vertex,
Find_Cycles_In_Component, Has_Elaborate_All_Edge): New routines.
(Insert_And_Sort): Remove.
(Is_Elaborate_Body_Edge): Use predicate
Is_Vertex_With_Elaborate_Body.
(Is_Recorded_Cycle): Remove.
(Is_Vertex_With_Elaborate_Body): New routine.
(Normalize_And_Add_Cycle): Remove.
(Precedence): Rename to xxx_Precedence, where xxx relates to the
input. These versions better reflect the desired input
precedence.
(Record_Cycle): New routine.
(Remove_Vertex_And_Complement, Set_Is_Recorded_Cycle): Remove.
(Trace_xxx): Update all versions to use debug switch -d_t.
(Trace_Component): New routine.
(Trace_Eol): Removed.
(Trace_Vertex): Do not output the component as this information
is already available when the component is traced.
(Unvisit, Visit): New routine.
* bindo-graphs.ads: Add new instance LGV_Lists. Remove instance
RC_Sets. Update the structure of type Library_Graph_Attributes
to remove the set of recorded cycles.
(Destroy_Library_Graph_Vertex): Move to the library level.
* bindo-writers.adb (Write_Component_Vertices): Output
information about the number of vertices.
* debug.adb: Document the use of binder switch -d_t. Update the
use of binder switch -d_T.
2019-07-10 Yannick Moy <moy@adacore.com> 2019-07-10 Yannick Moy <moy@adacore.com>
* sem_spark.adb (Get_Root_Object): Replace precondition by error * sem_spark.adb (Get_Root_Object): Replace precondition by error
......
gcc/ada/bindo-graphs.adb
...@@ -94,6 +94,18 @@ package body Bindo.Graphs is ...@@ -94,6 +94,18 @@ package body Bindo.Graphs is
null; null;
end Destroy_Library_Graph_Edge; end Destroy_Library_Graph_Edge;
----------------------------------
-- Destroy_Library_Graph_Vertex --
----------------------------------
procedure Destroy_Library_Graph_Vertex
(Vertex : in out Library_Graph_Vertex_Id)
is
pragma Unreferenced (Vertex);
begin
null;
end Destroy_Library_Graph_Vertex;
-------------------------------- --------------------------------
-- Hash_Invocation_Graph_Edge -- -- Hash_Invocation_Graph_Edge --
-------------------------------- --------------------------------
...@@ -1047,16 +1059,6 @@ package body Bindo.Graphs is ...@@ -1047,16 +1059,6 @@ package body Bindo.Graphs is
-- corresponding specs or bodies, where the body is a predecessor -- corresponding specs or bodies, where the body is a predecessor
-- and the spec is a successor. Add all edges to list Edges. -- and the spec is a successor. Add all edges to list Edges.
procedure Add_Cycle
(G : Library_Graph;
Attrs : Library_Graph_Cycle_Attributes;
Indent : Indentation_Level);
pragma Inline (Add_Cycle);
-- Store a cycle described by attributes Attrs in library graph G,
-- unless a prior rotation of it already exists. The edges of the cycle
-- must be in normalized form. Indent is the desired indentation level
-- for tracing.
function Add_Edge_With_Return function Add_Edge_With_Return
(G : Library_Graph; (G : Library_Graph;
Pred : Library_Graph_Vertex_Id; Pred : Library_Graph_Vertex_Id;
...@@ -1070,16 +1072,6 @@ package body Bindo.Graphs is ...@@ -1070,16 +1072,6 @@ package body Bindo.Graphs is
-- involves a task activation. If Pred and Succ are already related, -- involves a task activation. If Pred and Succ are already related,
-- no edge is created and No_Library_Graph_Edge is returned. -- no edge is created and No_Library_Graph_Edge is returned.
procedure Add_Vertex_And_Complement
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id;
Set : LGV_Sets.Membership_Set;
Do_Complement : Boolean);
pragma Inline (Add_Vertex_And_Complement);
-- Add vertex Vertex of library graph G to set Set. If the vertex is
-- part of an Elaborate_Body pair, or flag Do_Complement is set, add
-- the complementary vertex to the set.
function At_Least_One_Edge_Satisfies function At_Least_One_Edge_Satisfies
(G : Library_Graph; (G : Library_Graph;
Cycle : Library_Graph_Cycle_Id; Cycle : Library_Graph_Cycle_Id;
...@@ -1094,6 +1086,18 @@ package body Bindo.Graphs is ...@@ -1094,6 +1086,18 @@ package body Bindo.Graphs is
pragma Inline (Copy_Cycle_Path); pragma Inline (Copy_Cycle_Path);
-- Create a deep copy of list Cycle_Path -- Create a deep copy of list Cycle_Path
function Cycle_End_Vertices
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id;
Elaborate_All_Active : Boolean) return LGV_Sets.Membership_Set;
pragma Inline (Cycle_End_Vertices);
-- Part of Tarjan's enumeration of the elementary circuits of a directed
-- graph algorithm. Collect the vertices that terminate a cycle starting
-- from vertex Vertex of library graph G in a set. This is usually the
-- vertex itself, unless the vertex is part of an Elaborate_Body pair,
-- or flag Elaborate_All_Active is set. In that case the complementary
-- vertex is also added to the set.
function Cycle_Kind_Of function Cycle_Kind_Of
(G : Library_Graph; (G : Library_Graph;
Edge : Library_Graph_Edge_Id) return Library_Graph_Cycle_Kind; Edge : Library_Graph_Edge_Id) return Library_Graph_Cycle_Kind;
...@@ -1101,6 +1105,29 @@ package body Bindo.Graphs is ...@@ -1101,6 +1105,29 @@ package body Bindo.Graphs is
-- Determine the cycle kind of edge Edge of library graph G if the edge -- Determine the cycle kind of edge Edge of library graph G if the edge
-- participated in a circuit. -- participated in a circuit.
function Cycle_Kind_Precedence
(Kind : Library_Graph_Cycle_Kind;
Compared_To : Library_Graph_Cycle_Kind) return Precedence_Kind;
pragma Inline (Cycle_Kind_Precedence);
-- Determine the precedence of cycle kind Kind compared to cycle kind
-- Compared_To.
function Cycle_Path_Precedence
(G : Library_Graph;
Path : LGE_Lists.Doubly_Linked_List;
Compared_To : LGE_Lists.Doubly_Linked_List) return Precedence_Kind;
pragma Inline (Cycle_Path_Precedence);
-- Determine the precedence of cycle path Path of library graph G
-- compared to path Compared_To.
function Cycle_Precedence
(G : Library_Graph;
Cycle : Library_Graph_Cycle_Id;
Compared_To : Library_Graph_Cycle_Id) return Precedence_Kind;
pragma Inline (Cycle_Precedence);
-- Determine the precedence of cycle Cycle of library graph G compared
-- to cycle Compared_To.
procedure Decrement_Library_Graph_Edge_Count procedure Decrement_Library_Graph_Edge_Count
(G : Library_Graph; (G : Library_Graph;
Kind : Library_Graph_Edge_Kind); Kind : Library_Graph_Edge_Kind);
...@@ -1121,40 +1148,133 @@ package body Bindo.Graphs is ...@@ -1121,40 +1148,133 @@ package body Bindo.Graphs is
pragma Inline (Delete_Edge); pragma Inline (Delete_Edge);
-- Delete edge Edge from library graph G -- Delete edge Edge from library graph G
procedure Find_All_Cycles_Through_Vertex function Edge_Precedence
(G : Library_Graph; (G : Library_Graph;
Vertex : Library_Graph_Vertex_Id; Edge : Library_Graph_Edge_Id;
End_Vertices : LGV_Sets.Membership_Set; Compared_To : Library_Graph_Edge_Id) return Precedence_Kind;
Most_Significant_Edge : Library_Graph_Edge_Id; pragma Inline (Edge_Precedence);
Invocation_Edge_Count : Natural; -- Determine the precedence of edge Edge of library graph G compared to
Spec_And_Body_Together : Boolean; -- edge Compared_To.
Cycle_Path : LGE_Lists.Doubly_Linked_List;
Visited_Vertices : LGV_Sets.Membership_Set; procedure Find_Cycles_From_Successor
Indent : Indentation_Level); (G : Library_Graph;
pragma Inline (Find_All_Cycles_Through_Vertex); Edge : Library_Graph_Edge_Id;
-- Explore all edges to successors of vertex Vertex of library graph G End_Vertices : LGV_Sets.Membership_Set;
-- in an attempt to find a cycle. A cycle is considered closed when the Deleted_Vertices : LGV_Sets.Membership_Set;
-- Vertex appears in set End_Vertices. Most_Significant_Edge denotes the Most_Significant_Edge : Library_Graph_Edge_Id;
-- edge with the highest significance along the candidate cycle path. Invocation_Edge_Count : Natural;
-- Invocation_Edge_Count denotes the number of invocation edges along Cycle_Path_Stack : LGE_Lists.Doubly_Linked_List;
-- the candidate cycle path. Spec_And_Body_Together should be set when Visited_Set : LGV_Sets.Membership_Set;
-- spec and body vertices must be treated as one vertex. Cycle_Path is Visited_Stack : LGV_Lists.Doubly_Linked_List;
-- the candidate cycle path. Visited_Vertices denotes the set of visited Cycle_Count : in out Natural;
-- vertices so far. Indent is the desired indentation level for tracing. Cycle_Limit : Natural;
Elaborate_All_Active : Boolean;
procedure Find_All_Cycles_With_Edge Has_Cycle : out Boolean;
(G : Library_Graph; Indent : Indentation_Level);
Initial_Edge : Library_Graph_Edge_Id; pragma Inline (Find_Cycles_From_Successor);
Spec_And_Body_Together : Boolean; -- Part of Tarjan's enumeration of the elementary circuits of a directed
Cycle_Path : LGE_Lists.Doubly_Linked_List; -- graph algorithm. Find all cycles from the successor indicated by edge
Visited_Vertices : LGV_Sets.Membership_Set; -- Edge of library graph G. If at least one cycle exists, set Has_Cycle
Indent : Indentation_Level); -- to True. The remaining parameters are as follows:
pragma Inline (Find_All_Cycles_With_Edge); --
-- Find all cycles which contain edge Initial_Edge of library graph G. -- * End vertices is the set of vertices that terminate a potential
-- Spec_And_Body_Together should be set when spec and body vertices must -- cycle.
-- be treated as one vertex. Cycle_Path is the candidate cycle path. --
-- Visited_Vertices is the set of visited vertices so far. Indent is -- * Deleted vertices is the set of vertices that have been expended
-- the desired indentation level for tracing. -- during previous depth-first searches and should not be visited
-- for the rest of the algorithm.
--
-- * Most_Significant_Edge is the current highest precedence edge on
-- the path of the potential cycle.
--
-- * Invocation_Edge_Count is the number of invocation edges on the
-- path of the potential cycle.
--
-- * Cycle_Path_Stack is the path of the potential cycle.
--
-- * Visited_Set is the set of vertices that have been visited during
-- the current depth-first search.
--
-- * Visited_Stack maintains the vertices of Visited_Set in a stack
-- for later unvisiting.
--
-- * Cycle_Count is the number of cycles discovered so far.
--
-- * Cycle_Limit is the upper bound of the number of cycles to be
-- discovered.
--
-- * Elaborate_All_Active should be set when the component currently
-- being examined for cycles contains an Elaborate_All edge.
--
-- * Indent in the desired indentation level for tracing.
procedure Find_Cycles_From_Vertex
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id;
End_Vertices : LGV_Sets.Membership_Set;
Deleted_Vertices : LGV_Sets.Membership_Set;
Most_Significant_Edge : Library_Graph_Edge_Id;
Invocation_Edge_Count : Natural;
Cycle_Path_Stack : LGE_Lists.Doubly_Linked_List;
Visited_Set : LGV_Sets.Membership_Set;
Visited_Stack : LGV_Lists.Doubly_Linked_List;
Cycle_Count : in out Natural;
Cycle_Limit : Natural;
Elaborate_All_Active : Boolean;
Is_Start_Vertex : Boolean;
Has_Cycle : out Boolean;
Indent : Indentation_Level);
pragma Inline (Find_Cycles_From_Vertex);
-- Part of Tarjan's enumeration of the elementary circuits of a directed
-- graph algorithm. Find all cycles from vertex Vertex of library graph
-- G. If at least one cycle exists, set Has_Cycle to True. The remaining
-- parameters are as follows:
--
-- * End_Vertices is the set of vertices that terminate a potential
-- cycle.
--
-- * Deleted_Vertices is the set of vertices that have been expended
-- during previous depth-first searches and should not be visited
-- for the rest of the algorithm.
--
-- * Most_Significant_Edge is the current highest precedence edge on
-- the path of the potential cycle.
--
-- * Invocation_Edge_Count is the number of invocation edges on the
-- path of the potential cycle.
--
-- * Cycle_Path_Stack is the path of the potential cycle.
--
-- * Visited_Set is the set of vertices that have been visited during
-- the current depth-first search.
--
-- * Visited_Stack maintains the vertices of Visited_Set in a stack
-- for later unvisiting.
--
-- * Cycle_Count is the number of cycles discovered so far.
--
-- * Cycle_Limit is the upper bound of the number of cycles to be
-- discovered.
--
-- * Elaborate_All_Active should be set when the component currently
-- being examined for cycles contains an Elaborate_All edge.
--
-- * Indent in the desired indentation level for tracing.
procedure Find_Cycles_In_Component
(G : Library_Graph;
Comp : Component_Id;
Cycle_Count : in out Natural;
Cycle_Limit : Natural);
pragma Inline (Find_Cycles_In_Component);
-- Part of Tarjan's enumeration of the elementary circuits of a directed
-- graph algorithm. Find all cycles in component Comp of library graph
-- G. The remaining parameters are as follows:
--
-- * Cycle_Count is the number of cycles discovered so far.
--
-- * Cycle_Limit is the upper bound of the number of cycles to be
-- discovered.
function Find_First_Lower_Precedence_Cycle function Find_First_Lower_Precedence_Cycle
(G : Library_Graph; (G : Library_Graph;
...@@ -1201,6 +1321,21 @@ package body Bindo.Graphs is ...@@ -1201,6 +1321,21 @@ package body Bindo.Graphs is
-- Determine whether vertex Vertex of library graph G is subject to -- Determine whether vertex Vertex of library graph G is subject to
-- pragma Elaborate_Body. -- pragma Elaborate_Body.
function Has_Elaborate_All_Edge
(G : Library_Graph;
Comp : Component_Id) return Boolean;
pragma Inline (Has_Elaborate_All_Edge);
-- Determine whether component Comp of library graph G contains an
-- Elaborate_All edge that links two vertices in the same component.
function Has_Elaborate_All_Edge
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (Has_Elaborate_All_Edge);
-- Determine whether vertex Vertex of library graph G contains an
-- Elaborate_All edge to a successor where both the vertex and the
-- successor reside in the same component.
function Highest_Precedence_Edge function Highest_Precedence_Edge
(G : Library_Graph; (G : Library_Graph;
Left : Library_Graph_Edge_Id; Left : Library_Graph_Edge_Id;
...@@ -1238,13 +1373,6 @@ package body Bindo.Graphs is ...@@ -1238,13 +1373,6 @@ package body Bindo.Graphs is
-- Initialize on the initial call or re-initialize on subsequent calls -- Initialize on the initial call or re-initialize on subsequent calls
-- all components of library graph G. -- all components of library graph G.
procedure Insert_And_Sort
(G : Library_Graph;
Cycle : Library_Graph_Cycle_Id);
pragma Inline (Insert_And_Sort);
-- Insert cycle Cycle in library graph G and sort it based on its
-- precedence relative to all recorded cycles.
function Is_Cycle_Initiating_Edge function Is_Cycle_Initiating_Edge
(G : Library_Graph; (G : Library_Graph;
Edge : Library_Graph_Edge_Id) return Boolean; Edge : Library_Graph_Edge_Id) return Boolean;
...@@ -1302,13 +1430,6 @@ package body Bindo.Graphs is ...@@ -1302,13 +1430,6 @@ package body Bindo.Graphs is
-- cycle and is the result of a with dependency between its successor -- cycle and is the result of a with dependency between its successor
-- and predecessor. -- and predecessor.
function Is_Recorded_Cycle
(G : Library_Graph;
Attrs : Library_Graph_Cycle_Attributes) return Boolean;
pragma Inline (Is_Recorded_Cycle);
-- Determine whether a cycle described by its attributes Attrs has
-- has already been recorded in library graph G.
function Is_Recorded_Edge function Is_Recorded_Edge
(G : Library_Graph; (G : Library_Graph;
Rel : Predecessor_Successor_Relation) return Boolean; Rel : Predecessor_Successor_Relation) return Boolean;
...@@ -1323,6 +1444,14 @@ package body Bindo.Graphs is ...@@ -1323,6 +1444,14 @@ package body Bindo.Graphs is
-- Determine whether the successor of invocation edge Edge represents a -- Determine whether the successor of invocation edge Edge represents a
-- unit that was compiled with the static model. -- unit that was compiled with the static model.
function Is_Vertex_With_Elaborate_Body
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (Is_Vertex_With_Elaborate_Body);
-- Determine whether vertex Vertex of library graph G denotes a spec
-- subject to pragma Elaborate_Body or the completing body of such a
-- spec.
function Links_Vertices_In_Same_Component function Links_Vertices_In_Same_Component
(G : Library_Graph; (G : Library_Graph;
Edge : Library_Graph_Edge_Id) return Boolean; Edge : Library_Graph_Edge_Id) return Boolean;
...@@ -1338,19 +1467,6 @@ package body Bindo.Graphs is ...@@ -1338,19 +1467,6 @@ package body Bindo.Graphs is
-- Determine whether edge Edge of library graph G is an invocation edge, -- Determine whether edge Edge of library graph G is an invocation edge,
-- and if it is return Count + 1, otherwise return Count. -- and if it is return Count + 1, otherwise return Count.
procedure Normalize_And_Add_Cycle
(G : Library_Graph;
Most_Significant_Edge : Library_Graph_Edge_Id;
Invocation_Edge_Count : Natural;
Cycle_Path : LGE_Lists.Doubly_Linked_List;
Indent : Indentation_Level);
pragma Inline (Normalize_And_Add_Cycle);
-- Normalize a cycle described by its path Cycle_Path and add it to
-- library graph G. Most_Significant_Edge denotes the edge with the
-- highest significance along the cycle path. Invocation_Edge_Count
-- denotes the number of invocation edges along the cycle path. Indent
-- is the desired indentation level for tracing.
procedure Normalize_Cycle_Path procedure Normalize_Cycle_Path
(Cycle_Path : LGE_Lists.Doubly_Linked_List; (Cycle_Path : LGE_Lists.Doubly_Linked_List;
Most_Significant_Edge : Library_Graph_Edge_Id); Most_Significant_Edge : Library_Graph_Edge_Id);
...@@ -1358,6 +1474,13 @@ package body Bindo.Graphs is ...@@ -1358,6 +1474,13 @@ package body Bindo.Graphs is
-- Normalize cycle path Path by rotating it until its starting edge is -- Normalize cycle path Path by rotating it until its starting edge is
-- Sig_Edge. -- Sig_Edge.
procedure Order_Cycle
(G : Library_Graph;
Cycle : Library_Graph_Cycle_Id);
pragma Inline (Order_Cycle);
-- Insert cycle Cycle in library graph G and sort it based on its
-- precedence relative to all recorded cycles.
function Path function Path
(G : Library_Graph; (G : Library_Graph;
Cycle : Library_Graph_Cycle_Id) return LGE_Lists.Doubly_Linked_List; Cycle : Library_Graph_Cycle_Id) return LGE_Lists.Doubly_Linked_List;
...@@ -1365,46 +1488,18 @@ package body Bindo.Graphs is ...@@ -1365,46 +1488,18 @@ package body Bindo.Graphs is
-- Obtain the path of edges which comprises cycle Cycle of library -- Obtain the path of edges which comprises cycle Cycle of library
-- graph G. -- graph G.
function Precedence procedure Record_Cycle
(G : Library_Graph; (G : Library_Graph;
Cycle : Library_Graph_Cycle_Id; Most_Significant_Edge : Library_Graph_Edge_Id;
Compared_To : Library_Graph_Cycle_Id) return Precedence_Kind; Invocation_Edge_Count : Natural;
pragma Inline (Precedence); Cycle_Path : LGE_Lists.Doubly_Linked_List;
-- Determine the precedence of cycle Cycle of library graph G compared Indent : Indentation_Level);
-- to cycle Compared_To. pragma Inline (Record_Cycle);
-- Normalize a cycle described by its path Cycle_Path and add it to
function Precedence -- library graph G. Most_Significant_Edge denotes the edge with the
(Kind : Library_Graph_Cycle_Kind; -- highest significance along the cycle path. Invocation_Edge_Count
Compared_To : Library_Graph_Cycle_Kind) return Precedence_Kind; -- is the number of invocation edges along the cycle path. Indent is
pragma Inline (Precedence); -- the desired indentation level for tracing.
-- Determine the precedence of cycle kind Kind compared to cycle kind
-- Compared_To.
function Precedence
(G : Library_Graph;
Edge : Library_Graph_Edge_Id;
Compared_To : Library_Graph_Edge_Id) return Precedence_Kind;
pragma Inline (Precedence);
-- Determine the precedence of edge Edge of library graph G compared to
-- edge Compared_To.
function Precedence
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id;
Compared_To : Library_Graph_Vertex_Id) return Precedence_Kind;
pragma Inline (Precedence);
-- Determine the precedence of vertex Vertex of library graph G compared
-- to vertex Compared_To.
procedure Remove_Vertex_And_Complement
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id;
Set : LGV_Sets.Membership_Set;
Do_Complement : Boolean);
pragma Inline (Remove_Vertex_And_Complement);
-- Remove vertex Vertex of library graph G from set Set. If the vertex
-- is part of an Elaborate_Body pair, or Do_Complement is set, remove
-- the complementary vertex from the set.
procedure Set_Component_Attributes procedure Set_Component_Attributes
(G : Library_Graph; (G : Library_Graph;
...@@ -1420,14 +1515,6 @@ package body Bindo.Graphs is ...@@ -1420,14 +1515,6 @@ package body Bindo.Graphs is
pragma Inline (Set_Corresponding_Vertex); pragma Inline (Set_Corresponding_Vertex);
-- Associate vertex Val of library graph G with unit U_Id -- Associate vertex Val of library graph G with unit U_Id
procedure Set_Is_Recorded_Cycle
(G : Library_Graph;
Attrs : Library_Graph_Cycle_Attributes;
Val : Boolean := True);
pragma Inline (Set_Is_Recorded_Cycle);
-- Mark a cycle described by its attributes Attrs as recorded in library
-- graph G depending on value Val.
procedure Set_Is_Recorded_Edge procedure Set_Is_Recorded_Edge
(G : Library_Graph; (G : Library_Graph;
Rel : Predecessor_Successor_Relation; Rel : Predecessor_Successor_Relation;
...@@ -1457,6 +1544,14 @@ package body Bindo.Graphs is ...@@ -1457,6 +1544,14 @@ package body Bindo.Graphs is
pragma Inline (Set_LGV_Attributes); pragma Inline (Set_LGV_Attributes);
-- Set the attributes of vertex Vertex of library graph G to value Val -- Set the attributes of vertex Vertex of library graph G to value Val
procedure Trace_Component
(G : Library_Graph;
Comp : Component_Id;
Indent : Indentation_Level);
pragma Inline (Trace_Component);
-- Write the contents of component Comp of library graph G to standard
-- output. Indent is the desired indentation level for tracing.
procedure Trace_Cycle procedure Trace_Cycle
(G : Library_Graph; (G : Library_Graph;
Cycle : Library_Graph_Cycle_Id; Cycle : Library_Graph_Cycle_Id;
...@@ -1473,10 +1568,6 @@ package body Bindo.Graphs is ...@@ -1473,10 +1568,6 @@ package body Bindo.Graphs is
-- Write the contents of edge Edge of library graph G to standard -- Write the contents of edge Edge of library graph G to standard
-- output. Indent is the desired indentation level for tracing. -- output. Indent is the desired indentation level for tracing.
procedure Trace_Eol;
pragma Inline (Trace_Eol);
-- Write an end-of-line to standard output
procedure Trace_Vertex procedure Trace_Vertex
(G : Library_Graph; (G : Library_Graph;
Vertex : Library_Graph_Vertex_Id; Vertex : Library_Graph_Vertex_Id;
...@@ -1485,6 +1576,15 @@ package body Bindo.Graphs is ...@@ -1485,6 +1576,15 @@ package body Bindo.Graphs is
-- Write the contents of vertex Vertex of library graph G to standard -- Write the contents of vertex Vertex of library graph G to standard
-- output. Indent is the desired indentation level for tracing. -- output. Indent is the desired indentation level for tracing.
procedure Unvisit
(Vertex : Library_Graph_Vertex_Id;
Visited_Set : LGV_Sets.Membership_Set;
Visited_Stack : LGV_Lists.Doubly_Linked_List);
pragma Inline (Unvisit);
-- Part of Tarjan's enumeration of the elementary circuits of a directed
-- graph algorithm. Unwind the Visited_Stack by removing the top vertex
-- from set Visited_Set until vertex Vertex is reached, inclusive.
procedure Update_Pending_Predecessors procedure Update_Pending_Predecessors
(Strong_Predecessors : in out Natural; (Strong_Predecessors : in out Natural;
Weak_Predecessors : in out Natural; Weak_Predecessors : in out Natural;
...@@ -1508,6 +1608,23 @@ package body Bindo.Graphs is ...@@ -1508,6 +1608,23 @@ package body Bindo.Graphs is
-- LGE_Is's successor vertex of library graph G must wait on before -- LGE_Is's successor vertex of library graph G must wait on before
-- it can be elaborated. -- it can be elaborated.
function Vertex_Precedence
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id;
Compared_To : Library_Graph_Vertex_Id) return Precedence_Kind;
pragma Inline (Vertex_Precedence);
-- Determine the precedence of vertex Vertex of library graph G compared
-- to vertex Compared_To.
procedure Visit
(Vertex : Library_Graph_Vertex_Id;
Visited_Set : LGV_Sets.Membership_Set;
Visited_Stack : LGV_Lists.Doubly_Linked_List);
pragma Inline (Visit);
-- Part of Tarjan's enumeration of the elementary circuits of a directed
-- graph algorithm. Push vertex Vertex on the Visited_Stack and add it
-- to set Visited_Set.
-------------------- --------------------
-- Activates_Task -- -- Activates_Task --
-------------------- --------------------
...@@ -1616,44 +1733,6 @@ package body Bindo.Graphs is ...@@ -1616,44 +1733,6 @@ package body Bindo.Graphs is
end loop; end loop;
end Add_Body_Before_Spec_Edges; end Add_Body_Before_Spec_Edges;
---------------
-- Add_Cycle --
---------------
procedure Add_Cycle
(G : Library_Graph;
Attrs : Library_Graph_Cycle_Attributes;
Indent : Indentation_Level)
is
Cycle : Library_Graph_Cycle_Id;
begin
pragma Assert (Present (G));
-- Nothing to do when the cycle has already been recorded, possibly
-- in a rotated form.
if Is_Recorded_Cycle (G, Attrs) then
return;
end if;
-- Mark the cycle as recorded. This prevents further attempts to add
-- rotations of the same cycle.
Set_Is_Recorded_Cycle (G, Attrs);
-- Save the attributes of the cycle
Cycle := Sequence_Next_Cycle;
Set_LGC_Attributes (G, Cycle, Attrs);
Trace_Cycle (G, Cycle, Indent);
-- Insert the cycle in the list of all cycle based on its precedence
Insert_And_Sort (G, Cycle);
end Add_Cycle;
-------------- --------------
-- Add_Edge -- -- Add_Edge --
-------------- --------------
...@@ -1799,34 +1878,6 @@ package body Bindo.Graphs is ...@@ -1799,34 +1878,6 @@ package body Bindo.Graphs is
Set_Corresponding_Vertex (G, U_Id, Vertex); Set_Corresponding_Vertex (G, U_Id, Vertex);
end Add_Vertex; end Add_Vertex;
-------------------------------
-- Add_Vertex_And_Complement --
-------------------------------
procedure Add_Vertex_And_Complement
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id;
Set : LGV_Sets.Membership_Set;
Do_Complement : Boolean)
is
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
pragma Assert (LGV_Sets.Present (Set));
Complement : constant Library_Graph_Vertex_Id :=
Complementary_Vertex
(G => G,
Vertex => Vertex,
Force_Complement => Do_Complement);
begin
LGV_Sets.Insert (Set, Vertex);
if Present (Complement) then
LGV_Sets.Insert (Set, Complement);
end if;
end Add_Vertex_And_Complement;
--------------------------------- ---------------------------------
-- At_Least_One_Edge_Satisfies -- -- At_Least_One_Edge_Satisfies --
--------------------------------- ---------------------------------
...@@ -2051,7 +2102,6 @@ package body Bindo.Graphs is ...@@ -2051,7 +2102,6 @@ package body Bindo.Graphs is
DG.Create DG.Create
(Initial_Vertices => Initial_Vertices, (Initial_Vertices => Initial_Vertices,
Initial_Edges => Initial_Edges); Initial_Edges => Initial_Edges);
G.Recorded_Cycles := RC_Sets.Create (Initial_Vertices);
G.Recorded_Edges := RE_Sets.Create (Initial_Edges); G.Recorded_Edges := RE_Sets.Create (Initial_Edges);
G.Unit_To_Vertex := Unit_Tables.Create (Initial_Vertices); G.Unit_To_Vertex := Unit_Tables.Create (Initial_Vertices);
G.Vertex_Attributes := LGV_Tables.Create (Initial_Vertices); G.Vertex_Attributes := LGV_Tables.Create (Initial_Vertices);
...@@ -2059,6 +2109,49 @@ package body Bindo.Graphs is ...@@ -2059,6 +2109,49 @@ package body Bindo.Graphs is
return G; return G;
end Create; end Create;
------------------------
-- Cycle_End_Vertices --
------------------------
function Cycle_End_Vertices
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id;
Elaborate_All_Active : Boolean) return LGV_Sets.Membership_Set
is
Complement : Library_Graph_Vertex_Id;
End_Vertices : LGV_Sets.Membership_Set := LGV_Sets.Nil;
begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
End_Vertices := LGV_Sets.Create (2);
-- The input vertex always terminates a cycle path
LGV_Sets.Insert (End_Vertices, Vertex);
-- Add the complementary vertex to the set of cycle terminating
-- vertices when either Elaborate_All is in effect, or the input
-- vertex is part of an Elaborat_Body pair.
if Elaborate_All_Active
or else Is_Vertex_With_Elaborate_Body (G, Vertex)
then
Complement :=
Complementary_Vertex
(G => G,
Vertex => Vertex,
Force_Complement => Elaborate_All_Active);
if Present (Complement) then
LGV_Sets.Insert (End_Vertices, Complement);
end if;
end if;
return End_Vertices;
end Cycle_End_Vertices;
------------------- -------------------
-- Cycle_Kind_Of -- -- Cycle_Kind_Of --
------------------- -------------------
...@@ -2091,84 +2184,252 @@ package body Bindo.Graphs is ...@@ -2091,84 +2184,252 @@ package body Bindo.Graphs is
end if; end if;
end Cycle_Kind_Of; end Cycle_Kind_Of;
---------------------------------------- ---------------------------
-- Decrement_Library_Graph_Edge_Count -- -- Cycle_Kind_Precedence --
---------------------------------------- ---------------------------
procedure Decrement_Library_Graph_Edge_Count function Cycle_Kind_Precedence
(G : Library_Graph; (Kind : Library_Graph_Cycle_Kind;
Kind : Library_Graph_Edge_Kind) Compared_To : Library_Graph_Cycle_Kind) return Precedence_Kind
is is
pragma Assert (Present (G)); Comp_Pos : constant Integer :=
Library_Graph_Cycle_Kind'Pos (Compared_To);
Count : Natural renames G.Counts (Kind); Kind_Pos : constant Integer := Library_Graph_Cycle_Kind'Pos (Kind);
begin begin
Count := Count - 1; -- A lower ordinal indicates a higher precedence
end Decrement_Library_Graph_Edge_Count;
------------------------------------ if Kind_Pos < Comp_Pos then
-- Decrement_Pending_Predecessors -- return Higher_Precedence;
------------------------------------
procedure Decrement_Pending_Predecessors elsif Kind_Pos > Comp_Pos then
(G : Library_Graph; return Lower_Precedence;
Comp : Component_Id;
Edge : Library_Graph_Edge_Id)
is
Attrs : Component_Attributes;
begin else
pragma Assert (Present (G)); return Equal_Precedence;
pragma Assert (Present (Comp)); end if;
end Cycle_Kind_Precedence;
Attrs := Get_Component_Attributes (G, Comp); ---------------------------
-- Cycle_Path_Precedence --
---------------------------
Update_Pending_Predecessors function Cycle_Path_Precedence
(Strong_Predecessors => Attrs.Pending_Strong_Predecessors, (G : Library_Graph;
Weak_Predecessors => Attrs.Pending_Weak_Predecessors, Path : LGE_Lists.Doubly_Linked_List;
Update_Weak => Is_Invocation_Edge (G, Edge), Compared_To : LGE_Lists.Doubly_Linked_List) return Precedence_Kind
Value => -1); is
procedure Next_Available
(Iter : in out LGE_Lists.Iterator;
Edge : out Library_Graph_Edge_Id);
pragma Inline (Next_Available);
-- Obtain the next edge available through iterator Iter, or return
-- No_Library_Graph_Edge if the iterator has been exhausted.
--------------------
-- Next_Available --
--------------------
procedure Next_Available
(Iter : in out LGE_Lists.Iterator;
Edge : out Library_Graph_Edge_Id)
is
begin
-- Assume that the iterator has been exhausted
Edge := No_Library_Graph_Edge;
if LGE_Lists.Has_Next (Iter) then
LGE_Lists.Next (Iter, Edge);
end if;
end Next_Available;
Set_Component_Attributes (G, Comp, Attrs); -- Local variables
end Decrement_Pending_Predecessors;
------------------------------------ Comp_Edge : Library_Graph_Edge_Id;
-- Decrement_Pending_Predecessors -- Comp_Iter : LGE_Lists.Iterator;
------------------------------------ Path_Edge : Library_Graph_Edge_Id;
Path_Iter : LGE_Lists.Iterator;
Prec : Precedence_Kind;
procedure Decrement_Pending_Predecessors -- Start of processing for Cycle_Path_Precedence
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id;
Edge : Library_Graph_Edge_Id)
is
Attrs : Library_Graph_Vertex_Attributes;
begin begin
pragma Assert (Present (G)); pragma Assert (Present (G));
pragma Assert (Present (Vertex)); pragma Assert (LGE_Lists.Present (Path));
pragma Assert (LGE_Lists.Present (Compared_To));
Attrs := Get_LGV_Attributes (G, Vertex); -- Assume that the paths have equal precedence
Update_Pending_Predecessors Prec := Equal_Precedence;
(Strong_Predecessors => Attrs.Pending_Strong_Predecessors,
Weak_Predecessors => Attrs.Pending_Weak_Predecessors,
Update_Weak => Is_Invocation_Edge (G, Edge),
Value => -1);
Set_LGV_Attributes (G, Vertex, Attrs); Comp_Iter := LGE_Lists.Iterate (Compared_To);
end Decrement_Pending_Predecessors; Path_Iter := LGE_Lists.Iterate (Path);
----------------------------------- Next_Available (Comp_Iter, Comp_Edge);
-- Delete_Body_Before_Spec_Edges -- Next_Available (Path_Iter, Path_Edge);
-----------------------------------
procedure Delete_Body_Before_Spec_Edges -- IMPORTANT:
(G : Library_Graph; --
Edges : LGE_Lists.Doubly_Linked_List) -- * The iteration must run to completion in order to unlock the
is -- edges of both paths.
Edge : Library_Graph_Edge_Id;
Iter : LGE_Lists.Iterator; while Present (Comp_Edge) or else Present (Path_Edge) loop
if Prec = Equal_Precedence
and then Present (Comp_Edge)
and then Present (Path_Edge)
then
Prec :=
Edge_Precedence
(G => G,
Edge => Path_Edge,
Compared_To => Comp_Edge);
end if;
Next_Available (Comp_Iter, Comp_Edge);
Next_Available (Path_Iter, Path_Edge);
end loop;
return Prec;
end Cycle_Path_Precedence;
----------------------
-- Cycle_Precedence --
----------------------
function Cycle_Precedence
(G : Library_Graph;
Cycle : Library_Graph_Cycle_Id;
Compared_To : Library_Graph_Cycle_Id) return Precedence_Kind
is
pragma Assert (Present (G));
pragma Assert (Present (Cycle));
pragma Assert (Present (Compared_To));
Comp_Invs : constant Natural :=
Invocation_Edge_Count (G, Compared_To);
Comp_Len : constant Natural := Length (G, Compared_To);
Cycle_Invs : constant Natural := Invocation_Edge_Count (G, Cycle);
Cycle_Len : constant Natural := Length (G, Cycle);
Kind_Prec : constant Precedence_Kind :=
Cycle_Kind_Precedence
(Kind => Kind (G, Cycle),
Compared_To => Kind (G, Compared_To));
begin
-- Prefer a cycle with higher precedence based on its kind
if Kind_Prec = Higher_Precedence
or else
Kind_Prec = Lower_Precedence
then
return Kind_Prec;
-- Prefer a shorter cycle
elsif Cycle_Len < Comp_Len then
return Higher_Precedence;
elsif Cycle_Len > Comp_Len then
return Lower_Precedence;
-- Prefer a cycle wih fewer invocation edges
elsif Cycle_Invs < Comp_Invs then
return Higher_Precedence;
elsif Cycle_Invs > Comp_Invs then
return Lower_Precedence;
-- Prever a cycle with a higher path precedence
else
return
Cycle_Path_Precedence
(G => G,
Path => Path (G, Cycle),
Compared_To => Path (G, Compared_To));
end if;
end Cycle_Precedence;
----------------------------------------
-- Decrement_Library_Graph_Edge_Count --
----------------------------------------
procedure Decrement_Library_Graph_Edge_Count
(G : Library_Graph;
Kind : Library_Graph_Edge_Kind)
is
pragma Assert (Present (G));
Count : Natural renames G.Counts (Kind);
begin
Count := Count - 1;
end Decrement_Library_Graph_Edge_Count;
------------------------------------
-- Decrement_Pending_Predecessors --
------------------------------------
procedure Decrement_Pending_Predecessors
(G : Library_Graph;
Comp : Component_Id;
Edge : Library_Graph_Edge_Id)
is
Attrs : Component_Attributes;
begin
pragma Assert (Present (G));
pragma Assert (Present (Comp));
Attrs := Get_Component_Attributes (G, Comp);
Update_Pending_Predecessors
(Strong_Predecessors => Attrs.Pending_Strong_Predecessors,
Weak_Predecessors => Attrs.Pending_Weak_Predecessors,
Update_Weak => Is_Invocation_Edge (G, Edge),
Value => -1);
Set_Component_Attributes (G, Comp, Attrs);
end Decrement_Pending_Predecessors;
------------------------------------
-- Decrement_Pending_Predecessors --
------------------------------------
procedure Decrement_Pending_Predecessors
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id;
Edge : Library_Graph_Edge_Id)
is
Attrs : Library_Graph_Vertex_Attributes;
begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
Attrs := Get_LGV_Attributes (G, Vertex);
Update_Pending_Predecessors
(Strong_Predecessors => Attrs.Pending_Strong_Predecessors,
Weak_Predecessors => Attrs.Pending_Weak_Predecessors,
Update_Weak => Is_Invocation_Edge (G, Edge),
Value => -1);
Set_LGV_Attributes (G, Vertex, Attrs);
end Decrement_Pending_Predecessors;
-----------------------------------
-- Delete_Body_Before_Spec_Edges --
-----------------------------------
procedure Delete_Body_Before_Spec_Edges
(G : Library_Graph;
Edges : LGE_Lists.Doubly_Linked_List)
is
Edge : Library_Graph_Edge_Id;
Iter : LGE_Lists.Iterator;
begin begin
pragma Assert (Present (G)); pragma Assert (Present (G));
...@@ -2240,7 +2501,6 @@ package body Bindo.Graphs is ...@@ -2240,7 +2501,6 @@ package body Bindo.Graphs is
LGC_Lists.Destroy (G.Cycles); LGC_Lists.Destroy (G.Cycles);
LGE_Tables.Destroy (G.Edge_Attributes); LGE_Tables.Destroy (G.Edge_Attributes);
DG.Destroy (G.Graph); DG.Destroy (G.Graph);
RC_Sets.Destroy (G.Recorded_Cycles);
RE_Sets.Destroy (G.Recorded_Edges); RE_Sets.Destroy (G.Recorded_Edges);
Unit_Tables.Destroy (G.Unit_To_Vertex); Unit_Tables.Destroy (G.Unit_To_Vertex);
LGV_Tables.Destroy (G.Vertex_Attributes); LGV_Tables.Destroy (G.Vertex_Attributes);
...@@ -2283,18 +2543,6 @@ package body Bindo.Graphs is ...@@ -2283,18 +2543,6 @@ package body Bindo.Graphs is
null; null;
end Destroy_Library_Graph_Edge_Attributes; end Destroy_Library_Graph_Edge_Attributes;
----------------------------------
-- Destroy_Library_Graph_Vertex --
----------------------------------
procedure Destroy_Library_Graph_Vertex
(Vertex : in out Library_Graph_Vertex_Id)
is
pragma Unreferenced (Vertex);
begin
null;
end Destroy_Library_Graph_Vertex;
--------------------------------------------- ---------------------------------------------
-- Destroy_Library_Graph_Vertex_Attributes -- -- Destroy_Library_Graph_Vertex_Attributes --
--------------------------------------------- ---------------------------------------------
...@@ -2307,6 +2555,62 @@ package body Bindo.Graphs is ...@@ -2307,6 +2555,62 @@ package body Bindo.Graphs is
null; null;
end Destroy_Library_Graph_Vertex_Attributes; end Destroy_Library_Graph_Vertex_Attributes;
---------------------
-- Edge_Precedence --
---------------------
function Edge_Precedence
(G : Library_Graph;
Edge : Library_Graph_Edge_Id;
Compared_To : Library_Graph_Edge_Id) return Precedence_Kind
is
pragma Assert (Present (G));
pragma Assert (Present (Edge));
pragma Assert (Present (Compared_To));
Comp_Succ : constant Library_Graph_Vertex_Id :=
Successor (G, Compared_To);
Edge_Succ : constant Library_Graph_Vertex_Id :=
Successor (G, Edge);
Kind_Prec : constant Precedence_Kind :=
Cycle_Kind_Precedence
(Kind => Cycle_Kind_Of (G, Edge),
Compared_To => Cycle_Kind_Of (G, Compared_To));
Succ_Prec : constant Precedence_Kind :=
Vertex_Precedence
(G => G,
Vertex => Edge_Succ,
Compared_To => Comp_Succ);
begin
-- Prefer an edge with a higher cycle kind precedence
if Kind_Prec = Higher_Precedence
or else
Kind_Prec = Lower_Precedence
then
return Kind_Prec;
-- Prefer an edge whose successor has a higher precedence
elsif Comp_Succ /= Edge_Succ
and then (Succ_Prec = Higher_Precedence
or else
Succ_Prec = Lower_Precedence)
then
return Succ_Prec;
-- Prefer an edge whose predecessor has a higher precedence
else
return
Vertex_Precedence
(G => G,
Vertex => Predecessor (G, Edge),
Compared_To => Predecessor (G, Compared_To));
end if;
end Edge_Precedence;
--------------- ---------------
-- File_Name -- -- File_Name --
--------------- ---------------
...@@ -2322,320 +2626,512 @@ package body Bindo.Graphs is ...@@ -2322,320 +2626,512 @@ package body Bindo.Graphs is
return File_Name (Unit (G, Vertex)); return File_Name (Unit (G, Vertex));
end File_Name; end File_Name;
------------------------------------ ---------------------
-- Find_All_Cycles_Through_Vertex -- -- Find_Components --
------------------------------------ ---------------------
procedure Find_All_Cycles_Through_Vertex procedure Find_Components (G : Library_Graph) is
(G : Library_Graph; Edges : LGE_Lists.Doubly_Linked_List;
Vertex : Library_Graph_Vertex_Id;
End_Vertices : LGV_Sets.Membership_Set; begin
Most_Significant_Edge : Library_Graph_Edge_Id; pragma Assert (Present (G));
Invocation_Edge_Count : Natural;
Spec_And_Body_Together : Boolean; -- Initialize or reinitialize the components of the graph
Cycle_Path : LGE_Lists.Doubly_Linked_List;
Visited_Vertices : LGV_Sets.Membership_Set; Initialize_Components (G);
Indent : Indentation_Level)
is -- Create a set of special edges that link a predecessor body with a
Edge_Indent : constant Indentation_Level := -- successor spec. This is an illegal dependency, however using such
Indent + Nested_Indentation; -- edges eliminates the need to create yet another graph, where both
-- spec and body are collapsed into a single vertex.
Edges := LGE_Lists.Create;
Add_Body_Before_Spec_Edges (G, Edges);
DG.Find_Components (G.Graph);
-- Remove the special edges that link a predecessor body with a
-- successor spec because they cause unresolvable circularities.
Iter : Edges_To_Successors_Iterator; Delete_Body_Before_Spec_Edges (G, Edges);
Next_Edge : Library_Graph_Edge_Id; LGE_Lists.Destroy (Edges);
-- Update the number of predecessors various components must wait on
-- before they can be elaborated.
Update_Pending_Predecessors_Of_Components (G);
end Find_Components;
-----------------
-- Find_Cycles --
-----------------
procedure Find_Cycles (G : Library_Graph) is
All_Cycle_Limit : constant Natural := 64;
-- The performance of Tarjan's algorithm may degrate to exponential
-- when pragma Elaborate_All is in effect, or some vertex is part of
-- an Elaborate_Body pair. In this case the algorithm discovers all
-- combinations of edges that close a circuit starting and ending on
-- some start vertex while going through different vertices. Use a
-- limit on the total number of cycles within a component to guard
-- against such degradation.
Comp : Component_Id;
Cycle_Count : Natural;
Iter : Component_Iterator;
begin begin
pragma Assert (Present (G)); pragma Assert (Present (G));
pragma Assert (LGV_Sets.Present (End_Vertices));
pragma Assert (Present (Most_Significant_Edge));
pragma Assert (LGE_Lists.Present (Cycle_Path));
pragma Assert (LGV_Sets.Present (Visited_Vertices));
-- Nothing to do when there is no vertex -- The cycles of graph G are discovered using Tarjan's enumeration
-- of the elementary circuits of a directed graph algorithm. Do not
-- modify this code unless you intimately understand the algorithm.
--
-- The logic of the algorithm is split among the following routines:
--
-- Cycle_End_Vertices
-- Find_Cycles_From_Successor
-- Find_Cycles_From_Vertex
-- Find_Cycles_In_Component
-- Unvisit
-- Visit
--
-- The original algorithm has been significantly modified in order to
--
-- * Accomodate the semantics of Elaborate_All and Elaborate_Body.
--
-- * Capture cycle paths as edges rather than vertices.
--
-- * Take advantage of graph components.
if not Present (Vertex) then -- Assume that the graph does not contain a cycle
return;
end if;
-- The current vertex denotes the end vertex of the cycle and closes Cycle_Count := 0;
-- the circuit. Normalize the cycle such that it is rotated with its
-- most significant edge first, and record it for diagnostics.
if LGV_Sets.Contains (End_Vertices, Vertex) then -- Run the modified version of the algorithm on each component of the
Trace_Vertex (G, Vertex, Indent); -- graph.
Normalize_And_Add_Cycle Iter := Iterate_Components (G);
(G => G, while Has_Next (Iter) loop
Most_Significant_Edge => Most_Significant_Edge, Next (Iter, Comp);
Invocation_Edge_Count => Invocation_Edge_Count,
Cycle_Path => Cycle_Path,
Indent => Indent + Nested_Indentation);
-- Otherwise extend the search for a cycle only when the vertex has Find_Cycles_In_Component
-- not been visited yet. (G => G,
Comp => Comp,
Cycle_Count => Cycle_Count,
Cycle_Limit => All_Cycle_Limit);
end loop;
end Find_Cycles;
elsif not LGV_Sets.Contains (Visited_Vertices, Vertex) then --------------------------------
Trace_Vertex (G, Vertex, Indent); -- Find_Cycles_From_Successor --
--------------------------------
procedure Find_Cycles_From_Successor
(G : Library_Graph;
Edge : Library_Graph_Edge_Id;
End_Vertices : LGV_Sets.Membership_Set;
Deleted_Vertices : LGV_Sets.Membership_Set;
Most_Significant_Edge : Library_Graph_Edge_Id;
Invocation_Edge_Count : Natural;
Cycle_Path_Stack : LGE_Lists.Doubly_Linked_List;
Visited_Set : LGV_Sets.Membership_Set;
Visited_Stack : LGV_Lists.Doubly_Linked_List;
Cycle_Count : in out Natural;
Cycle_Limit : Natural;
Elaborate_All_Active : Boolean;
Has_Cycle : out Boolean;
Indent : Indentation_Level)
is
pragma Assert (Present (G));
pragma Assert (Present (Edge));
pragma Assert (LGV_Sets.Present (End_Vertices));
pragma Assert (LGV_Sets.Present (Deleted_Vertices));
pragma Assert (LGE_Lists.Present (Cycle_Path_Stack));
pragma Assert (LGV_Sets.Present (Visited_Set));
pragma Assert (LGV_Lists.Present (Visited_Stack));
Succ : constant Library_Graph_Vertex_Id := Successor (G, Edge);
Succ_Indent : constant Indentation_Level :=
Indent + Nested_Indentation;
begin
-- Assume that the successor reached via the edge does not result in
-- a cycle.
Has_Cycle := False;
-- Nothing to do when the edge connects two vertices residing in two
-- different components.
if not Is_Cyclic_Edge (G, Edge) then
return;
end if;
-- Prepare for vertex backtracking Trace_Edge (G, Edge, Indent);
-- The modified version does not place vertices on the "point stack",
-- but instead collects the edges comprising the cycle. Prepare the
-- edge for backtracking.
LGE_Lists.Prepend (Cycle_Path_Stack, Edge);
Find_Cycles_From_Vertex
(G => G,
Vertex => Succ,
End_Vertices => End_Vertices,
Deleted_Vertices => Deleted_Vertices,
Most_Significant_Edge => Most_Significant_Edge,
Invocation_Edge_Count => Invocation_Edge_Count,
Cycle_Path_Stack => Cycle_Path_Stack,
Visited_Set => Visited_Set,
Visited_Stack => Visited_Stack,
Cycle_Count => Cycle_Count,
Cycle_Limit => Cycle_Limit,
Elaborate_All_Active => Elaborate_All_Active,
Is_Start_Vertex => False,
Has_Cycle => Has_Cycle,
Indent => Succ_Indent);
-- The modified version does not place vertices on the "point stack",
-- but instead collects the edges comprising the cycle. Backtrack the
-- edge.
LGV_Sets.Insert (Visited_Vertices, Vertex); LGE_Lists.Delete_First (Cycle_Path_Stack);
end Find_Cycles_From_Successor;
-- Extend the search via all edges to successors of the vertex -----------------------------
-- Find_Cycles_From_Vertex --
-----------------------------
Iter := Iterate_Edges_To_Successors (G, Vertex); procedure Find_Cycles_From_Vertex
while Has_Next (Iter) loop (G : Library_Graph;
Next (Iter, Next_Edge); Vertex : Library_Graph_Vertex_Id;
End_Vertices : LGV_Sets.Membership_Set;
Deleted_Vertices : LGV_Sets.Membership_Set;
Most_Significant_Edge : Library_Graph_Edge_Id;
Invocation_Edge_Count : Natural;
Cycle_Path_Stack : LGE_Lists.Doubly_Linked_List;
Visited_Set : LGV_Sets.Membership_Set;
Visited_Stack : LGV_Lists.Doubly_Linked_List;
Cycle_Count : in out Natural;
Cycle_Limit : Natural;
Elaborate_All_Active : Boolean;
Is_Start_Vertex : Boolean;
Has_Cycle : out Boolean;
Indent : Indentation_Level)
is
Edge_Indent : constant Indentation_Level :=
Indent + Nested_Indentation;
Complement : Library_Graph_Vertex_Id;
Edge : Library_Graph_Edge_Id;
Iter : Edges_To_Successors_Iterator;
if Is_Cyclic_Edge (G, Next_Edge) then Complement_Has_Cycle : Boolean;
Trace_Edge (G, Next_Edge, Edge_Indent); -- This flag is set when either Elaborate_All is in effect or the
-- current vertex is part of an Elaborate_Body pair, and visiting
-- the "complementary" vertex resulted in a cycle.
-- Prepare for edge backtracking. Prepending ensures that Successor_Has_Cycle : Boolean;
-- final ordering of edges can be traversed from successor -- This flag is set when visiting at least once successor of the
-- to predecessor. -- current vertex resulted in a cycle.
LGE_Lists.Prepend (Cycle_Path, Next_Edge); begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
pragma Assert (LGV_Sets.Present (End_Vertices));
pragma Assert (LGV_Sets.Present (Deleted_Vertices));
pragma Assert (LGE_Lists.Present (Cycle_Path_Stack));
pragma Assert (LGV_Sets.Present (Visited_Set));
pragma Assert (LGV_Lists.Present (Visited_Stack));
-- Extend the search via the successor of the next edge -- Assume that the vertex does not close a circuit
Find_All_Cycles_Through_Vertex Has_Cycle := False;
(G => G,
Vertex => Successor (G, Next_Edge),
End_Vertices => End_Vertices,
-- The next edge may be more important than the current -- Nothing to do when the limit on the number of saved cycles has
-- most important edge, thus "upgrading" the nature of -- been reached. This protects against a combinatorial explostion
-- the cycle, and shifting its point of normalization. -- in components with Elaborate_All cycles.
Most_Significant_Edge => if Cycle_Count >= Cycle_Limit then
Highest_Precedence_Edge return;
(G => G,
Left => Next_Edge,
Right => Most_Significant_Edge),
-- The next edge may be an invocation edge, in which case -- The vertex closes the circuit, thus resulting in a cycle. Save
-- the count of invocation edges increases by one. -- the cycle for later diagnostics. The initial invocation of the
-- routine always ignores the starting vertex to prevent a spurious
-- self cycle.
Invocation_Edge_Count => elsif not Is_Start_Vertex
Maximum_Invocation_Edge_Count and then LGV_Sets.Contains (End_Vertices, Vertex)
(G => G, then
Edge => Next_Edge, Trace_Vertex (G, Vertex, Indent);
Count => Invocation_Edge_Count),
Spec_And_Body_Together => Spec_And_Body_Together,
Cycle_Path => Cycle_Path,
Visited_Vertices => Visited_Vertices,
Indent => Indent);
-- Backtrack the edge Record_Cycle
(G => G,
Most_Significant_Edge => Most_Significant_Edge,
Invocation_Edge_Count => Invocation_Edge_Count,
Cycle_Path => Cycle_Path_Stack,
Indent => Indent);
LGE_Lists.Delete_First (Cycle_Path); Has_Cycle := True;
end if; Cycle_Count := Cycle_Count + 1;
end loop; return;
-- Extend the search via the complementary vertex when the current -- Nothing to do when the vertex has already been deleted. This
-- vertex is part of an Elaborate_Body pair, or the initial edge -- indicates that all available cycles involving the vertex have
-- is an Elaborate_All edge. -- been discovered, and the vertex cannot contribute further to
-- the depth-first search.
Find_All_Cycles_Through_Vertex elsif LGV_Sets.Contains (Deleted_Vertices, Vertex) then
(G => G, return;
Vertex =>
Complementary_Vertex
(G => G,
Vertex => Vertex,
Force_Complement => Spec_And_Body_Together),
End_Vertices => End_Vertices,
Most_Significant_Edge => Most_Significant_Edge,
Invocation_Edge_Count => Invocation_Edge_Count,
Spec_And_Body_Together => Spec_And_Body_Together,
Cycle_Path => Cycle_Path,
Visited_Vertices => Visited_Vertices,
Indent => Indent);
-- Backtrack the vertex -- Nothing to do when the vertex has already been visited. This
-- indicates that the depth-first search initiated from some start
-- vertex already encountered this vertex, and the visited stack has
-- not been unrolled yet.
LGV_Sets.Delete (Visited_Vertices, Vertex); elsif LGV_Sets.Contains (Visited_Set, Vertex) then
return;
end if; end if;
end Find_All_Cycles_Through_Vertex;
------------------------------- Trace_Vertex (G, Vertex, Indent);
-- Find_All_Cycles_With_Edge --
-------------------------------
procedure Find_All_Cycles_With_Edge
(G : Library_Graph;
Initial_Edge : Library_Graph_Edge_Id;
Spec_And_Body_Together : Boolean;
Cycle_Path : LGE_Lists.Doubly_Linked_List;
Visited_Vertices : LGV_Sets.Membership_Set;
Indent : Indentation_Level)
is
pragma Assert (Present (G));
pragma Assert (Present (Initial_Edge));
pragma Assert (LGE_Lists.Present (Cycle_Path));
pragma Assert (LGV_Sets.Present (Visited_Vertices));
Pred : constant Library_Graph_Vertex_Id := -- Mark the vertex as visited
Predecessor (G, Initial_Edge);
Succ : constant Library_Graph_Vertex_Id :=
Successor (G, Initial_Edge);
End_Vertices : LGV_Sets.Membership_Set; Visit
(Vertex => Vertex,
Visited_Set => Visited_Set,
Visited_Stack => Visited_Stack);
begin -- Extend the depth-first search via all the edges to successors
Trace_Edge (G, Initial_Edge, Indent);
-- Use a set to represent the end vertices of the cycle. The set is Iter := Iterate_Edges_To_Successors (G, Vertex);
-- needed to accommodate the Elaborate_All and Elaborate_Body cases while Has_Next (Iter) loop
-- where a cycle may terminate on either a spec or a body vertex. Next (Iter, Edge);
End_Vertices := LGV_Sets.Create (2); Find_Cycles_From_Successor
Add_Vertex_And_Complement (G => G,
(G => G, Edge => Edge,
Vertex => Pred, End_Vertices => End_Vertices,
Set => End_Vertices, Deleted_Vertices => Deleted_Vertices,
Do_Complement => Spec_And_Body_Together);
-- The edge may be more important than the most important edge
-- up to this point, thus "upgrading" the nature of the cycle,
-- and shifting its point of normalization.
Most_Significant_Edge =>
Highest_Precedence_Edge
(G => G,
Left => Edge,
Right => Most_Significant_Edge),
-- The edge may be an invocation edge, in which case the count
-- of invocation edges increases by one.
Invocation_Edge_Count =>
Maximum_Invocation_Edge_Count
(G => G,
Edge => Edge,
Count => Invocation_Edge_Count),
Cycle_Path_Stack => Cycle_Path_Stack,
Visited_Set => Visited_Set,
Visited_Stack => Visited_Stack,
Cycle_Count => Cycle_Count,
Cycle_Limit => Cycle_Limit,
Elaborate_All_Active => Elaborate_All_Active,
Has_Cycle => Successor_Has_Cycle,
Indent => Edge_Indent);
Has_Cycle := Has_Cycle or Successor_Has_Cycle;
end loop;
-- Prepare for edge backtracking -- Visit the complementary vertex of the current vertex when pragma
-- -- Elaborate_All is in effect, or the current vertex is part of an
-- The initial edge starts the path. During the traversal, edges with -- Elaborate_Body pair.
-- higher precedence may be discovered, in which case they supersede
-- the initial edge in terms of significance. Prepending to the cycle
-- path ensures that the vertices can be visited in the proper order
-- for diagnostics.
LGE_Lists.Prepend (Cycle_Path, Initial_Edge); if Elaborate_All_Active
or else Is_Vertex_With_Elaborate_Body (G, Vertex)
then
Complement :=
Complementary_Vertex
(G => G,
Vertex => Vertex,
Force_Complement => Elaborate_All_Active);
if Present (Complement) then
Find_Cycles_From_Vertex
(G => G,
Vertex => Complement,
End_Vertices => End_Vertices,
Deleted_Vertices => Deleted_Vertices,
Most_Significant_Edge => Most_Significant_Edge,
Invocation_Edge_Count => Invocation_Edge_Count,
Cycle_Path_Stack => Cycle_Path_Stack,
Visited_Set => Visited_Set,
Visited_Stack => Visited_Stack,
Cycle_Count => Cycle_Count,
Cycle_Limit => Cycle_Limit,
Elaborate_All_Active => Elaborate_All_Active,
Is_Start_Vertex => Is_Start_Vertex,
Has_Cycle => Complement_Has_Cycle,
Indent => Indent);
Has_Cycle := Has_Cycle or Complement_Has_Cycle;
end if;
end if;
-- Prepare for vertex backtracking -- The original algorithm clears the "marked stack" in two places:
-- --
-- The predecessor is considered the terminator of the path. Add it -- * When the depth-first search starting from the current vertex
-- to the set of visited vertices along with its complement vertex -- discovers at least one cycle, and
-- in the Elaborate_All and Elaborate_Body cases to prevent infinite --
-- recursion. -- * When the depth-first search initiated from a start vertex
-- completes.
Add_Vertex_And_Complement --
(G => G, -- The modified version handles both cases in one place.
Vertex => Pred,
Set => Visited_Vertices,
Do_Complement => Spec_And_Body_Together);
-- Traverse a potential cycle by continuously visiting successors
-- until either the predecessor of the initial edge is reached, or
-- no more successors are available.
Find_All_Cycles_Through_Vertex
(G => G,
Vertex => Succ,
End_Vertices => End_Vertices,
Most_Significant_Edge => Initial_Edge,
Invocation_Edge_Count =>
Maximum_Invocation_Edge_Count
(G => G,
Edge => Initial_Edge,
Count => 0),
Spec_And_Body_Together => Spec_And_Body_Together,
Cycle_Path => Cycle_Path,
Visited_Vertices => Visited_Vertices,
Indent => Indent + Nested_Indentation);
-- Backtrack the edge
LGE_Lists.Delete_First (Cycle_Path);
-- Backtrack the predecessor, along with the complement vertex in the
-- Elaborate_All and Elaborate_Body cases.
Remove_Vertex_And_Complement
(G => G,
Vertex => Pred,
Set => Visited_Vertices,
Do_Complement => Spec_And_Body_Together);
LGV_Sets.Destroy (End_Vertices);
end Find_All_Cycles_With_Edge;
---------------------
-- Find_Components --
---------------------
procedure Find_Components (G : Library_Graph) is if Has_Cycle or else Is_Start_Vertex then
Edges : LGE_Lists.Doubly_Linked_List; Unvisit
(Vertex => Vertex,
Visited_Set => Visited_Set,
Visited_Stack => Visited_Stack);
end if;
begin -- Delete a start vertex from the graph once its depth-first search
pragma Assert (Present (G)); -- completes. This action preserves the invariant where a cycle is
-- not rediscovered "later" in some permuted form.
-- Initialize or reinitialize the components of the graph if Is_Start_Vertex then
LGV_Sets.Insert (Deleted_Vertices, Vertex);
end if;
end Find_Cycles_From_Vertex;
Initialize_Components (G); ------------------------------
-- Find_Cycles_In_Component --
------------------------------
-- Create a set of special edges that link a predecessor body with a procedure Find_Cycles_In_Component
-- successor spec. This is an illegal dependency, however using such (G : Library_Graph;
-- edges eliminates the need to create yet another graph, where both Comp : Component_Id;
-- spec and body are collapsed into a single vertex. Cycle_Count : in out Natural;
Cycle_Limit : Natural)
is
pragma Assert (Present (G));
pragma Assert (Present (Comp));
Edges := LGE_Lists.Create; Num_Of_Vertices : constant Natural :=
Add_Body_Before_Spec_Edges (G, Edges); Number_Of_Component_Vertices (G, Comp);
DG.Find_Components (G.Graph); Elaborate_All_Active : constant Boolean :=
Has_Elaborate_All_Edge (G, Comp);
-- The presence of an Elaborate_All edge within a component causes
-- all spec-body pairs to be treated as one vertex.
-- Remove the special edges that link a predecessor body with a Has_Cycle : Boolean;
-- successor spec because they cause unresolvable circularities. Iter : Component_Vertex_Iterator;
Vertex : Library_Graph_Vertex_Id;
Delete_Body_Before_Spec_Edges (G, Edges); Cycle_Path_Stack : LGE_Lists.Doubly_Linked_List := LGE_Lists.Nil;
LGE_Lists.Destroy (Edges); -- The "point stack" of Tarjan's algorithm. The original maintains
-- a stack of vertices, however for diagnostic purposes using edges
-- is preferable.
-- Update the number of predecessors various components must wait on Deleted_Vertices : LGV_Sets.Membership_Set := LGV_Sets.Nil;
-- before they can be elaborated. -- The original algorithm alters the graph by deleting vertices with
-- lower ordinals compared to some starting vertex. Since the graph
-- must remain intact for diagnostic purposes, vertices are instead
-- inserted in this set and treated as "deleted".
Update_Pending_Predecessors_Of_Components (G); End_Vertices : LGV_Sets.Membership_Set := LGV_Sets.Nil;
end Find_Components; -- The original algorithm uses a single vertex to indicate the start
-- and end vertex of a cycle. The semantics of pragmas Elaborate_All
-- and Elaborate_Body increase this number by one. The end vertices
-- are added to this set and treated as "cycle-terminating".
----------------- Visited_Set : LGV_Sets.Membership_Set := LGV_Sets.Nil;
-- Find_Cycles -- -- The "mark" array of Tarjan's algorithm. Since the original visits
----------------- -- all vertices in increasing ordinal number 1 .. N, the array offers
-- a one to one mapping between a vertex and its "marked" state. The
-- modified version however visits vertices within components, where
-- their ordinals are not contiguous. Vertices are added to this set
-- and treated as "marked".
procedure Find_Cycles (G : Library_Graph) is Visited_Stack : LGV_Lists.Doubly_Linked_List := LGV_Lists.Nil;
Cycle_Path : LGE_Lists.Doubly_Linked_List; -- The "marked stack" of Tarjan's algorithm
Edge : Library_Graph_Edge_Id;
Iter : All_Edge_Iterator;
Visited_Vertices : LGV_Sets.Membership_Set;
begin begin
pragma Assert (Present (G)); Trace_Component (G, Comp, No_Indentation);
-- Use a list of edges to describe the path of a cycle -- Initialize all component-level data structures
Cycle_Path := LGE_Lists.Create; Cycle_Path_Stack := LGE_Lists.Create;
Deleted_Vertices := LGV_Sets.Create (Num_Of_Vertices);
Visited_Set := LGV_Sets.Create (Num_Of_Vertices);
Visited_Stack := LGV_Lists.Create;
-- Use a set of visited vertices to prevent infinite traversal of the -- The modified version does not use ordinals to visit vertices in
-- graph. -- 1 .. N fashion. To preserve the invariant of the original, this
-- version deletes a vertex after its depth-first search completes.
Visited_Vertices := LGV_Sets.Create (Number_Of_Vertices (G)); -- The timing of the deletion is sound because all cycles through
-- that vertex have already been discovered, thus the vertex cannot
-- contribute to any cycles discovered "later" in the algorithm.
-- Inspect all edges, trying to find an edge that links two vertices Iter := Iterate_Component_Vertices (G, Comp);
-- in the same component.
Iter := Iterate_All_Edges (G);
while Has_Next (Iter) loop while Has_Next (Iter) loop
Next (Iter, Edge); Next (Iter, Vertex);
-- Find all cycles involving the current edge. Duplicate cycles in -- Construct the set of vertices (at most 2) that terminates a
-- the forms of rotations are not saved for diagnostic purposes. -- potential cycle that starts from the current vertex.
if Is_Cycle_Initiating_Edge (G, Edge) then End_Vertices :=
Find_All_Cycles_With_Edge Cycle_End_Vertices
(G => G, (G => G,
Initial_Edge => Edge, Vertex => Vertex,
Spec_And_Body_Together => Is_Elaborate_All_Edge (G, Edge), Elaborate_All_Active => Elaborate_All_Active);
Cycle_Path => Cycle_Path,
Visited_Vertices => Visited_Vertices, -- The modified version maintans two addition attributes while
Indent => No_Indentation); -- performing the depth-first search:
--
Trace_Eol; -- * The most significant edge of the current potential cycle.
end if; --
-- * The number of invocation edges encountered along the path
-- of the current potential cycle.
--
-- Both attributes are used in the heuristic which determines the
-- importance of cycles.
Find_Cycles_From_Vertex
(G => G,
Vertex => Vertex,
End_Vertices => End_Vertices,
Deleted_Vertices => Deleted_Vertices,
Most_Significant_Edge => No_Library_Graph_Edge,
Invocation_Edge_Count => 0,
Cycle_Path_Stack => Cycle_Path_Stack,
Visited_Set => Visited_Set,
Visited_Stack => Visited_Stack,
Cycle_Count => Cycle_Count,
Cycle_Limit => Cycle_Limit,
Elaborate_All_Active => Elaborate_All_Active,
Is_Start_Vertex => True,
Has_Cycle => Has_Cycle,
Indent => Nested_Indentation);
-- Destroy the cycle-terminating vertices because a new set must
-- be constructed for the next vertex.
LGV_Sets.Destroy (End_Vertices);
end loop; end loop;
LGE_Lists.Destroy (Cycle_Path); -- Destroy all component-level data structures
LGV_Sets.Destroy (Visited_Vertices);
end Find_Cycles; LGE_Lists.Destroy (Cycle_Path_Stack);
LGV_Sets.Destroy (Deleted_Vertices);
LGV_Sets.Destroy (Visited_Set);
LGV_Lists.Destroy (Visited_Stack);
end Find_Cycles_In_Component;
--------------------------------------- ---------------------------------------
-- Find_First_Lower_Precedence_Cycle -- -- Find_First_Lower_Precedence_Cycle --
...@@ -2670,7 +3166,7 @@ package body Bindo.Graphs is ...@@ -2670,7 +3166,7 @@ package body Bindo.Graphs is
Next (Iter, Current_Cycle); Next (Iter, Current_Cycle);
if not Present (Lesser_Cycle) if not Present (Lesser_Cycle)
and then Precedence and then Cycle_Precedence
(G => G, (G => G,
Cycle => Cycle, Cycle => Cycle,
Compared_To => Current_Cycle) = Higher_Precedence Compared_To => Current_Cycle) = Higher_Precedence
...@@ -2776,6 +3272,77 @@ package body Bindo.Graphs is ...@@ -2776,6 +3272,77 @@ package body Bindo.Graphs is
return Seen; return Seen;
end Has_Elaborate_All_Cycle; end Has_Elaborate_All_Cycle;
----------------------------
-- Has_Elaborate_All_Edge --
----------------------------
function Has_Elaborate_All_Edge
(G : Library_Graph;
Comp : Component_Id) return Boolean
is
Has_Edge : Boolean;
Iter : Component_Vertex_Iterator;
Vertex : Library_Graph_Vertex_Id;
begin
pragma Assert (Present (G));
pragma Assert (Present (Comp));
-- Assume that there is no Elaborate_All edge
Has_Edge := False;
-- IMPORTANT:
--
-- * The iteration must run to completion in order to unlock the
-- component vertices.
Iter := Iterate_Component_Vertices (G, Comp);
while Has_Next (Iter) loop
Next (Iter, Vertex);
Has_Edge := Has_Edge or else Has_Elaborate_All_Edge (G, Vertex);
end loop;
return Has_Edge;
end Has_Elaborate_All_Edge;
----------------------------
-- Has_Elaborate_All_Edge --
----------------------------
function Has_Elaborate_All_Edge
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id) return Boolean
is
Edge : Library_Graph_Edge_Id;
Has_Edge : Boolean;
Iter : Edges_To_Successors_Iterator;
begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
-- Assume that there is no Elaborate_All edge
Has_Edge := False;
-- IMPORTANT:
--
-- * The iteration must run to completion in order to unlock the
-- edges to successors.
Iter := Iterate_Edges_To_Successors (G, Vertex);
while Has_Next (Iter) loop
Next (Iter, Edge);
Has_Edge :=
Has_Edge or else Is_Cyclic_Elaborate_All_Edge (G, Edge);
end loop;
return Has_Edge;
end Has_Elaborate_All_Edge;
------------------------ ------------------------
-- Has_Elaborate_Body -- -- Has_Elaborate_Body --
------------------------ ------------------------
...@@ -2961,7 +3528,7 @@ package body Bindo.Graphs is ...@@ -2961,7 +3528,7 @@ package body Bindo.Graphs is
if Present (Left) and then Present (Right) then if Present (Left) and then Present (Right) then
Edge_Prec := Edge_Prec :=
Precedence Edge_Precedence
(G => G, (G => G,
Edge => Left, Edge => Left,
Compared_To => Right); Compared_To => Right);
...@@ -3109,50 +3676,6 @@ package body Bindo.Graphs is ...@@ -3109,50 +3676,6 @@ package body Bindo.Graphs is
end if; end if;
end Initialize_Components; end Initialize_Components;
---------------------
-- Insert_And_Sort --
---------------------
procedure Insert_And_Sort
(G : Library_Graph;
Cycle : Library_Graph_Cycle_Id)
is
Lesser_Cycle : Library_Graph_Cycle_Id;
begin
pragma Assert (Present (G));
pragma Assert (Present (Cycle));
pragma Assert (LGC_Lists.Present (G.Cycles));
-- The input cycle is the first to be inserted
if LGC_Lists.Is_Empty (G.Cycles) then
LGC_Lists.Prepend (G.Cycles, Cycle);
-- Otherwise the list of all cycles contains at least one cycle.
-- Insert the input cycle based on its precedence.
else
Lesser_Cycle := Find_First_Lower_Precedence_Cycle (G, Cycle);
-- The list contains at least one cycle, and the input cycle has a
-- higher precedence compared to some cycle in the list.
if Present (Lesser_Cycle) then
LGC_Lists.Insert_Before
(L => G.Cycles,
Before => Lesser_Cycle,
Elem => Cycle);
-- Otherwise the input cycle has the lowest precedence among all
-- cycles.
else
LGC_Lists.Append (G.Cycles, Cycle);
end if;
end if;
end Insert_And_Sort;
--------------------------- ---------------------------
-- Invocation_Edge_Count -- -- Invocation_Edge_Count --
--------------------------- ---------------------------
...@@ -3496,17 +4019,13 @@ package body Bindo.Graphs is ...@@ -3496,17 +4019,13 @@ package body Bindo.Graphs is
(G : Library_Graph; (G : Library_Graph;
Edge : Library_Graph_Edge_Id) return Boolean Edge : Library_Graph_Edge_Id) return Boolean
is is
begin
pragma Assert (Present (G)); pragma Assert (Present (G));
pragma Assert (Present (Edge)); pragma Assert (Present (Edge));
Succ : constant Library_Graph_Vertex_Id := Successor (G, Edge);
begin
return return
Kind (G, Edge) = With_Edge Kind (G, Edge) = With_Edge
and then and then Is_Vertex_With_Elaborate_Body (G, Successor (G, Edge));
(Is_Spec_With_Elaborate_Body (G, Succ)
or else Is_Body_Of_Spec_With_Elaborate_Body (G, Succ));
end Is_Elaborate_Body_Edge; end Is_Elaborate_Body_Edge;
----------------------- -----------------------
...@@ -3622,20 +4141,6 @@ package body Bindo.Graphs is ...@@ -3622,20 +4141,6 @@ package body Bindo.Graphs is
return U_Rec.Preelab or else U_Rec.Pure; return U_Rec.Preelab or else U_Rec.Pure;
end Is_Preelaborated_Unit; end Is_Preelaborated_Unit;
-----------------------
-- Is_Recorded_Cycle --
-----------------------
function Is_Recorded_Cycle
(G : Library_Graph;
Attrs : Library_Graph_Cycle_Attributes) return Boolean
is
begin
pragma Assert (Present (G));
return RC_Sets.Contains (G.Recorded_Cycles, Attrs);
end Is_Recorded_Cycle;
---------------------- ----------------------
-- Is_Recorded_Edge -- -- Is_Recorded_Edge --
---------------------- ----------------------
...@@ -3722,6 +4227,24 @@ package body Bindo.Graphs is ...@@ -3722,6 +4227,24 @@ package body Bindo.Graphs is
and then not Is_Dynamically_Elaborated (G, Successor (G, Edge)); and then not Is_Dynamically_Elaborated (G, Successor (G, Edge));
end Is_Static_Successor_Edge; end Is_Static_Successor_Edge;
-----------------------------------
-- Is_Vertex_With_Elaborate_Body --
-----------------------------------
function Is_Vertex_With_Elaborate_Body
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id) return Boolean
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
return
Is_Spec_With_Elaborate_Body (G, Vertex)
or else
Is_Body_Of_Spec_With_Elaborate_Body (G, Vertex);
end Is_Vertex_With_Elaborate_Body;
--------------------------------- ---------------------------------
-- Is_Weakly_Elaborable_Vertex -- -- Is_Weakly_Elaborable_Vertex --
---------------------------------- ----------------------------------
...@@ -4107,50 +4630,6 @@ package body Bindo.Graphs is ...@@ -4107,50 +4630,6 @@ package body Bindo.Graphs is
DG.Next (DG.Component_Vertex_Iterator (Iter), Vertex); DG.Next (DG.Component_Vertex_Iterator (Iter), Vertex);
end Next; end Next;
-----------------------------
-- Normalize_And_Add_Cycle --
-----------------------------
procedure Normalize_And_Add_Cycle
(G : Library_Graph;
Most_Significant_Edge : Library_Graph_Edge_Id;
Invocation_Edge_Count : Natural;
Cycle_Path : LGE_Lists.Doubly_Linked_List;
Indent : Indentation_Level)
is
Path : LGE_Lists.Doubly_Linked_List;
begin
pragma Assert (Present (G));
pragma Assert (Present (Most_Significant_Edge));
pragma Assert (LGE_Lists.Present (Cycle_Path));
-- Replicate the path of the cycle in order to avoid sharing lists
Path := Copy_Cycle_Path (Cycle_Path);
-- Normalize the path of the cycle such that its most significant
-- edge is the first in the list of edges.
Normalize_Cycle_Path
(Cycle_Path => Path,
Most_Significant_Edge => Most_Significant_Edge);
-- Save the cycle for diagnostic purposes. Its kind is determined by
-- its most significant edge.
Add_Cycle
(G => G,
Attrs =>
(Invocation_Edge_Count => Invocation_Edge_Count,
Kind =>
Cycle_Kind_Of
(G => G,
Edge => Most_Significant_Edge),
Path => Path),
Indent => Indent);
end Normalize_And_Add_Cycle;
-------------------------- --------------------------
-- Normalize_Cycle_Path -- -- Normalize_Cycle_Path --
-------------------------- --------------------------
...@@ -4256,12 +4735,56 @@ package body Bindo.Graphs is ...@@ -4256,12 +4735,56 @@ package body Bindo.Graphs is
-- Number_Of_Vertices -- -- Number_Of_Vertices --
------------------------ ------------------------
function Number_Of_Vertices (G : Library_Graph) return Natural is function Number_Of_Vertices (G : Library_Graph) return Natural is
begin begin
pragma Assert (Present (G)); pragma Assert (Present (G));
return DG.Number_Of_Vertices (G.Graph);
end Number_Of_Vertices;
-----------------
-- Order_Cycle --
-----------------
procedure Order_Cycle
(G : Library_Graph;
Cycle : Library_Graph_Cycle_Id)
is
Lesser_Cycle : Library_Graph_Cycle_Id;
begin
pragma Assert (Present (G));
pragma Assert (Present (Cycle));
pragma Assert (LGC_Lists.Present (G.Cycles));
-- The input cycle is the first to be inserted
if LGC_Lists.Is_Empty (G.Cycles) then
LGC_Lists.Prepend (G.Cycles, Cycle);
-- Otherwise the list of all cycles contains at least one cycle.
-- Insert the input cycle based on its precedence.
else
Lesser_Cycle := Find_First_Lower_Precedence_Cycle (G, Cycle);
-- The list contains at least one cycle, and the input cycle has a
-- higher precedence compared to some cycle in the list.
if Present (Lesser_Cycle) then
LGC_Lists.Insert_Before
(L => G.Cycles,
Before => Lesser_Cycle,
Elem => Cycle);
-- Otherwise the input cycle has the lowest precedence among all
-- cycles.
return DG.Number_Of_Vertices (G.Graph); else
end Number_Of_Vertices; LGC_Lists.Append (G.Cycles, Cycle);
end if;
end if;
end Order_Cycle;
---------- ----------
-- Path -- -- Path --
...@@ -4399,146 +4922,6 @@ package body Bindo.Graphs is ...@@ -4399,146 +4922,6 @@ package body Bindo.Graphs is
return Get_LGV_Attributes (G, Vertex).Pending_Weak_Predecessors; return Get_LGV_Attributes (G, Vertex).Pending_Weak_Predecessors;
end Pending_Weak_Predecessors; end Pending_Weak_Predecessors;
----------------
-- Precedence --
----------------
function Precedence
(G : Library_Graph;
Cycle : Library_Graph_Cycle_Id;
Compared_To : Library_Graph_Cycle_Id) return Precedence_Kind
is
pragma Assert (Present (G));
pragma Assert (Present (Cycle));
pragma Assert (Present (Compared_To));
Comp_Invs : constant Natural :=
Invocation_Edge_Count (G, Compared_To);
Comp_Len : constant Natural := Length (G, Compared_To);
Cycle_Invs : constant Natural := Invocation_Edge_Count (G, Cycle);
Cycle_Len : constant Natural := Length (G, Cycle);
Kind_Prec : constant Precedence_Kind :=
Precedence
(Kind => Kind (G, Cycle),
Compared_To => Kind (G, Compared_To));
begin
if Kind_Prec = Higher_Precedence
or else
Kind_Prec = Lower_Precedence
then
return Kind_Prec;
-- Otherwise both cycles have the same precedence based on their
-- kind. Prefer a cycle with fewer invocation edges.
elsif Cycle_Invs < Comp_Invs then
return Higher_Precedence;
elsif Cycle_Invs > Comp_Invs then
return Lower_Precedence;
-- Otherwise both cycles have the same number of invocation edges.
-- Prefer a cycle with a smaller length.
elsif Cycle_Len < Comp_Len then
return Higher_Precedence;
elsif Cycle_Len > Comp_Len then
return Lower_Precedence;
else
return Equal_Precedence;
end if;
end Precedence;
----------------
-- Precedence --
----------------
function Precedence
(Kind : Library_Graph_Cycle_Kind;
Compared_To : Library_Graph_Cycle_Kind) return Precedence_Kind
is
Comp_Pos : constant Integer :=
Library_Graph_Cycle_Kind'Pos (Compared_To);
Kind_Pos : constant Integer := Library_Graph_Cycle_Kind'Pos (Kind);
begin
-- A lower ordinal indicates higher precedence
if Kind_Pos < Comp_Pos then
return Higher_Precedence;
elsif Kind_Pos > Comp_Pos then
return Lower_Precedence;
else
return Equal_Precedence;
end if;
end Precedence;
----------------
-- Precedence --
----------------
function Precedence
(G : Library_Graph;
Edge : Library_Graph_Edge_Id;
Compared_To : Library_Graph_Edge_Id) return Precedence_Kind
is
pragma Assert (Present (G));
pragma Assert (Present (Edge));
pragma Assert (Present (Compared_To));
Kind_Prec : constant Precedence_Kind :=
Precedence
(Kind => Cycle_Kind_Of (G, Edge),
Compared_To => Cycle_Kind_Of (G, Compared_To));
begin
if Kind_Prec = Higher_Precedence
or else
Kind_Prec = Lower_Precedence
then
return Kind_Prec;
-- Otherwise both edges have the same precedence based on their cycle
-- kinds. Prefer an edge whose successor has higher precedence.
else
return
Precedence
(G => G,
Vertex => Successor (G, Edge),
Compared_To => Successor (G, Compared_To));
end if;
end Precedence;
----------------
-- Precedence --
----------------
function Precedence
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id;
Compared_To : Library_Graph_Vertex_Id) return Precedence_Kind
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
pragma Assert (Present (Compared_To));
-- Use lexicographical order to determine precedence and ensure
-- deterministic behavior.
if Uname_Less (Name (G, Vertex), Name (G, Compared_To)) then
return Higher_Precedence;
else
return Lower_Precedence;
end if;
end Precedence;
----------------- -----------------
-- Predecessor -- -- Predecessor --
----------------- -----------------
...@@ -4615,33 +4998,59 @@ package body Bindo.Graphs is ...@@ -4615,33 +4998,59 @@ package body Bindo.Graphs is
end if; end if;
end Proper_Spec; end Proper_Spec;
---------------------------------- ------------------
-- Remove_Vertex_And_Complement -- -- Record_Cycle --
---------------------------------- ------------------
procedure Remove_Vertex_And_Complement procedure Record_Cycle
(G : Library_Graph; (G : Library_Graph;
Vertex : Library_Graph_Vertex_Id; Most_Significant_Edge : Library_Graph_Edge_Id;
Set : LGV_Sets.Membership_Set; Invocation_Edge_Count : Natural;
Do_Complement : Boolean) Cycle_Path : LGE_Lists.Doubly_Linked_List;
Indent : Indentation_Level)
is is
Cycle : Library_Graph_Cycle_Id;
Path : LGE_Lists.Doubly_Linked_List;
begin
pragma Assert (Present (G)); pragma Assert (Present (G));
pragma Assert (Present (Vertex)); pragma Assert (Present (Most_Significant_Edge));
pragma Assert (LGV_Sets.Present (Set)); pragma Assert (LGE_Lists.Present (Cycle_Path));
Complement : constant Library_Graph_Vertex_Id := -- Replicate the path of the cycle in order to avoid sharing lists
Complementary_Vertex
(G => G,
Vertex => Vertex,
Force_Complement => Do_Complement);
begin Path := Copy_Cycle_Path (Cycle_Path);
LGV_Sets.Delete (Set, Vertex);
if Present (Complement) then -- Normalize the path of the cycle such that its most significant
LGV_Sets.Delete (Set, Complement); -- edge is the first in the list of edges.
end if;
end Remove_Vertex_And_Complement; Normalize_Cycle_Path
(Cycle_Path => Path,
Most_Significant_Edge => Most_Significant_Edge);
-- Save the cycle for diagnostic purposes. Its kind is determined by
-- its most significant edge.
Cycle := Sequence_Next_Cycle;
Set_LGC_Attributes
(G => G,
Cycle => Cycle,
Val =>
(Invocation_Edge_Count => Invocation_Edge_Count,
Kind =>
Cycle_Kind_Of
(G => G,
Edge => Most_Significant_Edge),
Path => Path));
Trace_Cycle (G, Cycle, Indent);
-- Order the cycle based on its precedence relative to previously
-- discovered cycles.
Order_Cycle (G, Cycle);
end Record_Cycle;
----------------------------------------- -----------------------------------------
-- Same_Library_Graph_Cycle_Attributes -- -- Same_Library_Graph_Cycle_Attributes --
...@@ -4737,25 +5146,6 @@ package body Bindo.Graphs is ...@@ -4737,25 +5146,6 @@ package body Bindo.Graphs is
Set_LGV_Attributes (G, Vertex, Attrs); Set_LGV_Attributes (G, Vertex, Attrs);
end Set_In_Elaboration_Order; end Set_In_Elaboration_Order;
---------------------------
-- Set_Is_Recorded_Cycle --
---------------------------
procedure Set_Is_Recorded_Cycle
(G : Library_Graph;
Attrs : Library_Graph_Cycle_Attributes;
Val : Boolean := True)
is
begin
pragma Assert (Present (G));
if Val then
RC_Sets.Insert (G.Recorded_Cycles, Attrs);
else
RC_Sets.Delete (G.Recorded_Cycles, Attrs);
end if;
end Set_Is_Recorded_Cycle;
-------------------------- --------------------------
-- Set_Is_Recorded_Edge -- -- Set_Is_Recorded_Edge --
-------------------------- --------------------------
...@@ -4840,6 +5230,34 @@ package body Bindo.Graphs is ...@@ -4840,6 +5230,34 @@ package body Bindo.Graphs is
return DG.Destination_Vertex (G.Graph, Edge); return DG.Destination_Vertex (G.Graph, Edge);
end Successor; end Successor;
---------------------
-- Trace_Component --
---------------------
procedure Trace_Component
(G : Library_Graph;
Comp : Component_Id;
Indent : Indentation_Level)
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Comp));
-- Nothing to do when switch -d_t (output cycle detection trace
-- information) is not in effect.
if not Debug_Flag_Underscore_T then
return;
end if;
Write_Eol;
Indent_By (Indent);
Write_Str ("component (Comp_");
Write_Int (Int (Comp));
Write_Str (")");
Write_Eol;
end Trace_Component;
----------------- -----------------
-- Trace_Cycle -- -- Trace_Cycle --
----------------- -----------------
...@@ -4861,15 +5279,15 @@ package body Bindo.Graphs is ...@@ -4861,15 +5279,15 @@ package body Bindo.Graphs is
pragma Assert (Present (G)); pragma Assert (Present (G));
pragma Assert (Present (Cycle)); pragma Assert (Present (Cycle));
-- Nothing to do when switch -d_T (output elaboration order and cycle -- Nothing to do when switch -d_t (output cycle detection trace
-- detection trace information) is not in effect. -- information) is not in effect.
if not Debug_Flag_Underscore_TT then if not Debug_Flag_Underscore_T then
return; return;
end if; end if;
Indent_By (Indent); Indent_By (Indent);
Write_Str ("cycle (Cycle_Id_"); Write_Str ("cycle (LGC_Id_");
Write_Int (Int (Cycle)); Write_Int (Int (Cycle));
Write_Str (")"); Write_Str (")");
Write_Eol; Write_Eol;
...@@ -4920,10 +5338,10 @@ package body Bindo.Graphs is ...@@ -4920,10 +5338,10 @@ package body Bindo.Graphs is
Succ : constant Library_Graph_Vertex_Id := Successor (G, Edge); Succ : constant Library_Graph_Vertex_Id := Successor (G, Edge);
begin begin
-- Nothing to do when switch -d_T (output elaboration order and cycle -- Nothing to do when switch -d_t (output cycle detection trace
-- detection trace information) is not in effect. -- information) is not in effect.
if not Debug_Flag_Underscore_TT then if not Debug_Flag_Underscore_T then
return; return;
end if; end if;
...@@ -4953,22 +5371,6 @@ package body Bindo.Graphs is ...@@ -4953,22 +5371,6 @@ package body Bindo.Graphs is
Write_Eol; Write_Eol;
end Trace_Edge; end Trace_Edge;
---------------
-- Trace_Eol --
---------------
procedure Trace_Eol is
begin
-- Nothing to do when switch -d_T (output elaboration order and cycle
-- detection trace information) is not in effect.
if not Debug_Flag_Underscore_TT then
return;
end if;
Write_Eol;
end Trace_Eol;
------------------ ------------------
-- Trace_Vertex -- -- Trace_Vertex --
------------------ ------------------
...@@ -4985,10 +5387,10 @@ package body Bindo.Graphs is ...@@ -4985,10 +5387,10 @@ package body Bindo.Graphs is
pragma Assert (Present (G)); pragma Assert (Present (G));
pragma Assert (Present (Vertex)); pragma Assert (Present (Vertex));
-- Nothing to do when switch -d_T (output elaboration order and cycle -- Nothing to do when switch -d_t (output cycle detection trace
-- detection trace information) is not in effect. -- information) is not in effect.
if not Debug_Flag_Underscore_TT then if not Debug_Flag_Underscore_T then
return; return;
end if; end if;
...@@ -4998,12 +5400,6 @@ package body Bindo.Graphs is ...@@ -4998,12 +5400,6 @@ package body Bindo.Graphs is
Write_Str (")"); Write_Str (")");
Write_Eol; Write_Eol;
Indent_By (Attr_Indent);
Write_Str ("Component (Comp_Id_");
Write_Int (Int (Component (G, Vertex)));
Write_Str (")");
Write_Eol;
Indent_By (Attr_Indent); Indent_By (Attr_Indent);
Write_Str ("Unit (U_Id_"); Write_Str ("Unit (U_Id_");
Write_Int (Int (Unit (G, Vertex))); Write_Int (Int (Unit (G, Vertex)));
...@@ -5027,6 +5423,32 @@ package body Bindo.Graphs is ...@@ -5027,6 +5423,32 @@ package body Bindo.Graphs is
return Get_LGV_Attributes (G, Vertex).Unit; return Get_LGV_Attributes (G, Vertex).Unit;
end Unit; end Unit;
-------------
-- Unvisit --
-------------
procedure Unvisit
(Vertex : Library_Graph_Vertex_Id;
Visited_Set : LGV_Sets.Membership_Set;
Visited_Stack : LGV_Lists.Doubly_Linked_List)
is
Current_Vertex : Library_Graph_Vertex_Id;
begin
pragma Assert (Present (Vertex));
pragma Assert (LGV_Sets.Present (Visited_Set));
pragma Assert (LGV_Lists.Present (Visited_Stack));
while not LGV_Lists.Is_Empty (Visited_Stack) loop
Current_Vertex := LGV_Lists.First (Visited_Stack);
LGV_Lists.Delete_First (Visited_Stack);
LGV_Sets.Delete (Visited_Set, Current_Vertex);
exit when Current_Vertex = Vertex;
end loop;
end Unvisit;
--------------------------------- ---------------------------------
-- Update_Pending_Predecessors -- -- Update_Pending_Predecessors --
--------------------------------- ---------------------------------
...@@ -5097,6 +5519,48 @@ package body Bindo.Graphs is ...@@ -5097,6 +5519,48 @@ package body Bindo.Graphs is
Edge => Edge); Edge => Edge);
end if; end if;
end Update_Pending_Predecessors_Of_Components; end Update_Pending_Predecessors_Of_Components;
-----------------------
-- Vertex_Precedence --
-----------------------
function Vertex_Precedence
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id;
Compared_To : Library_Graph_Vertex_Id) return Precedence_Kind
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
pragma Assert (Present (Compared_To));
-- Use lexicographical order to determine precedence and ensure
-- deterministic behavior.
if Uname_Less (Name (G, Vertex), Name (G, Compared_To)) then
return Higher_Precedence;
else
return Lower_Precedence;
end if;
end Vertex_Precedence;
-----------
-- Visit --
-----------
procedure Visit
(Vertex : Library_Graph_Vertex_Id;
Visited_Set : LGV_Sets.Membership_Set;
Visited_Stack : LGV_Lists.Doubly_Linked_List)
is
begin
pragma Assert (Present (Vertex));
pragma Assert (LGV_Sets.Present (Visited_Set));
pragma Assert (LGV_Lists.Present (Visited_Stack));
LGV_Sets.Insert (Visited_Set, Vertex);
LGV_Lists.Prepend (Visited_Stack, Vertex);
end Visit;
end Library_Graphs; end Library_Graphs;
------------- -------------
......
gcc/ada/bindo-graphs.ads
...@@ -174,6 +174,11 @@ package Bindo.Graphs is ...@@ -174,6 +174,11 @@ package Bindo.Graphs is
First_Library_Graph_Vertex : constant Library_Graph_Vertex_Id := First_Library_Graph_Vertex : constant Library_Graph_Vertex_Id :=
No_Library_Graph_Vertex + 1; No_Library_Graph_Vertex + 1;
procedure Destroy_Library_Graph_Vertex
(Vertex : in out Library_Graph_Vertex_Id);
pragma Inline (Destroy_Library_Graph_Vertex);
-- Destroy library graph vertex Vertex
function Hash_Library_Graph_Vertex function Hash_Library_Graph_Vertex
(Vertex : Library_Graph_Vertex_Id) return Bucket_Range_Type; (Vertex : Library_Graph_Vertex_Id) return Bucket_Range_Type;
pragma Inline (Hash_Library_Graph_Vertex); pragma Inline (Hash_Library_Graph_Vertex);
...@@ -183,6 +188,11 @@ package Bindo.Graphs is ...@@ -183,6 +188,11 @@ package Bindo.Graphs is
pragma Inline (Present); pragma Inline (Present);
-- Determine whether library graph vertex Vertex exists -- Determine whether library graph vertex Vertex exists
package LGV_Lists is new Doubly_Linked_Lists
(Element_Type => Library_Graph_Vertex_Id,
"=" => "=",
Destroy_Element => Destroy_Library_Graph_Vertex);
package LGV_Sets is new Membership_Sets package LGV_Sets is new Membership_Sets
(Element_Type => Library_Graph_Vertex_Id, (Element_Type => Library_Graph_Vertex_Id,
"=" => "=", "=" => "=",
...@@ -1406,11 +1416,6 @@ package Bindo.Graphs is ...@@ -1406,11 +1416,6 @@ package Bindo.Graphs is
-- Vertices -- -- Vertices --
-------------- --------------
procedure Destroy_Library_Graph_Vertex
(Vertex : in out Library_Graph_Vertex_Id);
pragma Inline (Destroy_Library_Graph_Vertex);
-- Destroy library graph vertex Vertex
-- The following type represents the attributes of a library graph -- The following type represents the attributes of a library graph
-- vertex. -- vertex.
...@@ -1593,15 +1598,6 @@ package Bindo.Graphs is ...@@ -1593,15 +1598,6 @@ package Bindo.Graphs is
Destroy_Value => Destroy_Library_Graph_Cycle_Attributes, Destroy_Value => Destroy_Library_Graph_Cycle_Attributes,
Hash => Hash_Library_Graph_Cycle); Hash => Hash_Library_Graph_Cycle);
---------------------
-- Recorded cycles --
---------------------
package RC_Sets is new Membership_Sets
(Element_Type => Library_Graph_Cycle_Attributes,
"=" => Same_Library_Graph_Cycle_Attributes,
Hash => Hash_Library_Graph_Cycle_Attributes);
-------------------- --------------------
-- Recorded edges -- -- Recorded edges --
-------------------- --------------------
...@@ -1693,10 +1689,6 @@ package Bindo.Graphs is ...@@ -1693,10 +1689,6 @@ package Bindo.Graphs is
-- The underlying graph describing the relations between edges and -- The underlying graph describing the relations between edges and
-- vertices. -- vertices.
Recorded_Cycles : RC_Sets.Membership_Set := RC_Sets.Nil;
-- The set of recorded cycles, used to prevent duplicate cycles in
-- the graph.
Recorded_Edges : RE_Sets.Membership_Set := RE_Sets.Nil; Recorded_Edges : RE_Sets.Membership_Set := RE_Sets.Nil;
-- The set of recorded edges, used to prevent duplicate edges in the -- The set of recorded edges, used to prevent duplicate edges in the
-- graph. -- graph.
......
gcc/ada/bindo-writers.adb
...@@ -1102,6 +1102,8 @@ package body Bindo.Writers is ...@@ -1102,6 +1102,8 @@ package body Bindo.Writers is
Write_Eol; Write_Eol;
Write_Component_Vertices (G, Comp); Write_Component_Vertices (G, Comp);
Write_Eol;
end Write_Component; end Write_Component;
------------------------------ ------------------------------
...@@ -1112,25 +1114,34 @@ package body Bindo.Writers is ...@@ -1112,25 +1114,34 @@ package body Bindo.Writers is
(G : Library_Graph; (G : Library_Graph;
Comp : Component_Id) Comp : Component_Id)
is is
pragma Assert (Present (G));
pragma Assert (Present (Comp));
Num_Of_Vertices : constant Natural :=
Number_Of_Component_Vertices (G, Comp);
Iter : Component_Vertex_Iterator; Iter : Component_Vertex_Iterator;
Vertex : Library_Graph_Vertex_Id; Vertex : Library_Graph_Vertex_Id;
begin begin
pragma Assert (Present (G)); Write_Str (" Vertices: ");
pragma Assert (Present (Comp)); Write_Int (Int (Num_Of_Vertices));
Write_Eol;
Iter := Iterate_Component_Vertices (G, Comp); if Num_Of_Vertices > 0 then
while Has_Next (Iter) loop Iter := Iterate_Component_Vertices (G, Comp);
Next (Iter, Vertex); while Has_Next (Iter) loop
Next (Iter, Vertex);
Write_Str (" library graph vertex (LGV_Id_"); Write_Str (" library graph vertex (LGV_Id_");
Write_Int (Int (Vertex)); Write_Int (Int (Vertex));
Write_Str (") name = "); Write_Str (") name = ");
Write_Name (Name (G, Vertex)); Write_Name (Name (G, Vertex));
Write_Eol;
end loop;
else
Write_Eol; Write_Eol;
end loop; end if;
Write_Eol;
end Write_Component_Vertices; end Write_Component_Vertices;
---------------------- ----------------------
......
gcc/ada/bindo.adb
...@@ -322,6 +322,11 @@ package body Bindo is ...@@ -322,6 +322,11 @@ package body Bindo is
-- In addition, GNATbind does not create an edge to the body of the -- In addition, GNATbind does not create an edge to the body of the
-- pragma argument. -- pragma argument.
-- --
-- -d_t Output cycle detection trace information
--
-- GNATbind outputs trace information on cycle detection activities
-- to standard output.
--
-- -d_A Output ALI invocation tables -- -d_A Output ALI invocation tables
-- --
-- GNATbind outputs the contents of ALI table Invocation_Constructs -- GNATbind outputs the contents of ALI table Invocation_Constructs
...@@ -352,8 +357,8 @@ package body Bindo is ...@@ -352,8 +357,8 @@ package body Bindo is
-- --
-- -d_T Output elaboration-order trace information -- -d_T Output elaboration-order trace information
-- --
-- GNATbind outputs trace information on elaboration-order and cycle- -- GNATbind outputs trace information on elaboration-order detection
-- detection activities to standard output. -- activities to standard output.
-- --
-- -d_V Validate bindo cycles, graphs, and order -- -d_V Validate bindo cycles, graphs, and order
-- --
...@@ -395,7 +400,7 @@ package body Bindo is ...@@ -395,7 +400,7 @@ package body Bindo is
-- number of files in the bind, Bindo may emit anywhere between several MBs -- number of files in the bind, Bindo may emit anywhere between several MBs
-- to several hundred MBs of data to standard output. The switches are: -- to several hundred MBs of data to standard output. The switches are:
-- --
-- -d_A -d_C -d_I -d_L -d_P -d_T -d_V -- -d_A -d_C -d_I -d_L -d_P -d_t -d_T -d_V
-- --
-- Bindo offers several debugging routines that can be invoked from gdb. -- Bindo offers several debugging routines that can be invoked from gdb.
-- Those are defined in the body of Bindo.Writers, in sections denoted by -- Those are defined in the body of Bindo.Writers, in sections denoted by
......
gcc/ada/debug.adb
...@@ -368,7 +368,7 @@ package body Debug is ...@@ -368,7 +368,7 @@ package body Debug is
-- d_q -- d_q
-- d_r -- d_r
-- d_s -- d_s
-- d_t -- d_t Output cycle detection trace information
-- d_u -- d_u
-- d_v -- d_v
-- d_w -- d_w
...@@ -380,6 +380,7 @@ package body Debug is ...@@ -380,6 +380,7 @@ package body Debug is
-- d_B -- d_B
-- d_C Diagnose all cycles -- d_C Diagnose all cycles
-- d_D -- d_D
-- d_E
-- d_F -- d_F
-- d_G -- d_G
-- d_H -- d_H
...@@ -394,7 +395,7 @@ package body Debug is ...@@ -394,7 +395,7 @@ package body Debug is
-- d_Q -- d_Q
-- d_R -- d_R
-- d_S -- d_S
-- d_T Output elaboration order and cycle detection trace information -- d_T Output elaboration order trace information
-- d_U -- d_U
-- d_V Validate bindo cycles, graphs, and order -- d_V Validate bindo cycles, graphs, and order
-- d_W -- d_W
...@@ -1149,6 +1150,9 @@ package body Debug is ...@@ -1149,6 +1150,9 @@ package body Debug is
-- elaboration order and no longer creates an implicit dependency on -- elaboration order and no longer creates an implicit dependency on
-- the body of the argument. -- the body of the argument.
-- d_t GNATBIND output trace information of cycle detection activities to
-- standard output.
-- d_A GNATBIND output the contents of all ALI invocation-related tables -- d_A GNATBIND output the contents of all ALI invocation-related tables
-- in textual format to standard output. -- in textual format to standard output.
...@@ -1163,8 +1167,8 @@ package body Debug is ...@@ -1163,8 +1167,8 @@ package body Debug is
-- d_P GNATBIND outputs the cycle paths to standard output -- d_P GNATBIND outputs the cycle paths to standard output
-- d_T GNATBIND outputs trace information of elaboration order and cycle -- d_T GNATBIND outputs trace information of elaboration order detection
-- detection activities to standard output. -- activities to standard output.
-- d_V GNATBIND validates the invocation graph, library graph along with -- d_V GNATBIND validates the invocation graph, library graph along with
-- its cycles, and the elaboration order. -- its cycles, and the elaboration order.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment