return Bucket_Range_Type (Vertex);
end Hash_Library_Graph_Vertex;
- -----------------------
- -- Invocation_Graphs --
- -----------------------
+ --------------------
+ -- Library_Graphs --
+ --------------------
- package body Invocation_Graphs is
+ package body Library_Graphs is
-----------------------
-- Local subprograms --
-----------------------
- procedure Free is
- new Ada.Unchecked_Deallocation
- (Invocation_Graph_Attributes, Invocation_Graph);
+ procedure Add_Body_Before_Spec_Edge
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id;
+ Edges : LGE_Lists.Doubly_Linked_List);
+ pragma Inline (Add_Body_Before_Spec_Edge);
+ -- Create a new edge in library graph G between vertex Vertex and its
+ -- corresponding spec or body, where the body is a predecessor and the
+ -- spec a successor. Add the edge to list Edges.
- function Get_IGE_Attributes
- (G : Invocation_Graph;
- Edge : Invocation_Graph_Edge_Id)
- return Invocation_Graph_Edge_Attributes;
- pragma Inline (Get_IGE_Attributes);
- -- Obtain the attributes of edge Edge of invocation graph G
+ procedure Add_Body_Before_Spec_Edges
+ (G : Library_Graph;
+ Edges : LGE_Lists.Doubly_Linked_List);
+ pragma Inline (Add_Body_Before_Spec_Edges);
+ -- Create new edges in library graph G for all vertices and their
+ -- corresponding specs or bodies, where the body is a predecessor
+ -- and the spec is a successor. Add all edges to list Edges.
- function Get_IGV_Attributes
- (G : Invocation_Graph;
- Vertex : Invocation_Graph_Vertex_Id)
- return Invocation_Graph_Vertex_Attributes;
- pragma Inline (Get_IGV_Attributes);
- -- Obtain the attributes of vertex Vertex of invocation graph G
+ procedure Add_Edge_Kind_Check
+ (G : Library_Graph;
+ Pred : Library_Graph_Vertex_Id;
+ Succ : Library_Graph_Vertex_Id;
+ New_Kind : Library_Graph_Edge_Kind);
+ -- This is called by Add_Edge in the case where there is already a
+ -- Pred-->Succ edge, to assert that the New_Kind is appropriate. Raises
+ -- Program_Error if a bug is detected. The purpose is to prevent bugs
+ -- where calling Add_Edge in different orders produces different output.
- procedure Increment_Invocation_Graph_Edge_Count
- (G : Invocation_Graph;
- Kind : Invocation_Kind);
- pragma Inline (Increment_Invocation_Graph_Edge_Count);
- -- Increment the number of edges of king Kind in invocation graph G by
- -- one.
+ function Add_Edge
+ (G : Library_Graph;
+ Pred : Library_Graph_Vertex_Id;
+ Succ : Library_Graph_Vertex_Id;
+ Kind : Library_Graph_Edge_Kind;
+ Activates_Task : Boolean) return Library_Graph_Edge_Id;
+ pragma Inline (Add_Edge);
+ -- Create a new edge in library graph G with source vertex Pred and
+ -- destination vertex Succ, and return its handle. Kind denotes the
+ -- nature of the edge. Activates_Task should be set when the edge
+ -- involves a task activation. If Pred and Succ are already related,
+ -- no edge is created and No_Library_Graph_Edge is returned, but if
+ -- Activates_Task is True, then the flag of the existing edge is
+ -- updated.
- function Is_Elaboration_Root
- (G : Invocation_Graph;
- Vertex : Invocation_Graph_Vertex_Id) return Boolean;
- pragma Inline (Is_Elaboration_Root);
- -- Determine whether vertex Vertex of invocation graph denotes the
- -- elaboration procedure of a spec or a body.
+ function At_Least_One_Edge_Satisfies
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id;
+ Predicate : LGE_Predicate_Ptr) return Boolean;
+ pragma Inline (At_Least_One_Edge_Satisfies);
+ -- Determine whether at least one edge of cycle Cycle of library graph G
+ -- satisfies predicate Predicate.
- function Is_Existing_Source_Target_Relation
- (G : Invocation_Graph;
- Rel : Source_Target_Relation) return Boolean;
- pragma Inline (Is_Existing_Source_Target_Relation);
- -- Determine whether a source vertex and a target vertex described by
- -- relation Rel are already related in invocation graph G.
+ function Copy_Cycle_Path
+ (Cycle_Path : LGE_Lists.Doubly_Linked_List)
+ return LGE_Lists.Doubly_Linked_List;
+ pragma Inline (Copy_Cycle_Path);
+ -- Create a deep copy of list Cycle_Path
- procedure Save_Elaboration_Root
- (G : Invocation_Graph;
- Root : Invocation_Graph_Vertex_Id);
- pragma Inline (Save_Elaboration_Root);
- -- Save elaboration root Root of invocation graph G
+ 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.
- procedure Set_Corresponding_Vertex
- (G : Invocation_Graph;
- IS_Id : Invocation_Signature_Id;
- Vertex : Invocation_Graph_Vertex_Id);
- pragma Inline (Set_Corresponding_Vertex);
- -- Associate vertex Vertex of invocation graph G with signature IS_Id
+ function Cycle_Kind_Of
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Library_Graph_Cycle_Kind;
+ pragma Inline (Cycle_Kind_Of);
+ -- Determine the cycle kind of edge Edge of library graph G if the edge
+ -- participated in a circuit.
- procedure Set_Is_Existing_Source_Target_Relation
- (G : Invocation_Graph;
- Rel : Source_Target_Relation;
- Val : Boolean := True);
- pragma Inline (Set_Is_Existing_Source_Target_Relation);
- -- Mark a source vertex and a target vertex described by relation Rel as
- -- already related in invocation graph G depending on value Val.
+ 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.
- procedure Set_IGE_Attributes
- (G : Invocation_Graph;
- Edge : Invocation_Graph_Edge_Id;
- Val : Invocation_Graph_Edge_Attributes);
- pragma Inline (Set_IGE_Attributes);
- -- Set the attributes of edge Edge of invocation graph G to value Val
+ 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.
- procedure Set_IGV_Attributes
- (G : Invocation_Graph;
- Vertex : Invocation_Graph_Vertex_Id;
- Val : Invocation_Graph_Vertex_Attributes);
- pragma Inline (Set_IGV_Attributes);
- -- Set the attributes of vertex Vertex of invocation graph G to value
- -- Val.
+ 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.
- --------------
- -- Add_Edge --
- --------------
+ procedure Decrement_Library_Graph_Edge_Count
+ (G : Library_Graph;
+ Kind : Library_Graph_Edge_Kind);
+ pragma Inline (Decrement_Library_Graph_Edge_Count);
+ -- Decrement the number of edges of kind King in library graph G by one
- procedure Add_Edge
- (G : Invocation_Graph;
- Source : Invocation_Graph_Vertex_Id;
- Target : Invocation_Graph_Vertex_Id;
- IR_Id : Invocation_Relation_Id)
- is
- pragma Assert (Present (G));
- pragma Assert (Present (Source));
- pragma Assert (Present (Target));
- pragma Assert (Present (IR_Id));
+ procedure Delete_Body_Before_Spec_Edges
+ (G : Library_Graph;
+ Edges : LGE_Lists.Doubly_Linked_List);
+ pragma Inline (Delete_Body_Before_Spec_Edges);
+ -- Delete all edges in list Edges from library graph G, that link spec
+ -- and bodies, where the body acts as the predecessor and the spec as a
+ -- successor.
- Rel : constant Source_Target_Relation :=
- (Source => Source,
- Target => Target);
+ procedure Delete_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id);
+ pragma Inline (Delete_Edge);
+ -- Delete edge Edge from library graph G
- Edge : Invocation_Graph_Edge_Id;
+ function Edge_Precedence
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id;
+ Compared_To : Library_Graph_Edge_Id) return Precedence_Kind;
+ pragma Inline (Edge_Precedence);
+ -- Determine the precedence of edge Edge of library graph G compared to
+ -- edge Compared_To.
- begin
- -- Nothing to do when the source and target are already related by an
- -- edge.
+ 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);
+ pragma Inline (Find_Cycles_From_Successor);
+ -- Part of Tarjan's enumeration of the elementary circuits of a directed
+ -- graph algorithm. Find all cycles from the successor indicated by edge
+ -- Edge 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 expanded
+ -- 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.
- if Is_Existing_Source_Target_Relation (G, Rel) then
- return;
- end if;
+ 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 expanded
+ -- 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.
- Edge := Sequence_Next_Edge;
+ 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.
- -- Add the edge to the underlying graph
+ function Find_Edge
+ (G : Library_Graph;
+ Pred : Library_Graph_Vertex_Id;
+ Succ : Library_Graph_Vertex_Id) return Library_Graph_Edge_Id;
+ -- There must be an edge Pred-->Succ; this returns it
- DG.Add_Edge
- (G => G.Graph,
- E => Edge,
- Source => Source,
- Destination => Target);
+ function Find_First_Lower_Precedence_Cycle
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Id;
+ pragma Inline (Find_First_Lower_Precedence_Cycle);
+ -- Inspect the list of cycles of library graph G and return the first
+ -- cycle whose precedence is lower than that of cycle Cycle. If there
+ -- is no such cycle, return No_Library_Graph_Cycle.
- -- Build and save the attributes of the edge
+ procedure Free is
+ new Ada.Unchecked_Deallocation
+ (Library_Graph_Attributes, Library_Graph);
- Set_IGE_Attributes
- (G => G,
- Edge => Edge,
- Val => (Relation => IR_Id));
+ function Get_Component_Attributes
+ (G : Library_Graph;
+ Comp : Component_Id) return Component_Attributes;
+ pragma Inline (Get_Component_Attributes);
+ -- Obtain the attributes of component Comp of library graph G
- -- Mark the source and target as related by the new edge. This
- -- prevents all further attempts to link the same source and target.
+ function Get_LGC_Attributes
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Attributes;
+ pragma Inline (Get_LGC_Attributes);
+ -- Obtain the attributes of cycle Cycle of library graph G
- Set_Is_Existing_Source_Target_Relation (G, Rel);
+ function Get_LGE_Attributes
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id)
+ return Library_Graph_Edge_Attributes;
+ pragma Inline (Get_LGE_Attributes);
+ -- Obtain the attributes of edge Edge of library graph G
- -- Update the edge statistics
+ function Get_LGV_Attributes
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id)
+ return Library_Graph_Vertex_Attributes;
+ pragma Inline (Get_LGV_Attributes);
+ -- Obtain the attributes of vertex Edge of library graph G
- Increment_Invocation_Graph_Edge_Count (G, Kind (IR_Id));
- end Add_Edge;
+ function Has_Elaborate_Body
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
+ pragma Inline (Has_Elaborate_Body);
+ -- Determine whether vertex Vertex of library graph G is subject to
+ -- pragma Elaborate_Body.
- ----------------
- -- Add_Vertex --
- ----------------
+ 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.
- procedure Add_Vertex
- (G : Invocation_Graph;
- IC_Id : Invocation_Construct_Id;
- Body_Vertex : Library_Graph_Vertex_Id;
- Spec_Vertex : Library_Graph_Vertex_Id)
- is
- pragma Assert (Present (G));
- pragma Assert (Present (IC_Id));
- pragma Assert (Present (Body_Vertex));
- pragma Assert (Present (Spec_Vertex));
+ 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.
- Construct_Signature : constant Invocation_Signature_Id :=
- Signature (IC_Id);
- Vertex : Invocation_Graph_Vertex_Id;
+ function Highest_Precedence_Edge
+ (G : Library_Graph;
+ Left : Library_Graph_Edge_Id;
+ Right : Library_Graph_Edge_Id) return Library_Graph_Edge_Id;
+ pragma Inline (Highest_Precedence_Edge);
+ -- Return the edge with highest precedence among edges Left and Right of
+ -- library graph G.
- begin
- -- Nothing to do when the construct already has a vertex
+ procedure Increment_Library_Graph_Edge_Count
+ (G : Library_Graph;
+ Kind : Library_Graph_Edge_Kind);
+ pragma Inline (Increment_Library_Graph_Edge_Count);
+ -- Increment the number of edges of king Kind in library graph G by one
- if Present (Corresponding_Vertex (G, Construct_Signature)) then
- return;
- end if;
+ procedure Increment_Pending_Predecessors
+ (G : Library_Graph;
+ Comp : Component_Id;
+ Edge : Library_Graph_Edge_Id);
+ pragma Inline (Increment_Pending_Predecessors);
+ -- Increment the number of pending predecessors component Comp which was
+ -- reached via edge Edge of library graph G must wait on before it can
+ -- be elaborated by one.
- Vertex := Sequence_Next_Vertex;
+ procedure Increment_Pending_Predecessors
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id;
+ Edge : Library_Graph_Edge_Id);
+ pragma Inline (Increment_Pending_Predecessors);
+ -- Increment the number of pending predecessors vertex Vertex which was
+ -- reached via edge Edge of library graph G must wait on before it can
+ -- be elaborated by one.
- -- Add the vertex to the underlying graph
+ procedure Initialize_Components (G : Library_Graph);
+ pragma Inline (Initialize_Components);
+ -- Initialize on the initial call or re-initialize on subsequent calls
+ -- all components of library graph G.
- DG.Add_Vertex (G.Graph, Vertex);
+ function Is_Cycle_Initiating_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean;
+ pragma Inline (Is_Cycle_Initiating_Edge);
+ -- Determine whether edge Edge of library graph G starts a cycle
- -- Build and save the attributes of the vertex
+ function Is_Cyclic_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean;
+ pragma Inline (Is_Cyclic_Edge);
+ -- Determine whether edge Edge of library graph G participates in a
+ -- cycle.
- Set_IGV_Attributes
- (G => G,
- Vertex => Vertex,
- Val => (Body_Vertex => Body_Vertex,
- Construct => IC_Id,
- Spec_Vertex => Spec_Vertex));
+ function Is_Cyclic_Elaborate_All_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean;
+ pragma Inline (Is_Cyclic_Elaborate_All_Edge);
+ -- Determine whether edge Edge of library graph G participates in a
+ -- cycle and has a predecessor that is subject to pragma Elaborate_All.
- -- Associate the construct with its corresponding vertex
+ function Is_Cyclic_Elaborate_Body_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean;
+ pragma Inline (Is_Cyclic_Elaborate_Body_Edge);
+ -- Determine whether edge Edge of library graph G participates in a
+ -- cycle and has a successor that is either a spec subject to pragma
+ -- Elaborate_Body, or a body that completes such a spec.
- Set_Corresponding_Vertex (G, Construct_Signature, Vertex);
+ function Is_Cyclic_Elaborate_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean;
+ pragma Inline (Is_Cyclic_Elaborate_Edge);
+ -- Determine whether edge Edge of library graph G participates in a
+ -- cycle and has a predecessor that is subject to pragma Elaborate.
- -- Save the vertex for later processing when it denotes a spec or
- -- body elaboration procedure.
+ function Is_Cyclic_Forced_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean;
+ pragma Inline (Is_Cyclic_Forced_Edge);
+ -- Determine whether edge Edge of library graph G participates in a
+ -- cycle and came from the forced-elaboration-order file.
- if Is_Elaboration_Root (G, Vertex) then
- Save_Elaboration_Root (G, Vertex);
- end if;
- end Add_Vertex;
+ function Is_Cyclic_Invocation_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean;
+ pragma Inline (Is_Cyclic_Invocation_Edge);
+ -- Determine whether edge Edge of library graph G participates in a
+ -- cycle and came from the traversal of the invocation graph.
- -----------------
- -- Body_Vertex --
- -----------------
-
- function Body_Vertex
- (G : Invocation_Graph;
- Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id
- is
- begin
- pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
+ function Is_Cyclic_With_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean;
+ pragma Inline (Is_Cyclic_With_Edge);
+ -- Determine whether edge Edge of library graph G participates in a
+ -- cycle and is the result of a with dependency between its successor
+ -- and predecessor.
- return Get_IGV_Attributes (G, Vertex).Body_Vertex;
- end Body_Vertex;
+ function Is_Recorded_Edge
+ (G : Library_Graph;
+ Rel : Predecessor_Successor_Relation) return Boolean;
+ pragma Inline (Is_Recorded_Edge);
+ -- Determine whether a predecessor vertex and a successor vertex
+ -- described by relation Rel are already linked in library graph G.
- ------------
- -- Column --
- ------------
+ function Is_Static_Successor_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean;
+ pragma Inline (Is_Static_Successor_Edge);
+ -- Determine whether the successor of invocation edge Edge represents a
+ -- unit that was compiled with the static model.
- function Column
- (G : Invocation_Graph;
- Vertex : Invocation_Graph_Vertex_Id) return Nat
- is
- begin
- pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
+ 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.
- return Column (Signature (Construct (G, Vertex)));
- end Column;
+ function Links_Vertices_In_Same_Component
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean;
+ pragma Inline (Links_Vertices_In_Same_Component);
+ -- Determine whether edge Edge of library graph G links a predecessor
+ -- and successor that reside in the same component.
- ---------------
- -- Construct --
- ---------------
+ function Maximum_Invocation_Edge_Count
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id;
+ Count : Natural) return Natural;
+ pragma Inline (Maximum_Invocation_Edge_Count);
+ -- Determine whether edge Edge of library graph G is an invocation edge,
+ -- and if it is return Count + 1, otherwise return Count.
- function Construct
- (G : Invocation_Graph;
- Vertex : Invocation_Graph_Vertex_Id) return Invocation_Construct_Id
- is
- begin
- pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
+ procedure Normalize_Cycle_Path
+ (Cycle_Path : LGE_Lists.Doubly_Linked_List;
+ Most_Significant_Edge : Library_Graph_Edge_Id);
+ pragma Inline (Normalize_Cycle_Path);
+ -- Normalize cycle path Path by rotating it until its starting edge is
+ -- Sig_Edge.
- return Get_IGV_Attributes (G, Vertex).Construct;
- end Construct;
+ 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.
- --------------------------
- -- Corresponding_Vertex --
- --------------------------
+ function Path
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id) return LGE_Lists.Doubly_Linked_List;
+ pragma Inline (Path);
+ -- Obtain the path of edges which comprises cycle Cycle of library
+ -- graph G.
- function Corresponding_Vertex
- (G : Invocation_Graph;
- IS_Id : Invocation_Signature_Id) return Invocation_Graph_Vertex_Id
- is
- begin
- pragma Assert (Present (G));
- pragma Assert (Present (IS_Id));
+ procedure Record_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 (Record_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
+ -- is the number of invocation edges along the cycle path. Indent is
+ -- the desired indentation level for tracing.
- return Signature_Tables.Get (G.Signature_To_Vertex, IS_Id);
- end Corresponding_Vertex;
+ procedure Set_Activates_Task
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id);
+ -- Set the Activates_Task flag of the Edge to True
- ------------
- -- Create --
- ------------
+ procedure Set_Component_Attributes
+ (G : Library_Graph;
+ Comp : Component_Id;
+ Val : Component_Attributes);
+ pragma Inline (Set_Component_Attributes);
+ -- Set the attributes of component Comp of library graph G to value Val
- function Create
- (Initial_Vertices : Positive;
- Initial_Edges : Positive) return Invocation_Graph
- is
- G : constant Invocation_Graph := new Invocation_Graph_Attributes;
+ procedure Set_Corresponding_Vertex
+ (G : Library_Graph;
+ U_Id : Unit_Id;
+ Val : Library_Graph_Vertex_Id);
+ pragma Inline (Set_Corresponding_Vertex);
+ -- Associate vertex Val of library graph G with unit U_Id
- begin
- G.Edge_Attributes := IGE_Tables.Create (Initial_Edges);
- G.Graph :=
- DG.Create
- (Initial_Vertices => Initial_Vertices,
- Initial_Edges => Initial_Edges);
- G.Relations := Relation_Sets.Create (Initial_Edges);
- G.Roots := IGV_Sets.Create (Initial_Vertices);
- G.Signature_To_Vertex := Signature_Tables.Create (Initial_Vertices);
- G.Vertex_Attributes := IGV_Tables.Create (Initial_Vertices);
+ procedure Set_Is_Recorded_Edge
+ (G : Library_Graph;
+ Rel : Predecessor_Successor_Relation);
+ pragma Inline (Set_Is_Recorded_Edge);
+ -- Mark a predecessor vertex and a successor vertex described by
+ -- relation Rel as already linked.
- return G;
- end Create;
+ procedure Set_LGC_Attributes
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id;
+ Val : Library_Graph_Cycle_Attributes);
+ pragma Inline (Set_LGC_Attributes);
+ -- Set the attributes of cycle Cycle of library graph G to value Val
- -------------
- -- Destroy --
- -------------
+ procedure Set_LGE_Attributes
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id;
+ Val : Library_Graph_Edge_Attributes);
+ pragma Inline (Set_LGE_Attributes);
+ -- Set the attributes of edge Edge of library graph G to value Val
- procedure Destroy (G : in out Invocation_Graph) is
- begin
- pragma Assert (Present (G));
+ procedure Set_LGV_Attributes
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id;
+ Val : Library_Graph_Vertex_Attributes);
+ pragma Inline (Set_LGV_Attributes);
+ -- Set the attributes of vertex Vertex of library graph G to value Val
- IGE_Tables.Destroy (G.Edge_Attributes);
- DG.Destroy (G.Graph);
- Relation_Sets.Destroy (G.Relations);
- IGV_Sets.Destroy (G.Roots);
- Signature_Tables.Destroy (G.Signature_To_Vertex);
- IGV_Tables.Destroy (G.Vertex_Attributes);
+ 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.
- Free (G);
- end Destroy;
+ procedure Trace_Cycle
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id;
+ Indent : Indentation_Level);
+ pragma Inline (Trace_Cycle);
+ -- Write the contents of cycle Cycle of library graph G to standard
+ -- output. Indent is the desired indentation level for tracing.
- -----------------------------------
- -- Destroy_Invocation_Graph_Edge --
- -----------------------------------
+ procedure Trace_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id;
+ Indent : Indentation_Level);
+ pragma Inline (Trace_Edge);
+ -- Write the contents of edge Edge of library graph G to standard
+ -- output. Indent is the desired indentation level for tracing.
- procedure Destroy_Invocation_Graph_Edge
- (Edge : in out Invocation_Graph_Edge_Id)
- is
- pragma Unreferenced (Edge);
- begin
- null;
- end Destroy_Invocation_Graph_Edge;
+ procedure Trace_Vertex
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id;
+ Indent : Indentation_Level);
+ pragma Inline (Trace_Vertex);
+ -- Write the contents of vertex Vertex of library graph G to standard
+ -- output. Indent is the desired indentation level for tracing.
- ----------------------------------------------
- -- Destroy_Invocation_Graph_Edge_Attributes --
- ----------------------------------------------
+ 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 Destroy_Invocation_Graph_Edge_Attributes
- (Attrs : in out Invocation_Graph_Edge_Attributes)
- is
- pragma Unreferenced (Attrs);
- begin
- null;
- end Destroy_Invocation_Graph_Edge_Attributes;
+ procedure Update_Pending_Predecessors
+ (Strong_Predecessors : in out Natural;
+ Weak_Predecessors : in out Natural;
+ Update_Weak : Boolean;
+ Value : Integer);
+ pragma Inline (Update_Pending_Predecessors);
+ -- Update the number of pending strong or weak predecessors denoted by
+ -- Strong_Predecessors and Weak_Predecessors respectively depending on
+ -- flag Update_Weak by adding value Value.
- -------------------------------------
- -- Destroy_Invocation_Graph_Vertex --
- -------------------------------------
+ procedure Update_Pending_Predecessors_Of_Components (G : Library_Graph);
+ pragma Inline (Update_Pending_Predecessors_Of_Components);
+ -- Update the number of pending predecessors all components of library
+ -- graph G must wait on before they can be elaborated.
- procedure Destroy_Invocation_Graph_Vertex
- (Vertex : in out Invocation_Graph_Vertex_Id)
- is
- pragma Unreferenced (Vertex);
- begin
- null;
- end Destroy_Invocation_Graph_Vertex;
+ procedure Update_Pending_Predecessors_Of_Components
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id);
+ pragma Inline (Update_Pending_Predecessors_Of_Components);
+ -- Update the number of pending predecessors the component of edge
+ -- LGE_Is's successor vertex of library graph G must wait on before
+ -- it can be elaborated.
- ------------------------------------------------
- -- Destroy_Invocation_Graph_Vertex_Attributes --
- ------------------------------------------------
+ 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 Destroy_Invocation_Graph_Vertex_Attributes
- (Attrs : in out Invocation_Graph_Vertex_Attributes)
- is
- pragma Unreferenced (Attrs);
- begin
- null;
- end Destroy_Invocation_Graph_Vertex_Attributes;
+ 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.
- -----------
- -- Extra --
- -----------
+ --------------------
+ -- Activates_Task --
+ --------------------
- function Extra
- (G : Invocation_Graph;
- Edge : Invocation_Graph_Edge_Id) return Name_Id
+ function Activates_Task
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean
is
begin
- pragma Assert (Present (G));
- pragma Assert (Present (Edge));
-
- return Extra (Relation (G, Edge));
- end Extra;
+ return Get_LGE_Attributes (G, Edge).Activates_Task;
+ end Activates_Task;
- ------------------------
- -- Get_IGE_Attributes --
- ------------------------
+ -------------------------------
+ -- Add_Body_Before_Spec_Edge --
+ -------------------------------
- function Get_IGE_Attributes
- (G : Invocation_Graph;
- Edge : Invocation_Graph_Edge_Id)
- return Invocation_Graph_Edge_Attributes
+ procedure Add_Body_Before_Spec_Edge
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id;
+ Edges : LGE_Lists.Doubly_Linked_List)
is
- begin
- pragma Assert (Present (G));
- pragma Assert (Present (Edge));
-
- return IGE_Tables.Get (G.Edge_Attributes, Edge);
- end Get_IGE_Attributes;
-
- ------------------------
- -- Get_IGV_Attributes --
- ------------------------
+ Edge : Library_Graph_Edge_Id;
- function Get_IGV_Attributes
- (G : Invocation_Graph;
- Vertex : Invocation_Graph_Vertex_Id)
- return Invocation_Graph_Vertex_Attributes
- is
begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
+ pragma Assert (LGE_Lists.Present (Edges));
- return IGV_Tables.Get (G.Vertex_Attributes, Vertex);
- end Get_IGV_Attributes;
-
- --------------
- -- Has_Next --
- --------------
+ -- A vertex requires a special Body_Before_Spec edge to its
+ -- Corresponding_Item when it either denotes a
+ --
+ -- * Body that completes a previous spec
+ --
+ -- * Spec with a completing body
+ --
+ -- The edge creates an intentional circularity between the spec and
+ -- body in order to emulate a library unit, and guarantees that both
+ -- will appear in the same component.
+ --
+ -- Due to the structure of the library graph, either the spec or
+ -- the body may be visited first, yet Corresponding_Item will still
+ -- attempt to create the Body_Before_Spec edge. This is OK because
+ -- successor and predecessor are kept consistent in both cases, and
+ -- Add_Edge will prevent the creation of the second edge.
- function Has_Next (Iter : All_Edge_Iterator) return Boolean is
- begin
- return DG.Has_Next (DG.All_Edge_Iterator (Iter));
- end Has_Next;
+ -- Assume that no Body_Before_Spec is necessary
- --------------
- -- Has_Next --
- --------------
+ Edge := No_Library_Graph_Edge;
- function Has_Next (Iter : All_Vertex_Iterator) return Boolean is
- begin
- return DG.Has_Next (DG.All_Vertex_Iterator (Iter));
- end Has_Next;
+ -- A body that completes a previous spec
- --------------
- -- Has_Next --
- --------------
+ if Is_Body_With_Spec (G, Vertex) then
+ Edge :=
+ Add_Edge
+ (G => G,
+ Pred => Vertex,
+ Succ => Corresponding_Item (G, Vertex),
+ Kind => Body_Before_Spec_Edge,
+ Activates_Task => False);
- function Has_Next (Iter : Edges_To_Targets_Iterator) return Boolean is
- begin
- return DG.Has_Next (DG.Outgoing_Edge_Iterator (Iter));
- end Has_Next;
+ -- A spec with a completing body
- --------------
- -- Has_Next --
- --------------
+ elsif Is_Spec_With_Body (G, Vertex) then
+ Edge :=
+ Add_Edge
+ (G => G,
+ Pred => Corresponding_Item (G, Vertex),
+ Succ => Vertex,
+ Kind => Body_Before_Spec_Edge,
+ Activates_Task => False);
+ end if;
- function Has_Next (Iter : Elaboration_Root_Iterator) return Boolean is
- begin
- return IGV_Sets.Has_Next (IGV_Sets.Iterator (Iter));
- end Has_Next;
+ if Present (Edge) then
+ LGE_Lists.Append (Edges, Edge);
+ end if;
+ end Add_Body_Before_Spec_Edge;
- -------------------------------
- -- Hash_Invocation_Signature --
- -------------------------------
+ --------------------------------
+ -- Add_Body_Before_Spec_Edges --
+ --------------------------------
- function Hash_Invocation_Signature
- (IS_Id : Invocation_Signature_Id) return Bucket_Range_Type
+ procedure Add_Body_Before_Spec_Edges
+ (G : Library_Graph;
+ Edges : LGE_Lists.Doubly_Linked_List)
is
- begin
- pragma Assert (Present (IS_Id));
-
- return Bucket_Range_Type (IS_Id);
- end Hash_Invocation_Signature;
-
- ---------------------------------
- -- Hash_Source_Target_Relation --
- ---------------------------------
+ Iter : Elaborable_Units_Iterator;
+ U_Id : Unit_Id;
- function Hash_Source_Target_Relation
- (Rel : Source_Target_Relation) return Bucket_Range_Type
- is
begin
- pragma Assert (Present (Rel.Source));
- pragma Assert (Present (Rel.Target));
-
- return
- Hash_Two_Keys
- (Bucket_Range_Type (Rel.Source),
- Bucket_Range_Type (Rel.Target));
- end Hash_Source_Target_Relation;
-
- -------------------------------------------
- -- Increment_Invocation_Graph_Edge_Count --
- -------------------------------------------
-
- procedure Increment_Invocation_Graph_Edge_Count
- (G : Invocation_Graph;
- Kind : Invocation_Kind)
- is
pragma Assert (Present (G));
+ pragma Assert (LGE_Lists.Present (Edges));
- Count : Natural renames G.Counts (Kind);
+ Iter := Iterate_Elaborable_Units;
+ while Has_Next (Iter) loop
+ Next (Iter, U_Id);
- begin
- Count := Count + 1;
- end Increment_Invocation_Graph_Edge_Count;
+ Add_Body_Before_Spec_Edge
+ (G => G,
+ Vertex => Corresponding_Vertex (G, U_Id),
+ Edges => Edges);
+ end loop;
+ end Add_Body_Before_Spec_Edges;
- ---------------------------------
- -- Invocation_Graph_Edge_Count --
- ---------------------------------
+ --------------
+ -- Add_Edge --
+ --------------
- function Invocation_Graph_Edge_Count
- (G : Invocation_Graph;
- Kind : Invocation_Kind) return Natural
+ procedure Add_Edge
+ (G : Library_Graph;
+ Pred : Library_Graph_Vertex_Id;
+ Succ : Library_Graph_Vertex_Id;
+ Kind : Library_Graph_Edge_Kind;
+ Activates_Task : Boolean)
is
+ Ignore : constant Library_Graph_Edge_Id :=
+ Add_Edge
+ (G => G,
+ Pred => Pred,
+ Succ => Succ,
+ Kind => Kind,
+ Activates_Task => Activates_Task);
begin
- pragma Assert (Present (G));
-
- return G.Counts (Kind);
- end Invocation_Graph_Edge_Count;
+ null;
+ end Add_Edge;
-------------------------
- -- Is_Elaboration_Root --
+ -- Add_Edge_Kind_Check --
-------------------------
- function Is_Elaboration_Root
- (G : Invocation_Graph;
- Vertex : Invocation_Graph_Vertex_Id) return Boolean
+ procedure Add_Edge_Kind_Check
+ (G : Library_Graph;
+ Pred : Library_Graph_Vertex_Id;
+ Succ : Library_Graph_Vertex_Id;
+ New_Kind : Library_Graph_Edge_Kind)
is
- pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
-
- Vertex_Kind : constant Invocation_Construct_Kind :=
- Kind (Construct (G, Vertex));
-
+ Old_Edge : constant Library_Graph_Edge_Id :=
+ Find_Edge (G, Pred, Succ);
+ Old_Kind : constant Library_Graph_Edge_Kind :=
+ Get_LGE_Attributes (G, Old_Edge).Kind;
+ OK : Boolean;
begin
- return
- Vertex_Kind = Elaborate_Body_Procedure
- or else
- Vertex_Kind = Elaborate_Spec_Procedure;
- end Is_Elaboration_Root;
-
- ----------------------------------------
- -- Is_Existing_Source_Target_Relation --
- ----------------------------------------
+ case New_Kind is
+ when Spec_Before_Body_Edge =>
+ OK := False;
+ -- Spec_Before_Body_Edge comes first, and there is never more
+ -- than one Spec_Before_Body_Edge for a given unit, so we can't
+ -- have a preexisting edge in the Spec_Before_Body_Edge case.
- function Is_Existing_Source_Target_Relation
- (G : Invocation_Graph;
- Rel : Source_Target_Relation) return Boolean
- is
- begin
- pragma Assert (Present (G));
+ when With_Edge | Elaborate_Edge | Elaborate_All_Edge
+ | Forced_Edge | Invocation_Edge =>
+ OK := Old_Kind <= New_Kind;
+ -- These edges are created in the order of the enumeration
+ -- type, and there can be duplicates; hence "<=".
- return Relation_Sets.Contains (G.Relations, Rel);
- end Is_Existing_Source_Target_Relation;
+ when Body_Before_Spec_Edge =>
+ OK := Old_Kind = Body_Before_Spec_Edge
+ -- We call Add_Edge with Body_Before_Spec_Edge twice -- once
+ -- for the spec and once for the body.
- -----------------------
- -- Iterate_All_Edges --
- -----------------------
+ or else Old_Kind = Forced_Edge
+ or else Old_Kind = Invocation_Edge;
+ -- The old one can be Forced_Edge or Invocation_Edge, which
+ -- necessarily results in an elaboration cycle (in the static
+ -- model), but this assertion happens before cycle detection,
+ -- so we need to allow these cases.
- function Iterate_All_Edges
- (G : Invocation_Graph) return All_Edge_Iterator
- is
- begin
- pragma Assert (Present (G));
+ when No_Edge =>
+ OK := False;
+ end case;
- return All_Edge_Iterator (DG.Iterate_All_Edges (G.Graph));
- end Iterate_All_Edges;
+ if not OK then
+ raise Program_Error with Old_Kind'Img & "-->" & New_Kind'Img;
+ end if;
+ end Add_Edge_Kind_Check;
- --------------------------
- -- Iterate_All_Vertices --
- --------------------------
+ --------------
+ -- Add_Edge --
+ --------------
- function Iterate_All_Vertices
- (G : Invocation_Graph) return All_Vertex_Iterator
+ function Add_Edge
+ (G : Library_Graph;
+ Pred : Library_Graph_Vertex_Id;
+ Succ : Library_Graph_Vertex_Id;
+ Kind : Library_Graph_Edge_Kind;
+ Activates_Task : Boolean) return Library_Graph_Edge_Id
is
- begin
pragma Assert (Present (G));
+ pragma Assert (Present (Pred));
+ pragma Assert (Present (Succ));
+ pragma Assert (Kind = Invocation_Edge or else not Activates_Task);
+ -- Only invocation edges can activate tasks
- return All_Vertex_Iterator (DG.Iterate_All_Vertices (G.Graph));
- end Iterate_All_Vertices;
+ Rel : constant Predecessor_Successor_Relation :=
+ (Predecessor => Pred, Successor => Succ);
- ------------------------------
- -- Iterate_Edges_To_Targets --
- ------------------------------
+ Edge : Library_Graph_Edge_Id;
- function Iterate_Edges_To_Targets
- (G : Invocation_Graph;
- Vertex : Invocation_Graph_Vertex_Id) return Edges_To_Targets_Iterator
- is
begin
- pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
+ -- If we already have a Pred-->Succ edge, we don't add another
+ -- one. But we need to update Activates_Task, in order to avoid
+ -- depending on the order of processing of edges. If we have
+ -- Pred-->Succ with Activates_Task=True, and another Pred-->Succ with
+ -- Activates_Task=False, we want Activates_Task to be True no matter
+ -- which order we processed those two Add_Edge calls.
- return
- Edges_To_Targets_Iterator
- (DG.Iterate_Outgoing_Edges (G.Graph, Vertex));
- end Iterate_Edges_To_Targets;
+ if Is_Recorded_Edge (G, Rel) then
+ pragma Debug (Add_Edge_Kind_Check (G, Pred, Succ, Kind));
- -------------------------------
- -- Iterate_Elaboration_Roots --
- -------------------------------
+ if Activates_Task then
+ Set_Activates_Task (G, Find_Edge (G, Pred, Succ));
+ end if;
- function Iterate_Elaboration_Roots
- (G : Invocation_Graph) return Elaboration_Root_Iterator
- is
- begin
- pragma Assert (Present (G));
+ return No_Library_Graph_Edge;
+ end if;
- return Elaboration_Root_Iterator (IGV_Sets.Iterate (G.Roots));
- end Iterate_Elaboration_Roots;
+ Edge := Sequence_Next_Edge;
- ----------
- -- Kind --
- ----------
+ -- Add the edge to the underlying graph. Note that the predecessor
+ -- is the source of the edge because it will later need to notify
+ -- all its successors that it has been elaborated.
- function Kind
- (G : Invocation_Graph;
- Edge : Invocation_Graph_Edge_Id) return Invocation_Kind
- is
- begin
- pragma Assert (Present (G));
- pragma Assert (Present (Edge));
+ DG.Add_Edge
+ (G => G.Graph,
+ E => Edge,
+ Source => Pred,
+ Destination => Succ);
- return Kind (Relation (G, Edge));
- end Kind;
+ -- Construct and save the attributes of the edge
- ----------
- -- Line --
- ----------
+ Set_LGE_Attributes
+ (G => G,
+ Edge => Edge,
+ Val =>
+ (Activates_Task => Activates_Task,
+ Kind => Kind));
- function Line
- (G : Invocation_Graph;
- Vertex : Invocation_Graph_Vertex_Id) return Nat
- is
- begin
- pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
+ -- Mark the predecessor and successor as related by the new edge.
+ -- This prevents all further attempts to link the same predecessor
+ -- and successor.
- return Line (Signature (Construct (G, Vertex)));
- end Line;
+ Set_Is_Recorded_Edge (G, Rel);
- ----------
- -- Name --
- ----------
+ -- Update the number of pending predecessors the successor must wait
+ -- on before it is elaborated.
- function Name
- (G : Invocation_Graph;
- Vertex : Invocation_Graph_Vertex_Id) return Name_Id
- is
- begin
- pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
+ Increment_Pending_Predecessors
+ (G => G,
+ Vertex => Succ,
+ Edge => Edge);
- return Name (Signature (Construct (G, Vertex)));
- end Name;
+ -- Update the edge statistics
- ----------
- -- Next --
- ----------
+ Increment_Library_Graph_Edge_Count (G, Kind);
- procedure Next
- (Iter : in out All_Edge_Iterator;
- Edge : out Invocation_Graph_Edge_Id)
- is
- begin
- DG.Next (DG.All_Edge_Iterator (Iter), Edge);
- end Next;
+ return Edge;
+ end Add_Edge;
- ----------
- -- Next --
- ----------
+ ----------------
+ -- Add_Vertex --
+ ----------------
- procedure Next
- (Iter : in out All_Vertex_Iterator;
- Vertex : out Invocation_Graph_Vertex_Id)
+ procedure Add_Vertex
+ (G : Library_Graph;
+ U_Id : Unit_Id)
is
- begin
- DG.Next (DG.All_Vertex_Iterator (Iter), Vertex);
- end Next;
-
- ----------
- -- Next --
- ----------
+ Vertex : Library_Graph_Vertex_Id;
- procedure Next
- (Iter : in out Edges_To_Targets_Iterator;
- Edge : out Invocation_Graph_Edge_Id)
- is
begin
- DG.Next (DG.Outgoing_Edge_Iterator (Iter), Edge);
- end Next;
+ pragma Assert (Present (G));
+ pragma Assert (Present (U_Id));
- ----------
- -- Next --
- ----------
+ -- Nothing to do when the unit already has a vertex
- procedure Next
- (Iter : in out Elaboration_Root_Iterator;
- Root : out Invocation_Graph_Vertex_Id)
- is
- begin
- IGV_Sets.Next (IGV_Sets.Iterator (Iter), Root);
- end Next;
+ if Present (Corresponding_Vertex (G, U_Id)) then
+ return;
+ end if;
- ---------------------
- -- Number_Of_Edges --
- ---------------------
+ Vertex := Sequence_Next_Vertex;
- function Number_Of_Edges (G : Invocation_Graph) return Natural is
- begin
- pragma Assert (Present (G));
+ -- Add the vertex to the underlying graph
- return DG.Number_Of_Edges (G.Graph);
- end Number_Of_Edges;
+ DG.Add_Vertex (G.Graph, Vertex);
- --------------------------------
- -- Number_Of_Edges_To_Targets --
- --------------------------------
+ -- Construct and save the attributes of the vertex
- function Number_Of_Edges_To_Targets
- (G : Invocation_Graph;
- Vertex : Invocation_Graph_Vertex_Id) return Natural
- is
- begin
- pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
+ Set_LGV_Attributes
+ (G => G,
+ Vertex => Vertex,
+ Val =>
+ (Corresponding_Item => No_Library_Graph_Vertex,
+ In_Elaboration_Order => False,
+ Pending_Strong_Predecessors => 0,
+ Pending_Weak_Predecessors => 0,
+ Unit => U_Id));
- return DG.Number_Of_Outgoing_Edges (G.Graph, Vertex);
- end Number_Of_Edges_To_Targets;
+ -- Associate the unit with its corresponding vertex
+
+ Set_Corresponding_Vertex (G, U_Id, Vertex);
+ end Add_Vertex;
---------------------------------
- -- Number_Of_Elaboration_Roots --
+ -- At_Least_One_Edge_Satisfies --
---------------------------------
- function Number_Of_Elaboration_Roots
- (G : Invocation_Graph) return Natural
+ function At_Least_One_Edge_Satisfies
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id;
+ Predicate : LGE_Predicate_Ptr) return Boolean
is
+ Edge : Library_Graph_Edge_Id;
+ Iter : Edges_Of_Cycle_Iterator;
+ Satisfied : Boolean;
+
begin
pragma Assert (Present (G));
+ pragma Assert (Present (Cycle));
+ pragma Assert (Predicate /= null);
- return IGV_Sets.Size (G.Roots);
- end Number_Of_Elaboration_Roots;
+ -- Assume that the predicate cannot be satisfied
- ------------------------
- -- Number_Of_Vertices --
- ------------------------
+ Satisfied := False;
+
+ -- IMPORTANT:
+ --
+ -- * The iteration must run to completion in order to unlock the
+ -- edges of the cycle.
+
+ Iter := Iterate_Edges_Of_Cycle (G, Cycle);
+ while Has_Next (Iter) loop
+ Next (Iter, Edge);
+
+ Satisfied := Satisfied or else Predicate.all (G, Edge);
+ end loop;
+
+ return Satisfied;
+ end At_Least_One_Edge_Satisfies;
+
+ --------------------------
+ -- Complementary_Vertex --
+ --------------------------
+
+ function Complementary_Vertex
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id;
+ Force_Complement : Boolean) return Library_Graph_Vertex_Id
+ is
+ Complement : Library_Graph_Vertex_Id;
- function Number_Of_Vertices (G : Invocation_Graph) return Natural is
begin
pragma Assert (Present (G));
+ pragma Assert (Present (Vertex));
- return DG.Number_Of_Vertices (G.Graph);
- end Number_Of_Vertices;
+ -- Assume that there is no complementary vertex
- -------------
- -- Present --
- -------------
+ Complement := No_Library_Graph_Vertex;
- function Present (G : Invocation_Graph) return Boolean is
- begin
- return G /= Nil;
- end Present;
+ -- The caller requests the complement explicitly
- --------------
- -- Relation --
- --------------
+ if Force_Complement then
+ Complement := Corresponding_Item (G, Vertex);
- function Relation
- (G : Invocation_Graph;
- Edge : Invocation_Graph_Edge_Id) return Invocation_Relation_Id
+ -- The vertex is a completing body of a spec subject to pragma
+ -- Elaborate_Body. The complementary vertex is the spec.
+
+ elsif Is_Body_Of_Spec_With_Elaborate_Body (G, Vertex) then
+ Complement := Proper_Spec (G, Vertex);
+
+ -- The vertex is a spec subject to pragma Elaborate_Body. The
+ -- complementary vertex is the body.
+
+ elsif Is_Spec_With_Elaborate_Body (G, Vertex) then
+ Complement := Proper_Body (G, Vertex);
+ end if;
+
+ return Complement;
+ end Complementary_Vertex;
+
+ ---------------
+ -- Component --
+ ---------------
+
+ function Component
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Component_Id
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Edge));
+ pragma Assert (Present (Vertex));
- return Get_IGE_Attributes (G, Edge).Relation;
- end Relation;
+ return DG.Component (G.Graph, Vertex);
+ end Component;
- ---------------------------
- -- Save_Elaboration_Root --
- ---------------------------
+ ---------------------------------
+ -- Contains_Elaborate_All_Edge --
+ ---------------------------------
- procedure Save_Elaboration_Root
- (G : Invocation_Graph;
- Root : Invocation_Graph_Vertex_Id)
+ function Contains_Elaborate_All_Edge
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id) return Boolean
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Root));
+ pragma Assert (Present (Cycle));
- IGV_Sets.Insert (G.Roots, Root);
- end Save_Elaboration_Root;
+ return
+ At_Least_One_Edge_Satisfies
+ (G => G,
+ Cycle => Cycle,
+ Predicate => Is_Elaborate_All_Edge'Access);
+ end Contains_Elaborate_All_Edge;
- ------------------------------
- -- Set_Corresponding_Vertex --
- ------------------------------
+ ------------------------------------
+ -- Contains_Static_Successor_Edge --
+ ------------------------------------
- procedure Set_Corresponding_Vertex
- (G : Invocation_Graph;
- IS_Id : Invocation_Signature_Id;
- Vertex : Invocation_Graph_Vertex_Id)
+ function Contains_Static_Successor_Edge
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id) return Boolean
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (IS_Id));
- pragma Assert (Present (Vertex));
+ pragma Assert (Present (Cycle));
- Signature_Tables.Put (G.Signature_To_Vertex, IS_Id, Vertex);
- end Set_Corresponding_Vertex;
+ return
+ At_Least_One_Edge_Satisfies
+ (G => G,
+ Cycle => Cycle,
+ Predicate => Is_Static_Successor_Edge'Access);
+ end Contains_Static_Successor_Edge;
- --------------------------------------------
- -- Set_Is_Existing_Source_Target_Relation --
- --------------------------------------------
+ ------------------------------
+ -- Contains_Task_Activation --
+ ------------------------------
- procedure Set_Is_Existing_Source_Target_Relation
- (G : Invocation_Graph;
- Rel : Source_Target_Relation;
- Val : Boolean := True)
+ function Contains_Task_Activation
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id) return Boolean
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Rel.Source));
- pragma Assert (Present (Rel.Target));
+ pragma Assert (Present (Cycle));
- if Val then
- Relation_Sets.Insert (G.Relations, Rel);
- else
- Relation_Sets.Delete (G.Relations, Rel);
- end if;
- end Set_Is_Existing_Source_Target_Relation;
+ return
+ At_Least_One_Edge_Satisfies
+ (G => G,
+ Cycle => Cycle,
+ Predicate => Activates_Task'Access);
+ end Contains_Task_Activation;
- ------------------------
- -- Set_IGE_Attributes --
- ------------------------
+ ---------------------
+ -- Copy_Cycle_Path --
+ ---------------------
- procedure Set_IGE_Attributes
- (G : Invocation_Graph;
- Edge : Invocation_Graph_Edge_Id;
- Val : Invocation_Graph_Edge_Attributes)
+ function Copy_Cycle_Path
+ (Cycle_Path : LGE_Lists.Doubly_Linked_List)
+ return LGE_Lists.Doubly_Linked_List
is
+ Edge : Library_Graph_Edge_Id;
+ Iter : LGE_Lists.Iterator;
+ Path : LGE_Lists.Doubly_Linked_List;
+
begin
- pragma Assert (Present (G));
- pragma Assert (Present (Edge));
+ pragma Assert (LGE_Lists.Present (Cycle_Path));
- IGE_Tables.Put (G.Edge_Attributes, Edge, Val);
- end Set_IGE_Attributes;
+ Path := LGE_Lists.Create;
+ Iter := LGE_Lists.Iterate (Cycle_Path);
+ while LGE_Lists.Has_Next (Iter) loop
+ LGE_Lists.Next (Iter, Edge);
+
+ LGE_Lists.Append (Path, Edge);
+ end loop;
+
+ return Path;
+ end Copy_Cycle_Path;
------------------------
- -- Set_IGV_Attributes --
+ -- Corresponding_Item --
------------------------
- procedure Set_IGV_Attributes
- (G : Invocation_Graph;
- Vertex : Invocation_Graph_Vertex_Id;
- Val : Invocation_Graph_Vertex_Attributes)
+ function Corresponding_Item
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
- IGV_Tables.Put (G.Vertex_Attributes, Vertex, Val);
- end Set_IGV_Attributes;
+ return Get_LGV_Attributes (G, Vertex).Corresponding_Item;
+ end Corresponding_Item;
- -----------------
- -- Spec_Vertex --
- -----------------
+ --------------------------
+ -- Corresponding_Vertex --
+ --------------------------
- function Spec_Vertex
- (G : Invocation_Graph;
- Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id
+ function Corresponding_Vertex
+ (G : Library_Graph;
+ U_Id : Unit_Id) return Library_Graph_Vertex_Id
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
-
- return Get_IGV_Attributes (G, Vertex).Spec_Vertex;
- end Spec_Vertex;
+ pragma Assert (Present (U_Id));
+
+ return Unit_Tables.Get (G.Unit_To_Vertex, U_Id);
+ end Corresponding_Vertex;
------------
- -- Target --
+ -- Create --
------------
- function Target
- (G : Invocation_Graph;
- Edge : Invocation_Graph_Edge_Id) return Invocation_Graph_Vertex_Id
+ function Create
+ (Initial_Vertices : Positive;
+ Initial_Edges : Positive) return Library_Graph
is
- begin
- pragma Assert (Present (G));
- pragma Assert (Present (Edge));
-
- return DG.Destination_Vertex (G.Graph, Edge);
- end Target;
- end Invocation_Graphs;
-
- --------------------
- -- Library_Graphs --
- --------------------
-
- package body Library_Graphs is
-
- -----------------------
- -- Local subprograms --
- -----------------------
-
- procedure Add_Body_Before_Spec_Edge
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id;
- Edges : LGE_Lists.Doubly_Linked_List);
- pragma Inline (Add_Body_Before_Spec_Edge);
- -- Create a new edge in library graph G between vertex Vertex and its
- -- corresponding spec or body, where the body is a predecessor and the
- -- spec a successor. Add the edge to list Edges.
-
- procedure Add_Body_Before_Spec_Edges
- (G : Library_Graph;
- Edges : LGE_Lists.Doubly_Linked_List);
- pragma Inline (Add_Body_Before_Spec_Edges);
- -- Create new edges in library graph G for all vertices and their
- -- corresponding specs or bodies, where the body is a predecessor
- -- and the spec is a successor. Add all edges to list Edges.
-
- procedure Add_Edge_Kind_Check
- (G : Library_Graph;
- Pred : Library_Graph_Vertex_Id;
- Succ : Library_Graph_Vertex_Id;
- New_Kind : Library_Graph_Edge_Kind);
- -- This is called by Add_Edge in the case where there is already a
- -- Pred-->Succ edge, to assert that the New_Kind is appropriate. Raises
- -- Program_Error if a bug is detected. The purpose is to prevent bugs
- -- where calling Add_Edge in different orders produces different output.
-
- function Add_Edge
- (G : Library_Graph;
- Pred : Library_Graph_Vertex_Id;
- Succ : Library_Graph_Vertex_Id;
- Kind : Library_Graph_Edge_Kind;
- Activates_Task : Boolean) return Library_Graph_Edge_Id;
- pragma Inline (Add_Edge);
- -- Create a new edge in library graph G with source vertex Pred and
- -- destination vertex Succ, and return its handle. Kind denotes the
- -- nature of the edge. Activates_Task should be set when the edge
- -- involves a task activation. If Pred and Succ are already related,
- -- no edge is created and No_Library_Graph_Edge is returned, but if
- -- Activates_Task is True, then the flag of the existing edge is
- -- updated.
-
- function At_Least_One_Edge_Satisfies
- (G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id;
- Predicate : LGE_Predicate_Ptr) return Boolean;
- pragma Inline (At_Least_One_Edge_Satisfies);
- -- Determine whether at least one edge of cycle Cycle of library graph G
- -- satisfies predicate Predicate.
-
- function Copy_Cycle_Path
- (Cycle_Path : LGE_Lists.Doubly_Linked_List)
- return LGE_Lists.Doubly_Linked_List;
- pragma Inline (Copy_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
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Library_Graph_Cycle_Kind;
- pragma Inline (Cycle_Kind_Of);
- -- Determine the cycle kind of edge Edge of library graph G if the edge
- -- 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
- (G : Library_Graph;
- Kind : Library_Graph_Edge_Kind);
- pragma Inline (Decrement_Library_Graph_Edge_Count);
- -- Decrement the number of edges of kind King in library graph G by one
-
- procedure Delete_Body_Before_Spec_Edges
- (G : Library_Graph;
- Edges : LGE_Lists.Doubly_Linked_List);
- pragma Inline (Delete_Body_Before_Spec_Edges);
- -- Delete all edges in list Edges from library graph G, that link spec
- -- and bodies, where the body acts as the predecessor and the spec as a
- -- successor.
-
- procedure Delete_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id);
- pragma Inline (Delete_Edge);
- -- Delete edge Edge from library graph G
-
- function Edge_Precedence
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id;
- Compared_To : Library_Graph_Edge_Id) return Precedence_Kind;
- pragma Inline (Edge_Precedence);
- -- Determine the precedence of edge Edge of library graph G compared to
- -- edge Compared_To.
+ G : constant Library_Graph := new Library_Graph_Attributes;
- 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);
- pragma Inline (Find_Cycles_From_Successor);
- -- Part of Tarjan's enumeration of the elementary circuits of a directed
- -- graph algorithm. Find all cycles from the successor indicated by edge
- -- Edge 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 expanded
- -- 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.
+ begin
+ G.Component_Attributes := Component_Tables.Create (Initial_Vertices);
+ G.Cycle_Attributes := LGC_Tables.Create (Initial_Vertices);
+ G.Cycles := LGC_Lists.Create;
+ G.Edge_Attributes := LGE_Tables.Create (Initial_Edges);
+ G.Graph :=
+ DG.Create
+ (Initial_Vertices => Initial_Vertices,
+ Initial_Edges => Initial_Edges);
+ G.Recorded_Edges := RE_Sets.Create (Initial_Edges);
+ G.Unit_To_Vertex := Unit_Tables.Create (Initial_Vertices);
+ G.Vertex_Attributes := LGV_Tables.Create (Initial_Vertices);
- 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 expanded
- -- 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.
+ return G;
+ end Create;
- 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.
+ ------------------------
+ -- Cycle_End_Vertices --
+ ------------------------
- function Find_Edge
- (G : Library_Graph;
- Pred : Library_Graph_Vertex_Id;
- Succ : Library_Graph_Vertex_Id) return Library_Graph_Edge_Id;
- -- There must be an edge Pred-->Succ; this returns it
+ 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;
- function Find_First_Lower_Precedence_Cycle
- (G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Id;
- pragma Inline (Find_First_Lower_Precedence_Cycle);
- -- Inspect the list of cycles of library graph G and return the first
- -- cycle whose precedence is lower than that of cycle Cycle. If there
- -- is no such cycle, return No_Library_Graph_Cycle.
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Vertex));
- procedure Free is
- new Ada.Unchecked_Deallocation
- (Library_Graph_Attributes, Library_Graph);
+ End_Vertices := LGV_Sets.Create (2);
- function Get_Component_Attributes
- (G : Library_Graph;
- Comp : Component_Id) return Component_Attributes;
- pragma Inline (Get_Component_Attributes);
- -- Obtain the attributes of component Comp of library graph G
+ -- The input vertex always terminates a cycle path
- function Get_LGC_Attributes
- (G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Attributes;
- pragma Inline (Get_LGC_Attributes);
- -- Obtain the attributes of cycle Cycle of library graph G
+ LGV_Sets.Insert (End_Vertices, Vertex);
- function Get_LGE_Attributes
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id)
- return Library_Graph_Edge_Attributes;
- pragma Inline (Get_LGE_Attributes);
- -- Obtain the attributes of edge Edge of library graph G
+ -- 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.
- function Get_LGV_Attributes
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id)
- return Library_Graph_Vertex_Attributes;
- pragma Inline (Get_LGV_Attributes);
- -- Obtain the attributes of vertex Edge of library graph G
+ 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);
- function Has_Elaborate_Body
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean;
- pragma Inline (Has_Elaborate_Body);
- -- Determine whether vertex Vertex of library graph G is subject to
- -- pragma Elaborate_Body.
+ if Present (Complement) then
+ LGV_Sets.Insert (End_Vertices, Complement);
+ end if;
+ end if;
- function Has_Elaborate_All_Edge
+ return End_Vertices;
+ end Cycle_End_Vertices;
+
+ -------------------
+ -- Cycle_Kind_Of --
+ -------------------
+
+ function Cycle_Kind_Of
(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.
+ Edge : Library_Graph_Edge_Id) return Library_Graph_Cycle_Kind
+ is
+ pragma Assert (Present (G));
+ pragma Assert (Present (Edge));
- 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.
+ begin
+ if Is_Cyclic_Elaborate_All_Edge (G, Edge) then
+ return Elaborate_All_Cycle;
- function Highest_Precedence_Edge
- (G : Library_Graph;
- Left : Library_Graph_Edge_Id;
- Right : Library_Graph_Edge_Id) return Library_Graph_Edge_Id;
- pragma Inline (Highest_Precedence_Edge);
- -- Return the edge with highest precedence among edges Left and Right of
- -- library graph G.
+ elsif Is_Cyclic_Elaborate_Body_Edge (G, Edge) then
+ return Elaborate_Body_Cycle;
- procedure Increment_Library_Graph_Edge_Count
- (G : Library_Graph;
- Kind : Library_Graph_Edge_Kind);
- pragma Inline (Increment_Library_Graph_Edge_Count);
- -- Increment the number of edges of king Kind in library graph G by one
+ elsif Is_Cyclic_Elaborate_Edge (G, Edge) then
+ return Elaborate_Cycle;
- procedure Increment_Pending_Predecessors
- (G : Library_Graph;
- Comp : Component_Id;
- Edge : Library_Graph_Edge_Id);
- pragma Inline (Increment_Pending_Predecessors);
- -- Increment the number of pending predecessors component Comp which was
- -- reached via edge Edge of library graph G must wait on before it can
- -- be elaborated by one.
+ elsif Is_Cyclic_Forced_Edge (G, Edge) then
+ return Forced_Cycle;
- procedure Increment_Pending_Predecessors
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id;
- Edge : Library_Graph_Edge_Id);
- pragma Inline (Increment_Pending_Predecessors);
- -- Increment the number of pending predecessors vertex Vertex which was
- -- reached via edge Edge of library graph G must wait on before it can
- -- be elaborated by one.
+ elsif Is_Cyclic_Invocation_Edge (G, Edge) then
+ return Invocation_Cycle;
- procedure Initialize_Components (G : Library_Graph);
- pragma Inline (Initialize_Components);
- -- Initialize on the initial call or re-initialize on subsequent calls
- -- all components of library graph G.
+ else
+ return No_Cycle_Kind;
+ end if;
+ end Cycle_Kind_Of;
- function Is_Cycle_Initiating_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean;
- pragma Inline (Is_Cycle_Initiating_Edge);
- -- Determine whether edge Edge of library graph G starts a cycle
+ ---------------------------
+ -- Cycle_Kind_Precedence --
+ ---------------------------
- function Is_Cyclic_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean;
- pragma Inline (Is_Cyclic_Edge);
- -- Determine whether edge Edge of library graph G participates in a
- -- cycle.
+ function Cycle_Kind_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);
- function Is_Cyclic_Elaborate_All_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean;
- pragma Inline (Is_Cyclic_Elaborate_All_Edge);
- -- Determine whether edge Edge of library graph G participates in a
- -- cycle and has a predecessor that is subject to pragma Elaborate_All.
+ begin
+ -- A lower ordinal indicates a higher precedence
- function Is_Cyclic_Elaborate_Body_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean;
- pragma Inline (Is_Cyclic_Elaborate_Body_Edge);
- -- Determine whether edge Edge of library graph G participates in a
- -- cycle and has a successor that is either a spec subject to pragma
- -- Elaborate_Body, or a body that completes such a spec.
+ if Kind_Pos < Comp_Pos then
+ return Higher_Precedence;
- function Is_Cyclic_Elaborate_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean;
- pragma Inline (Is_Cyclic_Elaborate_Edge);
- -- Determine whether edge Edge of library graph G participates in a
- -- cycle and has a predecessor that is subject to pragma Elaborate.
+ elsif Kind_Pos > Comp_Pos then
+ return Lower_Precedence;
- function Is_Cyclic_Forced_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean;
- pragma Inline (Is_Cyclic_Forced_Edge);
- -- Determine whether edge Edge of library graph G participates in a
- -- cycle and came from the forced-elaboration-order file.
+ else
+ return Equal_Precedence;
+ end if;
+ end Cycle_Kind_Precedence;
- function Is_Cyclic_Invocation_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean;
- pragma Inline (Is_Cyclic_Invocation_Edge);
- -- Determine whether edge Edge of library graph G participates in a
- -- cycle and came from the traversal of the invocation graph.
+ ---------------------------
+ -- Cycle_Path_Precedence --
+ ---------------------------
- function Is_Cyclic_With_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean;
- pragma Inline (Is_Cyclic_With_Edge);
- -- Determine whether edge Edge of library graph G participates in a
- -- cycle and is the result of a with dependency between its successor
- -- and predecessor.
+ function Cycle_Path_Precedence
+ (G : Library_Graph;
+ Path : LGE_Lists.Doubly_Linked_List;
+ Compared_To : LGE_Lists.Doubly_Linked_List) return Precedence_Kind
+ 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;
- function Is_Recorded_Edge
- (G : Library_Graph;
- Rel : Predecessor_Successor_Relation) return Boolean;
- pragma Inline (Is_Recorded_Edge);
- -- Determine whether a predecessor vertex and a successor vertex
- -- described by relation Rel are already linked in library graph G.
+ if LGE_Lists.Has_Next (Iter) then
+ LGE_Lists.Next (Iter, Edge);
+ end if;
+ end Next_Available;
- function Is_Static_Successor_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean;
- pragma Inline (Is_Static_Successor_Edge);
- -- Determine whether the successor of invocation edge Edge represents a
- -- unit that was compiled with the static model.
+ -- Local variables
- 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.
+ Comp_Edge : Library_Graph_Edge_Id;
+ Comp_Iter : LGE_Lists.Iterator;
+ Path_Edge : Library_Graph_Edge_Id;
+ Path_Iter : LGE_Lists.Iterator;
+ Prec : Precedence_Kind;
- function Links_Vertices_In_Same_Component
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean;
- pragma Inline (Links_Vertices_In_Same_Component);
- -- Determine whether edge Edge of library graph G links a predecessor
- -- and successor that reside in the same component.
+ -- Start of processing for Cycle_Path_Precedence
- function Maximum_Invocation_Edge_Count
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id;
- Count : Natural) return Natural;
- pragma Inline (Maximum_Invocation_Edge_Count);
- -- Determine whether edge Edge of library graph G is an invocation edge,
- -- and if it is return Count + 1, otherwise return Count.
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (LGE_Lists.Present (Path));
+ pragma Assert (LGE_Lists.Present (Compared_To));
- procedure Normalize_Cycle_Path
- (Cycle_Path : LGE_Lists.Doubly_Linked_List;
- Most_Significant_Edge : Library_Graph_Edge_Id);
- pragma Inline (Normalize_Cycle_Path);
- -- Normalize cycle path Path by rotating it until its starting edge is
- -- Sig_Edge.
+ -- Assume that the paths have equal precedence
- 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.
+ Prec := Equal_Precedence;
- function Path
- (G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id) return LGE_Lists.Doubly_Linked_List;
- pragma Inline (Path);
- -- Obtain the path of edges which comprises cycle Cycle of library
- -- graph G.
+ Comp_Iter := LGE_Lists.Iterate (Compared_To);
+ Path_Iter := LGE_Lists.Iterate (Path);
- procedure Record_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 (Record_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
- -- is the number of invocation edges along the cycle path. Indent is
- -- the desired indentation level for tracing.
+ Next_Available (Comp_Iter, Comp_Edge);
+ Next_Available (Path_Iter, Path_Edge);
- procedure Set_Activates_Task
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id);
- -- Set the Activates_Task flag of the Edge to True
+ -- IMPORTANT:
+ --
+ -- * The iteration must run to completion in order to unlock the
+ -- edges of both paths.
- procedure Set_Component_Attributes
- (G : Library_Graph;
- Comp : Component_Id;
- Val : Component_Attributes);
- pragma Inline (Set_Component_Attributes);
- -- Set the attributes of component Comp of library graph G to value Val
+ 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;
- procedure Set_Corresponding_Vertex
- (G : Library_Graph;
- U_Id : Unit_Id;
- Val : Library_Graph_Vertex_Id);
- pragma Inline (Set_Corresponding_Vertex);
- -- Associate vertex Val of library graph G with unit U_Id
+ Next_Available (Comp_Iter, Comp_Edge);
+ Next_Available (Path_Iter, Path_Edge);
+ end loop;
- procedure Set_Is_Recorded_Edge
- (G : Library_Graph;
- Rel : Predecessor_Successor_Relation);
- pragma Inline (Set_Is_Recorded_Edge);
- -- Mark a predecessor vertex and a successor vertex described by
- -- relation Rel as already linked.
+ return Prec;
+ end Cycle_Path_Precedence;
- procedure Set_LGC_Attributes
- (G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id;
- Val : Library_Graph_Cycle_Attributes);
- pragma Inline (Set_LGC_Attributes);
- -- Set the attributes of cycle Cycle of library graph G to value Val
+ ----------------------
+ -- Cycle_Precedence --
+ ----------------------
- procedure Set_LGE_Attributes
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id;
- Val : Library_Graph_Edge_Attributes);
- pragma Inline (Set_LGE_Attributes);
- -- Set the attributes of edge Edge of library graph G to value Val
+ 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));
- procedure Set_LGV_Attributes
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id;
- Val : Library_Graph_Vertex_Attributes);
- pragma Inline (Set_LGV_Attributes);
- -- Set the attributes of vertex Vertex of library graph G to value Val
+ 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));
- 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.
+ begin
+ -- Prefer a cycle with higher precedence based on its kind
- procedure Trace_Cycle
- (G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id;
- Indent : Indentation_Level);
- pragma Inline (Trace_Cycle);
- -- Write the contents of cycle Cycle of library graph G to standard
- -- output. Indent is the desired indentation level for tracing.
+ if Kind_Prec = Higher_Precedence
+ or else
+ Kind_Prec = Lower_Precedence
+ then
+ return Kind_Prec;
- procedure Trace_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id;
- Indent : Indentation_Level);
- pragma Inline (Trace_Edge);
- -- Write the contents of edge Edge of library graph G to standard
- -- output. Indent is the desired indentation level for tracing.
+ -- Prefer a shorter cycle
- procedure Trace_Vertex
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id;
- Indent : Indentation_Level);
- pragma Inline (Trace_Vertex);
- -- Write the contents of vertex Vertex of library graph G to standard
- -- output. Indent is the desired indentation level for tracing.
+ elsif Cycle_Len < Comp_Len then
+ return Higher_Precedence;
- 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.
+ elsif Cycle_Len > Comp_Len then
+ return Lower_Precedence;
- procedure Update_Pending_Predecessors
- (Strong_Predecessors : in out Natural;
- Weak_Predecessors : in out Natural;
- Update_Weak : Boolean;
- Value : Integer);
- pragma Inline (Update_Pending_Predecessors);
- -- Update the number of pending strong or weak predecessors denoted by
- -- Strong_Predecessors and Weak_Predecessors respectively depending on
- -- flag Update_Weak by adding value Value.
+ -- Prefer a cycle wih fewer invocation edges
- procedure Update_Pending_Predecessors_Of_Components (G : Library_Graph);
- pragma Inline (Update_Pending_Predecessors_Of_Components);
- -- Update the number of pending predecessors all components of library
- -- graph G must wait on before they can be elaborated.
+ elsif Cycle_Invs < Comp_Invs then
+ return Higher_Precedence;
- procedure Update_Pending_Predecessors_Of_Components
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id);
- pragma Inline (Update_Pending_Predecessors_Of_Components);
- -- Update the number of pending predecessors the component of edge
- -- LGE_Is's successor vertex of library graph G must wait on before
- -- it can be elaborated.
+ elsif Cycle_Invs > Comp_Invs then
+ return Lower_Precedence;
- 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.
+ -- Prefer a cycle with a higher path precedence
- 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.
+ else
+ return
+ Cycle_Path_Precedence
+ (G => G,
+ Path => Path (G, Cycle),
+ Compared_To => Path (G, Compared_To));
+ end if;
+ end Cycle_Precedence;
- --------------------
- -- Activates_Task --
- --------------------
+ ----------------------------------------
+ -- Decrement_Library_Graph_Edge_Count --
+ ----------------------------------------
- function Activates_Task
+ procedure Decrement_Library_Graph_Edge_Count
(G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean
+ Kind : Library_Graph_Edge_Kind)
is
+ pragma Assert (Present (G));
+
+ Count : Natural renames G.Counts (Kind);
+
begin
- return Get_LGE_Attributes (G, Edge).Activates_Task;
- end Activates_Task;
+ Count := Count - 1;
+ end Decrement_Library_Graph_Edge_Count;
- -------------------------------
- -- Add_Body_Before_Spec_Edge --
- -------------------------------
+ ------------------------------------
+ -- Decrement_Pending_Predecessors --
+ ------------------------------------
- procedure Add_Body_Before_Spec_Edge
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id;
- Edges : LGE_Lists.Doubly_Linked_List)
+ procedure Decrement_Pending_Predecessors
+ (G : Library_Graph;
+ Comp : Component_Id;
+ Edge : Library_Graph_Edge_Id)
is
- Edge : Library_Graph_Edge_Id;
+ Attrs : Component_Attributes;
begin
pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
- pragma Assert (LGE_Lists.Present (Edges));
+ pragma Assert (Present (Comp));
- -- A vertex requires a special Body_Before_Spec edge to its
- -- Corresponding_Item when it either denotes a
- --
- -- * Body that completes a previous spec
- --
- -- * Spec with a completing body
- --
- -- The edge creates an intentional circularity between the spec and
- -- body in order to emulate a library unit, and guarantees that both
- -- will appear in the same component.
- --
- -- Due to the structure of the library graph, either the spec or
- -- the body may be visited first, yet Corresponding_Item will still
- -- attempt to create the Body_Before_Spec edge. This is OK because
- -- successor and predecessor are kept consistent in both cases, and
- -- Add_Edge will prevent the creation of the second edge.
+ Attrs := Get_Component_Attributes (G, Comp);
- -- Assume that no Body_Before_Spec is necessary
+ Update_Pending_Predecessors
+ (Strong_Predecessors => Attrs.Pending_Strong_Predecessors,
+ Weak_Predecessors => Attrs.Pending_Weak_Predecessors,
+ Update_Weak => Is_Invocation_Edge (G, Edge),
+ Value => -1);
- Edge := No_Library_Graph_Edge;
+ Set_Component_Attributes (G, Comp, Attrs);
+ end Decrement_Pending_Predecessors;
- -- A body that completes a previous spec
+ ------------------------------------
+ -- Decrement_Pending_Predecessors --
+ ------------------------------------
- if Is_Body_With_Spec (G, Vertex) then
- Edge :=
- Add_Edge
- (G => G,
- Pred => Vertex,
- Succ => Corresponding_Item (G, Vertex),
- Kind => Body_Before_Spec_Edge,
- Activates_Task => False);
+ procedure Decrement_Pending_Predecessors
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id;
+ Edge : Library_Graph_Edge_Id)
+ is
+ Attrs : Library_Graph_Vertex_Attributes;
- -- A spec with a completing body
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Vertex));
- elsif Is_Spec_With_Body (G, Vertex) then
- Edge :=
- Add_Edge
- (G => G,
- Pred => Corresponding_Item (G, Vertex),
- Succ => Vertex,
- Kind => Body_Before_Spec_Edge,
- Activates_Task => False);
- end if;
+ Attrs := Get_LGV_Attributes (G, Vertex);
- if Present (Edge) then
- LGE_Lists.Append (Edges, Edge);
- end if;
- end Add_Body_Before_Spec_Edge;
+ Update_Pending_Predecessors
+ (Strong_Predecessors => Attrs.Pending_Strong_Predecessors,
+ Weak_Predecessors => Attrs.Pending_Weak_Predecessors,
+ Update_Weak => Is_Invocation_Edge (G, Edge),
+ Value => -1);
- --------------------------------
- -- Add_Body_Before_Spec_Edges --
- --------------------------------
+ Set_LGV_Attributes (G, Vertex, Attrs);
+ end Decrement_Pending_Predecessors;
- procedure Add_Body_Before_Spec_Edges
+ -----------------------------------
+ -- Delete_Body_Before_Spec_Edges --
+ -----------------------------------
+
+ procedure Delete_Body_Before_Spec_Edges
(G : Library_Graph;
Edges : LGE_Lists.Doubly_Linked_List)
is
- Iter : Elaborable_Units_Iterator;
- U_Id : Unit_Id;
+ Edge : Library_Graph_Edge_Id;
+ Iter : LGE_Lists.Iterator;
begin
pragma Assert (Present (G));
pragma Assert (LGE_Lists.Present (Edges));
- Iter := Iterate_Elaborable_Units;
- while Has_Next (Iter) loop
- Next (Iter, U_Id);
+ Iter := LGE_Lists.Iterate (Edges);
+ while LGE_Lists.Has_Next (Iter) loop
+ LGE_Lists.Next (Iter, Edge);
+ pragma Assert (Kind (G, Edge) = Body_Before_Spec_Edge);
- Add_Body_Before_Spec_Edge
- (G => G,
- Vertex => Corresponding_Vertex (G, U_Id),
- Edges => Edges);
+ Delete_Edge (G, Edge);
end loop;
- end Add_Body_Before_Spec_Edges;
+ end Delete_Body_Before_Spec_Edges;
- --------------
- -- Add_Edge --
- --------------
+ -----------------
+ -- Delete_Edge --
+ -----------------
- procedure Add_Edge
- (G : Library_Graph;
- Pred : Library_Graph_Vertex_Id;
- Succ : Library_Graph_Vertex_Id;
- Kind : Library_Graph_Edge_Kind;
- Activates_Task : Boolean)
+ procedure Delete_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id)
is
- Ignore : constant Library_Graph_Edge_Id :=
- Add_Edge
- (G => G,
- Pred => Pred,
- Succ => Succ,
- Kind => Kind,
- Activates_Task => Activates_Task);
- begin
- null;
- end Add_Edge;
+ pragma Assert (Present (G));
+ pragma Assert (Present (Edge));
- -------------------------
- -- Add_Edge_Kind_Check --
- -------------------------
+ Pred : constant Library_Graph_Vertex_Id := Predecessor (G, Edge);
+ Succ : constant Library_Graph_Vertex_Id := Successor (G, Edge);
+ Rel : constant Predecessor_Successor_Relation :=
+ (Predecessor => Pred,
+ Successor => Succ);
- procedure Add_Edge_Kind_Check
- (G : Library_Graph;
- Pred : Library_Graph_Vertex_Id;
- Succ : Library_Graph_Vertex_Id;
- New_Kind : Library_Graph_Edge_Kind)
- is
- Old_Edge : constant Library_Graph_Edge_Id :=
- Find_Edge (G, Pred, Succ);
- Old_Kind : constant Library_Graph_Edge_Kind :=
- Get_LGE_Attributes (G, Old_Edge).Kind;
- OK : Boolean;
begin
- case New_Kind is
- when Spec_Before_Body_Edge =>
- OK := False;
- -- Spec_Before_Body_Edge comes first, and there is never more
- -- than one Spec_Before_Body_Edge for a given unit, so we can't
- -- have a preexisting edge in the Spec_Before_Body_Edge case.
+ -- Update the edge statistics
- when With_Edge | Elaborate_Edge | Elaborate_All_Edge
- | Forced_Edge | Invocation_Edge =>
- OK := Old_Kind <= New_Kind;
- -- These edges are created in the order of the enumeration
- -- type, and there can be duplicates; hence "<=".
+ Decrement_Library_Graph_Edge_Count (G, Kind (G, Edge));
- when Body_Before_Spec_Edge =>
- OK := Old_Kind = Body_Before_Spec_Edge
- -- We call Add_Edge with Body_Before_Spec_Edge twice -- once
- -- for the spec and once for the body.
+ -- Update the number of pending predecessors the successor must wait
+ -- on before it is elaborated.
- or else Old_Kind = Forced_Edge
- or else Old_Kind = Invocation_Edge;
- -- The old one can be Forced_Edge or Invocation_Edge, which
- -- necessarily results in an elaboration cycle (in the static
- -- model), but this assertion happens before cycle detection,
- -- so we need to allow these cases.
+ Decrement_Pending_Predecessors
+ (G => G,
+ Vertex => Succ,
+ Edge => Edge);
- when No_Edge =>
- OK := False;
- end case;
+ -- Delete the link between the predecessor and successor. This allows
+ -- for further attempts to link the same predecessor and successor.
- if not OK then
- raise Program_Error with Old_Kind'Img & "-->" & New_Kind'Img;
- end if;
- end Add_Edge_Kind_Check;
+ RE_Sets.Delete (G.Recorded_Edges, Rel);
- --------------
- -- Add_Edge --
- --------------
+ -- Delete the attributes of the edge
- function Add_Edge
- (G : Library_Graph;
- Pred : Library_Graph_Vertex_Id;
- Succ : Library_Graph_Vertex_Id;
- Kind : Library_Graph_Edge_Kind;
- Activates_Task : Boolean) return Library_Graph_Edge_Id
- is
+ LGE_Tables.Delete (G.Edge_Attributes, Edge);
+
+ -- Delete the edge from the underlying graph
+
+ DG.Delete_Edge (G.Graph, Edge);
+ end Delete_Edge;
+
+ -------------
+ -- Destroy --
+ -------------
+
+ procedure Destroy (G : in out Library_Graph) is
+ begin
pragma Assert (Present (G));
- pragma Assert (Present (Pred));
- pragma Assert (Present (Succ));
- pragma Assert (Kind = Invocation_Edge or else not Activates_Task);
- -- Only invocation edges can activate tasks
- Rel : constant Predecessor_Successor_Relation :=
- (Predecessor => Pred, Successor => Succ);
+ Component_Tables.Destroy (G.Component_Attributes);
+ LGC_Tables.Destroy (G.Cycle_Attributes);
+ LGC_Lists.Destroy (G.Cycles);
+ LGE_Tables.Destroy (G.Edge_Attributes);
+ DG.Destroy (G.Graph);
+ RE_Sets.Destroy (G.Recorded_Edges);
+ Unit_Tables.Destroy (G.Unit_To_Vertex);
+ LGV_Tables.Destroy (G.Vertex_Attributes);
+
+ Free (G);
+ end Destroy;
- Edge : Library_Graph_Edge_Id;
+ ----------------------------------
+ -- Destroy_Component_Attributes --
+ ----------------------------------
+ procedure Destroy_Component_Attributes
+ (Attrs : in out Component_Attributes)
+ is
+ pragma Unreferenced (Attrs);
begin
- -- If we already have a Pred-->Succ edge, we don't add another
- -- one. But we need to update Activates_Task, in order to avoid
- -- depending on the order of processing of edges. If we have
- -- Pred-->Succ with Activates_Task=True, and another Pred-->Succ with
- -- Activates_Task=False, we want Activates_Task to be True no matter
- -- which order we processed those two Add_Edge calls.
+ null;
+ end Destroy_Component_Attributes;
- if Is_Recorded_Edge (G, Rel) then
- pragma Debug (Add_Edge_Kind_Check (G, Pred, Succ, Kind));
+ --------------------------------------------
+ -- Destroy_Library_Graph_Cycle_Attributes --
+ --------------------------------------------
- if Activates_Task then
- Set_Activates_Task (G, Find_Edge (G, Pred, Succ));
- end if;
+ procedure Destroy_Library_Graph_Cycle_Attributes
+ (Attrs : in out Library_Graph_Cycle_Attributes)
+ is
+ begin
+ LGE_Lists.Destroy (Attrs.Path);
+ end Destroy_Library_Graph_Cycle_Attributes;
- return No_Library_Graph_Edge;
- end if;
+ -------------------------------------------
+ -- Destroy_Library_Graph_Edge_Attributes --
+ -------------------------------------------
- Edge := Sequence_Next_Edge;
+ procedure Destroy_Library_Graph_Edge_Attributes
+ (Attrs : in out Library_Graph_Edge_Attributes)
+ is
+ pragma Unreferenced (Attrs);
+ begin
+ null;
+ end Destroy_Library_Graph_Edge_Attributes;
- -- Add the edge to the underlying graph. Note that the predecessor
- -- is the source of the edge because it will later need to notify
- -- all its successors that it has been elaborated.
+ ---------------------------------------------
+ -- Destroy_Library_Graph_Vertex_Attributes --
+ ---------------------------------------------
- DG.Add_Edge
- (G => G.Graph,
- E => Edge,
- Source => Pred,
- Destination => Succ);
+ procedure Destroy_Library_Graph_Vertex_Attributes
+ (Attrs : in out Library_Graph_Vertex_Attributes)
+ is
+ pragma Unreferenced (Attrs);
+ begin
+ null;
+ end Destroy_Library_Graph_Vertex_Attributes;
- -- Construct and save the attributes of the edge
+ ---------------------
+ -- Edge_Precedence --
+ ---------------------
- Set_LGE_Attributes
- (G => G,
- Edge => Edge,
- Val =>
- (Activates_Task => Activates_Task,
- Kind => Kind));
+ 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));
- -- Mark the predecessor and successor as related by the new edge.
- -- This prevents all further attempts to link the same predecessor
- -- and successor.
+ 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);
- Set_Is_Recorded_Edge (G, Rel);
+ begin
+ -- Prefer an edge with a higher cycle kind precedence
- -- Update the number of pending predecessors the successor must wait
- -- on before it is elaborated.
+ if Kind_Prec = Higher_Precedence
+ or else
+ Kind_Prec = Lower_Precedence
+ then
+ return Kind_Prec;
- Increment_Pending_Predecessors
- (G => G,
- Vertex => Succ,
- Edge => Edge);
+ -- Prefer an edge whose successor has a higher precedence
- -- Update the edge statistics
+ elsif Comp_Succ /= Edge_Succ
+ and then (Succ_Prec = Higher_Precedence
+ or else
+ Succ_Prec = Lower_Precedence)
+ then
+ return Succ_Prec;
- Increment_Library_Graph_Edge_Count (G, Kind);
+ -- Prefer an edge whose predecessor has a higher precedence
- return Edge;
- end Add_Edge;
+ else
+ return
+ Vertex_Precedence
+ (G => G,
+ Vertex => Predecessor (G, Edge),
+ Compared_To => Predecessor (G, Compared_To));
+ end if;
+ end Edge_Precedence;
- ----------------
- -- Add_Vertex --
- ----------------
+ ---------------
+ -- File_Name --
+ ---------------
- procedure Add_Vertex
- (G : Library_Graph;
- U_Id : Unit_Id)
+ function File_Name
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return File_Name_Type
is
- Vertex : Library_Graph_Vertex_Id;
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Vertex));
+
+ return File_Name (Unit (G, Vertex));
+ end File_Name;
+
+ ---------------------
+ -- Find_Components --
+ ---------------------
+
+ procedure Find_Components (G : Library_Graph) is
+ Edges : LGE_Lists.Doubly_Linked_List;
begin
pragma Assert (Present (G));
- pragma Assert (Present (U_Id));
- -- Nothing to do when the unit already has a vertex
+ Start_Phase (Component_Discovery);
- if Present (Corresponding_Vertex (G, U_Id)) then
- return;
- end if;
+ -- Initialize or reinitialize the components of the graph
- Vertex := Sequence_Next_Vertex;
+ Initialize_Components (G);
- -- Add the vertex to the underlying graph
+ -- Create a set of special edges that link a predecessor body with a
+ -- successor spec. This is an illegal dependency, however using such
+ -- edges eliminates the need to create yet another graph, where both
+ -- spec and body are collapsed into a single vertex.
- DG.Add_Vertex (G.Graph, Vertex);
+ Edges := LGE_Lists.Create;
+ Add_Body_Before_Spec_Edges (G, Edges);
- -- Construct and save the attributes of the vertex
+ DG.Find_Components (G.Graph);
- Set_LGV_Attributes
- (G => G,
- Vertex => Vertex,
- Val =>
- (Corresponding_Item => No_Library_Graph_Vertex,
- In_Elaboration_Order => False,
- Pending_Strong_Predecessors => 0,
- Pending_Weak_Predecessors => 0,
- Unit => U_Id));
+ -- Remove the special edges that link a predecessor body with a
+ -- successor spec because they cause unresolvable circularities.
- -- Associate the unit with its corresponding vertex
+ Delete_Body_Before_Spec_Edges (G, Edges);
+ LGE_Lists.Destroy (Edges);
- Set_Corresponding_Vertex (G, U_Id, Vertex);
- end Add_Vertex;
+ -- Update the number of predecessors various components must wait on
+ -- before they can be elaborated.
- ---------------------------------
- -- At_Least_One_Edge_Satisfies --
- ---------------------------------
+ Update_Pending_Predecessors_Of_Components (G);
+ End_Phase (Component_Discovery);
+ end Find_Components;
- function At_Least_One_Edge_Satisfies
- (G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id;
- Predicate : LGE_Predicate_Ptr) return Boolean
- is
- Edge : Library_Graph_Edge_Id;
- Iter : Edges_Of_Cycle_Iterator;
- Satisfied : Boolean;
+ -----------------
+ -- 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
pragma Assert (Present (G));
- pragma Assert (Present (Cycle));
- pragma Assert (Predicate /= null);
- -- Assume that the predicate cannot be satisfied
+ Start_Phase (Cycle_Discovery);
+
+ -- 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
+ --
+ -- * Accommodate the semantics of Elaborate_All and Elaborate_Body.
+ --
+ -- * Capture cycle paths as edges rather than vertices.
+ --
+ -- * Take advantage of graph components.
+
+ -- Assume that the graph does not contain a cycle
- Satisfied := False;
+ Cycle_Count := 0;
- -- IMPORTANT:
- --
- -- * The iteration must run to completion in order to unlock the
- -- edges of the cycle.
+ -- Run the modified version of the algorithm on each component of the
+ -- graph.
- Iter := Iterate_Edges_Of_Cycle (G, Cycle);
+ Iter := Iterate_Components (G);
while Has_Next (Iter) loop
- Next (Iter, Edge);
+ Next (Iter, Comp);
- Satisfied := Satisfied or else Predicate.all (G, Edge);
+ Find_Cycles_In_Component
+ (G => G,
+ Comp => Comp,
+ Cycle_Count => Cycle_Count,
+ Cycle_Limit => All_Cycle_Limit);
end loop;
- return Satisfied;
- end At_Least_One_Edge_Satisfies;
+ End_Phase (Cycle_Discovery);
+ end Find_Cycles;
- --------------------------
- -- Complementary_Vertex --
- --------------------------
+ --------------------------------
+ -- Find_Cycles_From_Successor --
+ --------------------------------
- function Complementary_Vertex
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id;
- Force_Complement : Boolean) return Library_Graph_Vertex_Id
+ 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
- Complement : Library_Graph_Vertex_Id;
-
- begin
pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
-
- -- Assume that there is no complementary vertex
-
- Complement := No_Library_Graph_Vertex;
-
- -- The caller requests the complement explicitly
+ 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));
- if Force_Complement then
- Complement := Corresponding_Item (G, Vertex);
+ Succ : constant Library_Graph_Vertex_Id := Successor (G, Edge);
+ Succ_Indent : constant Indentation_Level :=
+ Indent + Nested_Indentation;
- -- The vertex is a completing body of a spec subject to pragma
- -- Elaborate_Body. The complementary vertex is the spec.
+ begin
+ -- Assume that the successor reached via the edge does not result in
+ -- a cycle.
- elsif Is_Body_Of_Spec_With_Elaborate_Body (G, Vertex) then
- Complement := Proper_Spec (G, Vertex);
+ Has_Cycle := False;
- -- The vertex is a spec subject to pragma Elaborate_Body. The
- -- complementary vertex is the body.
+ -- Nothing to do when the edge connects two vertices residing in two
+ -- different components.
- elsif Is_Spec_With_Elaborate_Body (G, Vertex) then
- Complement := Proper_Body (G, Vertex);
+ if not Is_Cyclic_Edge (G, Edge) then
+ return;
end if;
- return Complement;
- end Complementary_Vertex;
-
- ---------------
- -- Component --
- ---------------
+ Trace_Edge (G, Edge, Indent);
- function Component
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Component_Id
- is
- begin
- pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
+ -- The modified version does not place vertices on the "point stack",
+ -- but instead collects the edges comprising the cycle. Prepare the
+ -- edge for backtracking.
- return DG.Component (G.Graph, Vertex);
- end Component;
+ LGE_Lists.Prepend (Cycle_Path_Stack, Edge);
- ---------------------------------
- -- Contains_Elaborate_All_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);
- function Contains_Elaborate_All_Edge
- (G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id) return Boolean
- is
- begin
- pragma Assert (Present (G));
- pragma Assert (Present (Cycle));
+ -- The modified version does not place vertices on the "point stack",
+ -- but instead collects the edges comprising the cycle. Backtrack the
+ -- edge.
- return
- At_Least_One_Edge_Satisfies
- (G => G,
- Cycle => Cycle,
- Predicate => Is_Elaborate_All_Edge'Access);
- end Contains_Elaborate_All_Edge;
+ LGE_Lists.Delete_First (Cycle_Path_Stack);
+ end Find_Cycles_From_Successor;
- ------------------------------------
- -- Contains_Static_Successor_Edge --
- ------------------------------------
+ -----------------------------
+ -- Find_Cycles_From_Vertex --
+ -----------------------------
- function Contains_Static_Successor_Edge
- (G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id) return Boolean
+ 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)
is
- begin
- pragma Assert (Present (G));
- pragma Assert (Present (Cycle));
+ Edge_Indent : constant Indentation_Level :=
+ Indent + Nested_Indentation;
- return
- At_Least_One_Edge_Satisfies
- (G => G,
- Cycle => Cycle,
- Predicate => Is_Static_Successor_Edge'Access);
- end Contains_Static_Successor_Edge;
+ Complement : Library_Graph_Vertex_Id;
+ Edge : Library_Graph_Edge_Id;
+ Iter : Edges_To_Successors_Iterator;
- ------------------------------
- -- Contains_Task_Activation --
- ------------------------------
+ Complement_Has_Cycle : Boolean;
+ -- 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.
+
+ Successor_Has_Cycle : Boolean;
+ -- This flag is set when visiting at least one successor of the
+ -- current vertex resulted in a cycle.
- function Contains_Task_Activation
- (G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id) return Boolean
- is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Cycle));
+ 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));
- return
- At_Least_One_Edge_Satisfies
- (G => G,
- Cycle => Cycle,
- Predicate => Activates_Task'Access);
- end Contains_Task_Activation;
+ -- Assume that the vertex does not close a circuit
- ---------------------
- -- Copy_Cycle_Path --
- ---------------------
+ Has_Cycle := False;
- function Copy_Cycle_Path
- (Cycle_Path : LGE_Lists.Doubly_Linked_List)
- return LGE_Lists.Doubly_Linked_List
- is
- Edge : Library_Graph_Edge_Id;
- Iter : LGE_Lists.Iterator;
- Path : LGE_Lists.Doubly_Linked_List;
+ -- Nothing to do when the limit on the number of saved cycles has
+ -- been reached. This protects against a combinatorial explosion
+ -- in components with Elaborate_All cycles.
- begin
- pragma Assert (LGE_Lists.Present (Cycle_Path));
+ if Cycle_Count >= Cycle_Limit then
+ return;
- Path := LGE_Lists.Create;
- Iter := LGE_Lists.Iterate (Cycle_Path);
- while LGE_Lists.Has_Next (Iter) loop
- LGE_Lists.Next (Iter, Edge);
+ -- The vertex closes the circuit, thus resulting in a cycle. Save
+ -- the cycle for later diagnostics. The initial invocation of the
+ -- routine always ignores the starting vertex, to prevent a spurious
+ -- self-cycle.
- LGE_Lists.Append (Path, Edge);
- end loop;
+ elsif not Is_Start_Vertex
+ and then LGV_Sets.Contains (End_Vertices, Vertex)
+ then
+ Trace_Vertex (G, Vertex, Indent);
- return Path;
- end Copy_Cycle_Path;
+ Record_Cycle
+ (G => G,
+ Most_Significant_Edge => Most_Significant_Edge,
+ Invocation_Edge_Count => Invocation_Edge_Count,
+ Cycle_Path => Cycle_Path_Stack,
+ Indent => Indent);
- ------------------------
- -- Corresponding_Item --
- ------------------------
+ Has_Cycle := True;
+ Cycle_Count := Cycle_Count + 1;
+ return;
- function Corresponding_Item
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id
- is
- begin
- pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
+ -- Nothing to do when the vertex has already been deleted. This
+ -- indicates that all available cycles involving the vertex have
+ -- been discovered, and the vertex cannot contribute further to
+ -- the depth-first search.
- return Get_LGV_Attributes (G, Vertex).Corresponding_Item;
- end Corresponding_Item;
+ elsif LGV_Sets.Contains (Deleted_Vertices, Vertex) then
+ return;
- --------------------------
- -- Corresponding_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.
- function Corresponding_Vertex
- (G : Library_Graph;
- U_Id : Unit_Id) return Library_Graph_Vertex_Id
- is
- begin
- pragma Assert (Present (G));
- pragma Assert (Present (U_Id));
+ elsif LGV_Sets.Contains (Visited_Set, Vertex) then
+ return;
+ end if;
- return Unit_Tables.Get (G.Unit_To_Vertex, U_Id);
- end Corresponding_Vertex;
+ Trace_Vertex (G, Vertex, Indent);
- ------------
- -- Create --
- ------------
+ -- Mark the vertex as visited
- function Create
- (Initial_Vertices : Positive;
- Initial_Edges : Positive) return Library_Graph
- is
- G : constant Library_Graph := new Library_Graph_Attributes;
+ Visit
+ (Vertex => Vertex,
+ Visited_Set => Visited_Set,
+ Visited_Stack => Visited_Stack);
- begin
- G.Component_Attributes := Component_Tables.Create (Initial_Vertices);
- G.Cycle_Attributes := LGC_Tables.Create (Initial_Vertices);
- G.Cycles := LGC_Lists.Create;
- G.Edge_Attributes := LGE_Tables.Create (Initial_Edges);
- G.Graph :=
- DG.Create
- (Initial_Vertices => Initial_Vertices,
- Initial_Edges => Initial_Edges);
- G.Recorded_Edges := RE_Sets.Create (Initial_Edges);
- G.Unit_To_Vertex := Unit_Tables.Create (Initial_Vertices);
- G.Vertex_Attributes := LGV_Tables.Create (Initial_Vertices);
+ -- Extend the depth-first search via all the edges to successors
- return G;
- end Create;
+ Iter := Iterate_Edges_To_Successors (G, Vertex);
+ while Has_Next (Iter) loop
+ Next (Iter, Edge);
- ------------------------
- -- Cycle_End_Vertices --
- ------------------------
+ Find_Cycles_From_Successor
+ (G => G,
+ Edge => Edge,
+ End_Vertices => End_Vertices,
+ Deleted_Vertices => Deleted_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;
+ -- 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.
- begin
- pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
+ Most_Significant_Edge =>
+ Highest_Precedence_Edge
+ (G => G,
+ Left => Edge,
+ Right => Most_Significant_Edge),
- End_Vertices := LGV_Sets.Create (2);
+ -- The edge may be an invocation edge, in which case the count
+ -- of invocation edges increases by one.
- -- The input vertex always terminates a cycle path
+ Invocation_Edge_Count =>
+ Maximum_Invocation_Edge_Count
+ (G => G,
+ Edge => Edge,
+ Count => Invocation_Edge_Count),
- LGV_Sets.Insert (End_Vertices, Vertex);
+ 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);
- -- 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.
+ Has_Cycle := Has_Cycle or Successor_Has_Cycle;
+ end loop;
+
+ -- Visit the complementary vertex of the current vertex when pragma
+ -- Elaborate_All is in effect, or the current vertex is part of an
+ -- Elaborate_Body pair.
if Elaborate_All_Active
or else Is_Vertex_With_Elaborate_Body (G, Vertex)
Force_Complement => Elaborate_All_Active);
if Present (Complement) then
- LGV_Sets.Insert (End_Vertices, Complement);
+ 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;
- return End_Vertices;
- end Cycle_End_Vertices;
+ -- The original algorithm clears the "marked stack" in two places:
+ --
+ -- * When the depth-first search starting from the current vertex
+ -- discovers at least one cycle, and
+ --
+ -- * When the depth-first search initiated from a start vertex
+ -- completes.
+ --
+ -- The modified version handles both cases in one place.
- -------------------
- -- Cycle_Kind_Of --
- -------------------
+ if Has_Cycle or else Is_Start_Vertex then
+ Unvisit
+ (Vertex => Vertex,
+ Visited_Set => Visited_Set,
+ Visited_Stack => Visited_Stack);
+ end if;
- function Cycle_Kind_Of
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Library_Graph_Cycle_Kind
+ -- Delete a start vertex from the graph once its depth-first search
+ -- completes. This action preserves the invariant where a cycle is
+ -- not rediscovered "later" in some permuted form.
+
+ if Is_Start_Vertex then
+ LGV_Sets.Insert (Deleted_Vertices, Vertex);
+ end if;
+ end Find_Cycles_From_Vertex;
+
+ ------------------------------
+ -- Find_Cycles_In_Component --
+ ------------------------------
+
+ procedure Find_Cycles_In_Component
+ (G : Library_Graph;
+ Comp : Component_Id;
+ Cycle_Count : in out Natural;
+ Cycle_Limit : Natural)
is
pragma Assert (Present (G));
- pragma Assert (Present (Edge));
+ pragma Assert (Present (Comp));
+
+ Num_Of_Vertices : constant Natural :=
+ Number_Of_Component_Vertices (G, Comp);
+
+ 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.
+
+ Has_Cycle : Boolean;
+ Iter : Component_Vertex_Iterator;
+ Vertex : Library_Graph_Vertex_Id;
+
+ Cycle_Path_Stack : LGE_Lists.Doubly_Linked_List := LGE_Lists.Nil;
+ -- The "point stack" of Tarjan's algorithm. The original maintains
+ -- a stack of vertices, however for diagnostic purposes using edges
+ -- is preferable.
+
+ Deleted_Vertices : LGV_Sets.Membership_Set := LGV_Sets.Nil;
+ -- 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".
+
+ End_Vertices : LGV_Sets.Membership_Set := LGV_Sets.Nil;
+ -- 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;
+ -- 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".
+
+ Visited_Stack : LGV_Lists.Doubly_Linked_List := LGV_Lists.Nil;
+ -- The "marked stack" of Tarjan's algorithm
begin
- if Is_Cyclic_Elaborate_All_Edge (G, Edge) then
- return Elaborate_All_Cycle;
+ Trace_Component (G, Comp, No_Indentation);
- elsif Is_Cyclic_Elaborate_Body_Edge (G, Edge) then
- return Elaborate_Body_Cycle;
+ -- Initialize all component-level data structures
- elsif Is_Cyclic_Elaborate_Edge (G, Edge) then
- return Elaborate_Cycle;
+ 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;
- elsif Is_Cyclic_Forced_Edge (G, Edge) then
- return Forced_Cycle;
+ -- The modified version does not use ordinals to visit vertices in
+ -- 1 .. N fashion. To preserve the invariant of the original, this
+ -- version deletes a vertex after its depth-first search completes.
+ -- 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.
- elsif Is_Cyclic_Invocation_Edge (G, Edge) then
- return Invocation_Cycle;
+ Iter := Iterate_Component_Vertices (G, Comp);
+ while Has_Next (Iter) loop
+ Next (Iter, Vertex);
- else
- return No_Cycle_Kind;
- end if;
- end Cycle_Kind_Of;
+ -- Construct the set of vertices (at most 2) that terminates a
+ -- potential cycle that starts from the current vertex.
+
+ End_Vertices :=
+ Cycle_End_Vertices
+ (G => G,
+ Vertex => Vertex,
+ Elaborate_All_Active => Elaborate_All_Active);
- ---------------------------
- -- Cycle_Kind_Precedence --
- ---------------------------
+ -- The modified version maintains two additional attributes while
+ -- performing the depth-first search:
+ --
+ -- * The most significant edge of the current potential cycle.
+ --
+ -- * The number of invocation edges encountered along the path
+ -- of the current potential cycle.
+ --
+ -- Both attributes are used in the heuristic that determines the
+ -- importance of cycles.
- function Cycle_Kind_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);
+ 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);
- begin
- -- A lower ordinal indicates a higher precedence
+ -- Destroy the cycle-terminating vertices because a new set must
+ -- be constructed for the next vertex.
- if Kind_Pos < Comp_Pos then
- return Higher_Precedence;
+ LGV_Sets.Destroy (End_Vertices);
+ end loop;
- elsif Kind_Pos > Comp_Pos then
- return Lower_Precedence;
+ -- Destroy all component-level data structures
- else
- return Equal_Precedence;
- end if;
- end Cycle_Kind_Precedence;
+ 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;
- ---------------------------
- -- Cycle_Path_Precedence --
- ---------------------------
+ ---------------
+ -- Find_Edge --
+ ---------------
- function Cycle_Path_Precedence
- (G : Library_Graph;
- Path : LGE_Lists.Doubly_Linked_List;
- Compared_To : LGE_Lists.Doubly_Linked_List) return Precedence_Kind
+ function Find_Edge
+ (G : Library_Graph;
+ Pred : Library_Graph_Vertex_Id;
+ Succ : Library_Graph_Vertex_Id) return Library_Graph_Edge_Id
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.
+ Result : Library_Graph_Edge_Id := No_Library_Graph_Edge;
+ Edge : Library_Graph_Edge_Id;
+ Iter : Edges_To_Successors_Iterator :=
+ Iterate_Edges_To_Successors (G, Pred);
- --------------------
- -- Next_Available --
- --------------------
+ begin
+ -- IMPORTANT:
+ --
+ -- * The iteration must run to completion in order to unlock the
+ -- edges to successors.
- procedure Next_Available
- (Iter : in out LGE_Lists.Iterator;
- Edge : out Library_Graph_Edge_Id)
- is
- begin
- -- Assume that the iterator has been exhausted
+ -- This does a linear search through the successors of Pred.
+ -- Efficiency is not a problem, because this is called only when
+ -- Activates_Task is True, which is rare, and anyway, there aren't
+ -- usually large numbers of successors.
- Edge := No_Library_Graph_Edge;
+ while Has_Next (Iter) loop
+ Next (Iter, Edge);
- if LGE_Lists.Has_Next (Iter) then
- LGE_Lists.Next (Iter, Edge);
+ if Succ = Successor (G, Edge) then
+ pragma Assert (not Present (Result));
+ Result := Edge;
end if;
- end Next_Available;
+ end loop;
- -- Local variables
+ pragma Assert (Present (Result));
+ return Result;
+ end Find_Edge;
- Comp_Edge : Library_Graph_Edge_Id;
- Comp_Iter : LGE_Lists.Iterator;
- Path_Edge : Library_Graph_Edge_Id;
- Path_Iter : LGE_Lists.Iterator;
- Prec : Precedence_Kind;
+ ---------------------------------------
+ -- Find_First_Lower_Precedence_Cycle --
+ ---------------------------------------
- -- Start of processing for Cycle_Path_Precedence
+ function Find_First_Lower_Precedence_Cycle
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Id
+ is
+ Current_Cycle : Library_Graph_Cycle_Id;
+ Iter : All_Cycle_Iterator;
+ Lesser_Cycle : Library_Graph_Cycle_Id;
begin
pragma Assert (Present (G));
- pragma Assert (LGE_Lists.Present (Path));
- pragma Assert (LGE_Lists.Present (Compared_To));
-
- -- Assume that the paths have equal precedence
-
- Prec := Equal_Precedence;
+ pragma Assert (Present (Cycle));
- Comp_Iter := LGE_Lists.Iterate (Compared_To);
- Path_Iter := LGE_Lists.Iterate (Path);
+ -- Assume that there is no lesser cycle
- Next_Available (Comp_Iter, Comp_Edge);
- Next_Available (Path_Iter, Path_Edge);
+ Lesser_Cycle := No_Library_Graph_Cycle;
+ -- Find a cycle with a slightly lower precedence than the input
+ -- cycle.
+ --
-- IMPORTANT:
--
- -- * The iteration must run to completion in order to unlock the
- -- edges of both paths.
+ -- * The iterator must run to completion in order to unlock the
+ -- list of all cycles.
- while Present (Comp_Edge) or else Present (Path_Edge) loop
- if Prec = Equal_Precedence
- and then Present (Comp_Edge)
- and then Present (Path_Edge)
+ Iter := Iterate_All_Cycles (G);
+ while Has_Next (Iter) loop
+ Next (Iter, Current_Cycle);
+
+ if not Present (Lesser_Cycle)
+ and then Cycle_Precedence
+ (G => G,
+ Cycle => Cycle,
+ Compared_To => Current_Cycle) = Higher_Precedence
then
- Prec :=
- Edge_Precedence
- (G => G,
- Edge => Path_Edge,
- Compared_To => Comp_Edge);
+ Lesser_Cycle := Current_Cycle;
end if;
-
- Next_Available (Comp_Iter, Comp_Edge);
- Next_Available (Path_Iter, Path_Edge);
end loop;
- return Prec;
- end Cycle_Path_Precedence;
+ return Lesser_Cycle;
+ end Find_First_Lower_Precedence_Cycle;
- ----------------------
- -- Cycle_Precedence --
- ----------------------
+ ------------------------------
+ -- Get_Component_Attributes --
+ ------------------------------
- function Cycle_Precedence
- (G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id;
- Compared_To : Library_Graph_Cycle_Id) return Precedence_Kind
+ function Get_Component_Attributes
+ (G : Library_Graph;
+ Comp : Component_Id) return Component_Attributes
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Comp));
+
+ return Component_Tables.Get (G.Component_Attributes, Comp);
+ end Get_Component_Attributes;
+
+ ------------------------
+ -- Get_LGC_Attributes --
+ ------------------------
+
+ function Get_LGC_Attributes
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Attributes
is
+ begin
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));
+ return LGC_Tables.Get (G.Cycle_Attributes, Cycle);
+ end Get_LGC_Attributes;
+
+ ------------------------
+ -- Get_LGE_Attributes --
+ ------------------------
+ function Get_LGE_Attributes
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Library_Graph_Edge_Attributes
+ is
begin
- -- Prefer a cycle with higher precedence based on its kind
+ pragma Assert (Present (G));
+ pragma Assert (Present (Edge));
- if Kind_Prec = Higher_Precedence
- or else
- Kind_Prec = Lower_Precedence
- then
- return Kind_Prec;
+ return LGE_Tables.Get (G.Edge_Attributes, Edge);
+ end Get_LGE_Attributes;
- -- Prefer a shorter cycle
+ ------------------------
+ -- Get_LGV_Attributes --
+ ------------------------
- elsif Cycle_Len < Comp_Len then
- return Higher_Precedence;
+ function Get_LGV_Attributes
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id)
+ return Library_Graph_Vertex_Attributes
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Vertex));
- elsif Cycle_Len > Comp_Len then
- return Lower_Precedence;
+ return LGV_Tables.Get (G.Vertex_Attributes, Vertex);
+ end Get_LGV_Attributes;
- -- Prefer a cycle wih fewer invocation edges
+ -----------------------------
+ -- Has_Elaborate_All_Cycle --
+ -----------------------------
- elsif Cycle_Invs < Comp_Invs then
- return Higher_Precedence;
+ function Has_Elaborate_All_Cycle (G : Library_Graph) return Boolean is
+ Edge : Library_Graph_Edge_Id;
+ Iter : All_Edge_Iterator;
+ Seen : Boolean;
- elsif Cycle_Invs > Comp_Invs then
- return Lower_Precedence;
+ begin
+ pragma Assert (Present (G));
- -- Prefer a cycle with a higher path precedence
+ -- Assume that no cyclic Elaborate_All edge has been seen
- else
- return
- Cycle_Path_Precedence
- (G => G,
- Path => Path (G, Cycle),
- Compared_To => Path (G, Compared_To));
- end if;
- end Cycle_Precedence;
+ Seen := False;
- ----------------------------------------
- -- Decrement_Library_Graph_Edge_Count --
- ----------------------------------------
+ -- IMPORTANT:
+ --
+ -- * The iteration must run to completion in order to unlock the
+ -- graph.
- procedure Decrement_Library_Graph_Edge_Count
- (G : Library_Graph;
- Kind : Library_Graph_Edge_Kind)
- is
- pragma Assert (Present (G));
+ Iter := Iterate_All_Edges (G);
+ while Has_Next (Iter) loop
+ Next (Iter, Edge);
- Count : Natural renames G.Counts (Kind);
+ if not Seen and then Is_Cyclic_Elaborate_All_Edge (G, Edge) then
+ Seen := True;
+ end if;
+ end loop;
- begin
- Count := Count - 1;
- end Decrement_Library_Graph_Edge_Count;
+ return Seen;
+ end Has_Elaborate_All_Cycle;
- ------------------------------------
- -- Decrement_Pending_Predecessors --
- ------------------------------------
+ ----------------------------
+ -- Has_Elaborate_All_Edge --
+ ----------------------------
- procedure Decrement_Pending_Predecessors
+ function Has_Elaborate_All_Edge
(G : Library_Graph;
- Comp : Component_Id;
- Edge : Library_Graph_Edge_Id)
+ Comp : Component_Id) return Boolean
is
- Attrs : Component_Attributes;
+ Has_Edge : Boolean;
+ Iter : Component_Vertex_Iterator;
+ Vertex : Library_Graph_Vertex_Id;
begin
pragma Assert (Present (G));
pragma Assert (Present (Comp));
- Attrs := Get_Component_Attributes (G, Comp);
+ -- Assume that there is no Elaborate_All edge
- Update_Pending_Predecessors
- (Strong_Predecessors => Attrs.Pending_Strong_Predecessors,
- Weak_Predecessors => Attrs.Pending_Weak_Predecessors,
- Update_Weak => Is_Invocation_Edge (G, Edge),
- Value => -1);
+ Has_Edge := False;
- Set_Component_Attributes (G, Comp, Attrs);
- end Decrement_Pending_Predecessors;
+ -- IMPORTANT:
+ --
+ -- * The iteration must run to completion in order to unlock the
+ -- component vertices.
- ------------------------------------
- -- Decrement_Pending_Predecessors --
- ------------------------------------
+ Iter := Iterate_Component_Vertices (G, Comp);
+ while Has_Next (Iter) loop
+ Next (Iter, Vertex);
- procedure Decrement_Pending_Predecessors
+ 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;
- Edge : Library_Graph_Edge_Id)
+ Vertex : Library_Graph_Vertex_Id) return Boolean
is
- Attrs : Library_Graph_Vertex_Attributes;
+ Edge : Library_Graph_Edge_Id;
+ Has_Edge : Boolean;
+ Iter : Edges_To_Successors_Iterator;
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 --
- -----------------------------------
+ -- Assume that there is no Elaborate_All edge
- 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;
+ Has_Edge := False;
- begin
- pragma Assert (Present (G));
- pragma Assert (LGE_Lists.Present (Edges));
+ -- IMPORTANT:
+ --
+ -- * The iteration must run to completion in order to unlock the
+ -- edges to successors.
- Iter := LGE_Lists.Iterate (Edges);
- while LGE_Lists.Has_Next (Iter) loop
- LGE_Lists.Next (Iter, Edge);
- pragma Assert (Kind (G, Edge) = Body_Before_Spec_Edge);
+ Iter := Iterate_Edges_To_Successors (G, Vertex);
+ while Has_Next (Iter) loop
+ Next (Iter, Edge);
- Delete_Edge (G, Edge);
+ Has_Edge :=
+ Has_Edge or else Is_Cyclic_Elaborate_All_Edge (G, Edge);
end loop;
- end Delete_Body_Before_Spec_Edges;
- -----------------
- -- Delete_Edge --
- -----------------
+ return Has_Edge;
+ end Has_Elaborate_All_Edge;
- procedure Delete_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id)
+ ------------------------
+ -- Has_Elaborate_Body --
+ ------------------------
+
+ function Has_Elaborate_Body
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean
is
pragma Assert (Present (G));
- pragma Assert (Present (Edge));
+ pragma Assert (Present (Vertex));
- Pred : constant Library_Graph_Vertex_Id := Predecessor (G, Edge);
- Succ : constant Library_Graph_Vertex_Id := Successor (G, Edge);
- Rel : constant Predecessor_Successor_Relation :=
- (Predecessor => Pred,
- Successor => Succ);
+ U_Id : constant Unit_Id := Unit (G, Vertex);
+ U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
begin
- -- Update the edge statistics
-
- Decrement_Library_Graph_Edge_Count (G, Kind (G, Edge));
-
- -- Update the number of pending predecessors the successor must wait
- -- on before it is elaborated.
-
- Decrement_Pending_Predecessors
- (G => G,
- Vertex => Succ,
- Edge => Edge);
-
- -- Delete the link between the predecessor and successor. This allows
- -- for further attempts to link the same predecessor and successor.
+ -- Treat the spec and body as decoupled when switch -d_b (ignore the
+ -- effects of pragma Elaborate_Body) is in effect.
- RE_Sets.Delete (G.Recorded_Edges, Rel);
+ return U_Rec.Elaborate_Body and not Debug_Flag_Underscore_B;
+ end Has_Elaborate_Body;
- -- Delete the attributes of the edge
+ --------------
+ -- Has_Next --
+ --------------
- LGE_Tables.Delete (G.Edge_Attributes, Edge);
+ function Has_Next (Iter : All_Cycle_Iterator) return Boolean is
+ begin
+ return LGC_Lists.Has_Next (LGC_Lists.Iterator (Iter));
+ end Has_Next;
- -- Delete the edge from the underlying graph
+ --------------
+ -- Has_Next --
+ --------------
- DG.Delete_Edge (G.Graph, Edge);
- end Delete_Edge;
+ function Has_Next (Iter : All_Edge_Iterator) return Boolean is
+ begin
+ return DG.Has_Next (DG.All_Edge_Iterator (Iter));
+ end Has_Next;
- -------------
- -- Destroy --
- -------------
+ --------------
+ -- Has_Next --
+ --------------
- procedure Destroy (G : in out Library_Graph) is
+ function Has_Next (Iter : All_Vertex_Iterator) return Boolean is
begin
- pragma Assert (Present (G));
+ return DG.Has_Next (DG.All_Vertex_Iterator (Iter));
+ end Has_Next;
- Component_Tables.Destroy (G.Component_Attributes);
- LGC_Tables.Destroy (G.Cycle_Attributes);
- LGC_Lists.Destroy (G.Cycles);
- LGE_Tables.Destroy (G.Edge_Attributes);
- DG.Destroy (G.Graph);
- RE_Sets.Destroy (G.Recorded_Edges);
- Unit_Tables.Destroy (G.Unit_To_Vertex);
- LGV_Tables.Destroy (G.Vertex_Attributes);
+ --------------
+ -- Has_Next --
+ --------------
- Free (G);
- end Destroy;
+ function Has_Next (Iter : Component_Iterator) return Boolean is
+ begin
+ return DG.Has_Next (DG.Component_Iterator (Iter));
+ end Has_Next;
- ----------------------------------
- -- Destroy_Component_Attributes --
- ----------------------------------
+ --------------
+ -- Has_Next --
+ --------------
- procedure Destroy_Component_Attributes
- (Attrs : in out Component_Attributes)
- is
- pragma Unreferenced (Attrs);
+ function Has_Next (Iter : Component_Vertex_Iterator) return Boolean is
begin
- null;
- end Destroy_Component_Attributes;
+ return DG.Has_Next (DG.Component_Vertex_Iterator (Iter));
+ end Has_Next;
- --------------------------------------------
- -- Destroy_Library_Graph_Cycle_Attributes --
- --------------------------------------------
+ --------------
+ -- Has_Next --
+ --------------
- procedure Destroy_Library_Graph_Cycle_Attributes
- (Attrs : in out Library_Graph_Cycle_Attributes)
- is
+ function Has_Next (Iter : Edges_Of_Cycle_Iterator) return Boolean is
begin
- LGE_Lists.Destroy (Attrs.Path);
- end Destroy_Library_Graph_Cycle_Attributes;
+ return LGE_Lists.Has_Next (LGE_Lists.Iterator (Iter));
+ end Has_Next;
- -------------------------------------------
- -- Destroy_Library_Graph_Edge_Attributes --
- -------------------------------------------
+ --------------
+ -- Has_Next --
+ --------------
- procedure Destroy_Library_Graph_Edge_Attributes
- (Attrs : in out Library_Graph_Edge_Attributes)
- is
- pragma Unreferenced (Attrs);
+ function Has_Next (Iter : Edges_To_Successors_Iterator) return Boolean is
begin
- null;
- end Destroy_Library_Graph_Edge_Attributes;
+ return DG.Has_Next (DG.Outgoing_Edge_Iterator (Iter));
+ end Has_Next;
- ---------------------------------------------
- -- Destroy_Library_Graph_Vertex_Attributes --
- ---------------------------------------------
+ -----------------------------
+ -- Has_No_Elaboration_Code --
+ -----------------------------
- procedure Destroy_Library_Graph_Vertex_Attributes
- (Attrs : in out Library_Graph_Vertex_Attributes)
+ function Has_No_Elaboration_Code
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean
is
- pragma Unreferenced (Attrs);
begin
- null;
- end Destroy_Library_Graph_Vertex_Attributes;
+ pragma Assert (Present (G));
+ pragma Assert (Present (Vertex));
- ---------------------
- -- Edge_Precedence --
- ---------------------
+ return Has_No_Elaboration_Code (Unit (G, Vertex));
+ end Has_No_Elaboration_Code;
- 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));
+ -----------------------------------------
+ -- Hash_Library_Graph_Cycle_Attributes --
+ -----------------------------------------
- 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);
+ function Hash_Library_Graph_Cycle_Attributes
+ (Attrs : Library_Graph_Cycle_Attributes) return Bucket_Range_Type
+ is
+ Edge : Library_Graph_Edge_Id;
+ Hash : Bucket_Range_Type;
+ Iter : LGE_Lists.Iterator;
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;
+ pragma Assert (LGE_Lists.Present (Attrs.Path));
- -- Prefer an edge whose successor has a higher precedence
+ -- The hash is obtained in the following manner:
+ --
+ -- (((edge1 * 31) + edge2) * 31) + edgeN
- elsif Comp_Succ /= Edge_Succ
- and then (Succ_Prec = Higher_Precedence
- or else
- Succ_Prec = Lower_Precedence)
- then
- return Succ_Prec;
+ Hash := 0;
+ Iter := LGE_Lists.Iterate (Attrs.Path);
+ while LGE_Lists.Has_Next (Iter) loop
+ LGE_Lists.Next (Iter, Edge);
- -- Prefer an edge whose predecessor has a higher precedence
+ Hash := (Hash * 31) + Bucket_Range_Type (Edge);
+ end loop;
- else
- return
- Vertex_Precedence
- (G => G,
- Vertex => Predecessor (G, Edge),
- Compared_To => Predecessor (G, Compared_To));
- end if;
- end Edge_Precedence;
+ return Hash;
+ end Hash_Library_Graph_Cycle_Attributes;
- ---------------
- -- File_Name --
- ---------------
+ -----------------------------------------
+ -- Hash_Predecessor_Successor_Relation --
+ -----------------------------------------
- function File_Name
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return File_Name_Type
+ function Hash_Predecessor_Successor_Relation
+ (Rel : Predecessor_Successor_Relation) return Bucket_Range_Type
is
begin
- pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
-
- return File_Name (Unit (G, Vertex));
- end File_Name;
+ pragma Assert (Present (Rel.Predecessor));
+ pragma Assert (Present (Rel.Successor));
- ---------------------
- -- Find_Components --
- ---------------------
+ return
+ Hash_Two_Keys
+ (Bucket_Range_Type (Rel.Predecessor),
+ Bucket_Range_Type (Rel.Successor));
+ end Hash_Predecessor_Successor_Relation;
- procedure Find_Components (G : Library_Graph) is
- Edges : LGE_Lists.Doubly_Linked_List;
+ ------------------------------
+ -- Highest_Precedence_Cycle --
+ ------------------------------
+ function Highest_Precedence_Cycle
+ (G : Library_Graph) return Library_Graph_Cycle_Id
+ is
begin
pragma Assert (Present (G));
+ pragma Assert (LGC_Lists.Present (G.Cycles));
- Start_Phase (Component_Discovery);
-
- -- Initialize or reinitialize the components of the graph
+ if LGC_Lists.Is_Empty (G.Cycles) then
+ return No_Library_Graph_Cycle;
- Initialize_Components (G);
+ -- The highest precedence cycle is always the first in the list of
+ -- all cycles.
- -- Create a set of special edges that link a predecessor body with a
- -- successor spec. This is an illegal dependency, however using such
- -- edges eliminates the need to create yet another graph, where both
- -- spec and body are collapsed into a single vertex.
+ else
+ return LGC_Lists.First (G.Cycles);
+ end if;
+ end Highest_Precedence_Cycle;
- Edges := LGE_Lists.Create;
- Add_Body_Before_Spec_Edges (G, Edges);
+ -----------------------------
+ -- Highest_Precedence_Edge --
+ -----------------------------
- DG.Find_Components (G.Graph);
+ function Highest_Precedence_Edge
+ (G : Library_Graph;
+ Left : Library_Graph_Edge_Id;
+ Right : Library_Graph_Edge_Id) return Library_Graph_Edge_Id
+ is
+ Edge_Prec : Precedence_Kind;
- -- Remove the special edges that link a predecessor body with a
- -- successor spec because they cause unresolvable circularities.
+ begin
+ pragma Assert (Present (G));
- Delete_Body_Before_Spec_Edges (G, Edges);
- LGE_Lists.Destroy (Edges);
+ -- Both edges are available, pick the one with highest precedence
- -- Update the number of predecessors various components must wait on
- -- before they can be elaborated.
+ if Present (Left) and then Present (Right) then
+ Edge_Prec :=
+ Edge_Precedence
+ (G => G,
+ Edge => Left,
+ Compared_To => Right);
- Update_Pending_Predecessors_Of_Components (G);
- End_Phase (Component_Discovery);
- end Find_Components;
+ if Edge_Prec = Higher_Precedence then
+ return Left;
- -----------------
- -- Find_Cycles --
- -----------------
+ -- The precedence rules for edges are such that no two edges can
+ -- ever have the same precedence.
- 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.
+ else
+ pragma Assert (Edge_Prec = Lower_Precedence);
+ return Right;
+ end if;
- Comp : Component_Id;
- Cycle_Count : Natural;
- Iter : Component_Iterator;
+ -- Otherwise at least one edge must be present
- begin
- pragma Assert (Present (G));
+ elsif Present (Left) then
+ return Left;
- Start_Phase (Cycle_Discovery);
+ else
+ pragma Assert (Present (Right));
- -- 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
- --
- -- * Accommodate the semantics of Elaborate_All and Elaborate_Body.
- --
- -- * Capture cycle paths as edges rather than vertices.
- --
- -- * Take advantage of graph components.
+ return Right;
+ end if;
+ end Highest_Precedence_Edge;
- -- Assume that the graph does not contain a cycle
+ --------------------------
+ -- In_Elaboration_Order --
+ --------------------------
- Cycle_Count := 0;
+ function In_Elaboration_Order
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Vertex));
- -- Run the modified version of the algorithm on each component of the
- -- graph.
+ return Get_LGV_Attributes (G, Vertex).In_Elaboration_Order;
+ end In_Elaboration_Order;
- Iter := Iterate_Components (G);
- while Has_Next (Iter) loop
- Next (Iter, Comp);
+ -----------------------
+ -- In_Same_Component --
+ -----------------------
- Find_Cycles_In_Component
- (G => G,
- Comp => Comp,
- Cycle_Count => Cycle_Count,
- Cycle_Limit => All_Cycle_Limit);
- end loop;
+ function In_Same_Component
+ (G : Library_Graph;
+ Left : Library_Graph_Vertex_Id;
+ Right : Library_Graph_Vertex_Id) return Boolean
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Left));
+ pragma Assert (Present (Right));
- End_Phase (Cycle_Discovery);
- end Find_Cycles;
+ return Component (G, Left) = Component (G, Right);
+ end In_Same_Component;
- --------------------------------
- -- Find_Cycles_From_Successor --
- --------------------------------
+ ----------------------------------------
+ -- Increment_Library_Graph_Edge_Count --
+ ----------------------------------------
- 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)
+ procedure Increment_Library_Graph_Edge_Count
+ (G : Library_Graph;
+ Kind : Library_Graph_Edge_Kind)
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;
+ Count : Natural renames G.Counts (Kind);
begin
- -- Assume that the successor reached via the edge does not result in
- -- a cycle.
-
- Has_Cycle := False;
+ Count := Count + 1;
+ end Increment_Library_Graph_Edge_Count;
- -- Nothing to do when the edge connects two vertices residing in two
- -- different components.
+ ------------------------------------
+ -- Increment_Pending_Predecessors --
+ ------------------------------------
- if not Is_Cyclic_Edge (G, Edge) then
- return;
- end if;
+ procedure Increment_Pending_Predecessors
+ (G : Library_Graph;
+ Comp : Component_Id;
+ Edge : Library_Graph_Edge_Id)
+ is
+ Attrs : Component_Attributes;
- Trace_Edge (G, Edge, Indent);
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Comp));
- -- The modified version does not place vertices on the "point stack",
- -- but instead collects the edges comprising the cycle. Prepare the
- -- edge for backtracking.
+ Attrs := Get_Component_Attributes (G, Comp);
- LGE_Lists.Prepend (Cycle_Path_Stack, Edge);
+ Update_Pending_Predecessors
+ (Strong_Predecessors => Attrs.Pending_Strong_Predecessors,
+ Weak_Predecessors => Attrs.Pending_Weak_Predecessors,
+ Update_Weak => Is_Invocation_Edge (G, Edge),
+ Value => 1);
- 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);
+ Set_Component_Attributes (G, Comp, Attrs);
+ end Increment_Pending_Predecessors;
- -- The modified version does not place vertices on the "point stack",
- -- but instead collects the edges comprising the cycle. Backtrack the
- -- edge.
+ ------------------------------------
+ -- Increment_Pending_Predecessors --
+ ------------------------------------
- LGE_Lists.Delete_First (Cycle_Path_Stack);
- end Find_Cycles_From_Successor;
+ procedure Increment_Pending_Predecessors
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id;
+ Edge : Library_Graph_Edge_Id)
+ is
+ Attrs : Library_Graph_Vertex_Attributes;
- -----------------------------
- -- Find_Cycles_From_Vertex --
- -----------------------------
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Vertex));
- 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)
- is
- Edge_Indent : constant Indentation_Level :=
- Indent + Nested_Indentation;
+ Attrs := Get_LGV_Attributes (G, Vertex);
- Complement : Library_Graph_Vertex_Id;
- Edge : Library_Graph_Edge_Id;
- Iter : Edges_To_Successors_Iterator;
+ Update_Pending_Predecessors
+ (Strong_Predecessors => Attrs.Pending_Strong_Predecessors,
+ Weak_Predecessors => Attrs.Pending_Weak_Predecessors,
+ Update_Weak => Is_Invocation_Edge (G, Edge),
+ Value => 1);
- Complement_Has_Cycle : Boolean;
- -- 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.
+ Set_LGV_Attributes (G, Vertex, Attrs);
+ end Increment_Pending_Predecessors;
- Successor_Has_Cycle : Boolean;
- -- This flag is set when visiting at least one successor of the
- -- current vertex resulted in a cycle.
+ ---------------------------
+ -- Initialize_Components --
+ ---------------------------
+ procedure Initialize_Components (G : Library_Graph) is
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));
- -- Assume that the vertex does not close a circuit
+ -- The graph already contains a set of components. Reinitialize
+ -- them in order to accommodate the new set of components about to
+ -- be computed.
- Has_Cycle := False;
+ if Number_Of_Components (G) > 0 then
+ Component_Tables.Destroy (G.Component_Attributes);
- -- Nothing to do when the limit on the number of saved cycles has
- -- been reached. This protects against a combinatorial explosion
- -- in components with Elaborate_All cycles.
+ G.Component_Attributes :=
+ Component_Tables.Create (Number_Of_Vertices (G));
+ end if;
+ end Initialize_Components;
- if Cycle_Count >= Cycle_Limit then
- return;
+ ---------------------------
+ -- Invocation_Edge_Count --
+ ---------------------------
- -- The vertex closes the circuit, thus resulting in a cycle. Save
- -- the cycle for later diagnostics. The initial invocation of the
- -- routine always ignores the starting vertex, to prevent a spurious
- -- self-cycle.
+ function Invocation_Edge_Count
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id) return Natural
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Cycle));
- elsif not Is_Start_Vertex
- and then LGV_Sets.Contains (End_Vertices, Vertex)
- then
- Trace_Vertex (G, Vertex, Indent);
+ return Get_LGC_Attributes (G, Cycle).Invocation_Edge_Count;
+ end Invocation_Edge_Count;
- Record_Cycle
- (G => G,
- Most_Significant_Edge => Most_Significant_Edge,
- Invocation_Edge_Count => Invocation_Edge_Count,
- Cycle_Path => Cycle_Path_Stack,
- Indent => Indent);
+ -------------------------------
+ -- Invocation_Graph_Encoding --
+ -------------------------------
- Has_Cycle := True;
- Cycle_Count := Cycle_Count + 1;
- return;
+ function Invocation_Graph_Encoding
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id)
+ return Invocation_Graph_Encoding_Kind
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Vertex));
- -- Nothing to do when the vertex has already been deleted. This
- -- indicates that all available cycles involving the vertex have
- -- been discovered, and the vertex cannot contribute further to
- -- the depth-first search.
+ return Invocation_Graph_Encoding (Unit (G, Vertex));
+ end Invocation_Graph_Encoding;
- elsif LGV_Sets.Contains (Deleted_Vertices, Vertex) then
- return;
+ -------------
+ -- Is_Body --
+ -------------
- -- 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.
+ function Is_Body
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean
+ is
+ pragma Assert (Present (G));
+ pragma Assert (Present (Vertex));
+
+ U_Id : constant Unit_Id := Unit (G, Vertex);
+ U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
- elsif LGV_Sets.Contains (Visited_Set, Vertex) then
- return;
- end if;
+ begin
+ return U_Rec.Utype = Is_Body or else U_Rec.Utype = Is_Body_Only;
+ end Is_Body;
- Trace_Vertex (G, Vertex, Indent);
+ -----------------------------------------
+ -- Is_Body_Of_Spec_With_Elaborate_Body --
+ -----------------------------------------
- -- Mark the vertex as visited
+ function Is_Body_Of_Spec_With_Elaborate_Body
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Vertex));
- Visit
- (Vertex => Vertex,
- Visited_Set => Visited_Set,
- Visited_Stack => Visited_Stack);
+ if Is_Body_With_Spec (G, Vertex) then
+ return
+ Is_Spec_With_Elaborate_Body
+ (G => G,
+ Vertex => Proper_Spec (G, Vertex));
+ end if;
- -- Extend the depth-first search via all the edges to successors
+ return False;
+ end Is_Body_Of_Spec_With_Elaborate_Body;
- Iter := Iterate_Edges_To_Successors (G, Vertex);
- while Has_Next (Iter) loop
- Next (Iter, Edge);
+ -----------------------
+ -- Is_Body_With_Spec --
+ -----------------------
- Find_Cycles_From_Successor
- (G => G,
- Edge => Edge,
- End_Vertices => End_Vertices,
- Deleted_Vertices => Deleted_Vertices,
+ function Is_Body_With_Spec
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean
+ is
+ pragma Assert (Present (G));
+ pragma Assert (Present (Vertex));
- -- 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.
+ U_Id : constant Unit_Id := Unit (G, Vertex);
+ U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
- Most_Significant_Edge =>
- Highest_Precedence_Edge
- (G => G,
- Left => Edge,
- Right => Most_Significant_Edge),
+ begin
+ return U_Rec.Utype = Is_Body;
+ end Is_Body_With_Spec;
- -- The edge may be an invocation edge, in which case the count
- -- of invocation edges increases by one.
+ ------------------------------
+ -- Is_Cycle_Initiating_Edge --
+ ------------------------------
- Invocation_Edge_Count =>
- Maximum_Invocation_Edge_Count
- (G => G,
- Edge => Edge,
- Count => Invocation_Edge_Count),
+ function Is_Cycle_Initiating_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Edge));
- 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);
+ return
+ Is_Cyclic_Elaborate_All_Edge (G, Edge)
+ or else Is_Cyclic_Elaborate_Body_Edge (G, Edge)
+ or else Is_Cyclic_Elaborate_Edge (G, Edge)
+ or else Is_Cyclic_Forced_Edge (G, Edge)
+ or else Is_Cyclic_Invocation_Edge (G, Edge);
+ end Is_Cycle_Initiating_Edge;
- Has_Cycle := Has_Cycle or Successor_Has_Cycle;
- end loop;
+ --------------------
+ -- Is_Cyclic_Edge --
+ --------------------
- -- Visit the complementary vertex of the current vertex when pragma
- -- Elaborate_All is in effect, or the current vertex is part of an
- -- Elaborate_Body pair.
+ function Is_Cyclic_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (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);
+ return
+ Is_Cycle_Initiating_Edge (G, Edge)
+ or else Is_Cyclic_With_Edge (G, Edge);
+ end Is_Cyclic_Edge;
- 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);
+ ----------------------------------
+ -- Is_Cyclic_Elaborate_All_Edge --
+ ----------------------------------
- Has_Cycle := Has_Cycle or Complement_Has_Cycle;
- end if;
- end if;
+ function Is_Cyclic_Elaborate_All_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Edge));
- -- The original algorithm clears the "marked stack" in two places:
- --
- -- * When the depth-first search starting from the current vertex
- -- discovers at least one cycle, and
- --
- -- * When the depth-first search initiated from a start vertex
- -- completes.
- --
- -- The modified version handles both cases in one place.
+ return
+ Is_Elaborate_All_Edge (G, Edge)
+ and then Links_Vertices_In_Same_Component (G, Edge);
+ end Is_Cyclic_Elaborate_All_Edge;
- if Has_Cycle or else Is_Start_Vertex then
- Unvisit
- (Vertex => Vertex,
- Visited_Set => Visited_Set,
- Visited_Stack => Visited_Stack);
- end if;
+ -----------------------------------
+ -- Is_Cyclic_Elaborate_Body_Edge --
+ -----------------------------------
- -- Delete a start vertex from the graph once its depth-first search
- -- completes. This action preserves the invariant where a cycle is
- -- not rediscovered "later" in some permuted form.
+ function Is_Cyclic_Elaborate_Body_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Edge));
- if Is_Start_Vertex then
- LGV_Sets.Insert (Deleted_Vertices, Vertex);
- end if;
- end Find_Cycles_From_Vertex;
+ return
+ Is_Elaborate_Body_Edge (G, Edge)
+ and then Links_Vertices_In_Same_Component (G, Edge);
+ end Is_Cyclic_Elaborate_Body_Edge;
------------------------------
- -- Find_Cycles_In_Component --
+ -- Is_Cyclic_Elaborate_Edge --
------------------------------
- procedure Find_Cycles_In_Component
- (G : Library_Graph;
- Comp : Component_Id;
- Cycle_Count : in out Natural;
- Cycle_Limit : Natural)
+ function Is_Cyclic_Elaborate_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean
is
+ begin
pragma Assert (Present (G));
- pragma Assert (Present (Comp));
-
- Num_Of_Vertices : constant Natural :=
- Number_Of_Component_Vertices (G, Comp);
-
- 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.
-
- Has_Cycle : Boolean;
- Iter : Component_Vertex_Iterator;
- Vertex : Library_Graph_Vertex_Id;
+ pragma Assert (Present (Edge));
- Cycle_Path_Stack : LGE_Lists.Doubly_Linked_List := LGE_Lists.Nil;
- -- The "point stack" of Tarjan's algorithm. The original maintains
- -- a stack of vertices, however for diagnostic purposes using edges
- -- is preferable.
+ return
+ Is_Elaborate_Edge (G, Edge)
+ and then Links_Vertices_In_Same_Component (G, Edge);
+ end Is_Cyclic_Elaborate_Edge;
- Deleted_Vertices : LGV_Sets.Membership_Set := LGV_Sets.Nil;
- -- 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".
+ ---------------------------
+ -- Is_Cyclic_Forced_Edge --
+ ---------------------------
- End_Vertices : LGV_Sets.Membership_Set := LGV_Sets.Nil;
- -- 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".
+ function Is_Cyclic_Forced_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Edge));
- Visited_Set : LGV_Sets.Membership_Set := LGV_Sets.Nil;
- -- 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".
+ return
+ Is_Forced_Edge (G, Edge)
+ and then Links_Vertices_In_Same_Component (G, Edge);
+ end Is_Cyclic_Forced_Edge;
- Visited_Stack : LGV_Lists.Doubly_Linked_List := LGV_Lists.Nil;
- -- The "marked stack" of Tarjan's algorithm
+ -------------------------------
+ -- Is_Cyclic_Invocation_Edge --
+ -------------------------------
+ function Is_Cyclic_Invocation_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean
+ is
begin
- Trace_Component (G, Comp, No_Indentation);
+ pragma Assert (Present (G));
+ pragma Assert (Present (Edge));
- -- Initialize all component-level data structures
+ return
+ Is_Invocation_Edge (G, Edge)
+ and then Links_Vertices_In_Same_Component (G, Edge);
+ end Is_Cyclic_Invocation_Edge;
- 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;
+ -------------------------
+ -- Is_Cyclic_With_Edge --
+ -------------------------
- -- The modified version does not use ordinals to visit vertices in
- -- 1 .. N fashion. To preserve the invariant of the original, this
- -- version deletes a vertex after its depth-first search completes.
- -- 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.
+ function Is_Cyclic_With_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Edge));
- Iter := Iterate_Component_Vertices (G, Comp);
- while Has_Next (Iter) loop
- Next (Iter, Vertex);
+ -- Ignore Elaborate_Body edges because they also appear as with
+ -- edges, but have special successors.
- -- Construct the set of vertices (at most 2) that terminates a
- -- potential cycle that starts from the current vertex.
+ return
+ Is_With_Edge (G, Edge)
+ and then Links_Vertices_In_Same_Component (G, Edge)
+ and then not Is_Elaborate_Body_Edge (G, Edge);
+ end Is_Cyclic_With_Edge;
- End_Vertices :=
- Cycle_End_Vertices
- (G => G,
- Vertex => Vertex,
- Elaborate_All_Active => Elaborate_All_Active);
+ -------------------------------
+ -- Is_Dynamically_Elaborated --
+ -------------------------------
- -- The modified version maintains two additional attributes while
- -- performing the depth-first search:
- --
- -- * The most significant edge of the current potential cycle.
- --
- -- * The number of invocation edges encountered along the path
- -- of the current potential cycle.
- --
- -- Both attributes are used in the heuristic that determines the
- -- importance of cycles.
+ function Is_Dynamically_Elaborated
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Vertex));
- 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);
+ return Is_Dynamically_Elaborated (Unit (G, Vertex));
+ end Is_Dynamically_Elaborated;
- -- Destroy the cycle-terminating vertices because a new set must
- -- be constructed for the next vertex.
+ -----------------------------
+ -- Is_Elaborable_Component --
+ -----------------------------
- LGV_Sets.Destroy (End_Vertices);
- end loop;
+ function Is_Elaborable_Component
+ (G : Library_Graph;
+ Comp : Component_Id) return Boolean
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Comp));
- -- Destroy all component-level data structures
+ -- A component is elaborable when:
+ --
+ -- * It is not waiting on strong predecessors, and
+ -- * It is not waiting on weak predecessors
- 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;
+ return
+ Pending_Strong_Predecessors (G, Comp) = 0
+ and then Pending_Weak_Predecessors (G, Comp) = 0;
+ end Is_Elaborable_Component;
- ---------------
- -- Find_Edge --
- ---------------
+ --------------------------
+ -- Is_Elaborable_Vertex --
+ --------------------------
- function Find_Edge
- (G : Library_Graph;
- Pred : Library_Graph_Vertex_Id;
- Succ : Library_Graph_Vertex_Id) return Library_Graph_Edge_Id
+ function Is_Elaborable_Vertex
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean
is
- Result : Library_Graph_Edge_Id := No_Library_Graph_Edge;
- Edge : Library_Graph_Edge_Id;
- Iter : Edges_To_Successors_Iterator :=
- Iterate_Edges_To_Successors (G, Pred);
+ pragma Assert (Present (G));
+ pragma Assert (Present (Vertex));
+
+ Complement : constant Library_Graph_Vertex_Id :=
+ Complementary_Vertex
+ (G => G,
+ Vertex => Vertex,
+ Force_Complement => False);
+
+ Strong_Preds : Natural;
+ Weak_Preds : Natural;
begin
- -- IMPORTANT:
+ -- A vertex is elaborable when:
--
- -- * The iteration must run to completion in order to unlock the
- -- edges to successors.
+ -- * It has not been elaborated yet, and
+ -- * The complement vertex of an Elaborate_Body pair has not been
+ -- elaborated yet, and
+ -- * It resides within an elaborable component, and
+ -- * It is not waiting on strong predecessors, and
+ -- * It is not waiting on weak predecessors
- -- This does a linear search through the successors of Pred.
- -- Efficiency is not a problem, because this is called only when
- -- Activates_Task is True, which is rare, and anyway, there aren't
- -- usually large numbers of successors.
+ if In_Elaboration_Order (G, Vertex) then
+ return False;
- while Has_Next (Iter) loop
- Next (Iter, Edge);
+ elsif Present (Complement)
+ and then In_Elaboration_Order (G, Complement)
+ then
+ return False;
- if Succ = Successor (G, Edge) then
- pragma Assert (not Present (Result));
- Result := Edge;
- end if;
- end loop;
+ elsif not Is_Elaborable_Component (G, Component (G, Vertex)) then
+ return False;
+ end if;
- pragma Assert (Present (Result));
- return Result;
- end Find_Edge;
+ Pending_Predecessors_For_Elaboration
+ (G => G,
+ Vertex => Vertex,
+ Strong_Preds => Strong_Preds,
+ Weak_Preds => Weak_Preds);
- ---------------------------------------
- -- Find_First_Lower_Precedence_Cycle --
- ---------------------------------------
+ return Strong_Preds = 0 and then Weak_Preds = 0;
+ end Is_Elaborable_Vertex;
- function Find_First_Lower_Precedence_Cycle
- (G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Id
- is
- Current_Cycle : Library_Graph_Cycle_Id;
- Iter : All_Cycle_Iterator;
- Lesser_Cycle : Library_Graph_Cycle_Id;
+ ---------------------------
+ -- Is_Elaborate_All_Edge --
+ ---------------------------
+ function Is_Elaborate_All_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean
+ is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Cycle));
-
- -- Assume that there is no lesser cycle
-
- Lesser_Cycle := No_Library_Graph_Cycle;
+ pragma Assert (Present (Edge));
- -- Find a cycle with a slightly lower precedence than the input
- -- cycle.
- --
- -- IMPORTANT:
- --
- -- * The iterator must run to completion in order to unlock the
- -- list of all cycles.
+ return Kind (G, Edge) = Elaborate_All_Edge;
+ end Is_Elaborate_All_Edge;
- Iter := Iterate_All_Cycles (G);
- while Has_Next (Iter) loop
- Next (Iter, Current_Cycle);
+ ----------------------------
+ -- Is_Elaborate_Body_Edge --
+ ----------------------------
- if not Present (Lesser_Cycle)
- and then Cycle_Precedence
- (G => G,
- Cycle => Cycle,
- Compared_To => Current_Cycle) = Higher_Precedence
- then
- Lesser_Cycle := Current_Cycle;
- end if;
- end loop;
+ function Is_Elaborate_Body_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Edge));
- return Lesser_Cycle;
- end Find_First_Lower_Precedence_Cycle;
+ return
+ Kind (G, Edge) = With_Edge
+ and then Is_Vertex_With_Elaborate_Body (G, Successor (G, Edge));
+ end Is_Elaborate_Body_Edge;
- ------------------------------
- -- Get_Component_Attributes --
- ------------------------------
+ -----------------------
+ -- Is_Elaborate_Edge --
+ -----------------------
- function Get_Component_Attributes
+ function Is_Elaborate_Edge
(G : Library_Graph;
- Comp : Component_Id) return Component_Attributes
+ Edge : Library_Graph_Edge_Id) return Boolean
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Comp));
+ pragma Assert (Present (Edge));
- return Component_Tables.Get (G.Component_Attributes, Comp);
- end Get_Component_Attributes;
+ return Kind (G, Edge) = Elaborate_Edge;
+ end Is_Elaborate_Edge;
- ------------------------
- -- Get_LGC_Attributes --
- ------------------------
+ ----------------------------
+ -- Is_Elaborate_Body_Pair --
+ ----------------------------
- function Get_LGC_Attributes
- (G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Attributes
+ function Is_Elaborate_Body_Pair
+ (G : Library_Graph;
+ Spec_Vertex : Library_Graph_Vertex_Id;
+ Body_Vertex : Library_Graph_Vertex_Id) return Boolean
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Cycle));
+ pragma Assert (Present (Spec_Vertex));
+ pragma Assert (Present (Body_Vertex));
- return LGC_Tables.Get (G.Cycle_Attributes, Cycle);
- end Get_LGC_Attributes;
+ return
+ Is_Spec_With_Elaborate_Body (G, Spec_Vertex)
+ and then Is_Body_Of_Spec_With_Elaborate_Body (G, Body_Vertex)
+ and then Proper_Body (G, Spec_Vertex) = Body_Vertex;
+ end Is_Elaborate_Body_Pair;
- ------------------------
- -- Get_LGE_Attributes --
- ------------------------
+ --------------------
+ -- Is_Forced_Edge --
+ --------------------
- function Get_LGE_Attributes
+ function Is_Forced_Edge
(G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Library_Graph_Edge_Attributes
+ Edge : Library_Graph_Edge_Id) return Boolean
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Edge));
- return LGE_Tables.Get (G.Edge_Attributes, Edge);
- end Get_LGE_Attributes;
+ return Kind (G, Edge) = Forced_Edge;
+ end Is_Forced_Edge;
- ------------------------
- -- Get_LGV_Attributes --
- ------------------------
+ ----------------------
+ -- Is_Internal_Unit --
+ ----------------------
- function Get_LGV_Attributes
+ function Is_Internal_Unit
(G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id)
- return Library_Graph_Vertex_Attributes
+ Vertex : Library_Graph_Vertex_Id) return Boolean
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
- return LGV_Tables.Get (G.Vertex_Attributes, Vertex);
- end Get_LGV_Attributes;
-
- -----------------------------
- -- Has_Elaborate_All_Cycle --
- -----------------------------
-
- function Has_Elaborate_All_Cycle (G : Library_Graph) return Boolean is
- Edge : Library_Graph_Edge_Id;
- Iter : All_Edge_Iterator;
- Seen : Boolean;
-
- begin
- pragma Assert (Present (G));
-
- -- Assume that no cyclic Elaborate_All edge has been seen
-
- Seen := False;
-
- -- IMPORTANT:
- --
- -- * The iteration must run to completion in order to unlock the
- -- graph.
-
- Iter := Iterate_All_Edges (G);
- while Has_Next (Iter) loop
- Next (Iter, Edge);
-
- if not Seen and then Is_Cyclic_Elaborate_All_Edge (G, Edge) then
- Seen := True;
- end if;
- end loop;
-
- return Seen;
- end Has_Elaborate_All_Cycle;
+ return Is_Internal_Unit (Unit (G, Vertex));
+ end Is_Internal_Unit;
- ----------------------------
- -- Has_Elaborate_All_Edge --
- ----------------------------
+ ------------------------
+ -- Is_Invocation_Edge --
+ ------------------------
- function Has_Elaborate_All_Edge
+ function Is_Invocation_Edge
(G : Library_Graph;
- Comp : Component_Id) return Boolean
+ Edge : Library_Graph_Edge_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;
+ pragma Assert (Present (Edge));
- return Has_Edge;
- end Has_Elaborate_All_Edge;
+ return Kind (G, Edge) = Invocation_Edge;
+ end Is_Invocation_Edge;
- ----------------------------
- -- Has_Elaborate_All_Edge --
- ----------------------------
+ ------------------------
+ -- Is_Predefined_Unit --
+ ------------------------
- function Has_Elaborate_All_Edge
+ function Is_Predefined_Unit
(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;
+ return Is_Predefined_Unit (Unit (G, Vertex));
+ end Is_Predefined_Unit;
- ------------------------
- -- Has_Elaborate_Body --
- ------------------------
+ ---------------------------
+ -- Is_Preelaborated_Unit --
+ ---------------------------
- function Has_Elaborate_Body
+ function Is_Preelaborated_Unit
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id) return Boolean
is
U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
begin
- -- Treat the spec and body as decoupled when switch -d_b (ignore the
- -- effects of pragma Elaborate_Body) is in effect.
-
- return U_Rec.Elaborate_Body and not Debug_Flag_Underscore_B;
- end Has_Elaborate_Body;
-
- --------------
- -- Has_Next --
- --------------
-
- function Has_Next (Iter : All_Cycle_Iterator) return Boolean is
- begin
- return LGC_Lists.Has_Next (LGC_Lists.Iterator (Iter));
- end Has_Next;
-
- --------------
- -- Has_Next --
- --------------
-
- function Has_Next (Iter : All_Edge_Iterator) return Boolean is
- begin
- return DG.Has_Next (DG.All_Edge_Iterator (Iter));
- end Has_Next;
+ return U_Rec.Preelab or else U_Rec.Pure;
+ end Is_Preelaborated_Unit;
- --------------
- -- Has_Next --
- --------------
+ ----------------------
+ -- Is_Recorded_Edge --
+ ----------------------
- function Has_Next (Iter : All_Vertex_Iterator) return Boolean is
+ function Is_Recorded_Edge
+ (G : Library_Graph;
+ Rel : Predecessor_Successor_Relation) return Boolean
+ is
begin
- return DG.Has_Next (DG.All_Vertex_Iterator (Iter));
- end Has_Next;
-
- --------------
- -- Has_Next --
- --------------
+ pragma Assert (Present (G));
+ pragma Assert (Present (Rel.Predecessor));
+ pragma Assert (Present (Rel.Successor));
- function Has_Next (Iter : Component_Iterator) return Boolean is
- begin
- return DG.Has_Next (DG.Component_Iterator (Iter));
- end Has_Next;
+ return RE_Sets.Contains (G.Recorded_Edges, Rel);
+ end Is_Recorded_Edge;
- --------------
- -- Has_Next --
- --------------
+ -------------
+ -- Is_Spec --
+ -------------
- function Has_Next (Iter : Component_Vertex_Iterator) return Boolean is
- begin
- return DG.Has_Next (DG.Component_Vertex_Iterator (Iter));
- end Has_Next;
+ function Is_Spec
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean
+ is
+ pragma Assert (Present (G));
+ pragma Assert (Present (Vertex));
- --------------
- -- Has_Next --
- --------------
+ U_Id : constant Unit_Id := Unit (G, Vertex);
+ U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
- function Has_Next (Iter : Edges_Of_Cycle_Iterator) return Boolean is
begin
- return LGE_Lists.Has_Next (LGE_Lists.Iterator (Iter));
- end Has_Next;
+ return U_Rec.Utype = Is_Spec or else U_Rec.Utype = Is_Spec_Only;
+ end Is_Spec;
- --------------
- -- Has_Next --
- --------------
+ ------------------------------
+ -- Is_Spec_Before_Body_Edge --
+ ------------------------------
- function Has_Next (Iter : Edges_To_Successors_Iterator) return Boolean is
+ function Is_Spec_Before_Body_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean
+ is
begin
- return DG.Has_Next (DG.Outgoing_Edge_Iterator (Iter));
- end Has_Next;
+ pragma Assert (Present (G));
+ pragma Assert (Present (Edge));
- -----------------------------
- -- Has_No_Elaboration_Code --
- -----------------------------
+ return Kind (G, Edge) = Spec_Before_Body_Edge;
+ end Is_Spec_Before_Body_Edge;
- function Has_No_Elaboration_Code
+ -----------------------
+ -- Is_Spec_With_Body --
+ -----------------------
+
+ function Is_Spec_With_Body
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id) return Boolean
is
- begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
- return Has_No_Elaboration_Code (Unit (G, Vertex));
- end Has_No_Elaboration_Code;
-
- -----------------------------------------
- -- Hash_Library_Graph_Cycle_Attributes --
- -----------------------------------------
-
- function Hash_Library_Graph_Cycle_Attributes
- (Attrs : Library_Graph_Cycle_Attributes) return Bucket_Range_Type
- is
- Edge : Library_Graph_Edge_Id;
- Hash : Bucket_Range_Type;
- Iter : LGE_Lists.Iterator;
+ U_Id : constant Unit_Id := Unit (G, Vertex);
+ U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
begin
- pragma Assert (LGE_Lists.Present (Attrs.Path));
-
- -- The hash is obtained in the following manner:
- --
- -- (((edge1 * 31) + edge2) * 31) + edgeN
-
- Hash := 0;
- Iter := LGE_Lists.Iterate (Attrs.Path);
- while LGE_Lists.Has_Next (Iter) loop
- LGE_Lists.Next (Iter, Edge);
-
- Hash := (Hash * 31) + Bucket_Range_Type (Edge);
- end loop;
-
- return Hash;
- end Hash_Library_Graph_Cycle_Attributes;
+ return U_Rec.Utype = Is_Spec;
+ end Is_Spec_With_Body;
- -----------------------------------------
- -- Hash_Predecessor_Successor_Relation --
- -----------------------------------------
+ ---------------------------------
+ -- Is_Spec_With_Elaborate_Body --
+ ---------------------------------
- function Hash_Predecessor_Successor_Relation
- (Rel : Predecessor_Successor_Relation) return Bucket_Range_Type
+ function Is_Spec_With_Elaborate_Body
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean
is
begin
- pragma Assert (Present (Rel.Predecessor));
- pragma Assert (Present (Rel.Successor));
+ pragma Assert (Present (G));
+ pragma Assert (Present (Vertex));
return
- Hash_Two_Keys
- (Bucket_Range_Type (Rel.Predecessor),
- Bucket_Range_Type (Rel.Successor));
- end Hash_Predecessor_Successor_Relation;
+ Is_Spec_With_Body (G, Vertex)
+ and then Has_Elaborate_Body (G, Vertex);
+ end Is_Spec_With_Elaborate_Body;
------------------------------
- -- Highest_Precedence_Cycle --
+ -- Is_Static_Successor_Edge --
------------------------------
- function Highest_Precedence_Cycle
- (G : Library_Graph) return Library_Graph_Cycle_Id
+ function Is_Static_Successor_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean
is
begin
pragma Assert (Present (G));
- pragma Assert (LGC_Lists.Present (G.Cycles));
-
- if LGC_Lists.Is_Empty (G.Cycles) then
- return No_Library_Graph_Cycle;
-
- -- The highest precedence cycle is always the first in the list of
- -- all cycles.
+ pragma Assert (Present (Edge));
- else
- return LGC_Lists.First (G.Cycles);
- end if;
- end Highest_Precedence_Cycle;
+ return
+ Is_Invocation_Edge (G, Edge)
+ and then not Is_Dynamically_Elaborated (G, Successor (G, Edge));
+ end Is_Static_Successor_Edge;
- -----------------------------
- -- Highest_Precedence_Edge --
- -----------------------------
+ -----------------------------------
+ -- Is_Vertex_With_Elaborate_Body --
+ -----------------------------------
- function Highest_Precedence_Edge
- (G : Library_Graph;
- Left : Library_Graph_Edge_Id;
- Right : Library_Graph_Edge_Id) return Library_Graph_Edge_Id
+ function Is_Vertex_With_Elaborate_Body
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean
is
- Edge_Prec : Precedence_Kind;
-
begin
pragma Assert (Present (G));
+ pragma Assert (Present (Vertex));
- -- Both edges are available, pick the one with highest precedence
-
- if Present (Left) and then Present (Right) then
- Edge_Prec :=
- Edge_Precedence
- (G => G,
- Edge => Left,
- Compared_To => Right);
-
- if Edge_Prec = Higher_Precedence then
- return Left;
-
- -- The precedence rules for edges are such that no two edges can
- -- ever have the same precedence.
-
- else
- pragma Assert (Edge_Prec = Lower_Precedence);
- return Right;
- end if;
-
- -- Otherwise at least one edge must be present
-
- elsif Present (Left) then
- return Left;
-
- else
- pragma Assert (Present (Right));
-
- return Right;
- end if;
- end Highest_Precedence_Edge;
+ 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;
- --------------------------
- -- In_Elaboration_Order --
- --------------------------
+ ---------------------------------
+ -- Is_Weakly_Elaborable_Vertex --
+ ----------------------------------
- function In_Elaboration_Order
+ function Is_Weakly_Elaborable_Vertex
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id) return Boolean
is
- begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
- return Get_LGV_Attributes (G, Vertex).In_Elaboration_Order;
- end In_Elaboration_Order;
+ Complement : constant Library_Graph_Vertex_Id :=
+ Complementary_Vertex
+ (G => G,
+ Vertex => Vertex,
+ Force_Complement => False);
- -----------------------
- -- In_Same_Component --
- -----------------------
+ Strong_Preds : Natural;
+ Weak_Preds : Natural;
- function In_Same_Component
- (G : Library_Graph;
- Left : Library_Graph_Vertex_Id;
- Right : Library_Graph_Vertex_Id) return Boolean
- is
begin
- pragma Assert (Present (G));
- pragma Assert (Present (Left));
- pragma Assert (Present (Right));
+ -- A vertex is weakly elaborable when:
+ --
+ -- * It has not been elaborated yet, and
+ -- * The complement vertex of an Elaborate_Body pair has not been
+ -- elaborated yet, and
+ -- * It resides within an elaborable component, and
+ -- * It is not waiting on strong predecessors, and
+ -- * It is waiting on at least one weak predecessor
- return Component (G, Left) = Component (G, Right);
- end In_Same_Component;
+ if In_Elaboration_Order (G, Vertex) then
+ return False;
- ----------------------------------------
- -- Increment_Library_Graph_Edge_Count --
- ----------------------------------------
+ elsif Present (Complement)
+ and then In_Elaboration_Order (G, Complement)
+ then
+ return False;
- procedure Increment_Library_Graph_Edge_Count
- (G : Library_Graph;
- Kind : Library_Graph_Edge_Kind)
- is
- pragma Assert (Present (G));
+ elsif not Is_Elaborable_Component (G, Component (G, Vertex)) then
+ return False;
+ end if;
- Count : Natural renames G.Counts (Kind);
+ Pending_Predecessors_For_Elaboration
+ (G => G,
+ Vertex => Vertex,
+ Strong_Preds => Strong_Preds,
+ Weak_Preds => Weak_Preds);
- begin
- Count := Count + 1;
- end Increment_Library_Graph_Edge_Count;
+ return Strong_Preds = 0 and then Weak_Preds >= 1;
+ end Is_Weakly_Elaborable_Vertex;
- ------------------------------------
- -- Increment_Pending_Predecessors --
- ------------------------------------
+ ------------------
+ -- Is_With_Edge --
+ ------------------
- procedure Increment_Pending_Predecessors
+ function Is_With_Edge
(G : Library_Graph;
- Comp : Component_Id;
- Edge : Library_Graph_Edge_Id)
+ Edge : Library_Graph_Edge_Id) return Boolean
is
- Attrs : Component_Attributes;
-
begin
pragma Assert (Present (G));
- pragma Assert (Present (Comp));
+ pragma Assert (Present (Edge));
- Attrs := Get_Component_Attributes (G, Comp);
+ return Kind (G, Edge) = With_Edge;
+ end Is_With_Edge;
- Update_Pending_Predecessors
- (Strong_Predecessors => Attrs.Pending_Strong_Predecessors,
- Weak_Predecessors => Attrs.Pending_Weak_Predecessors,
- Update_Weak => Is_Invocation_Edge (G, Edge),
- Value => 1);
+ ------------------------
+ -- Iterate_All_Cycles --
+ ------------------------
- Set_Component_Attributes (G, Comp, Attrs);
- end Increment_Pending_Predecessors;
+ function Iterate_All_Cycles
+ (G : Library_Graph) return All_Cycle_Iterator
+ is
+ begin
+ pragma Assert (Present (G));
- ------------------------------------
- -- Increment_Pending_Predecessors --
- ------------------------------------
+ return All_Cycle_Iterator (LGC_Lists.Iterate (G.Cycles));
+ end Iterate_All_Cycles;
+
+ -----------------------
+ -- Iterate_All_Edges --
+ -----------------------
- procedure Increment_Pending_Predecessors
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id;
- Edge : Library_Graph_Edge_Id)
+ function Iterate_All_Edges
+ (G : Library_Graph) return All_Edge_Iterator
is
- Attrs : Library_Graph_Vertex_Attributes;
-
begin
pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
- Attrs := Get_LGV_Attributes (G, Vertex);
+ return All_Edge_Iterator (DG.Iterate_All_Edges (G.Graph));
+ end Iterate_All_Edges;
- Update_Pending_Predecessors
- (Strong_Predecessors => Attrs.Pending_Strong_Predecessors,
- Weak_Predecessors => Attrs.Pending_Weak_Predecessors,
- Update_Weak => Is_Invocation_Edge (G, Edge),
- Value => 1);
+ --------------------------
+ -- Iterate_All_Vertices --
+ --------------------------
- Set_LGV_Attributes (G, Vertex, Attrs);
- end Increment_Pending_Predecessors;
+ function Iterate_All_Vertices
+ (G : Library_Graph) return All_Vertex_Iterator
+ is
+ begin
+ pragma Assert (Present (G));
- ---------------------------
- -- Initialize_Components --
- ---------------------------
+ return All_Vertex_Iterator (DG.Iterate_All_Vertices (G.Graph));
+ end Iterate_All_Vertices;
- procedure Initialize_Components (G : Library_Graph) is
+ ------------------------
+ -- Iterate_Components --
+ ------------------------
+
+ function Iterate_Components
+ (G : Library_Graph) return Component_Iterator
+ is
begin
pragma Assert (Present (G));
- -- The graph already contains a set of components. Reinitialize
- -- them in order to accommodate the new set of components about to
- -- be computed.
+ return Component_Iterator (DG.Iterate_Components (G.Graph));
+ end Iterate_Components;
- if Number_Of_Components (G) > 0 then
- Component_Tables.Destroy (G.Component_Attributes);
+ --------------------------------
+ -- Iterate_Component_Vertices --
+ --------------------------------
- G.Component_Attributes :=
- Component_Tables.Create (Number_Of_Vertices (G));
- end if;
- end Initialize_Components;
+ function Iterate_Component_Vertices
+ (G : Library_Graph;
+ Comp : Component_Id) return Component_Vertex_Iterator
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Comp));
- ---------------------------
- -- Invocation_Edge_Count --
- ---------------------------
+ return
+ Component_Vertex_Iterator
+ (DG.Iterate_Component_Vertices (G.Graph, Comp));
+ end Iterate_Component_Vertices;
- function Invocation_Edge_Count
+ ----------------------------
+ -- Iterate_Edges_Of_Cycle --
+ ----------------------------
+
+ function Iterate_Edges_Of_Cycle
(G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id) return Natural
+ Cycle : Library_Graph_Cycle_Id) return Edges_Of_Cycle_Iterator
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Cycle));
- return Get_LGC_Attributes (G, Cycle).Invocation_Edge_Count;
- end Invocation_Edge_Count;
+ return Edges_Of_Cycle_Iterator (LGE_Lists.Iterate (Path (G, Cycle)));
+ end Iterate_Edges_Of_Cycle;
- -------------------------------
- -- Invocation_Graph_Encoding --
- -------------------------------
+ ---------------------------------
+ -- Iterate_Edges_To_Successors --
+ ---------------------------------
- function Invocation_Graph_Encoding
+ function Iterate_Edges_To_Successors
(G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id)
- return Invocation_Graph_Encoding_Kind
+ Vertex : Library_Graph_Vertex_Id) return Edges_To_Successors_Iterator
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
- return Invocation_Graph_Encoding (Unit (G, Vertex));
- end Invocation_Graph_Encoding;
+ return
+ Edges_To_Successors_Iterator
+ (DG.Iterate_Outgoing_Edges (G.Graph, Vertex));
+ end Iterate_Edges_To_Successors;
- -------------
- -- Is_Body --
- -------------
+ ----------
+ -- Kind --
+ ----------
- function Is_Body
+ function Kind
(G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean
+ Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Kind
is
+ begin
pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
+ pragma Assert (Present (Cycle));
- U_Id : constant Unit_Id := Unit (G, Vertex);
- U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
+ return Get_LGC_Attributes (G, Cycle).Kind;
+ end Kind;
+
+ ----------
+ -- Kind --
+ ----------
+ function Kind
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Library_Graph_Edge_Kind
+ is
begin
- return U_Rec.Utype = Is_Body or else U_Rec.Utype = Is_Body_Only;
- end Is_Body;
+ return Get_LGE_Attributes (G, Edge).Kind;
+ end Kind;
- -----------------------------------------
- -- Is_Body_Of_Spec_With_Elaborate_Body --
- -----------------------------------------
+ ------------
+ -- Length --
+ ------------
- function Is_Body_Of_Spec_With_Elaborate_Body
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean
+ function Length
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id) return Natural
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
-
- if Is_Body_With_Spec (G, Vertex) then
- return
- Is_Spec_With_Elaborate_Body
- (G => G,
- Vertex => Proper_Spec (G, Vertex));
- end if;
+ pragma Assert (Present (Cycle));
- return False;
- end Is_Body_Of_Spec_With_Elaborate_Body;
+ return LGE_Lists.Size (Path (G, Cycle));
+ end Length;
- -----------------------
- -- Is_Body_With_Spec --
- -----------------------
+ ------------------------------
+ -- Library_Graph_Edge_Count --
+ ------------------------------
- function Is_Body_With_Spec
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean
+ function Library_Graph_Edge_Count
+ (G : Library_Graph;
+ Kind : Library_Graph_Edge_Kind) return Natural
is
+ begin
pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
-
- U_Id : constant Unit_Id := Unit (G, Vertex);
- U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
- begin
- return U_Rec.Utype = Is_Body;
- end Is_Body_With_Spec;
+ return G.Counts (Kind);
+ end Library_Graph_Edge_Count;
- ------------------------------
- -- Is_Cycle_Initiating_Edge --
- ------------------------------
+ --------------------------------------
+ -- Links_Vertices_In_Same_Component --
+ --------------------------------------
- function Is_Cycle_Initiating_Edge
+ function Links_Vertices_In_Same_Component
(G : Library_Graph;
Edge : Library_Graph_Edge_Id) return Boolean
is
pragma Assert (Present (G));
pragma Assert (Present (Edge));
+ -- An edge is part of a cycle when both the successor and predecessor
+ -- reside in the same component.
+
return
- Is_Cyclic_Elaborate_All_Edge (G, Edge)
- or else Is_Cyclic_Elaborate_Body_Edge (G, Edge)
- or else Is_Cyclic_Elaborate_Edge (G, Edge)
- or else Is_Cyclic_Forced_Edge (G, Edge)
- or else Is_Cyclic_Invocation_Edge (G, Edge);
- end Is_Cycle_Initiating_Edge;
+ In_Same_Component
+ (G => G,
+ Left => Predecessor (G, Edge),
+ Right => Successor (G, Edge));
+ end Links_Vertices_In_Same_Component;
- --------------------
- -- Is_Cyclic_Edge --
- --------------------
+ -----------------------------------
+ -- Maximum_Invocation_Edge_Count --
+ -----------------------------------
- function Is_Cyclic_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean
+ function Maximum_Invocation_Edge_Count
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id;
+ Count : Natural) return Natural
is
+ New_Count : Natural;
+
begin
pragma Assert (Present (G));
- pragma Assert (Present (Edge));
- return
- Is_Cycle_Initiating_Edge (G, Edge)
- or else Is_Cyclic_With_Edge (G, Edge);
- end Is_Cyclic_Edge;
+ New_Count := Count;
- ----------------------------------
- -- Is_Cyclic_Elaborate_All_Edge --
- ----------------------------------
+ if Present (Edge) and then Is_Invocation_Edge (G, Edge) then
+ New_Count := New_Count + 1;
+ end if;
- function Is_Cyclic_Elaborate_All_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean
+ return New_Count;
+ end Maximum_Invocation_Edge_Count;
+
+ ----------
+ -- Name --
+ ----------
+
+ function Name
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Unit_Name_Type
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Edge));
+ pragma Assert (Present (Vertex));
- return
- Is_Elaborate_All_Edge (G, Edge)
- and then Links_Vertices_In_Same_Component (G, Edge);
- end Is_Cyclic_Elaborate_All_Edge;
+ return Name (Unit (G, Vertex));
+ end Name;
- -----------------------------------
- -- Is_Cyclic_Elaborate_Body_Edge --
- -----------------------------------
+ -----------------------
+ -- Needs_Elaboration --
+ -----------------------
- function Is_Cyclic_Elaborate_Body_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean
+ function Needs_Elaboration
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Edge));
+ pragma Assert (Present (Vertex));
- return
- Is_Elaborate_Body_Edge (G, Edge)
- and then Links_Vertices_In_Same_Component (G, Edge);
- end Is_Cyclic_Elaborate_Body_Edge;
+ return Needs_Elaboration (Unit (G, Vertex));
+ end Needs_Elaboration;
- ------------------------------
- -- Is_Cyclic_Elaborate_Edge --
- ------------------------------
+ ----------
+ -- Next --
+ ----------
- function Is_Cyclic_Elaborate_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean
+ procedure Next
+ (Iter : in out All_Cycle_Iterator;
+ Cycle : out Library_Graph_Cycle_Id)
is
begin
- pragma Assert (Present (G));
- pragma Assert (Present (Edge));
-
- return
- Is_Elaborate_Edge (G, Edge)
- and then Links_Vertices_In_Same_Component (G, Edge);
- end Is_Cyclic_Elaborate_Edge;
+ LGC_Lists.Next (LGC_Lists.Iterator (Iter), Cycle);
+ end Next;
- ---------------------------
- -- Is_Cyclic_Forced_Edge --
- ---------------------------
+ ----------
+ -- Next --
+ ----------
- function Is_Cyclic_Forced_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean
+ procedure Next
+ (Iter : in out All_Edge_Iterator;
+ Edge : out Library_Graph_Edge_Id)
is
begin
- pragma Assert (Present (G));
- pragma Assert (Present (Edge));
+ DG.Next (DG.All_Edge_Iterator (Iter), Edge);
+ end Next;
- return
- Is_Forced_Edge (G, Edge)
- and then Links_Vertices_In_Same_Component (G, Edge);
- end Is_Cyclic_Forced_Edge;
+ ----------
+ -- Next --
+ ----------
- -------------------------------
- -- Is_Cyclic_Invocation_Edge --
- -------------------------------
+ procedure Next
+ (Iter : in out All_Vertex_Iterator;
+ Vertex : out Library_Graph_Vertex_Id)
+ is
+ begin
+ DG.Next (DG.All_Vertex_Iterator (Iter), Vertex);
+ end Next;
- function Is_Cyclic_Invocation_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean
+ ----------
+ -- Next --
+ ----------
+
+ procedure Next
+ (Iter : in out Edges_Of_Cycle_Iterator;
+ Edge : out Library_Graph_Edge_Id)
is
begin
- pragma Assert (Present (G));
- pragma Assert (Present (Edge));
+ LGE_Lists.Next (LGE_Lists.Iterator (Iter), Edge);
+ end Next;
- return
- Is_Invocation_Edge (G, Edge)
- and then Links_Vertices_In_Same_Component (G, Edge);
- end Is_Cyclic_Invocation_Edge;
+ ----------
+ -- Next --
+ ----------
- -------------------------
- -- Is_Cyclic_With_Edge --
- -------------------------
+ procedure Next
+ (Iter : in out Component_Iterator;
+ Comp : out Component_Id)
+ is
+ begin
+ DG.Next (DG.Component_Iterator (Iter), Comp);
+ end Next;
- function Is_Cyclic_With_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean
+ ----------
+ -- Next --
+ ----------
+
+ procedure Next
+ (Iter : in out Edges_To_Successors_Iterator;
+ Edge : out Library_Graph_Edge_Id)
is
begin
- pragma Assert (Present (G));
- pragma Assert (Present (Edge));
+ DG.Next (DG.Outgoing_Edge_Iterator (Iter), Edge);
+ end Next;
- -- Ignore Elaborate_Body edges because they also appear as with
- -- edges, but have special successors.
+ ----------
+ -- Next --
+ ----------
- return
- Is_With_Edge (G, Edge)
- and then Links_Vertices_In_Same_Component (G, Edge)
- and then not Is_Elaborate_Body_Edge (G, Edge);
- end Is_Cyclic_With_Edge;
+ procedure Next
+ (Iter : in out Component_Vertex_Iterator;
+ Vertex : out Library_Graph_Vertex_Id)
+ is
+ begin
+ DG.Next (DG.Component_Vertex_Iterator (Iter), Vertex);
+ end Next;
- -------------------------------
- -- Is_Dynamically_Elaborated --
- -------------------------------
+ --------------------------
+ -- Normalize_Cycle_Path --
+ --------------------------
- function Is_Dynamically_Elaborated
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean
+ procedure Normalize_Cycle_Path
+ (Cycle_Path : LGE_Lists.Doubly_Linked_List;
+ Most_Significant_Edge : Library_Graph_Edge_Id)
is
+ Edge : Library_Graph_Edge_Id;
+
begin
- pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
+ pragma Assert (LGE_Lists.Present (Cycle_Path));
+ pragma Assert (Present (Most_Significant_Edge));
- return Is_Dynamically_Elaborated (Unit (G, Vertex));
- end Is_Dynamically_Elaborated;
+ -- Perform at most |Cycle_Path| rotations in case the cycle is
+ -- malformed and the significant edge does not appear within.
- -----------------------------
- -- Is_Elaborable_Component --
- -----------------------------
+ for Rotation in 1 .. LGE_Lists.Size (Cycle_Path) loop
+ Edge := LGE_Lists.First (Cycle_Path);
- function Is_Elaborable_Component
+ -- The cycle is already rotated such that the most significant
+ -- edge is first.
+
+ if Edge = Most_Significant_Edge then
+ return;
+
+ -- Otherwise rotate the cycle by relocating the current edge from
+ -- the start to the end of the path. This preserves the order of
+ -- the path.
+
+ else
+ LGE_Lists.Delete_First (Cycle_Path);
+ LGE_Lists.Append (Cycle_Path, Edge);
+ end if;
+ end loop;
+
+ pragma Assert (False);
+ end Normalize_Cycle_Path;
+
+ ----------------------------------
+ -- Number_Of_Component_Vertices --
+ ----------------------------------
+
+ function Number_Of_Component_Vertices
(G : Library_Graph;
- Comp : Component_Id) return Boolean
+ Comp : Component_Id) return Natural
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Comp));
- -- A component is elaborable when:
- --
- -- * It is not waiting on strong predecessors, and
- -- * It is not waiting on weak predecessors
-
- return
- Pending_Strong_Predecessors (G, Comp) = 0
- and then Pending_Weak_Predecessors (G, Comp) = 0;
- end Is_Elaborable_Component;
+ return DG.Number_Of_Component_Vertices (G.Graph, Comp);
+ end Number_Of_Component_Vertices;
--------------------------
- -- Is_Elaborable_Vertex --
+ -- Number_Of_Components --
--------------------------
- function Is_Elaborable_Vertex
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean
- is
+ function Number_Of_Components (G : Library_Graph) return Natural is
+ begin
pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
- Complement : constant Library_Graph_Vertex_Id :=
- Complementary_Vertex
- (G => G,
- Vertex => Vertex,
- Force_Complement => False);
+ return DG.Number_Of_Components (G.Graph);
+ end Number_Of_Components;
- Strong_Preds : Natural;
- Weak_Preds : Natural;
+ ----------------------
+ -- Number_Of_Cycles --
+ ----------------------
+ function Number_Of_Cycles (G : Library_Graph) return Natural is
begin
- -- A vertex is elaborable when:
- --
- -- * It has not been elaborated yet, and
- -- * The complement vertex of an Elaborate_Body pair has not been
- -- elaborated yet, and
- -- * It resides within an elaborable component, and
- -- * It is not waiting on strong predecessors, and
- -- * It is not waiting on weak predecessors
-
- if In_Elaboration_Order (G, Vertex) then
- return False;
+ pragma Assert (Present (G));
- elsif Present (Complement)
- and then In_Elaboration_Order (G, Complement)
- then
- return False;
+ return LGC_Lists.Size (G.Cycles);
+ end Number_Of_Cycles;
- elsif not Is_Elaborable_Component (G, Component (G, Vertex)) then
- return False;
- end if;
+ ---------------------
+ -- Number_Of_Edges --
+ ---------------------
- Pending_Predecessors_For_Elaboration
- (G => G,
- Vertex => Vertex,
- Strong_Preds => Strong_Preds,
- Weak_Preds => Weak_Preds);
+ function Number_Of_Edges (G : Library_Graph) return Natural is
+ begin
+ pragma Assert (Present (G));
- return Strong_Preds = 0 and then Weak_Preds = 0;
- end Is_Elaborable_Vertex;
+ return DG.Number_Of_Edges (G.Graph);
+ end Number_Of_Edges;
- ---------------------------
- -- Is_Elaborate_All_Edge --
- ---------------------------
+ -----------------------------------
+ -- Number_Of_Edges_To_Successors --
+ -----------------------------------
- function Is_Elaborate_All_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean
+ function Number_Of_Edges_To_Successors
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Natural
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Edge));
- return Kind (G, Edge) = Elaborate_All_Edge;
- end Is_Elaborate_All_Edge;
+ return DG.Number_Of_Outgoing_Edges (G.Graph, Vertex);
+ end Number_Of_Edges_To_Successors;
- ----------------------------
- -- Is_Elaborate_Body_Edge --
- ----------------------------
+ ------------------------
+ -- Number_Of_Vertices --
+ ------------------------
- function Is_Elaborate_Body_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean
- is
+ function Number_Of_Vertices (G : Library_Graph) return Natural is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Edge));
- return
- Kind (G, Edge) = With_Edge
- and then Is_Vertex_With_Elaborate_Body (G, Successor (G, Edge));
- end Is_Elaborate_Body_Edge;
+ return DG.Number_Of_Vertices (G.Graph);
+ end Number_Of_Vertices;
- -----------------------
- -- Is_Elaborate_Edge --
- -----------------------
+ -----------------
+ -- Order_Cycle --
+ -----------------
- function Is_Elaborate_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean
+ 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 (Edge));
+ pragma Assert (Present (Cycle));
+ pragma Assert (LGC_Lists.Present (G.Cycles));
- return Kind (G, Edge) = Elaborate_Edge;
- end Is_Elaborate_Edge;
+ -- The input cycle is the first to be inserted
- ----------------------------
- -- Is_Elaborate_Body_Pair --
- ----------------------------
+ if LGC_Lists.Is_Empty (G.Cycles) then
+ LGC_Lists.Prepend (G.Cycles, Cycle);
- function Is_Elaborate_Body_Pair
- (G : Library_Graph;
- Spec_Vertex : Library_Graph_Vertex_Id;
- Body_Vertex : Library_Graph_Vertex_Id) return Boolean
- is
- begin
- pragma Assert (Present (G));
- pragma Assert (Present (Spec_Vertex));
- pragma Assert (Present (Body_Vertex));
+ -- Otherwise the list of all cycles contains at least one cycle.
+ -- Insert the input cycle based on its precedence.
- return
- Is_Spec_With_Elaborate_Body (G, Spec_Vertex)
- and then Is_Body_Of_Spec_With_Elaborate_Body (G, Body_Vertex)
- and then Proper_Body (G, Spec_Vertex) = Body_Vertex;
- end Is_Elaborate_Body_Pair;
+ else
+ Lesser_Cycle := Find_First_Lower_Precedence_Cycle (G, Cycle);
- --------------------
- -- Is_Forced_Edge --
- --------------------
+ -- The list contains at least one cycle, and the input cycle has a
+ -- higher precedence compared to some cycle in the list.
- function Is_Forced_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean
+ 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 Order_Cycle;
+
+ ----------
+ -- Path --
+ ----------
+
+ function Path
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id) return LGE_Lists.Doubly_Linked_List
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Edge));
+ pragma Assert (Present (Cycle));
- return Kind (G, Edge) = Forced_Edge;
- end Is_Forced_Edge;
+ return Get_LGC_Attributes (G, Cycle).Path;
+ end Path;
- ----------------------
- -- Is_Internal_Unit --
- ----------------------
+ ------------------------------------------
+ -- Pending_Predecessors_For_Elaboration --
+ ------------------------------------------
- function Is_Internal_Unit
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean
+ procedure Pending_Predecessors_For_Elaboration
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id;
+ Strong_Preds : out Natural;
+ Weak_Preds : out Natural)
is
+ Complement : Library_Graph_Vertex_Id;
+ Spec_Vertex : Library_Graph_Vertex_Id;
+ Total_Strong_Preds : Natural;
+ Total_Weak_Preds : Natural;
+
begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
- return Is_Internal_Unit (Unit (G, Vertex));
- end Is_Internal_Unit;
+ Total_Strong_Preds := Pending_Strong_Predecessors (G, Vertex);
+ Total_Weak_Preds := Pending_Weak_Predecessors (G, Vertex);
- ------------------------
- -- Is_Invocation_Edge --
- ------------------------
+ -- Assume that there is no complementary vertex that needs to be
+ -- examined.
- function Is_Invocation_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean
- is
- begin
- pragma Assert (Present (G));
- pragma Assert (Present (Edge));
+ Complement := No_Library_Graph_Vertex;
+ Spec_Vertex := No_Library_Graph_Vertex;
- return Kind (G, Edge) = Invocation_Edge;
- end Is_Invocation_Edge;
+ if Is_Body_Of_Spec_With_Elaborate_Body (G, Vertex) then
+ Complement := Proper_Spec (G, Vertex);
+ Spec_Vertex := Complement;
- ------------------------
- -- Is_Predefined_Unit --
- ------------------------
+ elsif Is_Spec_With_Elaborate_Body (G, Vertex) then
+ Complement := Proper_Body (G, Vertex);
+ Spec_Vertex := Vertex;
+ end if;
- function Is_Predefined_Unit
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean
+ -- The vertex is part of an Elaborate_Body pair. Take into account
+ -- the strong and weak predecessors of the complementary vertex.
+
+ if Present (Complement) then
+ Total_Strong_Preds :=
+ Pending_Strong_Predecessors (G, Complement) + Total_Strong_Preds;
+ Total_Weak_Preds :=
+ Pending_Weak_Predecessors (G, Complement) + Total_Weak_Preds;
+
+ -- The body of an Elaborate_Body pair is the successor of a strong
+ -- edge where the predecessor is the spec. This edge must not be
+ -- considered for elaboration purposes because the pair is treated
+ -- as one vertex. Account for the edge only when the spec has not
+ -- been elaborated yet.
+
+ if not In_Elaboration_Order (G, Spec_Vertex) then
+ Total_Strong_Preds := Total_Strong_Preds - 1;
+ end if;
+ end if;
+
+ Strong_Preds := Total_Strong_Preds;
+ Weak_Preds := Total_Weak_Preds;
+ end Pending_Predecessors_For_Elaboration;
+
+ ---------------------------------
+ -- Pending_Strong_Predecessors --
+ ---------------------------------
+
+ function Pending_Strong_Predecessors
+ (G : Library_Graph;
+ Comp : Component_Id) return Natural
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
+ pragma Assert (Present (Comp));
- return Is_Predefined_Unit (Unit (G, Vertex));
- end Is_Predefined_Unit;
+ return Get_Component_Attributes (G, Comp).Pending_Strong_Predecessors;
+ end Pending_Strong_Predecessors;
- ---------------------------
- -- Is_Preelaborated_Unit --
- ---------------------------
+ ---------------------------------
+ -- Pending_Strong_Predecessors --
+ ---------------------------------
- function Is_Preelaborated_Unit
+ function Pending_Strong_Predecessors
(G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean
+ Vertex : Library_Graph_Vertex_Id) return Natural
is
+ begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
- U_Id : constant Unit_Id := Unit (G, Vertex);
- U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
-
- begin
- return U_Rec.Preelab or else U_Rec.Pure;
- end Is_Preelaborated_Unit;
+ return Get_LGV_Attributes (G, Vertex).Pending_Strong_Predecessors;
+ end Pending_Strong_Predecessors;
- ----------------------
- -- Is_Recorded_Edge --
- ----------------------
+ -------------------------------
+ -- Pending_Weak_Predecessors --
+ -------------------------------
- function Is_Recorded_Edge
- (G : Library_Graph;
- Rel : Predecessor_Successor_Relation) return Boolean
+ function Pending_Weak_Predecessors
+ (G : Library_Graph;
+ Comp : Component_Id) return Natural
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Rel.Predecessor));
- pragma Assert (Present (Rel.Successor));
+ pragma Assert (Present (Comp));
- return RE_Sets.Contains (G.Recorded_Edges, Rel);
- end Is_Recorded_Edge;
+ return Get_Component_Attributes (G, Comp).Pending_Weak_Predecessors;
+ end Pending_Weak_Predecessors;
- -------------
- -- Is_Spec --
- -------------
+ -------------------------------
+ -- Pending_Weak_Predecessors --
+ -------------------------------
- function Is_Spec
+ function Pending_Weak_Predecessors
(G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean
+ Vertex : Library_Graph_Vertex_Id) return Natural
is
+ begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
- U_Id : constant Unit_Id := Unit (G, Vertex);
- U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
-
- begin
- return U_Rec.Utype = Is_Spec or else U_Rec.Utype = Is_Spec_Only;
- end Is_Spec;
+ return Get_LGV_Attributes (G, Vertex).Pending_Weak_Predecessors;
+ end Pending_Weak_Predecessors;
- ------------------------------
- -- Is_Spec_Before_Body_Edge --
- ------------------------------
+ -----------------
+ -- Predecessor --
+ -----------------
- function Is_Spec_Before_Body_Edge
+ function Predecessor
(G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean
+ Edge : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Edge));
- return Kind (G, Edge) = Spec_Before_Body_Edge;
- end Is_Spec_Before_Body_Edge;
+ return DG.Source_Vertex (G.Graph, Edge);
+ end Predecessor;
- -----------------------
- -- Is_Spec_With_Body --
- -----------------------
+ -------------
+ -- Present --
+ -------------
- function Is_Spec_With_Body
+ function Present (G : Library_Graph) return Boolean is
+ begin
+ return G /= Nil;
+ end Present;
+
+ -----------------
+ -- Proper_Body --
+ -----------------
+
+ function Proper_Body
(G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean
+ Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id
is
+ begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
- U_Id : constant Unit_Id := Unit (G, Vertex);
- U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
+ -- When the vertex denotes a spec with a completing body, return the
+ -- body.
- begin
- return U_Rec.Utype = Is_Spec;
- end Is_Spec_With_Body;
+ if Is_Spec_With_Body (G, Vertex) then
+ return Corresponding_Item (G, Vertex);
- ---------------------------------
- -- Is_Spec_With_Elaborate_Body --
- ---------------------------------
+ -- Otherwise the vertex must be a body
- function Is_Spec_With_Elaborate_Body
+ else
+ pragma Assert (Is_Body (G, Vertex));
+ return Vertex;
+ end if;
+ end Proper_Body;
+
+ -----------------
+ -- Proper_Spec --
+ -----------------
+
+ function Proper_Spec
(G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean
+ Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
- return
- Is_Spec_With_Body (G, Vertex)
- and then Has_Elaborate_Body (G, Vertex);
- end Is_Spec_With_Elaborate_Body;
+ -- When the vertex denotes a body that completes a spec, return the
+ -- spec.
- ------------------------------
- -- Is_Static_Successor_Edge --
- ------------------------------
+ if Is_Body_With_Spec (G, Vertex) then
+ return Corresponding_Item (G, Vertex);
- function Is_Static_Successor_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean
- is
- begin
- pragma Assert (Present (G));
- pragma Assert (Present (Edge));
+ -- Otherwise the vertex must denote a spec
- return
- Is_Invocation_Edge (G, Edge)
- and then not Is_Dynamically_Elaborated (G, Successor (G, Edge));
- end Is_Static_Successor_Edge;
+ else
+ pragma Assert (Is_Spec (G, Vertex));
+ return Vertex;
+ end if;
+ end Proper_Spec;
- -----------------------------------
- -- Is_Vertex_With_Elaborate_Body --
- -----------------------------------
+ ------------------
+ -- Record_Cycle --
+ ------------------
- function Is_Vertex_With_Elaborate_Body
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean
+ procedure Record_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
+ Cycle : Library_Graph_Cycle_Id;
+ Path : LGE_Lists.Doubly_Linked_List;
+
begin
pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
+ pragma Assert (Present (Most_Significant_Edge));
+ pragma Assert (LGE_Lists.Present (Cycle_Path));
- 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;
+ -- Replicate the path of the cycle in order to avoid sharing lists
- ---------------------------------
- -- Is_Weakly_Elaborable_Vertex --
- ----------------------------------
+ Path := Copy_Cycle_Path (Cycle_Path);
- function Is_Weakly_Elaborable_Vertex
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean
- is
- pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
+ -- Normalize the path of the cycle such that its most significant
+ -- edge is the first in the list of edges.
- Complement : constant Library_Graph_Vertex_Id :=
- Complementary_Vertex
- (G => G,
- Vertex => Vertex,
- Force_Complement => False);
+ Normalize_Cycle_Path
+ (Cycle_Path => Path,
+ Most_Significant_Edge => Most_Significant_Edge);
- Strong_Preds : Natural;
- Weak_Preds : Natural;
+ -- 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 --
+ -----------------------------------------
+ function Same_Library_Graph_Cycle_Attributes
+ (Left : Library_Graph_Cycle_Attributes;
+ Right : Library_Graph_Cycle_Attributes) return Boolean
+ is
begin
- -- A vertex is weakly elaborable when:
+ -- Two cycles are the same when
--
- -- * It has not been elaborated yet, and
- -- * The complement vertex of an Elaborate_Body pair has not been
- -- elaborated yet, and
- -- * It resides within an elaborable component, and
- -- * It is not waiting on strong predecessors, and
- -- * It is waiting on at least one weak predecessor
+ -- * They are of the same kind
+ -- * They have the same number of invocation edges in their paths
+ -- * Their paths are the same length
+ -- * The edges comprising their paths are the same
- if In_Elaboration_Order (G, Vertex) then
- return False;
+ return
+ Left.Invocation_Edge_Count = Right.Invocation_Edge_Count
+ and then Left.Kind = Right.Kind
+ and then LGE_Lists.Equal (Left.Path, Right.Path);
+ end Same_Library_Graph_Cycle_Attributes;
- elsif Present (Complement)
- and then In_Elaboration_Order (G, Complement)
- then
- return False;
+ ------------------------
+ -- Set_Activates_Task --
+ ------------------------
- elsif not Is_Elaborable_Component (G, Component (G, Vertex)) then
- return False;
- end if;
+ procedure Set_Activates_Task
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id)
+ is
+ Attributes : Library_Graph_Edge_Attributes :=
+ Get_LGE_Attributes (G, Edge);
+ begin
+ Attributes.Activates_Task := True;
+ Set_LGE_Attributes (G, Edge, Attributes);
+ end Set_Activates_Task;
- Pending_Predecessors_For_Elaboration
- (G => G,
- Vertex => Vertex,
- Strong_Preds => Strong_Preds,
- Weak_Preds => Weak_Preds);
+ ------------------------------
+ -- Set_Component_Attributes --
+ ------------------------------
- return Strong_Preds = 0 and then Weak_Preds >= 1;
- end Is_Weakly_Elaborable_Vertex;
+ procedure Set_Component_Attributes
+ (G : Library_Graph;
+ Comp : Component_Id;
+ Val : Component_Attributes)
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Comp));
- ------------------
- -- Is_With_Edge --
- ------------------
+ Component_Tables.Put (G.Component_Attributes, Comp, Val);
+ end Set_Component_Attributes;
- function Is_With_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean
+ ----------------------------
+ -- Set_Corresponding_Item --
+ ----------------------------
+
+ procedure Set_Corresponding_Item
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id;
+ Val : Library_Graph_Vertex_Id)
is
+ Attrs : Library_Graph_Vertex_Attributes;
+
begin
pragma Assert (Present (G));
- pragma Assert (Present (Edge));
+ pragma Assert (Present (Vertex));
- return Kind (G, Edge) = With_Edge;
- end Is_With_Edge;
+ Attrs := Get_LGV_Attributes (G, Vertex);
+ Attrs.Corresponding_Item := Val;
+ Set_LGV_Attributes (G, Vertex, Attrs);
+ end Set_Corresponding_Item;
- ------------------------
- -- Iterate_All_Cycles --
- ------------------------
+ ------------------------------
+ -- Set_Corresponding_Vertex --
+ ------------------------------
- function Iterate_All_Cycles
- (G : Library_Graph) return All_Cycle_Iterator
+ procedure Set_Corresponding_Vertex
+ (G : Library_Graph;
+ U_Id : Unit_Id;
+ Val : Library_Graph_Vertex_Id)
is
begin
pragma Assert (Present (G));
+ pragma Assert (Present (U_Id));
- return All_Cycle_Iterator (LGC_Lists.Iterate (G.Cycles));
- end Iterate_All_Cycles;
+ Unit_Tables.Put (G.Unit_To_Vertex, U_Id, Val);
+ end Set_Corresponding_Vertex;
- -----------------------
- -- Iterate_All_Edges --
- -----------------------
+ ------------------------------
+ -- Set_In_Elaboration_Order --
+ ------------------------------
- function Iterate_All_Edges
- (G : Library_Graph) return All_Edge_Iterator
+ procedure Set_In_Elaboration_Order
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id;
+ Val : Boolean := True)
is
+ Attrs : Library_Graph_Vertex_Attributes;
+
begin
pragma Assert (Present (G));
+ pragma Assert (Present (Vertex));
- return All_Edge_Iterator (DG.Iterate_All_Edges (G.Graph));
- end Iterate_All_Edges;
+ Attrs := Get_LGV_Attributes (G, Vertex);
+ Attrs.In_Elaboration_Order := Val;
+ Set_LGV_Attributes (G, Vertex, Attrs);
+ end Set_In_Elaboration_Order;
--------------------------
- -- Iterate_All_Vertices --
+ -- Set_Is_Recorded_Edge --
--------------------------
- function Iterate_All_Vertices
- (G : Library_Graph) return All_Vertex_Iterator
+ procedure Set_Is_Recorded_Edge
+ (G : Library_Graph;
+ Rel : Predecessor_Successor_Relation)
is
begin
pragma Assert (Present (G));
+ pragma Assert (Present (Rel.Predecessor));
+ pragma Assert (Present (Rel.Successor));
- return All_Vertex_Iterator (DG.Iterate_All_Vertices (G.Graph));
- end Iterate_All_Vertices;
+ RE_Sets.Insert (G.Recorded_Edges, Rel);
+ end Set_Is_Recorded_Edge;
------------------------
- -- Iterate_Components --
+ -- Set_LGC_Attributes --
------------------------
- function Iterate_Components
- (G : Library_Graph) return Component_Iterator
+ procedure Set_LGC_Attributes
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id;
+ Val : Library_Graph_Cycle_Attributes)
is
begin
pragma Assert (Present (G));
+ pragma Assert (Present (Cycle));
- return Component_Iterator (DG.Iterate_Components (G.Graph));
- end Iterate_Components;
+ LGC_Tables.Put (G.Cycle_Attributes, Cycle, Val);
+ end Set_LGC_Attributes;
- --------------------------------
- -- Iterate_Component_Vertices --
- --------------------------------
+ ------------------------
+ -- Set_LGE_Attributes --
+ ------------------------
- function Iterate_Component_Vertices
+ procedure Set_LGE_Attributes
(G : Library_Graph;
- Comp : Component_Id) return Component_Vertex_Iterator
+ Edge : Library_Graph_Edge_Id;
+ Val : Library_Graph_Edge_Attributes)
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Comp));
+ pragma Assert (Present (Edge));
- return
- Component_Vertex_Iterator
- (DG.Iterate_Component_Vertices (G.Graph, Comp));
- end Iterate_Component_Vertices;
+ LGE_Tables.Put (G.Edge_Attributes, Edge, Val);
+ end Set_LGE_Attributes;
- ----------------------------
- -- Iterate_Edges_Of_Cycle --
- ----------------------------
+ ------------------------
+ -- Set_LGV_Attributes --
+ ------------------------
- function Iterate_Edges_Of_Cycle
- (G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id) return Edges_Of_Cycle_Iterator
+ procedure Set_LGV_Attributes
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id;
+ Val : Library_Graph_Vertex_Attributes)
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Cycle));
+ pragma Assert (Present (Vertex));
- return Edges_Of_Cycle_Iterator (LGE_Lists.Iterate (Path (G, Cycle)));
- end Iterate_Edges_Of_Cycle;
+ LGV_Tables.Put (G.Vertex_Attributes, Vertex, Val);
+ end Set_LGV_Attributes;
- ---------------------------------
- -- Iterate_Edges_To_Successors --
- ---------------------------------
+ ---------------
+ -- Successor --
+ ---------------
- function Iterate_Edges_To_Successors
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Edges_To_Successors_Iterator
+ function Successor
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
+ pragma Assert (Present (Edge));
- return
- Edges_To_Successors_Iterator
- (DG.Iterate_Outgoing_Edges (G.Graph, Vertex));
- end Iterate_Edges_To_Successors;
+ return DG.Destination_Vertex (G.Graph, Edge);
+ end Successor;
- ----------
- -- Kind --
- ----------
+ ---------------------
+ -- Trace_Component --
+ ---------------------
- function Kind
+ procedure Trace_Component
(G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Kind
+ Comp : Component_Id;
+ Indent : Indentation_Level)
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Cycle));
+ pragma Assert (Present (Comp));
- return Get_LGC_Attributes (G, Cycle).Kind;
- end Kind;
+ -- Nothing to do when switch -d_t (output cycle-detection trace
+ -- information) is not in effect.
- ----------
- -- Kind --
- ----------
+ if not Debug_Flag_Underscore_T then
+ return;
+ end if;
- function Kind
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Library_Graph_Edge_Kind
- is
- begin
- return Get_LGE_Attributes (G, Edge).Kind;
- end Kind;
+ Write_Eol;
+ Indent_By (Indent);
+ Write_Str ("component (Comp_");
+ Write_Int (Int (Comp));
+ Write_Str (")");
+ Write_Eol;
+ end Trace_Component;
- ------------
- -- Length --
- ------------
+ -----------------
+ -- Trace_Cycle --
+ -----------------
- function Length
- (G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id) return Natural
+ procedure Trace_Cycle
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id;
+ Indent : Indentation_Level)
is
+ Attr_Indent : constant Indentation_Level :=
+ Indent + Nested_Indentation;
+ Edge_Indent : constant Indentation_Level :=
+ Attr_Indent + Nested_Indentation;
+
+ Edge : Library_Graph_Edge_Id;
+ Iter : Edges_Of_Cycle_Iterator;
+
begin
pragma Assert (Present (G));
pragma Assert (Present (Cycle));
- return LGE_Lists.Size (Path (G, Cycle));
- end Length;
+ -- Nothing to do when switch -d_t (output cycle-detection trace
+ -- information) is not in effect.
- ------------------------------
- -- Library_Graph_Edge_Count --
- ------------------------------
+ if not Debug_Flag_Underscore_T then
+ return;
+ end if;
- function Library_Graph_Edge_Count
- (G : Library_Graph;
- Kind : Library_Graph_Edge_Kind) return Natural
- is
- begin
- pragma Assert (Present (G));
+ Indent_By (Indent);
+ Write_Str ("cycle (LGC_Id_");
+ Write_Int (Int (Cycle));
+ Write_Str (")");
+ Write_Eol;
- return G.Counts (Kind);
- end Library_Graph_Edge_Count;
+ Indent_By (Attr_Indent);
+ Write_Str ("kind = ");
+ Write_Str (Kind (G, Cycle)'Img);
+ Write_Eol;
- --------------------------------------
- -- Links_Vertices_In_Same_Component --
- --------------------------------------
+ Indent_By (Attr_Indent);
+ Write_Str ("invocation edges = ");
+ Write_Int (Int (Invocation_Edge_Count (G, Cycle)));
+ Write_Eol;
- function Links_Vertices_In_Same_Component
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean
- is
- begin
- pragma Assert (Present (G));
- pragma Assert (Present (Edge));
+ Indent_By (Attr_Indent);
+ Write_Str ("length: ");
+ Write_Int (Int (Length (G, Cycle)));
+ Write_Eol;
- -- An edge is part of a cycle when both the successor and predecessor
- -- reside in the same component.
+ Iter := Iterate_Edges_Of_Cycle (G, Cycle);
+ while Has_Next (Iter) loop
+ Next (Iter, Edge);
- return
- In_Same_Component
- (G => G,
- Left => Predecessor (G, Edge),
- Right => Successor (G, Edge));
- end Links_Vertices_In_Same_Component;
+ Indent_By (Edge_Indent);
+ Write_Str ("library graph edge (LGE_Id_");
+ Write_Int (Int (Edge));
+ Write_Str (")");
+ Write_Eol;
+ end loop;
+ end Trace_Cycle;
- -----------------------------------
- -- Maximum_Invocation_Edge_Count --
- -----------------------------------
+ ----------------
+ -- Trace_Edge --
+ ----------------
- function Maximum_Invocation_Edge_Count
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id;
- Count : Natural) return Natural
+ procedure Trace_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id;
+ Indent : Indentation_Level)
is
- New_Count : Natural;
+ pragma Assert (Present (G));
+ pragma Assert (Present (Edge));
+
+ Attr_Indent : constant Indentation_Level :=
+ Indent + Nested_Indentation;
+
+ Pred : constant Library_Graph_Vertex_Id := Predecessor (G, Edge);
+ Succ : constant Library_Graph_Vertex_Id := Successor (G, Edge);
begin
- pragma Assert (Present (G));
-
- New_Count := Count;
+ -- Nothing to do when switch -d_t (output cycle-detection trace
+ -- information) is not in effect.
- if Present (Edge) and then Is_Invocation_Edge (G, Edge) then
- New_Count := New_Count + 1;
+ if not Debug_Flag_Underscore_T then
+ return;
end if;
- return New_Count;
- end Maximum_Invocation_Edge_Count;
+ Indent_By (Indent);
+ Write_Str ("library graph edge (LGE_Id_");
+ Write_Int (Int (Edge));
+ Write_Str (")");
+ Write_Eol;
- ----------
- -- Name --
- ----------
+ Indent_By (Attr_Indent);
+ Write_Str ("kind = ");
+ Write_Str (Kind (G, Edge)'Img);
+ Write_Eol;
- function Name
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Unit_Name_Type
- is
- begin
- pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
+ Indent_By (Attr_Indent);
+ Write_Str ("Predecessor (LGV_Id_");
+ Write_Int (Int (Pred));
+ Write_Str (") name = ");
+ Write_Name (Name (G, Pred));
+ Write_Eol;
- return Name (Unit (G, Vertex));
- end Name;
+ Indent_By (Attr_Indent);
+ Write_Str ("Successor (LGV_Id_");
+ Write_Int (Int (Succ));
+ Write_Str (") name = ");
+ Write_Name (Name (G, Succ));
+ Write_Eol;
+ end Trace_Edge;
- -----------------------
- -- Needs_Elaboration --
- -----------------------
+ ------------------
+ -- Trace_Vertex --
+ ------------------
- function Needs_Elaboration
+ procedure Trace_Vertex
(G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean
+ Vertex : Library_Graph_Vertex_Id;
+ Indent : Indentation_Level)
is
+ Attr_Indent : constant Indentation_Level :=
+ Indent + Nested_Indentation;
+
begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
- return Needs_Elaboration (Unit (G, Vertex));
- end Needs_Elaboration;
-
- ----------
- -- Next --
- ----------
+ -- Nothing to do when switch -d_t (output cycle-detection trace
+ -- information) is not in effect.
- procedure Next
- (Iter : in out All_Cycle_Iterator;
- Cycle : out Library_Graph_Cycle_Id)
- is
- begin
- LGC_Lists.Next (LGC_Lists.Iterator (Iter), Cycle);
- end Next;
+ if not Debug_Flag_Underscore_T then
+ return;
+ end if;
- ----------
- -- Next --
- ----------
+ Indent_By (Indent);
+ Write_Str ("library graph vertex (LGV_Id_");
+ Write_Int (Int (Vertex));
+ Write_Str (")");
+ Write_Eol;
- procedure Next
- (Iter : in out All_Edge_Iterator;
- Edge : out Library_Graph_Edge_Id)
- is
- begin
- DG.Next (DG.All_Edge_Iterator (Iter), Edge);
- end Next;
+ Indent_By (Attr_Indent);
+ Write_Str ("Unit (U_Id_");
+ Write_Int (Int (Unit (G, Vertex)));
+ Write_Str (") name = ");
+ Write_Name (Name (G, Vertex));
+ Write_Eol;
+ end Trace_Vertex;
----------
- -- Next --
+ -- Unit --
----------
- procedure Next
- (Iter : in out All_Vertex_Iterator;
- Vertex : out Library_Graph_Vertex_Id)
+ function Unit
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Unit_Id
is
begin
- DG.Next (DG.All_Vertex_Iterator (Iter), Vertex);
- end Next;
-
- ----------
- -- Next --
- ----------
+ pragma Assert (Present (G));
+ pragma Assert (Present (Vertex));
- procedure Next
- (Iter : in out Edges_Of_Cycle_Iterator;
- Edge : out Library_Graph_Edge_Id)
- is
- begin
- LGE_Lists.Next (LGE_Lists.Iterator (Iter), Edge);
- end Next;
+ return Get_LGV_Attributes (G, Vertex).Unit;
+ end Unit;
- ----------
- -- Next --
- ----------
+ -------------
+ -- Unvisit --
+ -------------
- procedure Next
- (Iter : in out Component_Iterator;
- Comp : out Component_Id)
+ 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
- DG.Next (DG.Component_Iterator (Iter), Comp);
- end Next;
+ pragma Assert (Present (Vertex));
+ pragma Assert (LGV_Sets.Present (Visited_Set));
+ pragma Assert (LGV_Lists.Present (Visited_Stack));
- ----------
- -- Next --
- ----------
+ while not LGV_Lists.Is_Empty (Visited_Stack) loop
+ Current_Vertex := LGV_Lists.First (Visited_Stack);
- procedure Next
- (Iter : in out Edges_To_Successors_Iterator;
- Edge : out Library_Graph_Edge_Id)
- is
- begin
- DG.Next (DG.Outgoing_Edge_Iterator (Iter), Edge);
- end Next;
+ LGV_Lists.Delete_First (Visited_Stack);
+ LGV_Sets.Delete (Visited_Set, Current_Vertex);
- ----------
- -- Next --
- ----------
+ exit when Current_Vertex = Vertex;
+ end loop;
+ end Unvisit;
- procedure Next
- (Iter : in out Component_Vertex_Iterator;
- Vertex : out Library_Graph_Vertex_Id)
+ ---------------------------------
+ -- Update_Pending_Predecessors --
+ ---------------------------------
+
+ procedure Update_Pending_Predecessors
+ (Strong_Predecessors : in out Natural;
+ Weak_Predecessors : in out Natural;
+ Update_Weak : Boolean;
+ Value : Integer)
is
begin
- DG.Next (DG.Component_Vertex_Iterator (Iter), Vertex);
- end Next;
+ if Update_Weak then
+ Weak_Predecessors := Weak_Predecessors + Value;
+ else
+ Strong_Predecessors := Strong_Predecessors + Value;
+ end if;
+ end Update_Pending_Predecessors;
- --------------------------
- -- Normalize_Cycle_Path --
- --------------------------
+ -----------------------------------------------
+ -- Update_Pending_Predecessors_Of_Components --
+ -----------------------------------------------
- procedure Normalize_Cycle_Path
- (Cycle_Path : LGE_Lists.Doubly_Linked_List;
- Most_Significant_Edge : Library_Graph_Edge_Id)
+ procedure Update_Pending_Predecessors_Of_Components
+ (G : Library_Graph)
is
Edge : Library_Graph_Edge_Id;
+ Iter : All_Edge_Iterator;
begin
- pragma Assert (LGE_Lists.Present (Cycle_Path));
- pragma Assert (Present (Most_Significant_Edge));
+ pragma Assert (Present (G));
- -- Perform at most |Cycle_Path| rotations in case the cycle is
- -- malformed and the significant edge does not appear within.
+ Iter := Iterate_All_Edges (G);
+ while Has_Next (Iter) loop
+ Next (Iter, Edge);
- for Rotation in 1 .. LGE_Lists.Size (Cycle_Path) loop
- Edge := LGE_Lists.First (Cycle_Path);
+ Update_Pending_Predecessors_Of_Components (G, Edge);
+ end loop;
+ end Update_Pending_Predecessors_Of_Components;
- -- The cycle is already rotated such that the most significant
- -- edge is first.
+ -----------------------------------------------
+ -- Update_Pending_Predecessors_Of_Components --
+ -----------------------------------------------
- if Edge = Most_Significant_Edge then
- return;
+ procedure Update_Pending_Predecessors_Of_Components
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id)
+ is
+ pragma Assert (Present (G));
+ pragma Assert (Present (Edge));
- -- Otherwise rotate the cycle by relocating the current edge from
- -- the start to the end of the path. This preserves the order of
- -- the path.
+ Pred_Comp : constant Component_Id :=
+ Component (G, Predecessor (G, Edge));
+ Succ_Comp : constant Component_Id :=
+ Component (G, Successor (G, Edge));
- else
- LGE_Lists.Delete_First (Cycle_Path);
- LGE_Lists.Append (Cycle_Path, Edge);
- end if;
- end loop;
+ pragma Assert (Present (Pred_Comp));
+ pragma Assert (Present (Succ_Comp));
- pragma Assert (False);
- end Normalize_Cycle_Path;
+ begin
+ -- The edge links a successor and a predecessor coming from two
+ -- different SCCs. This indicates that the SCC of the successor
+ -- must wait on another predecessor until it can be elaborated.
- ----------------------------------
- -- Number_Of_Component_Vertices --
- ----------------------------------
+ if Pred_Comp /= Succ_Comp then
+ Increment_Pending_Predecessors
+ (G => G,
+ Comp => Succ_Comp,
+ Edge => Edge);
+ end if;
+ end Update_Pending_Predecessors_Of_Components;
+
+ -----------------------
+ -- Vertex_Precedence --
+ -----------------------
- function Number_Of_Component_Vertices
- (G : Library_Graph;
- Comp : Component_Id) return Natural
+ 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 (Comp));
+ pragma Assert (Present (Vertex));
+ pragma Assert (Present (Compared_To));
- return DG.Number_Of_Component_Vertices (G.Graph, Comp);
- end Number_Of_Component_Vertices;
+ -- Use lexicographical order to determine precedence and ensure
+ -- deterministic behavior.
- --------------------------
- -- Number_Of_Components --
- --------------------------
+ if Uname_Less (Name (G, Vertex), Name (G, Compared_To)) then
+ return Higher_Precedence;
+ else
+ return Lower_Precedence;
+ end if;
+ end Vertex_Precedence;
- function Number_Of_Components (G : Library_Graph) return Natural is
+ -----------
+ -- 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 (G));
+ pragma Assert (Present (Vertex));
+ pragma Assert (LGV_Sets.Present (Visited_Set));
+ pragma Assert (LGV_Lists.Present (Visited_Stack));
- return DG.Number_Of_Components (G.Graph);
- end Number_Of_Components;
+ LGV_Sets.Insert (Visited_Set, Vertex);
+ LGV_Lists.Prepend (Visited_Stack, Vertex);
+ end Visit;
+ end Library_Graphs;
- ----------------------
- -- Number_Of_Cycles --
- ----------------------
+ -----------------------
+ -- Invocation_Graphs --
+ -----------------------
- function Number_Of_Cycles (G : Library_Graph) return Natural is
- begin
- pragma Assert (Present (G));
+ package body Invocation_Graphs is
- return LGC_Lists.Size (G.Cycles);
- end Number_Of_Cycles;
+ -----------------------
+ -- Local subprograms --
+ -----------------------
- ---------------------
- -- Number_Of_Edges --
- ---------------------
+ procedure Free is
+ new Ada.Unchecked_Deallocation
+ (Invocation_Graph_Attributes, Invocation_Graph);
- function Number_Of_Edges (G : Library_Graph) return Natural is
- begin
- pragma Assert (Present (G));
+ function Get_IGE_Attributes
+ (G : Invocation_Graph;
+ Edge : Invocation_Graph_Edge_Id)
+ return Invocation_Graph_Edge_Attributes;
+ pragma Inline (Get_IGE_Attributes);
+ -- Obtain the attributes of edge Edge of invocation graph G
- return DG.Number_Of_Edges (G.Graph);
- end Number_Of_Edges;
+ function Get_IGV_Attributes
+ (G : Invocation_Graph;
+ Vertex : Invocation_Graph_Vertex_Id)
+ return Invocation_Graph_Vertex_Attributes;
+ pragma Inline (Get_IGV_Attributes);
+ -- Obtain the attributes of vertex Vertex of invocation graph G
- -----------------------------------
- -- Number_Of_Edges_To_Successors --
- -----------------------------------
+ procedure Increment_Invocation_Graph_Edge_Count
+ (G : Invocation_Graph;
+ Kind : Invocation_Kind);
+ pragma Inline (Increment_Invocation_Graph_Edge_Count);
+ -- Increment the number of edges of king Kind in invocation graph G by
+ -- one.
- function Number_Of_Edges_To_Successors
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Natural
- is
- begin
- pragma Assert (Present (G));
+ function Is_Elaboration_Root
+ (G : Invocation_Graph;
+ Vertex : Invocation_Graph_Vertex_Id) return Boolean;
+ pragma Inline (Is_Elaboration_Root);
+ -- Determine whether vertex Vertex of invocation graph denotes the
+ -- elaboration procedure of a spec or a body.
- return DG.Number_Of_Outgoing_Edges (G.Graph, Vertex);
- end Number_Of_Edges_To_Successors;
+ function Is_Existing_Source_Target_Relation
+ (G : Invocation_Graph;
+ Rel : Source_Target_Relation) return Boolean;
+ pragma Inline (Is_Existing_Source_Target_Relation);
+ -- Determine whether a source vertex and a target vertex described by
+ -- relation Rel are already related in invocation graph G.
- ------------------------
- -- Number_Of_Vertices --
- ------------------------
+ procedure Save_Elaboration_Root
+ (G : Invocation_Graph;
+ Root : Invocation_Graph_Vertex_Id);
+ pragma Inline (Save_Elaboration_Root);
+ -- Save elaboration root Root of invocation graph G
- function Number_Of_Vertices (G : Library_Graph) return Natural is
- begin
- pragma Assert (Present (G));
+ procedure Set_Corresponding_Vertex
+ (G : Invocation_Graph;
+ IS_Id : Invocation_Signature_Id;
+ Vertex : Invocation_Graph_Vertex_Id);
+ pragma Inline (Set_Corresponding_Vertex);
+ -- Associate vertex Vertex of invocation graph G with signature IS_Id
- return DG.Number_Of_Vertices (G.Graph);
- end Number_Of_Vertices;
+ procedure Set_Is_Existing_Source_Target_Relation
+ (G : Invocation_Graph;
+ Rel : Source_Target_Relation;
+ Val : Boolean := True);
+ pragma Inline (Set_Is_Existing_Source_Target_Relation);
+ -- Mark a source vertex and a target vertex described by relation Rel as
+ -- already related in invocation graph G depending on value Val.
- -----------------
- -- Order_Cycle --
- -----------------
+ procedure Set_IGE_Attributes
+ (G : Invocation_Graph;
+ Edge : Invocation_Graph_Edge_Id;
+ Val : Invocation_Graph_Edge_Attributes);
+ pragma Inline (Set_IGE_Attributes);
+ -- Set the attributes of edge Edge of invocation graph G to value Val
- procedure Order_Cycle
- (G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id)
- is
- Lesser_Cycle : Library_Graph_Cycle_Id;
+ procedure Set_IGV_Attributes
+ (G : Invocation_Graph;
+ Vertex : Invocation_Graph_Vertex_Id;
+ Val : Invocation_Graph_Vertex_Attributes);
+ pragma Inline (Set_IGV_Attributes);
+ -- Set the attributes of vertex Vertex of invocation graph G to value
+ -- Val.
- begin
+ --------------
+ -- Add_Edge --
+ --------------
+
+ procedure Add_Edge
+ (G : Invocation_Graph;
+ Source : Invocation_Graph_Vertex_Id;
+ Target : Invocation_Graph_Vertex_Id;
+ IR_Id : Invocation_Relation_Id)
+ is
pragma Assert (Present (G));
- pragma Assert (Present (Cycle));
- pragma Assert (LGC_Lists.Present (G.Cycles));
+ pragma Assert (Present (Source));
+ pragma Assert (Present (Target));
+ pragma Assert (Present (IR_Id));
- -- The input cycle is the first to be inserted
+ Rel : constant Source_Target_Relation :=
+ (Source => Source,
+ Target => Target);
- if LGC_Lists.Is_Empty (G.Cycles) then
- LGC_Lists.Prepend (G.Cycles, Cycle);
+ Edge : Invocation_Graph_Edge_Id;
- -- Otherwise the list of all cycles contains at least one cycle.
- -- Insert the input cycle based on its precedence.
+ begin
+ -- Nothing to do when the source and target are already related by an
+ -- edge.
- else
- Lesser_Cycle := Find_First_Lower_Precedence_Cycle (G, Cycle);
+ if Is_Existing_Source_Target_Relation (G, Rel) then
+ return;
+ end if;
- -- The list contains at least one cycle, and the input cycle has a
- -- higher precedence compared to some cycle in the list.
+ Edge := Sequence_Next_Edge;
- if Present (Lesser_Cycle) then
- LGC_Lists.Insert_Before
- (L => G.Cycles,
- Before => Lesser_Cycle,
- Elem => Cycle);
+ -- Add the edge to the underlying graph
- -- Otherwise the input cycle has the lowest precedence among all
- -- cycles.
+ DG.Add_Edge
+ (G => G.Graph,
+ E => Edge,
+ Source => Source,
+ Destination => Target);
- else
- LGC_Lists.Append (G.Cycles, Cycle);
- end if;
- end if;
- end Order_Cycle;
+ -- Build and save the attributes of the edge
- ----------
- -- Path --
- ----------
+ Set_IGE_Attributes
+ (G => G,
+ Edge => Edge,
+ Val => (Relation => IR_Id));
- function Path
- (G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id) return LGE_Lists.Doubly_Linked_List
- is
- begin
- pragma Assert (Present (G));
- pragma Assert (Present (Cycle));
+ -- Mark the source and target as related by the new edge. This
+ -- prevents all further attempts to link the same source and target.
- return Get_LGC_Attributes (G, Cycle).Path;
- end Path;
+ Set_Is_Existing_Source_Target_Relation (G, Rel);
- ------------------------------------------
- -- Pending_Predecessors_For_Elaboration --
- ------------------------------------------
+ -- Update the edge statistics
- procedure Pending_Predecessors_For_Elaboration
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id;
- Strong_Preds : out Natural;
- Weak_Preds : out Natural)
- is
- Complement : Library_Graph_Vertex_Id;
- Spec_Vertex : Library_Graph_Vertex_Id;
- Total_Strong_Preds : Natural;
- Total_Weak_Preds : Natural;
+ Increment_Invocation_Graph_Edge_Count (G, Kind (IR_Id));
+ end Add_Edge;
+
+ ----------------
+ -- Add_Vertex --
+ ----------------
+
+ procedure Add_Vertex
+ (G : Invocation_Graph;
+ IC_Id : Invocation_Construct_Id;
+ Body_Vertex : Library_Graph_Vertex_Id;
+ Spec_Vertex : Library_Graph_Vertex_Id)
+ is
+ pragma Assert (Present (G));
+ pragma Assert (Present (IC_Id));
+ pragma Assert (Present (Body_Vertex));
+ pragma Assert (Present (Spec_Vertex));
+
+ Construct_Signature : constant Invocation_Signature_Id :=
+ Signature (IC_Id);
+ Vertex : Invocation_Graph_Vertex_Id;
begin
- pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
+ -- Nothing to do when the construct already has a vertex
- Total_Strong_Preds := Pending_Strong_Predecessors (G, Vertex);
- Total_Weak_Preds := Pending_Weak_Predecessors (G, Vertex);
+ if Present (Corresponding_Vertex (G, Construct_Signature)) then
+ return;
+ end if;
- -- Assume that there is no complementary vertex that needs to be
- -- examined.
+ Vertex := Sequence_Next_Vertex;
- Complement := No_Library_Graph_Vertex;
- Spec_Vertex := No_Library_Graph_Vertex;
+ -- Add the vertex to the underlying graph
- if Is_Body_Of_Spec_With_Elaborate_Body (G, Vertex) then
- Complement := Proper_Spec (G, Vertex);
- Spec_Vertex := Complement;
+ DG.Add_Vertex (G.Graph, Vertex);
- elsif Is_Spec_With_Elaborate_Body (G, Vertex) then
- Complement := Proper_Body (G, Vertex);
- Spec_Vertex := Vertex;
- end if;
+ -- Build and save the attributes of the vertex
- -- The vertex is part of an Elaborate_Body pair. Take into account
- -- the strong and weak predecessors of the complementary vertex.
+ Set_IGV_Attributes
+ (G => G,
+ Vertex => Vertex,
+ Val => (Body_Vertex => Body_Vertex,
+ Construct => IC_Id,
+ Spec_Vertex => Spec_Vertex));
- if Present (Complement) then
- Total_Strong_Preds :=
- Pending_Strong_Predecessors (G, Complement) + Total_Strong_Preds;
- Total_Weak_Preds :=
- Pending_Weak_Predecessors (G, Complement) + Total_Weak_Preds;
+ -- Associate the construct with its corresponding vertex
- -- The body of an Elaborate_Body pair is the successor of a strong
- -- edge where the predecessor is the spec. This edge must not be
- -- considered for elaboration purposes because the pair is treated
- -- as one vertex. Account for the edge only when the spec has not
- -- been elaborated yet.
+ Set_Corresponding_Vertex (G, Construct_Signature, Vertex);
- if not In_Elaboration_Order (G, Spec_Vertex) then
- Total_Strong_Preds := Total_Strong_Preds - 1;
- end if;
- end if;
+ -- Save the vertex for later processing when it denotes a spec or
+ -- body elaboration procedure.
- Strong_Preds := Total_Strong_Preds;
- Weak_Preds := Total_Weak_Preds;
- end Pending_Predecessors_For_Elaboration;
+ if Is_Elaboration_Root (G, Vertex) then
+ Save_Elaboration_Root (G, Vertex);
+ end if;
+ end Add_Vertex;
- ---------------------------------
- -- Pending_Strong_Predecessors --
- ---------------------------------
+ -----------------
+ -- Body_Vertex --
+ -----------------
- function Pending_Strong_Predecessors
- (G : Library_Graph;
- Comp : Component_Id) return Natural
+ function Body_Vertex
+ (G : Invocation_Graph;
+ Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Comp));
+ pragma Assert (Present (Vertex));
- return Get_Component_Attributes (G, Comp).Pending_Strong_Predecessors;
- end Pending_Strong_Predecessors;
+ return Get_IGV_Attributes (G, Vertex).Body_Vertex;
+ end Body_Vertex;
- ---------------------------------
- -- Pending_Strong_Predecessors --
- ---------------------------------
+ ------------
+ -- Column --
+ ------------
- function Pending_Strong_Predecessors
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Natural
+ function Column
+ (G : Invocation_Graph;
+ Vertex : Invocation_Graph_Vertex_Id) return Nat
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
- return Get_LGV_Attributes (G, Vertex).Pending_Strong_Predecessors;
- end Pending_Strong_Predecessors;
+ return Column (Signature (Construct (G, Vertex)));
+ end Column;
- -------------------------------
- -- Pending_Weak_Predecessors --
- -------------------------------
+ ---------------
+ -- Construct --
+ ---------------
- function Pending_Weak_Predecessors
- (G : Library_Graph;
- Comp : Component_Id) return Natural
+ function Construct
+ (G : Invocation_Graph;
+ Vertex : Invocation_Graph_Vertex_Id) return Invocation_Construct_Id
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Comp));
+ pragma Assert (Present (Vertex));
- return Get_Component_Attributes (G, Comp).Pending_Weak_Predecessors;
- end Pending_Weak_Predecessors;
+ return Get_IGV_Attributes (G, Vertex).Construct;
+ end Construct;
- -------------------------------
- -- Pending_Weak_Predecessors --
- -------------------------------
+ --------------------------
+ -- Corresponding_Vertex --
+ --------------------------
- function Pending_Weak_Predecessors
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Natural
+ function Corresponding_Vertex
+ (G : Invocation_Graph;
+ IS_Id : Invocation_Signature_Id) return Invocation_Graph_Vertex_Id
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
+ pragma Assert (Present (IS_Id));
- return Get_LGV_Attributes (G, Vertex).Pending_Weak_Predecessors;
- end Pending_Weak_Predecessors;
+ return Signature_Tables.Get (G.Signature_To_Vertex, IS_Id);
+ end Corresponding_Vertex;
- -----------------
- -- Predecessor --
- -----------------
+ ------------
+ -- Create --
+ ------------
- function Predecessor
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id
- is
+ function Create
+ (Initial_Vertices : Positive;
+ Initial_Edges : Positive;
+ Lib_Graph : Library_Graphs.Library_Graph)
+ return Invocation_Graph
+ is
+ G : constant Invocation_Graph := new Invocation_Graph_Attributes'
+ (Counts => <>,
+ Edge_Attributes => IGE_Tables.Create (Initial_Edges),
+ Graph =>
+ DG.Create
+ (Initial_Vertices => Initial_Vertices,
+ Initial_Edges => Initial_Edges),
+ Relations => Relation_Sets.Create (Initial_Edges),
+ Roots => IGV_Sets.Create (Initial_Vertices),
+ Signature_To_Vertex => Signature_Tables.Create (Initial_Vertices),
+ Vertex_Attributes => IGV_Tables.Create (Initial_Vertices),
+ Lib_Graph => Lib_Graph);
begin
- pragma Assert (Present (G));
- pragma Assert (Present (Edge));
-
- return DG.Source_Vertex (G.Graph, Edge);
- end Predecessor;
+ return G;
+ end Create;
-------------
- -- Present --
+ -- Destroy --
-------------
- function Present (G : Library_Graph) return Boolean is
+ procedure Destroy (G : in out Invocation_Graph) is
begin
- return G /= Nil;
- end Present;
+ pragma Assert (Present (G));
- -----------------
- -- Proper_Body --
- -----------------
+ IGE_Tables.Destroy (G.Edge_Attributes);
+ DG.Destroy (G.Graph);
+ Relation_Sets.Destroy (G.Relations);
+ IGV_Sets.Destroy (G.Roots);
+ Signature_Tables.Destroy (G.Signature_To_Vertex);
+ IGV_Tables.Destroy (G.Vertex_Attributes);
- function Proper_Body
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id
- is
- begin
- pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
+ Free (G);
+ end Destroy;
- -- When the vertex denotes a spec with a completing body, return the
- -- body.
+ -----------------------------------
+ -- Destroy_Invocation_Graph_Edge --
+ -----------------------------------
- if Is_Spec_With_Body (G, Vertex) then
- return Corresponding_Item (G, Vertex);
+ procedure Destroy_Invocation_Graph_Edge
+ (Edge : in out Invocation_Graph_Edge_Id)
+ is
+ pragma Unreferenced (Edge);
+ begin
+ null;
+ end Destroy_Invocation_Graph_Edge;
- -- Otherwise the vertex must be a body
+ ----------------------------------------------
+ -- Destroy_Invocation_Graph_Edge_Attributes --
+ ----------------------------------------------
- else
- pragma Assert (Is_Body (G, Vertex));
- return Vertex;
- end if;
- end Proper_Body;
+ procedure Destroy_Invocation_Graph_Edge_Attributes
+ (Attrs : in out Invocation_Graph_Edge_Attributes)
+ is
+ pragma Unreferenced (Attrs);
+ begin
+ null;
+ end Destroy_Invocation_Graph_Edge_Attributes;
- -----------------
- -- Proper_Spec --
- -----------------
+ -------------------------------------
+ -- Destroy_Invocation_Graph_Vertex --
+ -------------------------------------
- function Proper_Spec
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id
+ procedure Destroy_Invocation_Graph_Vertex
+ (Vertex : in out Invocation_Graph_Vertex_Id)
is
+ pragma Unreferenced (Vertex);
begin
- pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
+ null;
+ end Destroy_Invocation_Graph_Vertex;
- -- When the vertex denotes a body that completes a spec, return the
- -- spec.
+ ------------------------------------------------
+ -- Destroy_Invocation_Graph_Vertex_Attributes --
+ ------------------------------------------------
- if Is_Body_With_Spec (G, Vertex) then
- return Corresponding_Item (G, Vertex);
+ procedure Destroy_Invocation_Graph_Vertex_Attributes
+ (Attrs : in out Invocation_Graph_Vertex_Attributes)
+ is
+ pragma Unreferenced (Attrs);
+ begin
+ null;
+ end Destroy_Invocation_Graph_Vertex_Attributes;
- -- Otherwise the vertex must denote a spec
+ -----------
+ -- Extra --
+ -----------
- else
- pragma Assert (Is_Spec (G, Vertex));
- return Vertex;
- end if;
- end Proper_Spec;
+ function Extra
+ (G : Invocation_Graph;
+ Edge : Invocation_Graph_Edge_Id) return Name_Id
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Edge));
- ------------------
- -- Record_Cycle --
- ------------------
+ return Extra (Relation (G, Edge));
+ end Extra;
- procedure Record_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
- Cycle : Library_Graph_Cycle_Id;
- Path : LGE_Lists.Doubly_Linked_List;
+ ------------------------
+ -- Get_IGE_Attributes --
+ ------------------------
+ function Get_IGE_Attributes
+ (G : Invocation_Graph;
+ Edge : Invocation_Graph_Edge_Id)
+ return Invocation_Graph_Edge_Attributes
+ is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Most_Significant_Edge));
- pragma Assert (LGE_Lists.Present (Cycle_Path));
+ pragma Assert (Present (Edge));
- -- Replicate the path of the cycle in order to avoid sharing lists
+ return IGE_Tables.Get (G.Edge_Attributes, Edge);
+ end Get_IGE_Attributes;
- Path := Copy_Cycle_Path (Cycle_Path);
+ ------------------------
+ -- Get_IGV_Attributes --
+ ------------------------
- -- Normalize the path of the cycle such that its most significant
- -- edge is the first in the list of edges.
+ function Get_IGV_Attributes
+ (G : Invocation_Graph;
+ Vertex : Invocation_Graph_Vertex_Id)
+ return Invocation_Graph_Vertex_Attributes
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Vertex));
- Normalize_Cycle_Path
- (Cycle_Path => Path,
- Most_Significant_Edge => Most_Significant_Edge);
+ return IGV_Tables.Get (G.Vertex_Attributes, Vertex);
+ end Get_IGV_Attributes;
- -- Save the cycle for diagnostic purposes. Its kind is determined by
- -- its most significant edge.
+ --------------
+ -- Has_Next --
+ --------------
- Cycle := Sequence_Next_Cycle;
+ function Has_Next (Iter : All_Edge_Iterator) return Boolean is
+ begin
+ return DG.Has_Next (DG.All_Edge_Iterator (Iter));
+ end Has_Next;
- 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));
+ --------------
+ -- Has_Next --
+ --------------
- Trace_Cycle (G, Cycle, Indent);
+ function Has_Next (Iter : All_Vertex_Iterator) return Boolean is
+ begin
+ return DG.Has_Next (DG.All_Vertex_Iterator (Iter));
+ end Has_Next;
- -- Order the cycle based on its precedence relative to previously
- -- discovered cycles.
+ --------------
+ -- Has_Next --
+ --------------
- Order_Cycle (G, Cycle);
- end Record_Cycle;
+ function Has_Next (Iter : Edges_To_Targets_Iterator) return Boolean is
+ begin
+ return DG.Has_Next (DG.Outgoing_Edge_Iterator (Iter));
+ end Has_Next;
- -----------------------------------------
- -- Same_Library_Graph_Cycle_Attributes --
- -----------------------------------------
+ --------------
+ -- Has_Next --
+ --------------
- function Same_Library_Graph_Cycle_Attributes
- (Left : Library_Graph_Cycle_Attributes;
- Right : Library_Graph_Cycle_Attributes) return Boolean
- is
+ function Has_Next (Iter : Elaboration_Root_Iterator) return Boolean is
begin
- -- Two cycles are the same when
- --
- -- * They are of the same kind
- -- * They have the same number of invocation edges in their paths
- -- * Their paths are the same length
- -- * The edges comprising their paths are the same
-
- return
- Left.Invocation_Edge_Count = Right.Invocation_Edge_Count
- and then Left.Kind = Right.Kind
- and then LGE_Lists.Equal (Left.Path, Right.Path);
- end Same_Library_Graph_Cycle_Attributes;
+ return IGV_Sets.Has_Next (IGV_Sets.Iterator (Iter));
+ end Has_Next;
- ------------------------
- -- Set_Activates_Task --
- ------------------------
+ -------------------------------
+ -- Hash_Invocation_Signature --
+ -------------------------------
- procedure Set_Activates_Task
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id)
+ function Hash_Invocation_Signature
+ (IS_Id : Invocation_Signature_Id) return Bucket_Range_Type
is
- Attributes : Library_Graph_Edge_Attributes :=
- Get_LGE_Attributes (G, Edge);
begin
- Attributes.Activates_Task := True;
- Set_LGE_Attributes (G, Edge, Attributes);
- end Set_Activates_Task;
+ pragma Assert (Present (IS_Id));
- ------------------------------
- -- Set_Component_Attributes --
- ------------------------------
+ return Bucket_Range_Type (IS_Id);
+ end Hash_Invocation_Signature;
- procedure Set_Component_Attributes
- (G : Library_Graph;
- Comp : Component_Id;
- Val : Component_Attributes)
+ ---------------------------------
+ -- Hash_Source_Target_Relation --
+ ---------------------------------
+
+ function Hash_Source_Target_Relation
+ (Rel : Source_Target_Relation) return Bucket_Range_Type
is
begin
- pragma Assert (Present (G));
- pragma Assert (Present (Comp));
+ pragma Assert (Present (Rel.Source));
+ pragma Assert (Present (Rel.Target));
- Component_Tables.Put (G.Component_Attributes, Comp, Val);
- end Set_Component_Attributes;
+ return
+ Hash_Two_Keys
+ (Bucket_Range_Type (Rel.Source),
+ Bucket_Range_Type (Rel.Target));
+ end Hash_Source_Target_Relation;
- ----------------------------
- -- Set_Corresponding_Item --
- ----------------------------
+ -------------------------------------------
+ -- Increment_Invocation_Graph_Edge_Count --
+ -------------------------------------------
- procedure Set_Corresponding_Item
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id;
- Val : Library_Graph_Vertex_Id)
+ procedure Increment_Invocation_Graph_Edge_Count
+ (G : Invocation_Graph;
+ Kind : Invocation_Kind)
is
- Attrs : Library_Graph_Vertex_Attributes;
-
- begin
pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
- Attrs := Get_LGV_Attributes (G, Vertex);
- Attrs.Corresponding_Item := Val;
- Set_LGV_Attributes (G, Vertex, Attrs);
- end Set_Corresponding_Item;
+ Count : Natural renames G.Counts (Kind);
- ------------------------------
- -- Set_Corresponding_Vertex --
- ------------------------------
+ begin
+ Count := Count + 1;
+ end Increment_Invocation_Graph_Edge_Count;
- procedure Set_Corresponding_Vertex
- (G : Library_Graph;
- U_Id : Unit_Id;
- Val : Library_Graph_Vertex_Id)
+ ---------------------------------
+ -- Invocation_Graph_Edge_Count --
+ ---------------------------------
+
+ function Invocation_Graph_Edge_Count
+ (G : Invocation_Graph;
+ Kind : Invocation_Kind) return Natural
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (U_Id));
- Unit_Tables.Put (G.Unit_To_Vertex, U_Id, Val);
- end Set_Corresponding_Vertex;
+ return G.Counts (Kind);
+ end Invocation_Graph_Edge_Count;
- ------------------------------
- -- Set_In_Elaboration_Order --
- ------------------------------
+ -------------------------
+ -- Is_Elaboration_Root --
+ -------------------------
- procedure Set_In_Elaboration_Order
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id;
- Val : Boolean := True)
+ function Is_Elaboration_Root
+ (G : Invocation_Graph;
+ Vertex : Invocation_Graph_Vertex_Id) return Boolean
is
- Attrs : Library_Graph_Vertex_Attributes;
-
- begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
- Attrs := Get_LGV_Attributes (G, Vertex);
- Attrs.In_Elaboration_Order := Val;
- Set_LGV_Attributes (G, Vertex, Attrs);
- end Set_In_Elaboration_Order;
+ Vertex_Kind : constant Invocation_Construct_Kind :=
+ Kind (Construct (G, Vertex));
- --------------------------
- -- Set_Is_Recorded_Edge --
- --------------------------
+ begin
+ return
+ Vertex_Kind = Elaborate_Body_Procedure
+ or else
+ Vertex_Kind = Elaborate_Spec_Procedure;
+ end Is_Elaboration_Root;
- procedure Set_Is_Recorded_Edge
- (G : Library_Graph;
- Rel : Predecessor_Successor_Relation)
+ ----------------------------------------
+ -- Is_Existing_Source_Target_Relation --
+ ----------------------------------------
+
+ function Is_Existing_Source_Target_Relation
+ (G : Invocation_Graph;
+ Rel : Source_Target_Relation) return Boolean
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Rel.Predecessor));
- pragma Assert (Present (Rel.Successor));
-
- RE_Sets.Insert (G.Recorded_Edges, Rel);
- end Set_Is_Recorded_Edge;
- ------------------------
- -- Set_LGC_Attributes --
- ------------------------
+ return Relation_Sets.Contains (G.Relations, Rel);
+ end Is_Existing_Source_Target_Relation;
- procedure Set_LGC_Attributes
- (G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id;
- Val : Library_Graph_Cycle_Attributes)
+ -----------------------
+ -- Iterate_All_Edges --
+ -----------------------
+
+ function Iterate_All_Edges
+ (G : Invocation_Graph) return All_Edge_Iterator
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Cycle));
- LGC_Tables.Put (G.Cycle_Attributes, Cycle, Val);
- end Set_LGC_Attributes;
+ return All_Edge_Iterator (DG.Iterate_All_Edges (G.Graph));
+ end Iterate_All_Edges;
- ------------------------
- -- Set_LGE_Attributes --
- ------------------------
+ --------------------------
+ -- Iterate_All_Vertices --
+ --------------------------
- procedure Set_LGE_Attributes
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id;
- Val : Library_Graph_Edge_Attributes)
+ function Iterate_All_Vertices
+ (G : Invocation_Graph) return All_Vertex_Iterator
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Edge));
- LGE_Tables.Put (G.Edge_Attributes, Edge, Val);
- end Set_LGE_Attributes;
+ return All_Vertex_Iterator (DG.Iterate_All_Vertices (G.Graph));
+ end Iterate_All_Vertices;
- ------------------------
- -- Set_LGV_Attributes --
- ------------------------
+ ------------------------------
+ -- Iterate_Edges_To_Targets --
+ ------------------------------
- procedure Set_LGV_Attributes
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id;
- Val : Library_Graph_Vertex_Attributes)
+ function Iterate_Edges_To_Targets
+ (G : Invocation_Graph;
+ Vertex : Invocation_Graph_Vertex_Id) return Edges_To_Targets_Iterator
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
- LGV_Tables.Put (G.Vertex_Attributes, Vertex, Val);
- end Set_LGV_Attributes;
+ return
+ Edges_To_Targets_Iterator
+ (DG.Iterate_Outgoing_Edges (G.Graph, Vertex));
+ end Iterate_Edges_To_Targets;
- ---------------
- -- Successor --
- ---------------
+ -------------------------------
+ -- Iterate_Elaboration_Roots --
+ -------------------------------
- function Successor
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id
+ function Iterate_Elaboration_Roots
+ (G : Invocation_Graph) return Elaboration_Root_Iterator
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Edge));
- return DG.Destination_Vertex (G.Graph, Edge);
- end Successor;
+ return Elaboration_Root_Iterator (IGV_Sets.Iterate (G.Roots));
+ end Iterate_Elaboration_Roots;
- ---------------------
- -- Trace_Component --
- ---------------------
+ ----------
+ -- Kind --
+ ----------
- procedure Trace_Component
- (G : Library_Graph;
- Comp : Component_Id;
- Indent : Indentation_Level)
+ function Kind
+ (G : Invocation_Graph;
+ Edge : Invocation_Graph_Edge_Id) return Invocation_Kind
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;
+ pragma Assert (Present (Edge));
- Write_Eol;
- Indent_By (Indent);
- Write_Str ("component (Comp_");
- Write_Int (Int (Comp));
- Write_Str (")");
- Write_Eol;
- end Trace_Component;
+ return Kind (Relation (G, Edge));
+ end Kind;
- -----------------
- -- Trace_Cycle --
- -----------------
+ -------------------
+ -- Get_Lib_Graph --
+ -------------------
- procedure Trace_Cycle
- (G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id;
- Indent : Indentation_Level)
+ function Get_Lib_Graph
+ (G : Invocation_Graph) return Library_Graphs.Library_Graph
is
- Attr_Indent : constant Indentation_Level :=
- Indent + Nested_Indentation;
- Edge_Indent : constant Indentation_Level :=
- Attr_Indent + Nested_Indentation;
+ pragma Assert (Present (G));
+ begin
+ return G.Lib_Graph;
+ end Get_Lib_Graph;
- Edge : Library_Graph_Edge_Id;
- Iter : Edges_Of_Cycle_Iterator;
+ ----------
+ -- Line --
+ ----------
+ function Line
+ (G : Invocation_Graph;
+ Vertex : Invocation_Graph_Vertex_Id) return Nat
+ is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Cycle));
-
- -- 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;
+ pragma Assert (Present (Vertex));
- Indent_By (Indent);
- Write_Str ("cycle (LGC_Id_");
- Write_Int (Int (Cycle));
- Write_Str (")");
- Write_Eol;
+ return Line (Signature (Construct (G, Vertex)));
+ end Line;
- Indent_By (Attr_Indent);
- Write_Str ("kind = ");
- Write_Str (Kind (G, Cycle)'Img);
- Write_Eol;
+ ----------
+ -- Name --
+ ----------
- Indent_By (Attr_Indent);
- Write_Str ("invocation edges = ");
- Write_Int (Int (Invocation_Edge_Count (G, Cycle)));
- Write_Eol;
+ function Name
+ (G : Invocation_Graph;
+ Vertex : Invocation_Graph_Vertex_Id) return Name_Id
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Vertex));
- Indent_By (Attr_Indent);
- Write_Str ("length: ");
- Write_Int (Int (Length (G, Cycle)));
- Write_Eol;
+ return Name (Signature (Construct (G, Vertex)));
+ end Name;
- Iter := Iterate_Edges_Of_Cycle (G, Cycle);
- while Has_Next (Iter) loop
- Next (Iter, Edge);
+ ----------
+ -- Next --
+ ----------
- Indent_By (Edge_Indent);
- Write_Str ("library graph edge (LGE_Id_");
- Write_Int (Int (Edge));
- Write_Str (")");
- Write_Eol;
- end loop;
- end Trace_Cycle;
+ procedure Next
+ (Iter : in out All_Edge_Iterator;
+ Edge : out Invocation_Graph_Edge_Id)
+ is
+ begin
+ DG.Next (DG.All_Edge_Iterator (Iter), Edge);
+ end Next;
- ----------------
- -- Trace_Edge --
- ----------------
+ ----------
+ -- Next --
+ ----------
- procedure Trace_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id;
- Indent : Indentation_Level)
+ procedure Next
+ (Iter : in out All_Vertex_Iterator;
+ Vertex : out Invocation_Graph_Vertex_Id)
is
- pragma Assert (Present (G));
- pragma Assert (Present (Edge));
-
- Attr_Indent : constant Indentation_Level :=
- Indent + Nested_Indentation;
+ begin
+ DG.Next (DG.All_Vertex_Iterator (Iter), Vertex);
+ end Next;
- Pred : constant Library_Graph_Vertex_Id := Predecessor (G, Edge);
- Succ : constant Library_Graph_Vertex_Id := Successor (G, Edge);
+ ----------
+ -- Next --
+ ----------
+ procedure Next
+ (Iter : in out Edges_To_Targets_Iterator;
+ Edge : out Invocation_Graph_Edge_Id)
+ is
begin
- -- Nothing to do when switch -d_t (output cycle-detection trace
- -- information) is not in effect.
+ DG.Next (DG.Outgoing_Edge_Iterator (Iter), Edge);
+ end Next;
- if not Debug_Flag_Underscore_T then
- return;
- end if;
+ ----------
+ -- Next --
+ ----------
- Indent_By (Indent);
- Write_Str ("library graph edge (LGE_Id_");
- Write_Int (Int (Edge));
- Write_Str (")");
- Write_Eol;
+ procedure Next
+ (Iter : in out Elaboration_Root_Iterator;
+ Root : out Invocation_Graph_Vertex_Id)
+ is
+ begin
+ IGV_Sets.Next (IGV_Sets.Iterator (Iter), Root);
+ end Next;
- Indent_By (Attr_Indent);
- Write_Str ("kind = ");
- Write_Str (Kind (G, Edge)'Img);
- Write_Eol;
+ ---------------------
+ -- Number_Of_Edges --
+ ---------------------
- Indent_By (Attr_Indent);
- Write_Str ("Predecessor (LGV_Id_");
- Write_Int (Int (Pred));
- Write_Str (") name = ");
- Write_Name (Name (G, Pred));
- Write_Eol;
+ function Number_Of_Edges (G : Invocation_Graph) return Natural is
+ begin
+ pragma Assert (Present (G));
- Indent_By (Attr_Indent);
- Write_Str ("Successor (LGV_Id_");
- Write_Int (Int (Succ));
- Write_Str (") name = ");
- Write_Name (Name (G, Succ));
- Write_Eol;
- end Trace_Edge;
+ return DG.Number_Of_Edges (G.Graph);
+ end Number_Of_Edges;
- ------------------
- -- Trace_Vertex --
- ------------------
+ --------------------------------
+ -- Number_Of_Edges_To_Targets --
+ --------------------------------
- procedure Trace_Vertex
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id;
- Indent : Indentation_Level)
+ function Number_Of_Edges_To_Targets
+ (G : Invocation_Graph;
+ Vertex : Invocation_Graph_Vertex_Id) return Natural
is
- Attr_Indent : constant Indentation_Level :=
- Indent + Nested_Indentation;
-
begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
- -- Nothing to do when switch -d_t (output cycle-detection trace
- -- information) is not in effect.
+ return DG.Number_Of_Outgoing_Edges (G.Graph, Vertex);
+ end Number_Of_Edges_To_Targets;
- if not Debug_Flag_Underscore_T then
- return;
- end if;
+ ---------------------------------
+ -- Number_Of_Elaboration_Roots --
+ ---------------------------------
- Indent_By (Indent);
- Write_Str ("library graph vertex (LGV_Id_");
- Write_Int (Int (Vertex));
- Write_Str (")");
- Write_Eol;
+ function Number_Of_Elaboration_Roots
+ (G : Invocation_Graph) return Natural
+ is
+ begin
+ pragma Assert (Present (G));
- Indent_By (Attr_Indent);
- Write_Str ("Unit (U_Id_");
- Write_Int (Int (Unit (G, Vertex)));
- Write_Str (") name = ");
- Write_Name (Name (G, Vertex));
- Write_Eol;
- end Trace_Vertex;
+ return IGV_Sets.Size (G.Roots);
+ end Number_Of_Elaboration_Roots;
- ----------
- -- Unit --
- ----------
+ ------------------------
+ -- Number_Of_Vertices --
+ ------------------------
- function Unit
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Unit_Id
- is
+ function Number_Of_Vertices (G : Invocation_Graph) return Natural is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Vertex));
- return Get_LGV_Attributes (G, Vertex).Unit;
- end Unit;
+ return DG.Number_Of_Vertices (G.Graph);
+ end Number_Of_Vertices;
-------------
- -- Unvisit --
+ -- Present --
-------------
- 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;
-
+ function Present (G : Invocation_Graph) return Boolean is
begin
- pragma Assert (Present (Vertex));
- pragma Assert (LGV_Sets.Present (Visited_Set));
- pragma Assert (LGV_Lists.Present (Visited_Stack));
+ return G /= Nil;
+ end Present;
- while not LGV_Lists.Is_Empty (Visited_Stack) loop
- Current_Vertex := LGV_Lists.First (Visited_Stack);
+ --------------
+ -- Relation --
+ --------------
- LGV_Lists.Delete_First (Visited_Stack);
- LGV_Sets.Delete (Visited_Set, Current_Vertex);
+ function Relation
+ (G : Invocation_Graph;
+ Edge : Invocation_Graph_Edge_Id) return Invocation_Relation_Id
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Edge));
- exit when Current_Vertex = Vertex;
- end loop;
- end Unvisit;
+ return Get_IGE_Attributes (G, Edge).Relation;
+ end Relation;
- ---------------------------------
- -- Update_Pending_Predecessors --
- ---------------------------------
+ ---------------------------
+ -- Save_Elaboration_Root --
+ ---------------------------
- procedure Update_Pending_Predecessors
- (Strong_Predecessors : in out Natural;
- Weak_Predecessors : in out Natural;
- Update_Weak : Boolean;
- Value : Integer)
+ procedure Save_Elaboration_Root
+ (G : Invocation_Graph;
+ Root : Invocation_Graph_Vertex_Id)
is
begin
- if Update_Weak then
- Weak_Predecessors := Weak_Predecessors + Value;
- else
- Strong_Predecessors := Strong_Predecessors + Value;
- end if;
- end Update_Pending_Predecessors;
+ pragma Assert (Present (G));
+ pragma Assert (Present (Root));
- -----------------------------------------------
- -- Update_Pending_Predecessors_Of_Components --
- -----------------------------------------------
+ IGV_Sets.Insert (G.Roots, Root);
+ end Save_Elaboration_Root;
- procedure Update_Pending_Predecessors_Of_Components
- (G : Library_Graph)
- is
- Edge : Library_Graph_Edge_Id;
- Iter : All_Edge_Iterator;
+ ------------------------------
+ -- Set_Corresponding_Vertex --
+ ------------------------------
+ procedure Set_Corresponding_Vertex
+ (G : Invocation_Graph;
+ IS_Id : Invocation_Signature_Id;
+ Vertex : Invocation_Graph_Vertex_Id)
+ is
begin
pragma Assert (Present (G));
+ pragma Assert (Present (IS_Id));
+ pragma Assert (Present (Vertex));
- Iter := Iterate_All_Edges (G);
- while Has_Next (Iter) loop
- Next (Iter, Edge);
+ Signature_Tables.Put (G.Signature_To_Vertex, IS_Id, Vertex);
+ end Set_Corresponding_Vertex;
- Update_Pending_Predecessors_Of_Components (G, Edge);
- end loop;
- end Update_Pending_Predecessors_Of_Components;
+ --------------------------------------------
+ -- Set_Is_Existing_Source_Target_Relation --
+ --------------------------------------------
- -----------------------------------------------
- -- Update_Pending_Predecessors_Of_Components --
- -----------------------------------------------
+ procedure Set_Is_Existing_Source_Target_Relation
+ (G : Invocation_Graph;
+ Rel : Source_Target_Relation;
+ Val : Boolean := True)
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Rel.Source));
+ pragma Assert (Present (Rel.Target));
- procedure Update_Pending_Predecessors_Of_Components
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id)
+ if Val then
+ Relation_Sets.Insert (G.Relations, Rel);
+ else
+ Relation_Sets.Delete (G.Relations, Rel);
+ end if;
+ end Set_Is_Existing_Source_Target_Relation;
+
+ ------------------------
+ -- Set_IGE_Attributes --
+ ------------------------
+
+ procedure Set_IGE_Attributes
+ (G : Invocation_Graph;
+ Edge : Invocation_Graph_Edge_Id;
+ Val : Invocation_Graph_Edge_Attributes)
is
+ begin
pragma Assert (Present (G));
pragma Assert (Present (Edge));
- Pred_Comp : constant Component_Id :=
- Component (G, Predecessor (G, Edge));
- Succ_Comp : constant Component_Id :=
- Component (G, Successor (G, Edge));
+ IGE_Tables.Put (G.Edge_Attributes, Edge, Val);
+ end Set_IGE_Attributes;
- pragma Assert (Present (Pred_Comp));
- pragma Assert (Present (Succ_Comp));
+ ------------------------
+ -- Set_IGV_Attributes --
+ ------------------------
+ procedure Set_IGV_Attributes
+ (G : Invocation_Graph;
+ Vertex : Invocation_Graph_Vertex_Id;
+ Val : Invocation_Graph_Vertex_Attributes)
+ is
begin
- -- The edge links a successor and a predecessor coming from two
- -- different SCCs. This indicates that the SCC of the successor
- -- must wait on another predecessor until it can be elaborated.
+ pragma Assert (Present (G));
+ pragma Assert (Present (Vertex));
- if Pred_Comp /= Succ_Comp then
- Increment_Pending_Predecessors
- (G => G,
- Comp => Succ_Comp,
- Edge => Edge);
- end if;
- end Update_Pending_Predecessors_Of_Components;
+ IGV_Tables.Put (G.Vertex_Attributes, Vertex, Val);
+ end Set_IGV_Attributes;
- -----------------------
- -- Vertex_Precedence --
- -----------------------
+ -----------------
+ -- Spec_Vertex --
+ -----------------
- function Vertex_Precedence
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id;
- Compared_To : Library_Graph_Vertex_Id) return Precedence_Kind
+ function Spec_Vertex
+ (G : Invocation_Graph;
+ Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
- 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;
+ return Get_IGV_Attributes (G, Vertex).Spec_Vertex;
+ end Spec_Vertex;
- -----------
- -- Visit --
- -----------
+ ------------
+ -- Target --
+ ------------
- procedure Visit
- (Vertex : Library_Graph_Vertex_Id;
- Visited_Set : LGV_Sets.Membership_Set;
- Visited_Stack : LGV_Lists.Doubly_Linked_List)
+ function Target
+ (G : Invocation_Graph;
+ Edge : Invocation_Graph_Edge_Id) return Invocation_Graph_Vertex_Id
is
begin
- pragma Assert (Present (Vertex));
- pragma Assert (LGV_Sets.Present (Visited_Set));
- pragma Assert (LGV_Lists.Present (Visited_Stack));
+ pragma Assert (Present (G));
+ pragma Assert (Present (Edge));
- LGV_Sets.Insert (Visited_Set, Vertex);
- LGV_Lists.Prepend (Visited_Stack, Vertex);
- end Visit;
- end Library_Graphs;
+ return DG.Destination_Vertex (G.Graph, Edge);
+ end Target;
+ end Invocation_Graphs;
-------------
-- Present --
"=" => "=",
Hash => Hash_Library_Graph_Vertex);
- -----------------------
- -- Invocation_Graphs --
- -----------------------
+ --------------------
+ -- Library_Graphs --
+ --------------------
- package Invocation_Graphs is
+ package Library_Graphs is
+
+ -- The following type represents the various kinds of library graph
+ -- cycles. The ordering of kinds is significant, where a literal with
+ -- lower ordinal has a higher precedence than one with higher ordinal.
+
+ type Library_Graph_Cycle_Kind is
+ (Elaborate_Body_Cycle,
+ -- A cycle that involves at least one spec-body pair, where the
+ -- spec is subject to pragma Elaborate_Body. This is the highest
+ -- precedence cycle.
+
+ Elaborate_Cycle,
+ -- A cycle that involves at least one Elaborate edge
+
+ Elaborate_All_Cycle,
+ -- A cycle that involves at least one Elaborate_All edge
+
+ Forced_Cycle,
+ -- A cycle that involves at least one edge which is a byproduct of
+ -- the forced-elaboration-order file.
+
+ Invocation_Cycle,
+ -- A cycle that involves at least one invocation edge. This is the
+ -- lowest precedence cycle.
+
+ No_Cycle_Kind);
+
+ -- The following type represents the various kinds of library edges. The
+ -- order is important here, and corresponds to the order in which edges
+ -- are added to the graph. See Add_Edge_Kind_Check for details. If
+ -- changes are made such that new edge kinds are added or similar, we
+ -- need to make sure this type matches the code in Add_Edge_Kind_Check,
+ -- and Add_Edge_Kind_Check matches the order of edge adding. Likewise,
+ -- if the edge-adding order changes, we need consistency between this
+ -- enumeration type, the edge-adding order, and Add_Edge_Kind_Check.
+
+ type Library_Graph_Edge_Kind is
+ (Spec_Before_Body_Edge,
+ -- Successor denotes a body, Predecessor denotes a spec
+
+ Elaborate_Edge,
+ -- Successor withs Predecessor, and has pragma Elaborate for it
+
+ Elaborate_All_Edge,
+ -- Successor withs Predecessor, and has pragma Elaborate_All for it
+
+ With_Edge,
+ -- Successor withs Predecessor
+
+ Forced_Edge,
+ -- Successor is forced to with Predecessor by virtue of an existing
+ -- elaboration order provided in a file.
+
+ Invocation_Edge,
+ -- An invocation construct in unit Successor invokes a target in unit
+ -- Predecessor.
+
+ Body_Before_Spec_Edge,
+ -- Successor denotes spec, Predecessor denotes a body. This is a
+ -- special edge kind used only during the discovery of components.
+ -- Note that a body can never be elaborated before its spec.
+
+ No_Edge);
-----------
-- Graph --
-----------
- -- The following type denotes an invocation graph handle. Each instance
- -- must be created using routine Create.
+ -- The following type denotes a library graph handle. Each instance must
+ -- be created using routine Create.
- type Invocation_Graph is private;
- Nil : constant Invocation_Graph;
+ type Library_Graph is private;
+ Nil : constant Library_Graph;
+
+ type LGE_Predicate_Ptr is access function
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean;
+
+ type LGV_Comparator_Ptr is access function
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id;
+ Compared_To : Library_Graph_Vertex_Id) return Precedence_Kind;
+
+ type LGV_Predicate_Ptr is access function
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
----------------------
-- Graph operations --
----------------------
procedure Add_Edge
- (G : Invocation_Graph;
- Source : Invocation_Graph_Vertex_Id;
- Target : Invocation_Graph_Vertex_Id;
- IR_Id : Invocation_Relation_Id);
+ (G : Library_Graph;
+ Pred : Library_Graph_Vertex_Id;
+ Succ : Library_Graph_Vertex_Id;
+ Kind : Library_Graph_Edge_Kind;
+ Activates_Task : Boolean);
pragma Inline (Add_Edge);
- -- Create a new edge in invocation graph G with source vertex Source and
- -- destination vertex Target. IR_Id is the invocation relation the edge
- -- describes.
+ -- Create a new edge in library graph G with source vertex Pred and
+ -- destination vertex Succ. Kind denotes the nature of the edge. Flag
+ -- Activates_Task should be set when the edge involves task activation.
procedure Add_Vertex
- (G : Invocation_Graph;
- IC_Id : Invocation_Construct_Id;
- Body_Vertex : Library_Graph_Vertex_Id;
- Spec_Vertex : Library_Graph_Vertex_Id);
+ (G : Library_Graph;
+ U_Id : Unit_Id);
pragma Inline (Add_Vertex);
- -- Create a new vertex in invocation graph G. IC_Id is the invocation
- -- construct the vertex describes. Body_Vertex denotes the library graph
- -- vertex where the invocation construct's body is declared. Spec_Vertex
- -- is the library graph vertex where the invocation construct's spec is
- -- declared.
+ -- Create a new vertex in library graph G. U_Id is the unit the vertex
+ -- describes.
function Create
(Initial_Vertices : Positive;
- Initial_Edges : Positive) return Invocation_Graph;
+ Initial_Edges : Positive) return Library_Graph;
pragma Inline (Create);
-- Create a new empty graph with vertex capacity Initial_Vertices and
-- edge capacity Initial_Edges.
- procedure Destroy (G : in out Invocation_Graph);
+ procedure Destroy (G : in out Library_Graph);
pragma Inline (Destroy);
- -- Destroy the contents of invocation graph G, rendering it unusable
+ -- Destroy the contents of library graph G, rendering it unusable
- function Present (G : Invocation_Graph) return Boolean;
+ procedure Find_Components (G : Library_Graph);
+ pragma Inline (Find_Components);
+ -- Find all components in library graph G
+
+ procedure Find_Cycles (G : Library_Graph);
+ pragma Inline (Find_Cycles);
+ -- Find all cycles in library graph G
+
+ function Highest_Precedence_Cycle
+ (G : Library_Graph) return Library_Graph_Cycle_Id;
+ pragma Inline (Highest_Precedence_Cycle);
+ -- Obtain the cycle with highest precedence among all other cycles of
+ -- library graph G.
+
+ function Present (G : Library_Graph) return Boolean;
pragma Inline (Present);
- -- Determine whether invocation graph G exists
+ -- Determine whether library graph G exists
-----------------------
-- Vertex attributes --
-----------------------
- function Body_Vertex
- (G : Invocation_Graph;
- Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id;
- pragma Inline (Body_Vertex);
- -- Obtain the library graph vertex where the body of the invocation
- -- construct represented by vertex Vertex of invocation graph G is
- -- declared.
-
- function Column
- (G : Invocation_Graph;
- Vertex : Invocation_Graph_Vertex_Id) return Nat;
- pragma Inline (Column);
- -- Obtain the column number where the invocation construct vertex Vertex
- -- of invocation graph G describes.
+ function Component
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Component_Id;
+ pragma Inline (Component);
+ -- Obtain the component where vertex Vertex of library graph G resides
- function Construct
- (G : Invocation_Graph;
- Vertex : Invocation_Graph_Vertex_Id) return Invocation_Construct_Id;
- pragma Inline (Construct);
- -- Obtain the invocation construct vertex Vertex of invocation graph G
- -- describes.
+ function Corresponding_Item
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id;
+ pragma Inline (Corresponding_Item);
+ -- Obtain the complementary vertex which represents the corresponding
+ -- spec or body of vertex Vertex of library graph G.
function Corresponding_Vertex
- (G : Invocation_Graph;
- IS_Id : Invocation_Signature_Id) return Invocation_Graph_Vertex_Id;
+ (G : Library_Graph;
+ U_Id : Unit_Id) return Library_Graph_Vertex_Id;
pragma Inline (Corresponding_Vertex);
- -- Obtain the vertex of invocation graph G that corresponds to signature
- -- IS_Id.
+ -- Obtain the corresponding vertex of library graph G which represents
+ -- unit U_Id.
- function Line
- (G : Invocation_Graph;
- Vertex : Invocation_Graph_Vertex_Id) return Nat;
- pragma Inline (Line);
- -- Obtain the line number where the invocation construct vertex Vertex
- -- of invocation graph G describes.
+ procedure Decrement_Pending_Predecessors
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id;
+ Edge : Library_Graph_Edge_Id);
+ pragma Inline (Decrement_Pending_Predecessors);
+ -- Decrease the number of pending predecessors vertex Vertex which was
+ -- reached via edge Edge of library graph G must wait until it can be
+ -- elaborated.
+
+ function File_Name
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return File_Name_Type;
+ pragma Inline (File_Name);
+ -- Obtain the name of the file where vertex Vertex of library graph G
+ -- resides.
+
+ function In_Elaboration_Order
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
+ pragma Inline (In_Elaboration_Order);
+ -- Determine whether vertex Vertex of library graph G is already in some
+ -- elaboration order.
+
+ function Invocation_Graph_Encoding
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id)
+ return Invocation_Graph_Encoding_Kind;
+ pragma Inline (Invocation_Graph_Encoding);
+ -- Obtain the encoding format used to capture information related to
+ -- invocation vertices and edges that reside within vertex Vertex of
+ -- library graph G.
function Name
- (G : Invocation_Graph;
- Vertex : Invocation_Graph_Vertex_Id) return Name_Id;
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Unit_Name_Type;
pragma Inline (Name);
- -- Obtain the name of the construct vertex Vertex of invocation graph G
- -- describes.
+ -- Obtain the name of the unit which vertex Vertex of library graph G
+ -- represents.
- function Spec_Vertex
- (G : Invocation_Graph;
- Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id;
- pragma Inline (Spec_Vertex);
- -- Obtain the library graph vertex where the spec of the invocation
- -- construct represented by vertex Vertex of invocation graph G is
- -- declared.
+ procedure Pending_Predecessors_For_Elaboration
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id;
+ Strong_Preds : out Natural;
+ Weak_Preds : out Natural);
+ pragma Inline (Pending_Predecessors_For_Elaboration);
+ -- Obtain the number of pending strong and weak predecessors of vertex
+ -- Vertex of library graph G, taking into account Elaborate_Body pairs.
+ -- Strong predecessors are returned in Strong_Preds. Weak predecessors
+ -- are returned in Weak_Preds.
- ---------------------
- -- Edge attributes --
- ---------------------
+ function Pending_Strong_Predecessors
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Natural;
+ pragma Inline (Pending_Strong_Predecessors);
+ -- Obtain the number of pending strong predecessors vertex Vertex of
+ -- library graph G must wait on until it can be elaborated.
- function Extra
- (G : Invocation_Graph;
- Edge : Invocation_Graph_Edge_Id) return Name_Id;
- pragma Inline (Extra);
- -- Obtain the extra name used in error diagnostics of edge Edge of
- -- invocation graph G.
-
- function Kind
- (G : Invocation_Graph;
- Edge : Invocation_Graph_Edge_Id) return Invocation_Kind;
- pragma Inline (Kind);
- -- Obtain the nature of edge Edge of invocation graph G
-
- function Relation
- (G : Invocation_Graph;
- Edge : Invocation_Graph_Edge_Id) return Invocation_Relation_Id;
- pragma Inline (Relation);
- -- Obtain the relation edge Edge of invocation graph G describes
+ function Pending_Weak_Predecessors
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Natural;
+ pragma Inline (Pending_Weak_Predecessors);
+ -- Obtain the number of pending weak predecessors vertex Vertex of
+ -- library graph G must wait on until it can be elaborated.
- function Target
- (G : Invocation_Graph;
- Edge : Invocation_Graph_Edge_Id) return Invocation_Graph_Vertex_Id;
- pragma Inline (Target);
- -- Obtain the target vertex edge Edge of invocation graph G designates
+ procedure Set_Corresponding_Item
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id;
+ Val : Library_Graph_Vertex_Id);
+ pragma Inline (Set_Corresponding_Item);
+ -- Set the complementary vertex which represents the corresponding
+ -- spec or body of vertex Vertex of library graph G to value Val.
- ----------------
- -- Statistics --
- ----------------
+ procedure Set_In_Elaboration_Order
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id;
+ Val : Boolean := True);
+ pragma Inline (Set_In_Elaboration_Order);
+ -- Mark vertex Vertex of library graph G as included in some elaboration
+ -- order depending on value Val.
- function Invocation_Graph_Edge_Count
- (G : Invocation_Graph;
- Kind : Invocation_Kind) return Natural;
- pragma Inline (Invocation_Graph_Edge_Count);
- -- Obtain the total number of edges of kind Kind in invocation graph G
+ function Unit
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Unit_Id;
+ pragma Inline (Unit);
+ -- Obtain the unit vertex Vertex of library graph G represents
- function Number_Of_Edges (G : Invocation_Graph) return Natural;
- pragma Inline (Number_Of_Edges);
- -- Obtain the total number of edges in invocation graph G
+ ---------------------
+ -- Edge attributes --
+ ---------------------
- function Number_Of_Edges_To_Targets
- (G : Invocation_Graph;
- Vertex : Invocation_Graph_Vertex_Id) return Natural;
- pragma Inline (Number_Of_Edges_To_Targets);
- -- Obtain the total number of edges to targets vertex Vertex of
- -- invocation graph G has.
+ function Activates_Task
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean;
+ pragma Inline (Activates_Task);
+ -- Determine whether edge Edge of library graph G activates a task
- function Number_Of_Elaboration_Roots
- (G : Invocation_Graph) return Natural;
- pragma Inline (Number_Of_Elaboration_Roots);
- -- Obtain the total number of elaboration roots in invocation graph G
+ function Kind
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Library_Graph_Edge_Kind;
+ pragma Inline (Kind);
+ -- Obtain the nature of edge Edge of library graph G
- function Number_Of_Vertices (G : Invocation_Graph) return Natural;
- pragma Inline (Number_Of_Vertices);
- -- Obtain the total number of vertices in invocation graph G
+ function Predecessor
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id;
+ pragma Inline (Predecessor);
+ -- Obtain the predecessor vertex of edge Edge of library graph G
- ---------------
- -- Iterators --
- ---------------
+ function Successor
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id;
+ pragma Inline (Successor);
+ -- Obtain the successor vertex of edge Edge of library graph G
- -- The following type represents an iterator over all edges of an
- -- invocation graph.
+ --------------------------
+ -- Component attributes --
+ --------------------------
- type All_Edge_Iterator is private;
+ procedure Decrement_Pending_Predecessors
+ (G : Library_Graph;
+ Comp : Component_Id;
+ Edge : Library_Graph_Edge_Id);
+ pragma Inline (Decrement_Pending_Predecessors);
+ -- Decrease the number of pending predecessors component Comp which was
+ -- reached via edge Edge of library graph G must wait on until it can be
+ -- elaborated.
- function Has_Next (Iter : All_Edge_Iterator) return Boolean;
- pragma Inline (Has_Next);
- -- Determine whether iterator Iter has more edges to examine
+ function Pending_Strong_Predecessors
+ (G : Library_Graph;
+ Comp : Component_Id) return Natural;
+ pragma Inline (Pending_Strong_Predecessors);
+ -- Obtain the number of pending strong predecessors component Comp of
+ -- library graph G must wait on until it can be elaborated.
- function Iterate_All_Edges
- (G : Invocation_Graph) return All_Edge_Iterator;
- pragma Inline (Iterate_All_Edges);
- -- Obtain an iterator over all edges of invocation graph G
+ function Pending_Weak_Predecessors
+ (G : Library_Graph;
+ Comp : Component_Id) return Natural;
+ pragma Inline (Pending_Weak_Predecessors);
+ -- Obtain the number of pending weak predecessors component Comp of
+ -- library graph G must wait on until it can be elaborated.
- procedure Next
- (Iter : in out All_Edge_Iterator;
- Edge : out Invocation_Graph_Edge_Id);
- pragma Inline (Next);
- -- Return the current edge referenced by iterator Iter and advance to
- -- the next available edge.
+ ----------------------
+ -- Cycle attributes --
+ ----------------------
- -- The following type represents an iterator over all vertices of an
- -- invocation graph.
+ function Invocation_Edge_Count
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id) return Natural;
+ pragma Inline (Invocation_Edge_Count);
+ -- Obtain the number of invocation edges in cycle Cycle of library
+ -- graph G.
- type All_Vertex_Iterator is private;
+ function Kind
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Kind;
+ pragma Inline (Kind);
+ -- Obtain the nature of cycle Cycle of library graph G
- function Has_Next (Iter : All_Vertex_Iterator) return Boolean;
- pragma Inline (Has_Next);
- -- Determine whether iterator Iter has more vertices to examine
+ function Length
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id) return Natural;
+ pragma Inline (Length);
+ -- Obtain the length of cycle Cycle of library graph G
- function Iterate_All_Vertices
- (G : Invocation_Graph) return All_Vertex_Iterator;
- pragma Inline (Iterate_All_Vertices);
- -- Obtain an iterator over all vertices of invocation graph G
+ ---------------
+ -- Semantics --
+ ---------------
- procedure Next
- (Iter : in out All_Vertex_Iterator;
- Vertex : out Invocation_Graph_Vertex_Id);
- pragma Inline (Next);
- -- Return the current vertex referenced by iterator Iter and advance
- -- to the next available vertex.
+ function Complementary_Vertex
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id;
+ Force_Complement : Boolean) return Library_Graph_Vertex_Id;
+ pragma Inline (Complementary_Vertex);
+ -- Obtain the complementary vertex of vertex Vertex of library graph G
+ -- as follows:
+ --
+ -- * If Vertex is the spec of an Elaborate_Body pair, return the body
+ -- * If Vertex is the body of an Elaborate_Body pair, return the spec
+ --
+ -- This behavior can be forced by setting flag Force_Complement to True.
- -- The following type represents an iterator over all edges that reach
- -- targets starting from a particular source vertex.
+ function Contains_Elaborate_All_Edge
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id) return Boolean;
+ pragma Inline (Contains_Elaborate_All_Edge);
+ -- Determine whether cycle Cycle of library graph G contains an
+ -- Elaborate_All edge.
- type Edges_To_Targets_Iterator is private;
+ function Contains_Static_Successor_Edge
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id) return Boolean;
+ pragma Inline (Contains_Static_Successor_Edge);
+ -- Determine whether cycle Cycle of library graph G contains an edge
+ -- where the successor was compiled using the static model.
- function Has_Next (Iter : Edges_To_Targets_Iterator) return Boolean;
- pragma Inline (Has_Next);
- -- Determine whether iterator Iter has more edges to examine
+ function Contains_Task_Activation
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id) return Boolean;
+ pragma Inline (Contains_Task_Activation);
+ -- Determine whether cycle Cycle of library graph G contains an
+ -- invocation edge where the path it represents involves a task
+ -- activation.
- function Iterate_Edges_To_Targets
- (G : Invocation_Graph;
- Vertex : Invocation_Graph_Vertex_Id) return Edges_To_Targets_Iterator;
- pragma Inline (Iterate_Edges_To_Targets);
- -- Obtain an iterator over all edges to targets with source vertex
- -- Vertex of invocation graph G.
+ function Has_Elaborate_All_Cycle (G : Library_Graph) return Boolean;
+ pragma Inline (Has_Elaborate_All_Cycle);
+ -- Determine whether library graph G contains a cycle involving pragma
+ -- Elaborate_All.
- procedure Next
- (Iter : in out Edges_To_Targets_Iterator;
- Edge : out Invocation_Graph_Edge_Id);
- pragma Inline (Next);
- -- Return the current edge referenced by iterator Iter and advance to
- -- the next available edge.
+ function Has_No_Elaboration_Code
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
+ pragma Inline (Has_No_Elaboration_Code);
+ -- Determine whether vertex Vertex of library graph G represents a unit
+ -- that lacks elaboration code.
- -- The following type represents an iterator over all vertices of an
- -- invocation graph that denote the elaboration procedure or a spec or
- -- a body, referred to as elaboration root.
+ function In_Same_Component
+ (G : Library_Graph;
+ Left : Library_Graph_Vertex_Id;
+ Right : Library_Graph_Vertex_Id) return Boolean;
+ pragma Inline (In_Same_Component);
+ -- Determine whether vertices Left and Right of library graph G reside
+ -- in the same component.
- type Elaboration_Root_Iterator is private;
+ function Is_Body
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
+ pragma Inline (Is_Body);
+ -- Determine whether vertex Vertex of library graph G denotes a body
- function Has_Next (Iter : Elaboration_Root_Iterator) return Boolean;
- pragma Inline (Has_Next);
- -- Determine whether iterator Iter has more elaboration roots to examine
+ function Is_Body_Of_Spec_With_Elaborate_Body
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
+ pragma Inline (Is_Body_Of_Spec_With_Elaborate_Body);
+ -- Determine whether vertex Vertex of library graph G denotes a body
+ -- with a corresponding spec, and the spec has pragma Elaborate_Body.
- function Iterate_Elaboration_Roots
- (G : Invocation_Graph) return Elaboration_Root_Iterator;
- pragma Inline (Iterate_Elaboration_Roots);
- -- Obtain an iterator over all elaboration roots of invocation graph G
-
- procedure Next
- (Iter : in out Elaboration_Root_Iterator;
- Root : out Invocation_Graph_Vertex_Id);
- pragma Inline (Next);
- -- Return the current elaboration root referenced by iterator Iter and
- -- advance to the next available elaboration root.
-
- private
-
- --------------
- -- Vertices --
- --------------
-
- procedure Destroy_Invocation_Graph_Vertex
- (Vertex : in out Invocation_Graph_Vertex_Id);
- pragma Inline (Destroy_Invocation_Graph_Vertex);
- -- Destroy invocation graph vertex Vertex
+ function Is_Body_With_Spec
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
+ pragma Inline (Is_Body_With_Spec);
+ -- Determine whether vertex Vertex of library graph G denotes a body
+ -- with a corresponding spec.
- -- The following type represents the attributes of an invocation graph
- -- vertex.
+ function Is_Dynamically_Elaborated
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
+ pragma Inline (Is_Dynamically_Elaborated);
+ -- Determine whether vertex Vertex of library graph G was compiled
+ -- using the dynamic model.
- type Invocation_Graph_Vertex_Attributes is record
- Body_Vertex : Library_Graph_Vertex_Id := No_Library_Graph_Vertex;
- -- Reference to the library graph vertex where the body of this
- -- vertex resides.
+ function Is_Elaborable_Component
+ (G : Library_Graph;
+ Comp : Component_Id) return Boolean;
+ pragma Inline (Is_Elaborable_Component);
+ -- Determine whether component Comp of library graph G is not waiting on
+ -- any predecessors, and can thus be elaborated.
- Construct : Invocation_Construct_Id := No_Invocation_Construct;
- -- Reference to the invocation construct this vertex represents
+ function Is_Elaborable_Vertex
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
+ pragma Inline (Is_Elaborable_Vertex);
+ -- Determine whether vertex Vertex of library graph G is not waiting on
+ -- any predecessors, and can thus be elaborated.
- Spec_Vertex : Library_Graph_Vertex_Id := No_Library_Graph_Vertex;
- -- Reference to the library graph vertex where the spec of this
- -- vertex resides.
- end record;
+ function Is_Elaborate_All_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean;
+ pragma Inline (Is_Elaborate_All_Edge);
+ -- Determine whether edge Edge of library graph G is an edge whose
+ -- predecessor is subject to pragma Elaborate_All.
- No_Invocation_Graph_Vertex_Attributes :
- constant Invocation_Graph_Vertex_Attributes :=
- (Body_Vertex => No_Library_Graph_Vertex,
- Construct => No_Invocation_Construct,
- Spec_Vertex => No_Library_Graph_Vertex);
+ function Is_Elaborate_Body_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean;
+ pragma Inline (Is_Elaborate_Body_Edge);
+ -- Determine whether edge Edge of library graph G has a successor
+ -- that is either a spec subject to pragma Elaborate_Body, or a body
+ -- that completes such a spec.
- procedure Destroy_Invocation_Graph_Vertex_Attributes
- (Attrs : in out Invocation_Graph_Vertex_Attributes);
- pragma Inline (Destroy_Invocation_Graph_Vertex_Attributes);
- -- Destroy the contents of attributes Attrs
+ function Is_Elaborate_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean;
+ pragma Inline (Is_Elaborate_Edge);
+ -- Determine whether edge Edge of library graph G is an edge whose
+ -- predecessor is subject to pragma Elaborate.
- package IGV_Tables is new Dynamic_Hash_Tables
- (Key_Type => Invocation_Graph_Vertex_Id,
- Value_Type => Invocation_Graph_Vertex_Attributes,
- No_Value => No_Invocation_Graph_Vertex_Attributes,
- Expansion_Threshold => 1.5,
- Expansion_Factor => 2,
- Compression_Threshold => 0.3,
- Compression_Factor => 2,
- "=" => "=",
- Destroy_Value => Destroy_Invocation_Graph_Vertex_Attributes,
- Hash => Hash_Invocation_Graph_Vertex);
+ function Is_Elaborate_Body_Pair
+ (G : Library_Graph;
+ Spec_Vertex : Library_Graph_Vertex_Id;
+ Body_Vertex : Library_Graph_Vertex_Id) return Boolean;
+ pragma Inline (Is_Elaborate_Body_Pair);
+ -- Determine whether vertices Spec_Vertex and Body_Vertex of library
+ -- graph G denote a spec subject to Elaborate_Body and its completing
+ -- body.
- -----------
- -- Edges --
- -----------
+ function Is_Forced_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean;
+ pragma Inline (Is_Forced_Edge);
+ -- Determine whether edge Edge of library graph G is a byproduct of the
+ -- forced-elaboration-order file.
- procedure Destroy_Invocation_Graph_Edge
- (Edge : in out Invocation_Graph_Edge_Id);
- pragma Inline (Destroy_Invocation_Graph_Edge);
- -- Destroy invocation graph edge Edge
+ function Is_Internal_Unit
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
+ pragma Inline (Is_Internal_Unit);
+ -- Determine whether vertex Vertex of library graph G denotes an
+ -- internal unit.
- -- The following type represents the attributes of an invocation graph
- -- edge.
+ function Is_Invocation_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean;
+ pragma Inline (Is_Invocation_Edge);
+ -- Determine whether edge Edge of library graph G came from the
+ -- traversal of the invocation graph.
- type Invocation_Graph_Edge_Attributes is record
- Relation : Invocation_Relation_Id := No_Invocation_Relation;
- -- Reference to the invocation relation this edge represents
- end record;
+ function Is_Predefined_Unit
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
+ pragma Inline (Is_Predefined_Unit);
+ -- Determine whether vertex Vertex of library graph G denotes a
+ -- predefined unit.
- No_Invocation_Graph_Edge_Attributes :
- constant Invocation_Graph_Edge_Attributes :=
- (Relation => No_Invocation_Relation);
+ function Is_Preelaborated_Unit
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
+ pragma Inline (Is_Preelaborated_Unit);
+ -- Determine whether vertex Vertex of library graph G denotes a unit
+ -- subject to pragma Pure or Preelaborable.
- procedure Destroy_Invocation_Graph_Edge_Attributes
- (Attrs : in out Invocation_Graph_Edge_Attributes);
- pragma Inline (Destroy_Invocation_Graph_Edge_Attributes);
- -- Destroy the contents of attributes Attrs
+ function Is_Spec
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
+ pragma Inline (Is_Spec);
+ -- Determine whether vertex Vertex of library graph G denotes a spec
- package IGE_Tables is new Dynamic_Hash_Tables
- (Key_Type => Invocation_Graph_Edge_Id,
- Value_Type => Invocation_Graph_Edge_Attributes,
- No_Value => No_Invocation_Graph_Edge_Attributes,
- Expansion_Threshold => 1.5,
- Expansion_Factor => 2,
- Compression_Threshold => 0.3,
- Compression_Factor => 2,
- "=" => "=",
- Destroy_Value => Destroy_Invocation_Graph_Edge_Attributes,
- Hash => Hash_Invocation_Graph_Edge);
+ function Is_Spec_Before_Body_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean;
+ pragma Inline (Is_Spec_Before_Body_Edge);
+ -- Determine whether edge Edge of library graph G links a predecessor
+ -- spec and a successor body belonging to the same unit.
- ---------------
- -- Relations --
- ---------------
+ function Is_Spec_With_Body
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
+ pragma Inline (Is_Spec_With_Body);
+ -- Determine whether vertex Vertex of library graph G denotes a spec
+ -- with a corresponding body.
- -- The following type represents a relation between a source and target
- -- vertices.
+ function Is_Spec_With_Elaborate_Body
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
+ pragma Inline (Is_Spec_With_Elaborate_Body);
+ -- Determine whether vertex Vertex of library graph G denotes a spec
+ -- with a corresponding body, and is subject to pragma Elaborate_Body.
- type Source_Target_Relation is record
- Source : Invocation_Graph_Vertex_Id := No_Invocation_Graph_Vertex;
- -- The source vertex
+ function Is_Weakly_Elaborable_Vertex
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
+ pragma Inline (Is_Weakly_Elaborable_Vertex);
+ -- Determine whether vertex Vertex of library graph G is waiting on
+ -- weak predecessors only, in which case it can be elaborated assuming
+ -- that the weak edges will not be exercised at elaboration time.
- Target : Invocation_Graph_Vertex_Id := No_Invocation_Graph_Vertex;
- -- The destination vertex
- end record;
+ function Is_With_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean;
+ pragma Inline (Is_With_Edge);
+ -- Determine whether edge Edge of library graph G is the result of a
+ -- with dependency between its successor and predecessor.
- No_Source_Target_Relation :
- constant Source_Target_Relation :=
- (Source => No_Invocation_Graph_Vertex,
- Target => No_Invocation_Graph_Vertex);
+ function Needs_Elaboration
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
+ pragma Inline (Needs_Elaboration);
+ -- Determine whether vertex Vertex of library graph G represents a unit
+ -- that needs to be elaborated.
- function Hash_Source_Target_Relation
- (Rel : Source_Target_Relation) return Bucket_Range_Type;
- pragma Inline (Hash_Source_Target_Relation);
- -- Obtain the hash value of key Rel
+ function Proper_Body
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id;
+ pragma Inline (Proper_Body);
+ -- Obtain the body of vertex Vertex of library graph G
- package Relation_Sets is new Membership_Sets
- (Element_Type => Source_Target_Relation,
- "=" => "=",
- Hash => Hash_Source_Target_Relation);
+ function Proper_Spec
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id;
+ pragma Inline (Proper_Spec);
+ -- Obtain the spec of vertex Vertex of library graph G
----------------
-- Statistics --
----------------
- type Invocation_Graph_Edge_Counts is array (Invocation_Kind) of Natural;
+ function Library_Graph_Edge_Count
+ (G : Library_Graph;
+ Kind : Library_Graph_Edge_Kind) return Natural;
+ pragma Inline (Library_Graph_Edge_Count);
+ -- Obtain the total number of edges of kind Kind in library graph G
- ----------------
- -- Signatures --
- ----------------
+ function Number_Of_Component_Vertices
+ (G : Library_Graph;
+ Comp : Component_Id) return Natural;
+ pragma Inline (Number_Of_Component_Vertices);
+ -- Obtain the total number of vertices component Comp of library graph
+ -- contains.
- function Hash_Invocation_Signature
- (IS_Id : Invocation_Signature_Id) return Bucket_Range_Type;
- pragma Inline (Hash_Invocation_Signature);
- -- Obtain the hash value of key IS_Id
+ function Number_Of_Components (G : Library_Graph) return Natural;
+ pragma Inline (Number_Of_Components);
+ -- Obtain the total number of components in library graph G
- package Signature_Tables is new Dynamic_Hash_Tables
- (Key_Type => Invocation_Signature_Id,
- Value_Type => Invocation_Graph_Vertex_Id,
- No_Value => No_Invocation_Graph_Vertex,
- Expansion_Threshold => 1.5,
- Expansion_Factor => 2,
- Compression_Threshold => 0.3,
- Compression_Factor => 2,
- "=" => "=",
- Destroy_Value => Destroy_Invocation_Graph_Vertex,
- Hash => Hash_Invocation_Signature);
+ function Number_Of_Cycles (G : Library_Graph) return Natural;
+ pragma Inline (Number_Of_Cycles);
+ -- Obtain the total number of cycles in library graph G
- -----------------------
- -- Elaboration roots --
- -----------------------
+ function Number_Of_Edges (G : Library_Graph) return Natural;
+ pragma Inline (Number_Of_Edges);
+ -- Obtain the total number of edges in library graph G
- package IGV_Sets is new Membership_Sets
- (Element_Type => Invocation_Graph_Vertex_Id,
- "=" => "=",
- Hash => Hash_Invocation_Graph_Vertex);
+ function Number_Of_Edges_To_Successors
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Natural;
+ pragma Inline (Number_Of_Edges_To_Successors);
+ -- Obtain the total number of edges to successors vertex Vertex of
+ -- library graph G has.
- -----------
- -- Graph --
- -----------
+ function Number_Of_Vertices (G : Library_Graph) return Natural;
+ pragma Inline (Number_Of_Vertices);
+ -- Obtain the total number of vertices in library graph G
- package DG is new Directed_Graphs
- (Vertex_Id => Invocation_Graph_Vertex_Id,
- No_Vertex => No_Invocation_Graph_Vertex,
- Hash_Vertex => Hash_Invocation_Graph_Vertex,
- Same_Vertex => "=",
- Edge_id => Invocation_Graph_Edge_Id,
- No_Edge => No_Invocation_Graph_Edge,
- Hash_Edge => Hash_Invocation_Graph_Edge,
- Same_Edge => "=");
+ ---------------
+ -- Iterators --
+ ---------------
- -- The following type represents the attributes of an invocation graph
+ -- The following type represents an iterator over all cycles of a
+ -- library graph.
- type Invocation_Graph_Attributes is record
- Counts : Invocation_Graph_Edge_Counts := (others => 0);
- -- Edge statistics
+ type All_Cycle_Iterator is private;
- Edge_Attributes : IGE_Tables.Dynamic_Hash_Table := IGE_Tables.Nil;
- -- The map of edge -> edge attributes for all edges in the graph
+ function Has_Next (Iter : All_Cycle_Iterator) return Boolean;
+ pragma Inline (Has_Next);
+ -- Determine whether iterator Iter has more cycles to examine
- Graph : DG.Directed_Graph := DG.Nil;
- -- The underlying graph describing the relations between edges and
- -- vertices.
+ function Iterate_All_Cycles
+ (G : Library_Graph) return All_Cycle_Iterator;
+ pragma Inline (Iterate_All_Cycles);
+ -- Obtain an iterator over all cycles of library graph G
- Relations : Relation_Sets.Membership_Set := Relation_Sets.Nil;
- -- The set of relations between source and targets, used to prevent
- -- duplicate edges in the graph.
+ procedure Next
+ (Iter : in out All_Cycle_Iterator;
+ Cycle : out Library_Graph_Cycle_Id);
+ pragma Inline (Next);
+ -- Return the current cycle referenced by iterator Iter and advance to
+ -- the next available cycle.
- Roots : IGV_Sets.Membership_Set := IGV_Sets.Nil;
- -- The set of elaboration root vertices
+ -- The following type represents an iterator over all edges of a library
+ -- graph.
- Signature_To_Vertex : Signature_Tables.Dynamic_Hash_Table :=
- Signature_Tables.Nil;
- -- The map of signature -> vertex
+ type All_Edge_Iterator is private;
- Vertex_Attributes : IGV_Tables.Dynamic_Hash_Table := IGV_Tables.Nil;
- -- The map of vertex -> vertex attributes for all vertices in the
- -- graph.
- end record;
+ function Has_Next (Iter : All_Edge_Iterator) return Boolean;
+ pragma Inline (Has_Next);
+ -- Determine whether iterator Iter has more edges to examine
- type Invocation_Graph is access Invocation_Graph_Attributes;
- Nil : constant Invocation_Graph := null;
+ function Iterate_All_Edges (G : Library_Graph) return All_Edge_Iterator;
+ pragma Inline (Iterate_All_Edges);
+ -- Obtain an iterator over all edges of library graph G
- ---------------
- -- Iterators --
- ---------------
+ procedure Next
+ (Iter : in out All_Edge_Iterator;
+ Edge : out Library_Graph_Edge_Id);
+ pragma Inline (Next);
+ -- Return the current edge referenced by iterator Iter and advance to
+ -- the next available edge.
- type All_Edge_Iterator is new DG.All_Edge_Iterator;
- type All_Vertex_Iterator is new DG.All_Vertex_Iterator;
- type Edges_To_Targets_Iterator is new DG.Outgoing_Edge_Iterator;
- type Elaboration_Root_Iterator is new IGV_Sets.Iterator;
- end Invocation_Graphs;
+ -- The following type represents an iterator over all vertices of a
+ -- library graph.
- --------------------
- -- Library_Graphs --
- --------------------
+ type All_Vertex_Iterator is private;
- package Library_Graphs is
+ function Has_Next (Iter : All_Vertex_Iterator) return Boolean;
+ pragma Inline (Has_Next);
+ -- Determine whether iterator Iter has more vertices to examine
- -- The following type represents the various kinds of library graph
- -- cycles. The ordering of kinds is significant, where a literal with
- -- lower ordinal has a higher precedence than one with higher ordinal.
+ function Iterate_All_Vertices
+ (G : Library_Graph) return All_Vertex_Iterator;
+ pragma Inline (Iterate_All_Vertices);
+ -- Obtain an iterator over all vertices of library graph G
- type Library_Graph_Cycle_Kind is
- (Elaborate_Body_Cycle,
- -- A cycle that involves at least one spec-body pair, where the
- -- spec is subject to pragma Elaborate_Body. This is the highest
- -- precedence cycle.
+ procedure Next
+ (Iter : in out All_Vertex_Iterator;
+ Vertex : out Library_Graph_Vertex_Id);
+ pragma Inline (Next);
+ -- Return the current vertex referenced by iterator Iter and advance
+ -- to the next available vertex.
- Elaborate_Cycle,
- -- A cycle that involves at least one Elaborate edge
+ -- The following type represents an iterator over all components of a
+ -- library graph.
- Elaborate_All_Cycle,
- -- A cycle that involves at least one Elaborate_All edge
+ type Component_Iterator is private;
- Forced_Cycle,
- -- A cycle that involves at least one edge which is a byproduct of
- -- the forced-elaboration-order file.
+ function Has_Next (Iter : Component_Iterator) return Boolean;
+ pragma Inline (Has_Next);
+ -- Determine whether iterator Iter has more components to examine
- Invocation_Cycle,
- -- A cycle that involves at least one invocation edge. This is the
- -- lowest precedence cycle.
+ function Iterate_Components
+ (G : Library_Graph) return Component_Iterator;
+ pragma Inline (Iterate_Components);
+ -- Obtain an iterator over all components of library graph G
- No_Cycle_Kind);
+ procedure Next
+ (Iter : in out Component_Iterator;
+ Comp : out Component_Id);
+ pragma Inline (Next);
+ -- Return the current component referenced by iterator Iter and advance
+ -- to the next available component.
- -- The following type represents the various kinds of library edges. The
- -- order is important here, and corresponds to the order in which edges
- -- are added to the graph. See Add_Edge_Kind_Check for details. If
- -- changes are made such that new edge kinds are added or similar, we
- -- need to make sure this type matches the code in Add_Edge_Kind_Check,
- -- and Add_Edge_Kind_Check matches the order of edge adding. Likewise,
- -- if the edge-adding order changes, we need consistency between this
- -- enumeration type, the edge-adding order, and Add_Edge_Kind_Check.
+ -- The following type represents an iterator over all vertices of a
+ -- component.
- type Library_Graph_Edge_Kind is
- (Spec_Before_Body_Edge,
- -- Successor denotes a body, Predecessor denotes a spec
+ type Component_Vertex_Iterator is private;
- Elaborate_Edge,
- -- Successor withs Predecessor, and has pragma Elaborate for it
+ function Has_Next (Iter : Component_Vertex_Iterator) return Boolean;
+ pragma Inline (Has_Next);
+ -- Determine whether iterator Iter has more vertices to examine
- Elaborate_All_Edge,
- -- Successor withs Predecessor, and has pragma Elaborate_All for it
+ function Iterate_Component_Vertices
+ (G : Library_Graph;
+ Comp : Component_Id) return Component_Vertex_Iterator;
+ pragma Inline (Iterate_Component_Vertices);
+ -- Obtain an iterator over all vertices of component Comp of library
+ -- graph G.
- With_Edge,
- -- Successor withs Predecessor
+ procedure Next
+ (Iter : in out Component_Vertex_Iterator;
+ Vertex : out Library_Graph_Vertex_Id);
+ pragma Inline (Next);
+ -- Return the current vertex referenced by iterator Iter and advance
+ -- to the next available vertex.
- Forced_Edge,
- -- Successor is forced to with Predecessor by virtue of an existing
- -- elaboration order provided in a file.
+ -- The following type represents an iterator over all edges that form a
+ -- cycle.
- Invocation_Edge,
- -- An invocation construct in unit Successor invokes a target in unit
- -- Predecessor.
+ type Edges_Of_Cycle_Iterator is private;
- Body_Before_Spec_Edge,
- -- Successor denotes spec, Predecessor denotes a body. This is a
- -- special edge kind used only during the discovery of components.
- -- Note that a body can never be elaborated before its spec.
+ function Has_Next (Iter : Edges_Of_Cycle_Iterator) return Boolean;
+ pragma Inline (Has_Next);
+ -- Determine whether iterator Iter has more edges to examine
- No_Edge);
+ function Iterate_Edges_Of_Cycle
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id) return Edges_Of_Cycle_Iterator;
+ pragma Inline (Iterate_Edges_Of_Cycle);
+ -- Obtain an iterator over all edges that form cycle Cycle of library
+ -- graph G.
- -----------
- -- Graph --
- -----------
+ procedure Next
+ (Iter : in out Edges_Of_Cycle_Iterator;
+ Edge : out Library_Graph_Edge_Id);
+ pragma Inline (Next);
+ -- Return the current edge referenced by iterator Iter and advance to
+ -- the next available edge.
- -- The following type denotes a library graph handle. Each instance must
- -- be created using routine Create.
+ -- The following type represents an iterator over all edges that reach
+ -- successors starting from a particular predecessor vertex.
- type Library_Graph is private;
- Nil : constant Library_Graph;
+ type Edges_To_Successors_Iterator is private;
- type LGE_Predicate_Ptr is access function
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean;
+ function Has_Next (Iter : Edges_To_Successors_Iterator) return Boolean;
+ pragma Inline (Has_Next);
+ -- Determine whether iterator Iter has more edges to examine
- type LGV_Comparator_Ptr is access function
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id;
- Compared_To : Library_Graph_Vertex_Id) return Precedence_Kind;
-
- type LGV_Predicate_Ptr is access function
+ function Iterate_Edges_To_Successors
(G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean;
+ Vertex : Library_Graph_Vertex_Id) return Edges_To_Successors_Iterator;
+ pragma Inline (Iterate_Edges_To_Successors);
+ -- Obtain an iterator over all edges to successors with predecessor
+ -- vertex Vertex of library graph G.
- ----------------------
- -- Graph operations --
- ----------------------
+ procedure Next
+ (Iter : in out Edges_To_Successors_Iterator;
+ Edge : out Library_Graph_Edge_Id);
+ pragma Inline (Next);
+ -- Return the current edge referenced by iterator Iter and advance to
+ -- the next available edge.
- procedure Add_Edge
- (G : Library_Graph;
- Pred : Library_Graph_Vertex_Id;
- Succ : Library_Graph_Vertex_Id;
- Kind : Library_Graph_Edge_Kind;
- Activates_Task : Boolean);
- pragma Inline (Add_Edge);
- -- Create a new edge in library graph G with source vertex Pred and
- -- destination vertex Succ. Kind denotes the nature of the edge. Flag
- -- Activates_Task should be set when the edge involves task activation.
+ private
- procedure Add_Vertex
- (G : Library_Graph;
- U_Id : Unit_Id);
- pragma Inline (Add_Vertex);
- -- Create a new vertex in library graph G. U_Id is the unit the vertex
- -- describes.
+ --------------
+ -- Vertices --
+ --------------
- function Create
- (Initial_Vertices : Positive;
- Initial_Edges : Positive) return Library_Graph;
- pragma Inline (Create);
- -- Create a new empty graph with vertex capacity Initial_Vertices and
- -- edge capacity Initial_Edges.
+ -- The following type represents the attributes of a library graph
+ -- vertex.
- procedure Destroy (G : in out Library_Graph);
- pragma Inline (Destroy);
- -- Destroy the contents of library graph G, rendering it unusable
+ type Library_Graph_Vertex_Attributes is record
+ Corresponding_Item : Library_Graph_Vertex_Id :=
+ No_Library_Graph_Vertex;
+ -- The reference to the corresponding spec or body. This attribute is
+ -- set as follows:
+ --
+ -- * If predicate Is_Body_With_Spec is True, the reference denotes
+ -- the corresponding spec.
+ --
+ -- * If predicate Is_Spec_With_Body is True, the reference denotes
+ -- the corresponding body.
+ --
+ -- * Otherwise the attribute remains empty.
- procedure Find_Components (G : Library_Graph);
- pragma Inline (Find_Components);
- -- Find all components in library graph G
+ In_Elaboration_Order : Boolean := False;
+ -- Set when this vertex is elaborated
- procedure Find_Cycles (G : Library_Graph);
- pragma Inline (Find_Cycles);
- -- Find all cycles in library graph G
+ Pending_Strong_Predecessors : Natural := 0;
+ -- The number of pending strong predecessor vertices this vertex must
+ -- wait on before it can be elaborated.
- function Highest_Precedence_Cycle
- (G : Library_Graph) return Library_Graph_Cycle_Id;
- pragma Inline (Highest_Precedence_Cycle);
- -- Obtain the cycle with highest precedence among all other cycles of
- -- library graph G.
+ Pending_Weak_Predecessors : Natural := 0;
+ -- The number of weak predecessor vertices this vertex must wait on
+ -- before it can be elaborated.
- function Present (G : Library_Graph) return Boolean;
- pragma Inline (Present);
- -- Determine whether library graph G exists
+ Unit : Unit_Id := No_Unit_Id;
+ -- The reference to unit this vertex represents
+ end record;
- -----------------------
- -- Vertex attributes --
- -----------------------
+ No_Library_Graph_Vertex_Attributes :
+ constant Library_Graph_Vertex_Attributes :=
+ (Corresponding_Item => No_Library_Graph_Vertex,
+ In_Elaboration_Order => False,
+ Pending_Strong_Predecessors => 0,
+ Pending_Weak_Predecessors => 0,
+ Unit => No_Unit_Id);
- function Component
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Component_Id;
- pragma Inline (Component);
- -- Obtain the component where vertex Vertex of library graph G resides
+ procedure Destroy_Library_Graph_Vertex_Attributes
+ (Attrs : in out Library_Graph_Vertex_Attributes);
+ pragma Inline (Destroy_Library_Graph_Vertex_Attributes);
+ -- Destroy the contents of attributes Attrs
- function Corresponding_Item
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id;
- pragma Inline (Corresponding_Item);
- -- Obtain the complementary vertex which represents the corresponding
- -- spec or body of vertex Vertex of library graph G.
+ package LGV_Tables is new Dynamic_Hash_Tables
+ (Key_Type => Library_Graph_Vertex_Id,
+ Value_Type => Library_Graph_Vertex_Attributes,
+ No_Value => No_Library_Graph_Vertex_Attributes,
+ Expansion_Threshold => 1.5,
+ Expansion_Factor => 2,
+ Compression_Threshold => 0.3,
+ Compression_Factor => 2,
+ "=" => "=",
+ Destroy_Value => Destroy_Library_Graph_Vertex_Attributes,
+ Hash => Hash_Library_Graph_Vertex);
- function Corresponding_Vertex
- (G : Library_Graph;
- U_Id : Unit_Id) return Library_Graph_Vertex_Id;
- pragma Inline (Corresponding_Vertex);
- -- Obtain the corresponding vertex of library graph G which represents
- -- unit U_Id.
+ -----------
+ -- Edges --
+ -----------
- procedure Decrement_Pending_Predecessors
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id;
- Edge : Library_Graph_Edge_Id);
- pragma Inline (Decrement_Pending_Predecessors);
- -- Decrease the number of pending predecessors vertex Vertex which was
- -- reached via edge Edge of library graph G must wait until it can be
- -- elaborated.
+ -- The following type represents the attributes of a library graph edge
- function File_Name
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return File_Name_Type;
- pragma Inline (File_Name);
- -- Obtain the name of the file where vertex Vertex of library graph G
- -- resides.
+ type Library_Graph_Edge_Attributes is record
+ Activates_Task : Boolean := False;
+ -- Set for an invocation edge, where at least one of the paths the
+ -- edge represents activates a task.
- function In_Elaboration_Order
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean;
- pragma Inline (In_Elaboration_Order);
- -- Determine whether vertex Vertex of library graph G is already in some
- -- elaboration order.
+ Kind : Library_Graph_Edge_Kind := No_Edge;
+ -- The nature of the library graph edge
+ end record;
- function Invocation_Graph_Encoding
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id)
- return Invocation_Graph_Encoding_Kind;
- pragma Inline (Invocation_Graph_Encoding);
- -- Obtain the encoding format used to capture information related to
- -- invocation vertices and edges that reside within vertex Vertex of
- -- library graph G.
+ No_Library_Graph_Edge_Attributes :
+ constant Library_Graph_Edge_Attributes :=
+ (Activates_Task => False,
+ Kind => No_Edge);
- function Name
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Unit_Name_Type;
- pragma Inline (Name);
- -- Obtain the name of the unit which vertex Vertex of library graph G
- -- represents.
+ procedure Destroy_Library_Graph_Edge_Attributes
+ (Attrs : in out Library_Graph_Edge_Attributes);
+ pragma Inline (Destroy_Library_Graph_Edge_Attributes);
+ -- Destroy the contents of attributes Attrs
- procedure Pending_Predecessors_For_Elaboration
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id;
- Strong_Preds : out Natural;
- Weak_Preds : out Natural);
- pragma Inline (Pending_Predecessors_For_Elaboration);
- -- Obtain the number of pending strong and weak predecessors of vertex
- -- Vertex of library graph G, taking into account Elaborate_Body pairs.
- -- Strong predecessors are returned in Strong_Preds. Weak predecessors
- -- are returned in Weak_Preds.
+ package LGE_Tables is new Dynamic_Hash_Tables
+ (Key_Type => Library_Graph_Edge_Id,
+ Value_Type => Library_Graph_Edge_Attributes,
+ No_Value => No_Library_Graph_Edge_Attributes,
+ Expansion_Threshold => 1.5,
+ Expansion_Factor => 2,
+ Compression_Threshold => 0.3,
+ Compression_Factor => 2,
+ "=" => "=",
+ Destroy_Value => Destroy_Library_Graph_Edge_Attributes,
+ Hash => Hash_Library_Graph_Edge);
- function Pending_Strong_Predecessors
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Natural;
- pragma Inline (Pending_Strong_Predecessors);
- -- Obtain the number of pending strong predecessors vertex Vertex of
- -- library graph G must wait on until it can be elaborated.
+ ----------------
+ -- Components --
+ ----------------
- function Pending_Weak_Predecessors
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Natural;
- pragma Inline (Pending_Weak_Predecessors);
- -- Obtain the number of pending weak predecessors vertex Vertex of
- -- library graph G must wait on until it can be elaborated.
+ -- The following type represents the attributes of a component
- procedure Set_Corresponding_Item
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id;
- Val : Library_Graph_Vertex_Id);
- pragma Inline (Set_Corresponding_Item);
- -- Set the complementary vertex which represents the corresponding
- -- spec or body of vertex Vertex of library graph G to value Val.
+ type Component_Attributes is record
+ Pending_Strong_Predecessors : Natural := 0;
+ -- The number of pending strong predecessor components this component
+ -- must wait on before it can be elaborated.
- procedure Set_In_Elaboration_Order
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id;
- Val : Boolean := True);
- pragma Inline (Set_In_Elaboration_Order);
- -- Mark vertex Vertex of library graph G as included in some elaboration
- -- order depending on value Val.
+ Pending_Weak_Predecessors : Natural := 0;
+ -- The number of pending weak predecessor components this component
+ -- must wait on before it can be elaborated.
+ end record;
- function Unit
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Unit_Id;
- pragma Inline (Unit);
- -- Obtain the unit vertex Vertex of library graph G represents
+ No_Component_Attributes : constant Component_Attributes :=
+ (Pending_Strong_Predecessors => 0,
+ Pending_Weak_Predecessors => 0);
- ---------------------
- -- Edge attributes --
- ---------------------
+ procedure Destroy_Component_Attributes
+ (Attrs : in out Component_Attributes);
+ pragma Inline (Destroy_Component_Attributes);
+ -- Destroy the contents of attributes Attrs
- function Activates_Task
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean;
- pragma Inline (Activates_Task);
- -- Determine whether edge Edge of library graph G activates a task
+ package Component_Tables is new Dynamic_Hash_Tables
+ (Key_Type => Component_Id,
+ Value_Type => Component_Attributes,
+ No_Value => No_Component_Attributes,
+ Expansion_Threshold => 1.5,
+ Expansion_Factor => 2,
+ Compression_Threshold => 0.3,
+ Compression_Factor => 2,
+ "=" => "=",
+ Destroy_Value => Destroy_Component_Attributes,
+ Hash => Hash_Component);
- function Kind
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Library_Graph_Edge_Kind;
- pragma Inline (Kind);
- -- Obtain the nature of edge Edge of library graph G
+ ------------
+ -- Cycles --
+ ------------
- function Predecessor
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id;
- pragma Inline (Predecessor);
- -- Obtain the predecessor vertex of edge Edge of library graph G
+ -- The following type represents the attributes of a cycle
- function Successor
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id;
- pragma Inline (Successor);
- -- Obtain the successor vertex of edge Edge of library graph G
+ type Library_Graph_Cycle_Attributes is record
+ Invocation_Edge_Count : Natural := 0;
+ -- The number of invocation edges within the cycle
- --------------------------
- -- Component attributes --
- --------------------------
+ Kind : Library_Graph_Cycle_Kind := No_Cycle_Kind;
+ -- The nature of the cycle
- procedure Decrement_Pending_Predecessors
- (G : Library_Graph;
- Comp : Component_Id;
- Edge : Library_Graph_Edge_Id);
- pragma Inline (Decrement_Pending_Predecessors);
- -- Decrease the number of pending predecessors component Comp which was
- -- reached via edge Edge of library graph G must wait on until it can be
- -- elaborated.
+ Path : LGE_Lists.Doubly_Linked_List := LGE_Lists.Nil;
+ -- The path of edges that form the cycle
+ end record;
- function Pending_Strong_Predecessors
- (G : Library_Graph;
- Comp : Component_Id) return Natural;
- pragma Inline (Pending_Strong_Predecessors);
- -- Obtain the number of pending strong predecessors component Comp of
- -- library graph G must wait on until it can be elaborated.
+ No_Library_Graph_Cycle_Attributes :
+ constant Library_Graph_Cycle_Attributes :=
+ (Invocation_Edge_Count => 0,
+ Kind => No_Cycle_Kind,
+ Path => LGE_Lists.Nil);
- function Pending_Weak_Predecessors
- (G : Library_Graph;
- Comp : Component_Id) return Natural;
- pragma Inline (Pending_Weak_Predecessors);
- -- Obtain the number of pending weak predecessors component Comp of
- -- library graph G must wait on until it can be elaborated.
+ procedure Destroy_Library_Graph_Cycle_Attributes
+ (Attrs : in out Library_Graph_Cycle_Attributes);
+ pragma Inline (Destroy_Library_Graph_Cycle_Attributes);
+ -- Destroy the contents of attributes Attrs
- ----------------------
- -- Cycle attributes --
- ----------------------
+ function Hash_Library_Graph_Cycle_Attributes
+ (Attrs : Library_Graph_Cycle_Attributes) return Bucket_Range_Type;
+ pragma Inline (Hash_Library_Graph_Cycle_Attributes);
+ -- Obtain the hash of key Attrs
- function Invocation_Edge_Count
- (G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id) return Natural;
- pragma Inline (Invocation_Edge_Count);
- -- Obtain the number of invocation edges in cycle Cycle of library
- -- graph G.
+ function Same_Library_Graph_Cycle_Attributes
+ (Left : Library_Graph_Cycle_Attributes;
+ Right : Library_Graph_Cycle_Attributes) return Boolean;
+ pragma Inline (Same_Library_Graph_Cycle_Attributes);
+ -- Determine whether cycle attributes Left and Right are the same
- function Kind
- (G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Kind;
- pragma Inline (Kind);
- -- Obtain the nature of cycle Cycle of library graph G
+ package LGC_Tables is new Dynamic_Hash_Tables
+ (Key_Type => Library_Graph_Cycle_Id,
+ Value_Type => Library_Graph_Cycle_Attributes,
+ No_Value => No_Library_Graph_Cycle_Attributes,
+ Expansion_Threshold => 1.5,
+ Expansion_Factor => 2,
+ Compression_Threshold => 0.3,
+ Compression_Factor => 2,
+ "=" => "=",
+ Destroy_Value => Destroy_Library_Graph_Cycle_Attributes,
+ Hash => Hash_Library_Graph_Cycle);
- function Length
- (G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id) return Natural;
- pragma Inline (Length);
- -- Obtain the length of cycle Cycle of library graph G
+ --------------------
+ -- Recorded edges --
+ --------------------
- ---------------
- -- Semantics --
- ---------------
+ -- The following type represents a relation between a predecessor and
+ -- successor vertices.
- function Complementary_Vertex
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id;
- Force_Complement : Boolean) return Library_Graph_Vertex_Id;
- pragma Inline (Complementary_Vertex);
- -- Obtain the complementary vertex of vertex Vertex of library graph G
- -- as follows:
- --
- -- * If Vertex is the spec of an Elaborate_Body pair, return the body
- -- * If Vertex is the body of an Elaborate_Body pair, return the spec
- --
- -- This behavior can be forced by setting flag Force_Complement to True.
+ type Predecessor_Successor_Relation is record
+ Predecessor : Library_Graph_Vertex_Id := No_Library_Graph_Vertex;
+ -- The source vertex
- function Contains_Elaborate_All_Edge
- (G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id) return Boolean;
- pragma Inline (Contains_Elaborate_All_Edge);
- -- Determine whether cycle Cycle of library graph G contains an
- -- Elaborate_All edge.
+ Successor : Library_Graph_Vertex_Id := No_Library_Graph_Vertex;
+ -- The destination vertex
+ end record;
- function Contains_Static_Successor_Edge
- (G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id) return Boolean;
- pragma Inline (Contains_Static_Successor_Edge);
- -- Determine whether cycle Cycle of library graph G contains an edge
- -- where the successor was compiled using the static model.
+ No_Predecessor_Successor_Relation :
+ constant Predecessor_Successor_Relation :=
+ (Predecessor => No_Library_Graph_Vertex,
+ Successor => No_Library_Graph_Vertex);
- function Contains_Task_Activation
- (G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id) return Boolean;
- pragma Inline (Contains_Task_Activation);
- -- Determine whether cycle Cycle of library graph G contains an
- -- invocation edge where the path it represents involves a task
- -- activation.
+ function Hash_Predecessor_Successor_Relation
+ (Rel : Predecessor_Successor_Relation) return Bucket_Range_Type;
+ pragma Inline (Hash_Predecessor_Successor_Relation);
+ -- Obtain the hash value of key Rel
- function Has_Elaborate_All_Cycle (G : Library_Graph) return Boolean;
- pragma Inline (Has_Elaborate_All_Cycle);
- -- Determine whether library graph G contains a cycle involving pragma
- -- Elaborate_All.
+ package RE_Sets is new Membership_Sets
+ (Element_Type => Predecessor_Successor_Relation,
+ "=" => "=",
+ Hash => Hash_Predecessor_Successor_Relation);
- function Has_No_Elaboration_Code
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean;
- pragma Inline (Has_No_Elaboration_Code);
- -- Determine whether vertex Vertex of library graph G represents a unit
- -- that lacks elaboration code.
+ ----------------
+ -- Statistics --
+ ----------------
- function In_Same_Component
- (G : Library_Graph;
- Left : Library_Graph_Vertex_Id;
- Right : Library_Graph_Vertex_Id) return Boolean;
- pragma Inline (In_Same_Component);
- -- Determine whether vertices Left and Right of library graph G reside
- -- in the same component.
+ type Library_Graph_Edge_Counts is
+ array (Library_Graph_Edge_Kind) of Natural;
- function Is_Body
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean;
- pragma Inline (Is_Body);
- -- Determine whether vertex Vertex of library graph G denotes a body
+ -----------
+ -- Units --
+ -----------
- function Is_Body_Of_Spec_With_Elaborate_Body
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean;
- pragma Inline (Is_Body_Of_Spec_With_Elaborate_Body);
- -- Determine whether vertex Vertex of library graph G denotes a body
- -- with a corresponding spec, and the spec has pragma Elaborate_Body.
+ package Unit_Tables is new Dynamic_Hash_Tables
+ (Key_Type => Unit_Id,
+ Value_Type => Library_Graph_Vertex_Id,
+ No_Value => No_Library_Graph_Vertex,
+ Expansion_Threshold => 1.5,
+ Expansion_Factor => 2,
+ Compression_Threshold => 0.3,
+ Compression_Factor => 2,
+ "=" => "=",
+ Destroy_Value => Destroy_Library_Graph_Vertex,
+ Hash => Hash_Unit);
- function Is_Body_With_Spec
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean;
- pragma Inline (Is_Body_With_Spec);
- -- Determine whether vertex Vertex of library graph G denotes a body
- -- with a corresponding spec.
+ -----------
+ -- Graph --
+ -----------
- function Is_Dynamically_Elaborated
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean;
- pragma Inline (Is_Dynamically_Elaborated);
- -- Determine whether vertex Vertex of library graph G was compiled
- -- using the dynamic model.
+ package DG is new Directed_Graphs
+ (Vertex_Id => Library_Graph_Vertex_Id,
+ No_Vertex => No_Library_Graph_Vertex,
+ Hash_Vertex => Hash_Library_Graph_Vertex,
+ Same_Vertex => "=",
+ Edge_Id => Library_Graph_Edge_Id,
+ No_Edge => No_Library_Graph_Edge,
+ Hash_Edge => Hash_Library_Graph_Edge,
+ Same_Edge => "=");
- function Is_Elaborable_Component
- (G : Library_Graph;
- Comp : Component_Id) return Boolean;
- pragma Inline (Is_Elaborable_Component);
- -- Determine whether component Comp of library graph G is not waiting on
- -- any predecessors, and can thus be elaborated.
+ -- The following type represents the attributes of a library graph
+
+ type Library_Graph_Attributes is record
+ Component_Attributes : Component_Tables.Dynamic_Hash_Table :=
+ Component_Tables.Nil;
+ -- The map of component -> component attributes for all components in
+ -- the graph.
+
+ Counts : Library_Graph_Edge_Counts := (others => 0);
+ -- Edge statistics
+
+ Cycle_Attributes : LGC_Tables.Dynamic_Hash_Table := LGC_Tables.Nil;
+ -- The map of cycle -> cycle attributes for all cycles in the graph
+
+ Cycles : LGC_Lists.Doubly_Linked_List := LGC_Lists.Nil;
+ -- The list of all cycles in the graph, sorted based on precedence
+
+ Edge_Attributes : LGE_Tables.Dynamic_Hash_Table := LGE_Tables.Nil;
+ -- The map of edge -> edge attributes for all edges in the graph
+
+ Graph : DG.Directed_Graph := DG.Nil;
+ -- The underlying graph describing the relations between edges and
+ -- vertices.
+
+ Recorded_Edges : RE_Sets.Membership_Set := RE_Sets.Nil;
+ -- The set of recorded edges, used to prevent duplicate edges in the
+ -- graph.
+
+ Unit_To_Vertex : Unit_Tables.Dynamic_Hash_Table := Unit_Tables.Nil;
+ -- The map of unit -> vertex
+
+ Vertex_Attributes : LGV_Tables.Dynamic_Hash_Table := LGV_Tables.Nil;
+ -- The map of vertex -> vertex attributes for all vertices in the
+ -- graph.
+ end record;
+
+ type Library_Graph is access Library_Graph_Attributes;
+ Nil : constant Library_Graph := null;
+
+ ---------------
+ -- Iterators --
+ ---------------
+
+ type All_Cycle_Iterator is new LGC_Lists.Iterator;
+ type All_Edge_Iterator is new DG.All_Edge_Iterator;
+ type All_Vertex_Iterator is new DG.All_Vertex_Iterator;
+ type Component_Iterator is new DG.Component_Iterator;
+ type Component_Vertex_Iterator is new DG.Component_Vertex_Iterator;
+ type Edges_Of_Cycle_Iterator is new LGE_Lists.Iterator;
+ type Edges_To_Successors_Iterator is new DG.Outgoing_Edge_Iterator;
+ end Library_Graphs;
+
+ -----------------------
+ -- Invocation_Graphs --
+ -----------------------
+
+ package Invocation_Graphs is
+
+ -----------
+ -- Graph --
+ -----------
+
+ -- The following type denotes an invocation graph handle. Each instance
+ -- must be created using routine Create.
- function Is_Elaborable_Vertex
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean;
- pragma Inline (Is_Elaborable_Vertex);
- -- Determine whether vertex Vertex of library graph G is not waiting on
- -- any predecessors, and can thus be elaborated.
+ type Invocation_Graph is private;
+ Nil : constant Invocation_Graph;
- function Is_Elaborate_All_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean;
- pragma Inline (Is_Elaborate_All_Edge);
- -- Determine whether edge Edge of library graph G is an edge whose
- -- predecessor is subject to pragma Elaborate_All.
+ ----------------------
+ -- Graph operations --
+ ----------------------
- function Is_Elaborate_Body_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean;
- pragma Inline (Is_Elaborate_Body_Edge);
- -- Determine whether edge Edge of library graph G has a successor
- -- that is either a spec subject to pragma Elaborate_Body, or a body
- -- that completes such a spec.
+ procedure Add_Edge
+ (G : Invocation_Graph;
+ Source : Invocation_Graph_Vertex_Id;
+ Target : Invocation_Graph_Vertex_Id;
+ IR_Id : Invocation_Relation_Id);
+ pragma Inline (Add_Edge);
+ -- Create a new edge in invocation graph G with source vertex Source and
+ -- destination vertex Target. IR_Id is the invocation relation the edge
+ -- describes.
- function Is_Elaborate_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean;
- pragma Inline (Is_Elaborate_Edge);
- -- Determine whether edge Edge of library graph G is an edge whose
- -- predecessor is subject to pragma Elaborate.
+ procedure Add_Vertex
+ (G : Invocation_Graph;
+ IC_Id : Invocation_Construct_Id;
+ Body_Vertex : Library_Graph_Vertex_Id;
+ Spec_Vertex : Library_Graph_Vertex_Id);
+ pragma Inline (Add_Vertex);
+ -- Create a new vertex in invocation graph G. IC_Id is the invocation
+ -- construct the vertex describes. Body_Vertex denotes the library graph
+ -- vertex where the invocation construct's body is declared. Spec_Vertex
+ -- is the library graph vertex where the invocation construct's spec is
+ -- declared.
- function Is_Elaborate_Body_Pair
- (G : Library_Graph;
- Spec_Vertex : Library_Graph_Vertex_Id;
- Body_Vertex : Library_Graph_Vertex_Id) return Boolean;
- pragma Inline (Is_Elaborate_Body_Pair);
- -- Determine whether vertices Spec_Vertex and Body_Vertex of library
- -- graph G denote a spec subject to Elaborate_Body and its completing
- -- body.
+ function Create
+ (Initial_Vertices : Positive;
+ Initial_Edges : Positive;
+ Lib_Graph : Library_Graphs.Library_Graph)
+ return Invocation_Graph;
+ pragma Inline (Create);
+ -- Create a new empty graph with vertex capacity Initial_Vertices
+ -- and edge capacity Initial_Edges. Lib_Graph is the library graph
+ -- corresponding to this invocation graph.
- function Is_Forced_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean;
- pragma Inline (Is_Forced_Edge);
- -- Determine whether edge Edge of library graph G is a byproduct of the
- -- forced-elaboration-order file.
+ function Get_Lib_Graph
+ (G : Invocation_Graph) return Library_Graphs.Library_Graph;
+ pragma Inline (Get_Lib_Graph);
+ -- Return the library graph corresponding to this invocation graph
- function Is_Internal_Unit
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean;
- pragma Inline (Is_Internal_Unit);
- -- Determine whether vertex Vertex of library graph G denotes an
- -- internal unit.
+ procedure Destroy (G : in out Invocation_Graph);
+ pragma Inline (Destroy);
+ -- Destroy the contents of invocation graph G, rendering it unusable
- function Is_Invocation_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean;
- pragma Inline (Is_Invocation_Edge);
- -- Determine whether edge Edge of library graph G came from the
- -- traversal of the invocation graph.
+ function Present (G : Invocation_Graph) return Boolean;
+ pragma Inline (Present);
+ -- Determine whether invocation graph G exists
- function Is_Predefined_Unit
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean;
- pragma Inline (Is_Predefined_Unit);
- -- Determine whether vertex Vertex of library graph G denotes a
- -- predefined unit.
+ -----------------------
+ -- Vertex attributes --
+ -----------------------
- function Is_Preelaborated_Unit
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean;
- pragma Inline (Is_Preelaborated_Unit);
- -- Determine whether vertex Vertex of library graph G denotes a unit
- -- subject to pragma Pure or Preelaborable.
+ function Body_Vertex
+ (G : Invocation_Graph;
+ Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id;
+ pragma Inline (Body_Vertex);
+ -- Obtain the library graph vertex where the body of the invocation
+ -- construct represented by vertex Vertex of invocation graph G is
+ -- declared.
- function Is_Spec
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean;
- pragma Inline (Is_Spec);
- -- Determine whether vertex Vertex of library graph G denotes a spec
+ function Column
+ (G : Invocation_Graph;
+ Vertex : Invocation_Graph_Vertex_Id) return Nat;
+ pragma Inline (Column);
+ -- Obtain the column number where the invocation construct vertex Vertex
+ -- of invocation graph G describes.
- function Is_Spec_Before_Body_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean;
- pragma Inline (Is_Spec_Before_Body_Edge);
- -- Determine whether edge Edge of library graph G links a predecessor
- -- spec and a successor body belonging to the same unit.
+ function Construct
+ (G : Invocation_Graph;
+ Vertex : Invocation_Graph_Vertex_Id) return Invocation_Construct_Id;
+ pragma Inline (Construct);
+ -- Obtain the invocation construct vertex Vertex of invocation graph G
+ -- describes.
- function Is_Spec_With_Body
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean;
- pragma Inline (Is_Spec_With_Body);
- -- Determine whether vertex Vertex of library graph G denotes a spec
- -- with a corresponding body.
+ function Corresponding_Vertex
+ (G : Invocation_Graph;
+ IS_Id : Invocation_Signature_Id) return Invocation_Graph_Vertex_Id;
+ pragma Inline (Corresponding_Vertex);
+ -- Obtain the vertex of invocation graph G that corresponds to signature
+ -- IS_Id.
- function Is_Spec_With_Elaborate_Body
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean;
- pragma Inline (Is_Spec_With_Elaborate_Body);
- -- Determine whether vertex Vertex of library graph G denotes a spec
- -- with a corresponding body, and is subject to pragma Elaborate_Body.
+ function Line
+ (G : Invocation_Graph;
+ Vertex : Invocation_Graph_Vertex_Id) return Nat;
+ pragma Inline (Line);
+ -- Obtain the line number where the invocation construct vertex Vertex
+ -- of invocation graph G describes.
- function Is_Weakly_Elaborable_Vertex
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean;
- pragma Inline (Is_Weakly_Elaborable_Vertex);
- -- Determine whether vertex Vertex of library graph G is waiting on
- -- weak predecessors only, in which case it can be elaborated assuming
- -- that the weak edges will not be exercised at elaboration time.
+ function Name
+ (G : Invocation_Graph;
+ Vertex : Invocation_Graph_Vertex_Id) return Name_Id;
+ pragma Inline (Name);
+ -- Obtain the name of the construct vertex Vertex of invocation graph G
+ -- describes.
- function Is_With_Edge
- (G : Library_Graph;
- Edge : Library_Graph_Edge_Id) return Boolean;
- pragma Inline (Is_With_Edge);
- -- Determine whether edge Edge of library graph G is the result of a
- -- with dependency between its successor and predecessor.
+ function Spec_Vertex
+ (G : Invocation_Graph;
+ Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id;
+ pragma Inline (Spec_Vertex);
+ -- Obtain the library graph vertex where the spec of the invocation
+ -- construct represented by vertex Vertex of invocation graph G is
+ -- declared.
- function Needs_Elaboration
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Boolean;
- pragma Inline (Needs_Elaboration);
- -- Determine whether vertex Vertex of library graph G represents a unit
- -- that needs to be elaborated.
+ ---------------------
+ -- Edge attributes --
+ ---------------------
- function Proper_Body
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id;
- pragma Inline (Proper_Body);
- -- Obtain the body of vertex Vertex of library graph G
+ function Extra
+ (G : Invocation_Graph;
+ Edge : Invocation_Graph_Edge_Id) return Name_Id;
+ pragma Inline (Extra);
+ -- Obtain the extra name used in error diagnostics of edge Edge of
+ -- invocation graph G.
- function Proper_Spec
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id;
- pragma Inline (Proper_Spec);
- -- Obtain the spec of vertex Vertex of library graph G
+ function Kind
+ (G : Invocation_Graph;
+ Edge : Invocation_Graph_Edge_Id) return Invocation_Kind;
+ pragma Inline (Kind);
+ -- Obtain the nature of edge Edge of invocation graph G
+
+ function Relation
+ (G : Invocation_Graph;
+ Edge : Invocation_Graph_Edge_Id) return Invocation_Relation_Id;
+ pragma Inline (Relation);
+ -- Obtain the relation edge Edge of invocation graph G describes
+
+ function Target
+ (G : Invocation_Graph;
+ Edge : Invocation_Graph_Edge_Id) return Invocation_Graph_Vertex_Id;
+ pragma Inline (Target);
+ -- Obtain the target vertex edge Edge of invocation graph G designates
----------------
-- Statistics --
----------------
- function Library_Graph_Edge_Count
- (G : Library_Graph;
- Kind : Library_Graph_Edge_Kind) return Natural;
- pragma Inline (Library_Graph_Edge_Count);
- -- Obtain the total number of edges of kind Kind in library graph G
-
- function Number_Of_Component_Vertices
- (G : Library_Graph;
- Comp : Component_Id) return Natural;
- pragma Inline (Number_Of_Component_Vertices);
- -- Obtain the total number of vertices component Comp of library graph
- -- contains.
-
- function Number_Of_Components (G : Library_Graph) return Natural;
- pragma Inline (Number_Of_Components);
- -- Obtain the total number of components in library graph G
-
- function Number_Of_Cycles (G : Library_Graph) return Natural;
- pragma Inline (Number_Of_Cycles);
- -- Obtain the total number of cycles in library graph G
+ function Invocation_Graph_Edge_Count
+ (G : Invocation_Graph;
+ Kind : Invocation_Kind) return Natural;
+ pragma Inline (Invocation_Graph_Edge_Count);
+ -- Obtain the total number of edges of kind Kind in invocation graph G
- function Number_Of_Edges (G : Library_Graph) return Natural;
+ function Number_Of_Edges (G : Invocation_Graph) return Natural;
pragma Inline (Number_Of_Edges);
- -- Obtain the total number of edges in library graph G
+ -- Obtain the total number of edges in invocation graph G
+
+ function Number_Of_Edges_To_Targets
+ (G : Invocation_Graph;
+ Vertex : Invocation_Graph_Vertex_Id) return Natural;
+ pragma Inline (Number_Of_Edges_To_Targets);
+ -- Obtain the total number of edges to targets vertex Vertex of
+ -- invocation graph G has.
- function Number_Of_Edges_To_Successors
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Natural;
- pragma Inline (Number_Of_Edges_To_Successors);
- -- Obtain the total number of edges to successors vertex Vertex of
- -- library graph G has.
+ function Number_Of_Elaboration_Roots
+ (G : Invocation_Graph) return Natural;
+ pragma Inline (Number_Of_Elaboration_Roots);
+ -- Obtain the total number of elaboration roots in invocation graph G
- function Number_Of_Vertices (G : Library_Graph) return Natural;
+ function Number_Of_Vertices (G : Invocation_Graph) return Natural;
pragma Inline (Number_Of_Vertices);
- -- Obtain the total number of vertices in library graph G
+ -- Obtain the total number of vertices in invocation graph G
---------------
-- Iterators --
---------------
- -- The following type represents an iterator over all cycles of a
- -- library graph.
-
- type All_Cycle_Iterator is private;
-
- function Has_Next (Iter : All_Cycle_Iterator) return Boolean;
- pragma Inline (Has_Next);
- -- Determine whether iterator Iter has more cycles to examine
-
- function Iterate_All_Cycles
- (G : Library_Graph) return All_Cycle_Iterator;
- pragma Inline (Iterate_All_Cycles);
- -- Obtain an iterator over all cycles of library graph G
-
- procedure Next
- (Iter : in out All_Cycle_Iterator;
- Cycle : out Library_Graph_Cycle_Id);
- pragma Inline (Next);
- -- Return the current cycle referenced by iterator Iter and advance to
- -- the next available cycle.
-
- -- The following type represents an iterator over all edges of a library
- -- graph.
+ -- The following type represents an iterator over all edges of an
+ -- invocation graph.
type All_Edge_Iterator is private;
pragma Inline (Has_Next);
-- Determine whether iterator Iter has more edges to examine
- function Iterate_All_Edges (G : Library_Graph) return All_Edge_Iterator;
+ function Iterate_All_Edges
+ (G : Invocation_Graph) return All_Edge_Iterator;
pragma Inline (Iterate_All_Edges);
- -- Obtain an iterator over all edges of library graph G
+ -- Obtain an iterator over all edges of invocation graph G
procedure Next
(Iter : in out All_Edge_Iterator;
- Edge : out Library_Graph_Edge_Id);
+ Edge : out Invocation_Graph_Edge_Id);
pragma Inline (Next);
-- Return the current edge referenced by iterator Iter and advance to
-- the next available edge.
- -- The following type represents an iterator over all vertices of a
- -- library graph.
+ -- The following type represents an iterator over all vertices of an
+ -- invocation graph.
type All_Vertex_Iterator is private;
-- Determine whether iterator Iter has more vertices to examine
function Iterate_All_Vertices
- (G : Library_Graph) return All_Vertex_Iterator;
+ (G : Invocation_Graph) return All_Vertex_Iterator;
pragma Inline (Iterate_All_Vertices);
- -- Obtain an iterator over all vertices of library graph G
+ -- Obtain an iterator over all vertices of invocation graph G
procedure Next
(Iter : in out All_Vertex_Iterator;
- Vertex : out Library_Graph_Vertex_Id);
- pragma Inline (Next);
- -- Return the current vertex referenced by iterator Iter and advance
- -- to the next available vertex.
-
- -- The following type represents an iterator over all components of a
- -- library graph.
-
- type Component_Iterator is private;
-
- function Has_Next (Iter : Component_Iterator) return Boolean;
- pragma Inline (Has_Next);
- -- Determine whether iterator Iter has more components to examine
-
- function Iterate_Components
- (G : Library_Graph) return Component_Iterator;
- pragma Inline (Iterate_Components);
- -- Obtain an iterator over all components of library graph G
-
- procedure Next
- (Iter : in out Component_Iterator;
- Comp : out Component_Id);
- pragma Inline (Next);
- -- Return the current component referenced by iterator Iter and advance
- -- to the next available component.
-
- -- The following type represents an iterator over all vertices of a
- -- component.
-
- type Component_Vertex_Iterator is private;
-
- function Has_Next (Iter : Component_Vertex_Iterator) return Boolean;
- pragma Inline (Has_Next);
- -- Determine whether iterator Iter has more vertices to examine
-
- function Iterate_Component_Vertices
- (G : Library_Graph;
- Comp : Component_Id) return Component_Vertex_Iterator;
- pragma Inline (Iterate_Component_Vertices);
- -- Obtain an iterator over all vertices of component Comp of library
- -- graph G.
-
- procedure Next
- (Iter : in out Component_Vertex_Iterator;
- Vertex : out Library_Graph_Vertex_Id);
+ Vertex : out Invocation_Graph_Vertex_Id);
pragma Inline (Next);
-- Return the current vertex referenced by iterator Iter and advance
-- to the next available vertex.
- -- The following type represents an iterator over all edges that form a
- -- cycle.
+ -- The following type represents an iterator over all edges that reach
+ -- targets starting from a particular source vertex.
- type Edges_Of_Cycle_Iterator is private;
+ type Edges_To_Targets_Iterator is private;
- function Has_Next (Iter : Edges_Of_Cycle_Iterator) return Boolean;
+ function Has_Next (Iter : Edges_To_Targets_Iterator) return Boolean;
pragma Inline (Has_Next);
-- Determine whether iterator Iter has more edges to examine
- function Iterate_Edges_Of_Cycle
- (G : Library_Graph;
- Cycle : Library_Graph_Cycle_Id) return Edges_Of_Cycle_Iterator;
- pragma Inline (Iterate_Edges_Of_Cycle);
- -- Obtain an iterator over all edges that form cycle Cycle of library
- -- graph G.
+ function Iterate_Edges_To_Targets
+ (G : Invocation_Graph;
+ Vertex : Invocation_Graph_Vertex_Id) return Edges_To_Targets_Iterator;
+ pragma Inline (Iterate_Edges_To_Targets);
+ -- Obtain an iterator over all edges to targets with source vertex
+ -- Vertex of invocation graph G.
procedure Next
- (Iter : in out Edges_Of_Cycle_Iterator;
- Edge : out Library_Graph_Edge_Id);
+ (Iter : in out Edges_To_Targets_Iterator;
+ Edge : out Invocation_Graph_Edge_Id);
pragma Inline (Next);
-- Return the current edge referenced by iterator Iter and advance to
-- the next available edge.
- -- The following type represents an iterator over all edges that reach
- -- successors starting from a particular predecessor vertex.
+ -- The following type represents an iterator over all vertices of an
+ -- invocation graph that denote the elaboration procedure or a spec or
+ -- a body, referred to as elaboration root.
- type Edges_To_Successors_Iterator is private;
+ type Elaboration_Root_Iterator is private;
- function Has_Next (Iter : Edges_To_Successors_Iterator) return Boolean;
+ function Has_Next (Iter : Elaboration_Root_Iterator) return Boolean;
pragma Inline (Has_Next);
- -- Determine whether iterator Iter has more edges to examine
+ -- Determine whether iterator Iter has more elaboration roots to examine
- function Iterate_Edges_To_Successors
- (G : Library_Graph;
- Vertex : Library_Graph_Vertex_Id) return Edges_To_Successors_Iterator;
- pragma Inline (Iterate_Edges_To_Successors);
- -- Obtain an iterator over all edges to successors with predecessor
- -- vertex Vertex of library graph G.
+ function Iterate_Elaboration_Roots
+ (G : Invocation_Graph) return Elaboration_Root_Iterator;
+ pragma Inline (Iterate_Elaboration_Roots);
+ -- Obtain an iterator over all elaboration roots of invocation graph G
procedure Next
- (Iter : in out Edges_To_Successors_Iterator;
- Edge : out Library_Graph_Edge_Id);
+ (Iter : in out Elaboration_Root_Iterator;
+ Root : out Invocation_Graph_Vertex_Id);
pragma Inline (Next);
- -- Return the current edge referenced by iterator Iter and advance to
- -- the next available edge.
-
- private
-
- --------------
- -- Vertices --
- --------------
-
- -- The following type represents the attributes of a library graph
- -- vertex.
-
- type Library_Graph_Vertex_Attributes is record
- Corresponding_Item : Library_Graph_Vertex_Id :=
- No_Library_Graph_Vertex;
- -- The reference to the corresponding spec or body. This attribute is
- -- set as follows:
- --
- -- * If predicate Is_Body_With_Spec is True, the reference denotes
- -- the corresponding spec.
- --
- -- * If predicate Is_Spec_With_Body is True, the reference denotes
- -- the corresponding body.
- --
- -- * Otherwise the attribute remains empty.
-
- In_Elaboration_Order : Boolean := False;
- -- Set when this vertex is elaborated
-
- Pending_Strong_Predecessors : Natural := 0;
- -- The number of pending strong predecessor vertices this vertex must
- -- wait on before it can be elaborated.
-
- Pending_Weak_Predecessors : Natural := 0;
- -- The number of weak predecessor vertices this vertex must wait on
- -- before it can be elaborated.
-
- Unit : Unit_Id := No_Unit_Id;
- -- The reference to unit this vertex represents
- end record;
-
- No_Library_Graph_Vertex_Attributes :
- constant Library_Graph_Vertex_Attributes :=
- (Corresponding_Item => No_Library_Graph_Vertex,
- In_Elaboration_Order => False,
- Pending_Strong_Predecessors => 0,
- Pending_Weak_Predecessors => 0,
- Unit => No_Unit_Id);
-
- procedure Destroy_Library_Graph_Vertex_Attributes
- (Attrs : in out Library_Graph_Vertex_Attributes);
- pragma Inline (Destroy_Library_Graph_Vertex_Attributes);
- -- Destroy the contents of attributes Attrs
-
- package LGV_Tables is new Dynamic_Hash_Tables
- (Key_Type => Library_Graph_Vertex_Id,
- Value_Type => Library_Graph_Vertex_Attributes,
- No_Value => No_Library_Graph_Vertex_Attributes,
- Expansion_Threshold => 1.5,
- Expansion_Factor => 2,
- Compression_Threshold => 0.3,
- Compression_Factor => 2,
- "=" => "=",
- Destroy_Value => Destroy_Library_Graph_Vertex_Attributes,
- Hash => Hash_Library_Graph_Vertex);
-
- -----------
- -- Edges --
- -----------
-
- -- The following type represents the attributes of a library graph edge
-
- type Library_Graph_Edge_Attributes is record
- Activates_Task : Boolean := False;
- -- Set for an invocation edge, where at least one of the paths the
- -- edge represents activates a task.
-
- Kind : Library_Graph_Edge_Kind := No_Edge;
- -- The nature of the library graph edge
- end record;
-
- No_Library_Graph_Edge_Attributes :
- constant Library_Graph_Edge_Attributes :=
- (Activates_Task => False,
- Kind => No_Edge);
-
- procedure Destroy_Library_Graph_Edge_Attributes
- (Attrs : in out Library_Graph_Edge_Attributes);
- pragma Inline (Destroy_Library_Graph_Edge_Attributes);
- -- Destroy the contents of attributes Attrs
-
- package LGE_Tables is new Dynamic_Hash_Tables
- (Key_Type => Library_Graph_Edge_Id,
- Value_Type => Library_Graph_Edge_Attributes,
- No_Value => No_Library_Graph_Edge_Attributes,
- Expansion_Threshold => 1.5,
- Expansion_Factor => 2,
- Compression_Threshold => 0.3,
- Compression_Factor => 2,
- "=" => "=",
- Destroy_Value => Destroy_Library_Graph_Edge_Attributes,
- Hash => Hash_Library_Graph_Edge);
+ -- Return the current elaboration root referenced by iterator Iter and
+ -- advance to the next available elaboration root.
- ----------------
- -- Components --
- ----------------
+ private
- -- The following type represents the attributes of a component
+ --------------
+ -- Vertices --
+ --------------
- type Component_Attributes is record
- Pending_Strong_Predecessors : Natural := 0;
- -- The number of pending strong predecessor components this component
- -- must wait on before it can be elaborated.
+ procedure Destroy_Invocation_Graph_Vertex
+ (Vertex : in out Invocation_Graph_Vertex_Id);
+ pragma Inline (Destroy_Invocation_Graph_Vertex);
+ -- Destroy invocation graph vertex Vertex
- Pending_Weak_Predecessors : Natural := 0;
- -- The number of pending weak predecessor components this component
- -- must wait on before it can be elaborated.
+ -- The following type represents the attributes of an invocation graph
+ -- vertex.
+
+ type Invocation_Graph_Vertex_Attributes is record
+ Body_Vertex : Library_Graph_Vertex_Id := No_Library_Graph_Vertex;
+ -- Reference to the library graph vertex where the body of this
+ -- vertex resides.
+
+ Construct : Invocation_Construct_Id := No_Invocation_Construct;
+ -- Reference to the invocation construct this vertex represents
+
+ Spec_Vertex : Library_Graph_Vertex_Id := No_Library_Graph_Vertex;
+ -- Reference to the library graph vertex where the spec of this
+ -- vertex resides.
end record;
- No_Component_Attributes : constant Component_Attributes :=
- (Pending_Strong_Predecessors => 0,
- Pending_Weak_Predecessors => 0);
+ No_Invocation_Graph_Vertex_Attributes :
+ constant Invocation_Graph_Vertex_Attributes :=
+ (Body_Vertex => No_Library_Graph_Vertex,
+ Construct => No_Invocation_Construct,
+ Spec_Vertex => No_Library_Graph_Vertex);
- procedure Destroy_Component_Attributes
- (Attrs : in out Component_Attributes);
- pragma Inline (Destroy_Component_Attributes);
+ procedure Destroy_Invocation_Graph_Vertex_Attributes
+ (Attrs : in out Invocation_Graph_Vertex_Attributes);
+ pragma Inline (Destroy_Invocation_Graph_Vertex_Attributes);
-- Destroy the contents of attributes Attrs
- package Component_Tables is new Dynamic_Hash_Tables
- (Key_Type => Component_Id,
- Value_Type => Component_Attributes,
- No_Value => No_Component_Attributes,
+ package IGV_Tables is new Dynamic_Hash_Tables
+ (Key_Type => Invocation_Graph_Vertex_Id,
+ Value_Type => Invocation_Graph_Vertex_Attributes,
+ No_Value => No_Invocation_Graph_Vertex_Attributes,
Expansion_Threshold => 1.5,
Expansion_Factor => 2,
Compression_Threshold => 0.3,
Compression_Factor => 2,
"=" => "=",
- Destroy_Value => Destroy_Component_Attributes,
- Hash => Hash_Component);
-
- ------------
- -- Cycles --
- ------------
+ Destroy_Value => Destroy_Invocation_Graph_Vertex_Attributes,
+ Hash => Hash_Invocation_Graph_Vertex);
- -- The following type represents the attributes of a cycle
+ -----------
+ -- Edges --
+ -----------
- type Library_Graph_Cycle_Attributes is record
- Invocation_Edge_Count : Natural := 0;
- -- The number of invocation edges within the cycle
+ procedure Destroy_Invocation_Graph_Edge
+ (Edge : in out Invocation_Graph_Edge_Id);
+ pragma Inline (Destroy_Invocation_Graph_Edge);
+ -- Destroy invocation graph edge Edge
- Kind : Library_Graph_Cycle_Kind := No_Cycle_Kind;
- -- The nature of the cycle
+ -- The following type represents the attributes of an invocation graph
+ -- edge.
- Path : LGE_Lists.Doubly_Linked_List := LGE_Lists.Nil;
- -- The path of edges that form the cycle
+ type Invocation_Graph_Edge_Attributes is record
+ Relation : Invocation_Relation_Id := No_Invocation_Relation;
+ -- Reference to the invocation relation this edge represents
end record;
- No_Library_Graph_Cycle_Attributes :
- constant Library_Graph_Cycle_Attributes :=
- (Invocation_Edge_Count => 0,
- Kind => No_Cycle_Kind,
- Path => LGE_Lists.Nil);
+ No_Invocation_Graph_Edge_Attributes :
+ constant Invocation_Graph_Edge_Attributes :=
+ (Relation => No_Invocation_Relation);
- procedure Destroy_Library_Graph_Cycle_Attributes
- (Attrs : in out Library_Graph_Cycle_Attributes);
- pragma Inline (Destroy_Library_Graph_Cycle_Attributes);
+ procedure Destroy_Invocation_Graph_Edge_Attributes
+ (Attrs : in out Invocation_Graph_Edge_Attributes);
+ pragma Inline (Destroy_Invocation_Graph_Edge_Attributes);
-- Destroy the contents of attributes Attrs
- function Hash_Library_Graph_Cycle_Attributes
- (Attrs : Library_Graph_Cycle_Attributes) return Bucket_Range_Type;
- pragma Inline (Hash_Library_Graph_Cycle_Attributes);
- -- Obtain the hash of key Attrs
-
- function Same_Library_Graph_Cycle_Attributes
- (Left : Library_Graph_Cycle_Attributes;
- Right : Library_Graph_Cycle_Attributes) return Boolean;
- pragma Inline (Same_Library_Graph_Cycle_Attributes);
- -- Determine whether cycle attributes Left and Right are the same
-
- package LGC_Tables is new Dynamic_Hash_Tables
- (Key_Type => Library_Graph_Cycle_Id,
- Value_Type => Library_Graph_Cycle_Attributes,
- No_Value => No_Library_Graph_Cycle_Attributes,
+ package IGE_Tables is new Dynamic_Hash_Tables
+ (Key_Type => Invocation_Graph_Edge_Id,
+ Value_Type => Invocation_Graph_Edge_Attributes,
+ No_Value => No_Invocation_Graph_Edge_Attributes,
Expansion_Threshold => 1.5,
Expansion_Factor => 2,
Compression_Threshold => 0.3,
Compression_Factor => 2,
"=" => "=",
- Destroy_Value => Destroy_Library_Graph_Cycle_Attributes,
- Hash => Hash_Library_Graph_Cycle);
+ Destroy_Value => Destroy_Invocation_Graph_Edge_Attributes,
+ Hash => Hash_Invocation_Graph_Edge);
- --------------------
- -- Recorded edges --
- --------------------
+ ---------------
+ -- Relations --
+ ---------------
- -- The following type represents a relation between a predecessor and
- -- successor vertices.
+ -- The following type represents a relation between a source and target
+ -- vertices.
- type Predecessor_Successor_Relation is record
- Predecessor : Library_Graph_Vertex_Id := No_Library_Graph_Vertex;
+ type Source_Target_Relation is record
+ Source : Invocation_Graph_Vertex_Id := No_Invocation_Graph_Vertex;
-- The source vertex
- Successor : Library_Graph_Vertex_Id := No_Library_Graph_Vertex;
+ Target : Invocation_Graph_Vertex_Id := No_Invocation_Graph_Vertex;
-- The destination vertex
end record;
- No_Predecessor_Successor_Relation :
- constant Predecessor_Successor_Relation :=
- (Predecessor => No_Library_Graph_Vertex,
- Successor => No_Library_Graph_Vertex);
+ No_Source_Target_Relation :
+ constant Source_Target_Relation :=
+ (Source => No_Invocation_Graph_Vertex,
+ Target => No_Invocation_Graph_Vertex);
- function Hash_Predecessor_Successor_Relation
- (Rel : Predecessor_Successor_Relation) return Bucket_Range_Type;
- pragma Inline (Hash_Predecessor_Successor_Relation);
+ function Hash_Source_Target_Relation
+ (Rel : Source_Target_Relation) return Bucket_Range_Type;
+ pragma Inline (Hash_Source_Target_Relation);
-- Obtain the hash value of key Rel
- package RE_Sets is new Membership_Sets
- (Element_Type => Predecessor_Successor_Relation,
+ package Relation_Sets is new Membership_Sets
+ (Element_Type => Source_Target_Relation,
"=" => "=",
- Hash => Hash_Predecessor_Successor_Relation);
+ Hash => Hash_Source_Target_Relation);
----------------
-- Statistics --
----------------
- type Library_Graph_Edge_Counts is
- array (Library_Graph_Edge_Kind) of Natural;
+ type Invocation_Graph_Edge_Counts is array (Invocation_Kind) of Natural;
- -----------
- -- Units --
- -----------
+ ----------------
+ -- Signatures --
+ ----------------
- package Unit_Tables is new Dynamic_Hash_Tables
- (Key_Type => Unit_Id,
- Value_Type => Library_Graph_Vertex_Id,
- No_Value => No_Library_Graph_Vertex,
+ function Hash_Invocation_Signature
+ (IS_Id : Invocation_Signature_Id) return Bucket_Range_Type;
+ pragma Inline (Hash_Invocation_Signature);
+ -- Obtain the hash value of key IS_Id
+
+ package Signature_Tables is new Dynamic_Hash_Tables
+ (Key_Type => Invocation_Signature_Id,
+ Value_Type => Invocation_Graph_Vertex_Id,
+ No_Value => No_Invocation_Graph_Vertex,
Expansion_Threshold => 1.5,
Expansion_Factor => 2,
Compression_Threshold => 0.3,
Compression_Factor => 2,
"=" => "=",
- Destroy_Value => Destroy_Library_Graph_Vertex,
- Hash => Hash_Unit);
+ Destroy_Value => Destroy_Invocation_Graph_Vertex,
+ Hash => Hash_Invocation_Signature);
+
+ -----------------------
+ -- Elaboration roots --
+ -----------------------
+
+ package IGV_Sets is new Membership_Sets
+ (Element_Type => Invocation_Graph_Vertex_Id,
+ "=" => "=",
+ Hash => Hash_Invocation_Graph_Vertex);
-----------
-- Graph --
-----------
package DG is new Directed_Graphs
- (Vertex_Id => Library_Graph_Vertex_Id,
- No_Vertex => No_Library_Graph_Vertex,
- Hash_Vertex => Hash_Library_Graph_Vertex,
+ (Vertex_Id => Invocation_Graph_Vertex_Id,
+ No_Vertex => No_Invocation_Graph_Vertex,
+ Hash_Vertex => Hash_Invocation_Graph_Vertex,
Same_Vertex => "=",
- Edge_Id => Library_Graph_Edge_Id,
- No_Edge => No_Library_Graph_Edge,
- Hash_Edge => Hash_Library_Graph_Edge,
+ Edge_id => Invocation_Graph_Edge_Id,
+ No_Edge => No_Invocation_Graph_Edge,
+ Hash_Edge => Hash_Invocation_Graph_Edge,
Same_Edge => "=");
- -- The following type represents the attributes of a library graph
-
- type Library_Graph_Attributes is record
- Component_Attributes : Component_Tables.Dynamic_Hash_Table :=
- Component_Tables.Nil;
- -- The map of component -> component attributes for all components in
- -- the graph.
+ -- The following type represents the attributes of an invocation graph
- Counts : Library_Graph_Edge_Counts := (others => 0);
+ type Invocation_Graph_Attributes is record
+ Counts : Invocation_Graph_Edge_Counts := (others => 0);
-- Edge statistics
- Cycle_Attributes : LGC_Tables.Dynamic_Hash_Table := LGC_Tables.Nil;
- -- The map of cycle -> cycle attributes for all cycles in the graph
-
- Cycles : LGC_Lists.Doubly_Linked_List := LGC_Lists.Nil;
- -- The list of all cycles in the graph, sorted based on precedence
-
- Edge_Attributes : LGE_Tables.Dynamic_Hash_Table := LGE_Tables.Nil;
+ Edge_Attributes : IGE_Tables.Dynamic_Hash_Table := IGE_Tables.Nil;
-- The map of edge -> edge attributes for all edges in the graph
Graph : DG.Directed_Graph := DG.Nil;
-- The underlying graph describing the relations between edges and
-- vertices.
- Recorded_Edges : RE_Sets.Membership_Set := RE_Sets.Nil;
- -- The set of recorded edges, used to prevent duplicate edges in the
- -- graph.
+ Relations : Relation_Sets.Membership_Set := Relation_Sets.Nil;
+ -- The set of relations between source and targets, used to prevent
+ -- duplicate edges in the graph.
- Unit_To_Vertex : Unit_Tables.Dynamic_Hash_Table := Unit_Tables.Nil;
- -- The map of unit -> vertex
+ Roots : IGV_Sets.Membership_Set := IGV_Sets.Nil;
+ -- The set of elaboration root vertices
- Vertex_Attributes : LGV_Tables.Dynamic_Hash_Table := LGV_Tables.Nil;
+ Signature_To_Vertex : Signature_Tables.Dynamic_Hash_Table :=
+ Signature_Tables.Nil;
+ -- The map of signature -> vertex
+
+ Vertex_Attributes : IGV_Tables.Dynamic_Hash_Table := IGV_Tables.Nil;
-- The map of vertex -> vertex attributes for all vertices in the
-- graph.
+
+ Lib_Graph : Library_Graphs.Library_Graph;
end record;
- type Library_Graph is access Library_Graph_Attributes;
- Nil : constant Library_Graph := null;
+ type Invocation_Graph is access Invocation_Graph_Attributes;
+ Nil : constant Invocation_Graph := null;
---------------
-- Iterators --
---------------
- type All_Cycle_Iterator is new LGC_Lists.Iterator;
- type All_Edge_Iterator is new DG.All_Edge_Iterator;
- type All_Vertex_Iterator is new DG.All_Vertex_Iterator;
- type Component_Iterator is new DG.Component_Iterator;
- type Component_Vertex_Iterator is new DG.Component_Vertex_Iterator;
- type Edges_Of_Cycle_Iterator is new LGE_Lists.Iterator;
- type Edges_To_Successors_Iterator is new DG.Outgoing_Edge_Iterator;
- end Library_Graphs;
+ type All_Edge_Iterator is new DG.All_Edge_Iterator;
+ type All_Vertex_Iterator is new DG.All_Vertex_Iterator;
+ type Edges_To_Targets_Iterator is new DG.Outgoing_Edge_Iterator;
+ type Elaboration_Root_Iterator is new IGV_Sets.Iterator;
+ end Invocation_Graphs;
end Bindo.Graphs;
projects / gcc.git / commitdiff