blob: 09899813a7692f5eb0da5bb04e0915eb868da96d [file] [log] [blame]
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- B I N D O . G R A P H S --
-- --
-- B o d y --
-- --
-- Copyright (C) 2019-2021, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
with Butil; use Butil;
with Debug; use Debug;
with Output; use Output;
with Bindo.Writers;
use Bindo.Writers;
use Bindo.Writers.Phase_Writers;
package body Bindo.Graphs is
-----------------------
-- Local subprograms --
-----------------------
function Sequence_Next_Cycle return Library_Graph_Cycle_Id;
pragma Inline (Sequence_Next_Cycle);
-- Generate a new unique library graph cycle handle
function Sequence_Next_Edge return Invocation_Graph_Edge_Id;
pragma Inline (Sequence_Next_Edge);
-- Generate a new unique invocation graph edge handle
function Sequence_Next_Edge return Library_Graph_Edge_Id;
pragma Inline (Sequence_Next_Edge);
-- Generate a new unique library graph edge handle
function Sequence_Next_Vertex return Invocation_Graph_Vertex_Id;
pragma Inline (Sequence_Next_Vertex);
-- Generate a new unique invocation graph vertex handle
function Sequence_Next_Vertex return Library_Graph_Vertex_Id;
pragma Inline (Sequence_Next_Vertex);
-- Generate a new unique library graph vertex handle
-----------------------------------
-- Destroy_Invocation_Graph_Edge --
-----------------------------------
procedure Destroy_Invocation_Graph_Edge
(Edge : in out Invocation_Graph_Edge_Id)
is
pragma Unreferenced (Edge);
begin
null;
end Destroy_Invocation_Graph_Edge;
---------------------------------
-- Destroy_Library_Graph_Cycle --
---------------------------------
procedure Destroy_Library_Graph_Cycle
(Cycle : in out Library_Graph_Cycle_Id)
is
pragma Unreferenced (Cycle);
begin
null;
end Destroy_Library_Graph_Cycle;
--------------------------------
-- Destroy_Library_Graph_Edge --
--------------------------------
procedure Destroy_Library_Graph_Edge
(Edge : in out Library_Graph_Edge_Id)
is
pragma Unreferenced (Edge);
begin
null;
end Destroy_Library_Graph_Edge;
----------------------------------
-- Destroy_Library_Graph_Vertex --
----------------------------------
procedure Destroy_Library_Graph_Vertex
(Vertex : in out Library_Graph_Vertex_Id)
is
pragma Unreferenced (Vertex);
begin
null;
end Destroy_Library_Graph_Vertex;
--------------------------------
-- Hash_Invocation_Graph_Edge --
--------------------------------
function Hash_Invocation_Graph_Edge
(Edge : Invocation_Graph_Edge_Id) return Bucket_Range_Type
is
begin
pragma Assert (Present (Edge));
return Bucket_Range_Type (Edge);
end Hash_Invocation_Graph_Edge;
----------------------------------
-- Hash_Invocation_Graph_Vertex --
----------------------------------
function Hash_Invocation_Graph_Vertex
(Vertex : Invocation_Graph_Vertex_Id) return Bucket_Range_Type
is
begin
pragma Assert (Present (Vertex));
return Bucket_Range_Type (Vertex);
end Hash_Invocation_Graph_Vertex;
------------------------------
-- Hash_Library_Graph_Cycle --
------------------------------
function Hash_Library_Graph_Cycle
(Cycle : Library_Graph_Cycle_Id) return Bucket_Range_Type
is
begin
pragma Assert (Present (Cycle));
return Bucket_Range_Type (Cycle);
end Hash_Library_Graph_Cycle;
-----------------------------
-- Hash_Library_Graph_Edge --
-----------------------------
function Hash_Library_Graph_Edge
(Edge : Library_Graph_Edge_Id) return Bucket_Range_Type
is
begin
pragma Assert (Present (Edge));
return Bucket_Range_Type (Edge);
end Hash_Library_Graph_Edge;
-------------------------------
-- Hash_Library_Graph_Vertex --
-------------------------------
function Hash_Library_Graph_Vertex
(Vertex : Library_Graph_Vertex_Id) return Bucket_Range_Type
is
begin
pragma Assert (Present (Vertex));
return Bucket_Range_Type (Vertex);
end Hash_Library_Graph_Vertex;
--------------------
-- 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.
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.
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.
procedure Find_Cycles_In_Component
(G : Library_Graph;
Comp : Component_Id;
Cycle_Count : in out Natural;
Cycle_Limit : Natural);
pragma Inline (Find_Cycles_In_Component);
-- Part of Tarjan's enumeration of the elementary circuits of a directed
-- graph algorithm. Find all cycles in component Comp of library graph
-- G. The remaining parameters are as follows:
--
-- * Cycle_Count is the number of cycles discovered so far.
--
-- * Cycle_Limit is the upper bound of the number of cycles to be
-- discovered.
function Find_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 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.
procedure Free is
new Ada.Unchecked_Deallocation
(Library_Graph_Attributes, Library_Graph);
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
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
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
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
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.
function Has_Elaborate_All_Edge
(G : Library_Graph;
Comp : Component_Id) return Boolean;
pragma Inline (Has_Elaborate_All_Edge);
-- Determine whether component Comp of library graph G contains an
-- Elaborate_All edge that links two vertices in the same component.
function Has_Elaborate_All_Edge
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (Has_Elaborate_All_Edge);
-- Determine whether vertex Vertex of library graph G contains an
-- Elaborate_All edge to a successor where both the vertex and the
-- successor reside in the same component.
function Highest_Precedence_Edge
(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.
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
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.
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.
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.
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
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 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.
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.
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.
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.
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.
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 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.
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 Is_Vertex_With_Elaborate_Body
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (Is_Vertex_With_Elaborate_Body);
-- Determine whether vertex Vertex of library graph G denotes a spec
-- subject to pragma Elaborate_Body or the completing body of such a
-- spec.
function Links_Vertices_In_Same_Component
(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.
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.
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.
procedure Order_Cycle
(G : Library_Graph;
Cycle : Library_Graph_Cycle_Id);
pragma Inline (Order_Cycle);
-- Insert cycle Cycle in library graph G and sort it based on its
-- precedence relative to all recorded cycles.
function Path
(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.
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.
procedure Set_Activates_Task
(G : Library_Graph;
Edge : Library_Graph_Edge_Id);
-- Set the Activates_Task flag of the Edge to True
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
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
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.
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
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 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
procedure Trace_Component
(G : Library_Graph;
Comp : Component_Id;
Indent : Indentation_Level);
pragma Inline (Trace_Component);
-- Write the contents of component Comp of library graph G to standard
-- output. Indent is the desired indentation level for tracing.
procedure Trace_Cycle
(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.
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 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.
procedure Unvisit
(Vertex : Library_Graph_Vertex_Id;
Visited_Set : LGV_Sets.Membership_Set;
Visited_Stack : LGV_Lists.Doubly_Linked_List);
pragma Inline (Unvisit);
-- Part of Tarjan's enumeration of the elementary circuits of a directed
-- graph algorithm. Unwind the Visited_Stack by removing the top vertex
-- from set Visited_Set until vertex Vertex is reached, inclusive.
procedure Update_Pending_Predecessors
(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.
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 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.
function Vertex_Precedence
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id;
Compared_To : Library_Graph_Vertex_Id) return Precedence_Kind;
pragma Inline (Vertex_Precedence);
-- Determine the precedence of vertex Vertex of library graph G compared
-- to vertex Compared_To.
procedure Visit
(Vertex : Library_Graph_Vertex_Id;
Visited_Set : LGV_Sets.Membership_Set;
Visited_Stack : LGV_Lists.Doubly_Linked_List);
pragma Inline (Visit);
-- Part of Tarjan's enumeration of the elementary circuits of a directed
-- graph algorithm. Push vertex Vertex on the Visited_Stack and add it
-- to set Visited_Set.
--------------------
-- Activates_Task --
--------------------
function Activates_Task
(G : Library_Graph;
Edge : Library_Graph_Edge_Id) return Boolean
is
begin
return Get_LGE_Attributes (G, Edge).Activates_Task;
end Activates_Task;
-------------------------------
-- Add_Body_Before_Spec_Edge --
-------------------------------
procedure Add_Body_Before_Spec_Edge
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id;
Edges : LGE_Lists.Doubly_Linked_List)
is
Edge : Library_Graph_Edge_Id;
begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
pragma Assert (LGE_Lists.Present (Edges));
-- 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.
-- Assume that no Body_Before_Spec is necessary
Edge := No_Library_Graph_Edge;
-- A body that completes a previous spec
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);
-- A spec with a completing body
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;
if Present (Edge) then
LGE_Lists.Append (Edges, Edge);
end if;
end Add_Body_Before_Spec_Edge;
--------------------------------
-- Add_Body_Before_Spec_Edges --
--------------------------------
procedure Add_Body_Before_Spec_Edges
(G : Library_Graph;
Edges : LGE_Lists.Doubly_Linked_List)
is
Iter : Elaborable_Units_Iterator;
U_Id : Unit_Id;
begin
pragma Assert (Present (G));
pragma Assert (LGE_Lists.Present (Edges));
Iter := Iterate_Elaborable_Units;
while Has_Next (Iter) loop
Next (Iter, U_Id);
Add_Body_Before_Spec_Edge
(G => G,
Vertex => Corresponding_Vertex (G, U_Id),
Edges => Edges);
end loop;
end Add_Body_Before_Spec_Edges;
--------------
-- Add_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)
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;
-------------------------
-- Add_Edge_Kind_Check --
-------------------------
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.
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 "<=".
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.
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.
when No_Edge =>
OK := False;
end case;
if not OK then
raise Program_Error with Old_Kind'Img & "-->" & New_Kind'Img;
end if;
end Add_Edge_Kind_Check;
--------------
-- Add_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
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);
Edge : Library_Graph_Edge_Id;
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.
if Is_Recorded_Edge (G, Rel) then
pragma Debug (Add_Edge_Kind_Check (G, Pred, Succ, Kind));
if Activates_Task then
Set_Activates_Task (G, Find_Edge (G, Pred, Succ));
end if;
return No_Library_Graph_Edge;
end if;
Edge := Sequence_Next_Edge;
-- 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.
DG.Add_Edge
(G => G.Graph,
E => Edge,
Source => Pred,
Destination => Succ);
-- Construct and save the attributes of the edge
Set_LGE_Attributes
(G => G,
Edge => Edge,
Val =>
(Activates_Task => Activates_Task,
Kind => Kind));
-- Mark the predecessor and successor as related by the new edge.
-- This prevents all further attempts to link the same predecessor
-- and successor.
Set_Is_Recorded_Edge (G, Rel);
-- Update the number of pending predecessors the successor must wait
-- on before it is elaborated.
Increment_Pending_Predecessors
(G => G,
Vertex => Succ,
Edge => Edge);
-- Update the edge statistics
Increment_Library_Graph_Edge_Count (G, Kind);
return Edge;
end Add_Edge;
----------------
-- Add_Vertex --
----------------
procedure Add_Vertex
(G : Library_Graph;
U_Id : Unit_Id)
is
Vertex : Library_Graph_Vertex_Id;
begin
pragma Assert (Present (G));
pragma Assert (Present (U_Id));
-- Nothing to do when the unit already has a vertex
if Present (Corresponding_Vertex (G, U_Id)) then
return;
end if;
Vertex := Sequence_Next_Vertex;
-- Add the vertex to the underlying graph
DG.Add_Vertex (G.Graph, Vertex);
-- Construct and save the attributes of the 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));
-- Associate the unit with its corresponding vertex
Set_Corresponding_Vertex (G, U_Id, Vertex);
end Add_Vertex;
---------------------------------
-- At_Least_One_Edge_Satisfies --
---------------------------------
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);
-- Assume that the predicate cannot be satisfied
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;
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
if Force_Complement then
Complement := Corresponding_Item (G, Vertex);
-- 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 (Vertex));
return DG.Component (G.Graph, Vertex);
end Component;
---------------------------------
-- Contains_Elaborate_All_Edge --
---------------------------------
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));
return
At_Least_One_Edge_Satisfies
(G => G,
Cycle => Cycle,
Predicate => Is_Elaborate_All_Edge'Access);
end Contains_Elaborate_All_Edge;
------------------------------------
-- Contains_Static_Successor_Edge --
------------------------------------
function Contains_Static_Successor_Edge
(G : Library_Graph;
Cycle : Library_Graph_Cycle_Id) return Boolean
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Cycle));
return
At_Least_One_Edge_Satisfies
(G => G,
Cycle => Cycle,
Predicate => Is_Static_Successor_Edge'Access);
end Contains_Static_Successor_Edge;
------------------------------
-- Contains_Task_Activation --
------------------------------
function Contains_Task_Activation
(G : Library_Graph;
Cycle : Library_Graph_Cycle_Id) return Boolean
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Cycle));
return
At_Least_One_Edge_Satisfies
(G => G,
Cycle => Cycle,
Predicate => Activates_Task'Access);
end Contains_Task_Activation;
---------------------
-- Copy_Cycle_Path --
---------------------
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 (LGE_Lists.Present (Cycle_Path));
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;
------------------------
-- Corresponding_Item --
------------------------
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));
return Get_LGV_Attributes (G, Vertex).Corresponding_Item;
end Corresponding_Item;
--------------------------
-- Corresponding_Vertex --
--------------------------
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));
return Unit_Tables.Get (G.Unit_To_Vertex, U_Id);
end Corresponding_Vertex;
------------
-- Create --
------------
function Create
(Initial_Vertices : Positive;
Initial_Edges : Positive) return Library_Graph
is
G : constant Library_Graph := new Library_Graph_Attributes;
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);
return G;
end Create;
------------------------
-- Cycle_End_Vertices --
------------------------
function Cycle_End_Vertices
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id;
Elaborate_All_Active : Boolean) return LGV_Sets.Membership_Set
is
Complement : Library_Graph_Vertex_Id;
End_Vertices : LGV_Sets.Membership_Set := LGV_Sets.Nil;
begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
End_Vertices := LGV_Sets.Create (2);
-- The input vertex always terminates a cycle path
LGV_Sets.Insert (End_Vertices, Vertex);
-- Add the complementary vertex to the set of cycle terminating
-- vertices when either Elaborate_All is in effect, or the input
-- vertex is part of an Elaborat_Body pair.
if Elaborate_All_Active
or else Is_Vertex_With_Elaborate_Body (G, Vertex)
then
Complement :=
Complementary_Vertex
(G => G,
Vertex => Vertex,
Force_Complement => Elaborate_All_Active);
if Present (Complement) then
LGV_Sets.Insert (End_Vertices, Complement);
end if;
end if;
return End_Vertices;
end Cycle_End_Vertices;
-------------------
-- Cycle_Kind_Of --
-------------------
function Cycle_Kind_Of
(G : Library_Graph;
Edge : Library_Graph_Edge_Id) return Library_Graph_Cycle_Kind
is
pragma Assert (Present (G));
pragma Assert (Present (Edge));
begin
if Is_Cyclic_Elaborate_All_Edge (G, Edge) then
return Elaborate_All_Cycle;
elsif Is_Cyclic_Elaborate_Body_Edge (G, Edge) then
return Elaborate_Body_Cycle;
elsif Is_Cyclic_Elaborate_Edge (G, Edge) then
return Elaborate_Cycle;
elsif Is_Cyclic_Forced_Edge (G, Edge) then
return Forced_Cycle;
elsif Is_Cyclic_Invocation_Edge (G, Edge) then
return Invocation_Cycle;
else
return No_Cycle_Kind;
end if;
end Cycle_Kind_Of;
---------------------------
-- Cycle_Kind_Precedence --
---------------------------
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);
begin
-- A lower ordinal indicates a higher precedence
if Kind_Pos < Comp_Pos then
return Higher_Precedence;
elsif Kind_Pos > Comp_Pos then
return Lower_Precedence;
else
return Equal_Precedence;
end if;
end Cycle_Kind_Precedence;
---------------------------
-- Cycle_Path_Precedence --
---------------------------
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;
if LGE_Lists.Has_Next (Iter) then
LGE_Lists.Next (Iter, Edge);
end if;
end Next_Available;
-- Local variables
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;
-- Start of processing for Cycle_Path_Precedence
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;
Comp_Iter := LGE_Lists.Iterate (Compared_To);
Path_Iter := LGE_Lists.Iterate (Path);
Next_Available (Comp_Iter, Comp_Edge);
Next_Available (Path_Iter, Path_Edge);
-- IMPORTANT:
--
-- * The iteration must run to completion in order to unlock the
-- edges of both paths.
while Present (Comp_Edge) or else Present (Path_Edge) loop
if Prec = Equal_Precedence
and then Present (Comp_Edge)
and then Present (Path_Edge)
then
Prec :=
Edge_Precedence
(G => G,
Edge => Path_Edge,
Compared_To => Comp_Edge);
end if;
Next_Available (Comp_Iter, Comp_Edge);
Next_Available (Path_Iter, Path_Edge);
end loop;
return Prec;
end Cycle_Path_Precedence;
----------------------
-- Cycle_Precedence --
----------------------
function Cycle_Precedence
(G : Library_Graph;
Cycle : Library_Graph_Cycle_Id;
Compared_To : Library_Graph_Cycle_Id) return Precedence_Kind
is
pragma Assert (Present (G));
pragma Assert (Present (Cycle));
pragma Assert (Present (Compared_To));
Comp_Invs : constant Natural :=
Invocation_Edge_Count (G, Compared_To);
Comp_Len : constant Natural := Length (G, Compared_To);
Cycle_Invs : constant Natural := Invocation_Edge_Count (G, Cycle);
Cycle_Len : constant Natural := Length (G, Cycle);
Kind_Prec : constant Precedence_Kind :=
Cycle_Kind_Precedence
(Kind => Kind (G, Cycle),
Compared_To => Kind (G, Compared_To));
begin
-- Prefer a cycle with higher precedence based on its kind
if Kind_Prec = Higher_Precedence
or else
Kind_Prec = Lower_Precedence
then
return Kind_Prec;
-- Prefer a shorter cycle
elsif Cycle_Len < Comp_Len then
return Higher_Precedence;
elsif Cycle_Len > Comp_Len then
return Lower_Precedence;
-- Prefer a cycle wih fewer invocation edges
elsif Cycle_Invs < Comp_Invs then
return Higher_Precedence;
elsif Cycle_Invs > Comp_Invs then
return Lower_Precedence;
-- Prefer a cycle with a higher path precedence
else
return
Cycle_Path_Precedence
(G => G,
Path => Path (G, Cycle),
Compared_To => Path (G, Compared_To));
end if;
end Cycle_Precedence;
----------------------------------------
-- Decrement_Library_Graph_Edge_Count --
----------------------------------------
procedure Decrement_Library_Graph_Edge_Count
(G : Library_Graph;
Kind : Library_Graph_Edge_Kind)
is
pragma Assert (Present (G));
Count : Natural renames G.Counts (Kind);
begin
Count := Count - 1;
end Decrement_Library_Graph_Edge_Count;
------------------------------------
-- Decrement_Pending_Predecessors --
------------------------------------
procedure Decrement_Pending_Predecessors
(G : Library_Graph;
Comp : Component_Id;
Edge : Library_Graph_Edge_Id)
is
Attrs : Component_Attributes;
begin
pragma Assert (Present (G));
pragma Assert (Present (Comp));
Attrs := Get_Component_Attributes (G, Comp);
Update_Pending_Predecessors
(Strong_Predecessors => Attrs.Pending_Strong_Predecessors,
Weak_Predecessors => Attrs.Pending_Weak_Predecessors,
Update_Weak => Is_Invocation_Edge (G, Edge),
Value => -1);
Set_Component_Attributes (G, Comp, Attrs);
end Decrement_Pending_Predecessors;
------------------------------------
-- Decrement_Pending_Predecessors --
------------------------------------
procedure Decrement_Pending_Predecessors
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id;
Edge : Library_Graph_Edge_Id)
is
Attrs : Library_Graph_Vertex_Attributes;
begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
Attrs := Get_LGV_Attributes (G, Vertex);
Update_Pending_Predecessors
(Strong_Predecessors => Attrs.Pending_Strong_Predecessors,
Weak_Predecessors => Attrs.Pending_Weak_Predecessors,
Update_Weak => Is_Invocation_Edge (G, Edge),
Value => -1);
Set_LGV_Attributes (G, Vertex, Attrs);
end Decrement_Pending_Predecessors;
-----------------------------------
-- Delete_Body_Before_Spec_Edges --
-----------------------------------
procedure Delete_Body_Before_Spec_Edges
(G : Library_Graph;
Edges : LGE_Lists.Doubly_Linked_List)
is
Edge : Library_Graph_Edge_Id;
Iter : LGE_Lists.Iterator;
begin
pragma Assert (Present (G));
pragma Assert (LGE_Lists.Present (Edges));
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);
Delete_Edge (G, Edge);
end loop;
end Delete_Body_Before_Spec_Edges;
-----------------
-- Delete_Edge --
-----------------
procedure Delete_Edge
(G : Library_Graph;
Edge : Library_Graph_Edge_Id)
is
pragma Assert (Present (G));
pragma Assert (Present (Edge));
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);
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.
RE_Sets.Delete (G.Recorded_Edges, Rel);
-- Delete the attributes of the edge
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));
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;
----------------------------------
-- Destroy_Component_Attributes --
----------------------------------
procedure Destroy_Component_Attributes
(Attrs : in out Component_Attributes)
is
pragma Unreferenced (Attrs);
begin
null;
end Destroy_Component_Attributes;
--------------------------------------------
-- Destroy_Library_Graph_Cycle_Attributes --
--------------------------------------------
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;
-------------------------------------------
-- Destroy_Library_Graph_Edge_Attributes --
-------------------------------------------
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;
---------------------------------------------
-- Destroy_Library_Graph_Vertex_Attributes --
---------------------------------------------
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;
---------------------
-- Edge_Precedence --
---------------------
function Edge_Precedence
(G : Library_Graph;
Edge : Library_Graph_Edge_Id;
Compared_To : Library_Graph_Edge_Id) return Precedence_Kind
is
pragma Assert (Present (G));
pragma Assert (Present (Edge));
pragma Assert (Present (Compared_To));
Comp_Succ : constant Library_Graph_Vertex_Id :=
Successor (G, Compared_To);
Edge_Succ : constant Library_Graph_Vertex_Id :=
Successor (G, Edge);
Kind_Prec : constant Precedence_Kind :=
Cycle_Kind_Precedence
(Kind => Cycle_Kind_Of (G, Edge),
Compared_To => Cycle_Kind_Of (G, Compared_To));
Succ_Prec : constant Precedence_Kind :=
Vertex_Precedence
(G => G,
Vertex => Edge_Succ,
Compared_To => Comp_Succ);
begin
-- Prefer an edge with a higher cycle kind precedence
if Kind_Prec = Higher_Precedence
or else
Kind_Prec = Lower_Precedence
then
return Kind_Prec;
-- Prefer an edge whose successor has a higher precedence
elsif Comp_Succ /= Edge_Succ
and then (Succ_Prec = Higher_Precedence
or else
Succ_Prec = Lower_Precedence)
then
return Succ_Prec;
-- Prefer an edge whose predecessor has a higher precedence
else
return
Vertex_Precedence
(G => G,
Vertex => Predecessor (G, Edge),
Compared_To => Predecessor (G, Compared_To));
end if;
end Edge_Precedence;
---------------
-- File_Name --
---------------
function File_Name
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id) return File_Name_Type
is
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));
Start_Phase (Component_Discovery);
-- Initialize or reinitialize the components of the graph
Initialize_Components (G);
-- 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.
Edges := LGE_Lists.Create;
Add_Body_Before_Spec_Edges (G, Edges);
DG.Find_Components (G.Graph);
-- Remove the special edges that link a predecessor body with a
-- successor spec because they cause unresolvable circularities.
Delete_Body_Before_Spec_Edges (G, Edges);
LGE_Lists.Destroy (Edges);
-- Update the number of predecessors various components must wait on
-- before they can be elaborated.
Update_Pending_Predecessors_Of_Components (G);
End_Phase (Component_Discovery);
end Find_Components;
-----------------
-- Find_Cycles --
-----------------
procedure Find_Cycles (G : Library_Graph) is
All_Cycle_Limit : constant Natural := 64;
-- The performance of Tarjan's algorithm may degrate to exponential
-- when pragma Elaborate_All is in effect, or some vertex is part of
-- an Elaborate_Body pair. In this case the algorithm discovers all
-- combinations of edges that close a circuit starting and ending on
-- some start vertex while going through different vertices. Use a
-- limit on the total number of cycles within a component to guard
-- against such degradation.
Comp : Component_Id;
Cycle_Count : Natural;
Iter : Component_Iterator;
begin
pragma Assert (Present (G));
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
Cycle_Count := 0;
-- Run the modified version of the algorithm on each component of the
-- graph.
Iter := Iterate_Components (G);
while Has_Next (Iter) loop
Next (Iter, Comp);
Find_Cycles_In_Component
(G => G,
Comp => Comp,
Cycle_Count => Cycle_Count,
Cycle_Limit => All_Cycle_Limit);
end loop;
End_Phase (Cycle_Discovery);
end Find_Cycles;
--------------------------------
-- Find_Cycles_From_Successor --
--------------------------------
procedure Find_Cycles_From_Successor
(G : Library_Graph;
Edge : Library_Graph_Edge_Id;
End_Vertices : LGV_Sets.Membership_Set;
Deleted_Vertices : LGV_Sets.Membership_Set;
Most_Significant_Edge : Library_Graph_Edge_Id;
Invocation_Edge_Count : Natural;
Cycle_Path_Stack : LGE_Lists.Doubly_Linked_List;
Visited_Set : LGV_Sets.Membership_Set;
Visited_Stack : LGV_Lists.Doubly_Linked_List;
Cycle_Count : in out Natural;
Cycle_Limit : Natural;
Elaborate_All_Active : Boolean;
Has_Cycle : out Boolean;
Indent : Indentation_Level)
is
pragma Assert (Present (G));
pragma Assert (Present (Edge));
pragma Assert (LGV_Sets.Present (End_Vertices));
pragma Assert (LGV_Sets.Present (Deleted_Vertices));
pragma Assert (LGE_Lists.Present (Cycle_Path_Stack));
pragma Assert (LGV_Sets.Present (Visited_Set));
pragma Assert (LGV_Lists.Present (Visited_Stack));
Succ : constant Library_Graph_Vertex_Id := Successor (G, Edge);
Succ_Indent : constant Indentation_Level :=
Indent + Nested_Indentation;
begin
-- Assume that the successor reached via the edge does not result in
-- a cycle.
Has_Cycle := False;
-- Nothing to do when the edge connects two vertices residing in two
-- different components.
if not Is_Cyclic_Edge (G, Edge) then
return;
end if;
Trace_Edge (G, Edge, Indent);
-- The modified version does not place vertices on the "point stack",
-- but instead collects the edges comprising the cycle. Prepare the
-- edge for backtracking.
LGE_Lists.Prepend (Cycle_Path_Stack, Edge);
Find_Cycles_From_Vertex
(G => G,
Vertex => Succ,
End_Vertices => End_Vertices,
Deleted_Vertices => Deleted_Vertices,
Most_Significant_Edge => Most_Significant_Edge,
Invocation_Edge_Count => Invocation_Edge_Count,
Cycle_Path_Stack => Cycle_Path_Stack,
Visited_Set => Visited_Set,
Visited_Stack => Visited_Stack,
Cycle_Count => Cycle_Count,
Cycle_Limit => Cycle_Limit,
Elaborate_All_Active => Elaborate_All_Active,
Is_Start_Vertex => False,
Has_Cycle => Has_Cycle,
Indent => Succ_Indent);
-- The modified version does not place vertices on the "point stack",
-- but instead collects the edges comprising the cycle. Backtrack the
-- edge.
LGE_Lists.Delete_First (Cycle_Path_Stack);
end Find_Cycles_From_Successor;
-----------------------------
-- Find_Cycles_From_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;
Complement : Library_Graph_Vertex_Id;
Edge : Library_Graph_Edge_Id;
Iter : Edges_To_Successors_Iterator;
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.
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
Has_Cycle := False;
-- 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.
if Cycle_Count >= Cycle_Limit then
return;
-- 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.
elsif not Is_Start_Vertex
and then LGV_Sets.Contains (End_Vertices, Vertex)
then
Trace_Vertex (G, Vertex, Indent);
Record_Cycle
(G => G,
Most_Significant_Edge => Most_Significant_Edge,
Invocation_Edge_Count => Invocation_Edge_Count,
Cycle_Path => Cycle_Path_Stack,
Indent => Indent);
Has_Cycle := True;
Cycle_Count := Cycle_Count + 1;
return;
-- 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.
elsif LGV_Sets.Contains (Deleted_Vertices, Vertex) then
return;
-- 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.
elsif LGV_Sets.Contains (Visited_Set, Vertex) then
return;
end if;
Trace_Vertex (G, Vertex, Indent);
-- Mark the vertex as visited
Visit
(Vertex => Vertex,
Visited_Set => Visited_Set,
Visited_Stack => Visited_Stack);
-- Extend the depth-first search via all the edges to successors
Iter := Iterate_Edges_To_Successors (G, Vertex);
while Has_Next (Iter) loop
Next (Iter, Edge);
Find_Cycles_From_Successor
(G => G,
Edge => Edge,
End_Vertices => End_Vertices,
Deleted_Vertices => Deleted_Vertices,
-- The edge may be more important than the most important edge
-- up to this point, thus "upgrading" the nature of the cycle,
-- and shifting its point of normalization.
Most_Significant_Edge =>
Highest_Precedence_Edge
(G => G,
Left => Edge,
Right => Most_Significant_Edge),
-- The edge may be an invocation edge, in which case the count
-- of invocation edges increases by one.
Invocation_Edge_Count =>
Maximum_Invocation_Edge_Count
(G => G,
Edge => Edge,
Count => Invocation_Edge_Count),
Cycle_Path_Stack => Cycle_Path_Stack,
Visited_Set => Visited_Set,
Visited_Stack => Visited_Stack,
Cycle_Count => Cycle_Count,
Cycle_Limit => Cycle_Limit,
Elaborate_All_Active => Elaborate_All_Active,
Has_Cycle => Successor_Has_Cycle,
Indent => Edge_Indent);
Has_Cycle := Has_Cycle or Successor_Has_Cycle;
end loop;
-- 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)
then
Complement :=
Complementary_Vertex
(G => G,
Vertex => Vertex,
Force_Complement => Elaborate_All_Active);
if Present (Complement) then
Find_Cycles_From_Vertex
(G => G,
Vertex => Complement,
End_Vertices => End_Vertices,
Deleted_Vertices => Deleted_Vertices,
Most_Significant_Edge => Most_Significant_Edge,
Invocation_Edge_Count => Invocation_Edge_Count,
Cycle_Path_Stack => Cycle_Path_Stack,
Visited_Set => Visited_Set,
Visited_Stack => Visited_Stack,
Cycle_Count => Cycle_Count,
Cycle_Limit => Cycle_Limit,
Elaborate_All_Active => Elaborate_All_Active,
Is_Start_Vertex => Is_Start_Vertex,
Has_Cycle => Complement_Has_Cycle,
Indent => Indent);
Has_Cycle := Has_Cycle or Complement_Has_Cycle;
end if;
end if;
-- 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.
if Has_Cycle or else Is_Start_Vertex then
Unvisit
(Vertex => Vertex,
Visited_Set => Visited_Set,
Visited_Stack => Visited_Stack);
end if;
-- 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 (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
Trace_Component (G, Comp, No_Indentation);
-- Initialize all component-level data structures
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;
-- 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.
Iter := Iterate_Component_Vertices (G, Comp);
while Has_Next (Iter) loop
Next (Iter, Vertex);
-- 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);
-- 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.
Find_Cycles_From_Vertex
(G => G,
Vertex => Vertex,
End_Vertices => End_Vertices,
Deleted_Vertices => Deleted_Vertices,
Most_Significant_Edge => No_Library_Graph_Edge,
Invocation_Edge_Count => 0,
Cycle_Path_Stack => Cycle_Path_Stack,
Visited_Set => Visited_Set,
Visited_Stack => Visited_Stack,
Cycle_Count => Cycle_Count,
Cycle_Limit => Cycle_Limit,
Elaborate_All_Active => Elaborate_All_Active,
Is_Start_Vertex => True,
Has_Cycle => Has_Cycle,
Indent => Nested_Indentation);
-- Destroy the cycle-terminating vertices because a new set must
-- be constructed for the next vertex.
LGV_Sets.Destroy (End_Vertices);
end loop;
-- Destroy all component-level data structures
LGE_Lists.Destroy (Cycle_Path_Stack);
LGV_Sets.Destroy (Deleted_Vertices);
LGV_Sets.Destroy (Visited_Set);
LGV_Lists.Destroy (Visited_Stack);
end Find_Cycles_In_Component;
---------------
-- Find_Edge --
---------------
function Find_Edge
(G : Library_Graph;
Pred : Library_Graph_Vertex_Id;
Succ : Library_Graph_Vertex_Id) return Library_Graph_Edge_Id
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);
begin
-- IMPORTANT:
--
-- * The iteration must run to completion in order to unlock the
-- edges to successors.
-- 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.
while Has_Next (Iter) loop
Next (Iter, Edge);
if Succ = Successor (G, Edge) then
pragma Assert (not Present (Result));
Result := Edge;
end if;
end loop;
pragma Assert (Present (Result));
return Result;
end Find_Edge;
---------------------------------------
-- Find_First_Lower_Precedence_Cycle --
---------------------------------------
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 (Present (Cycle));
-- Assume that there is no lesser cycle
Lesser_Cycle := No_Library_Graph_Cycle;
-- 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.
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
Lesser_Cycle := Current_Cycle;
end if;
end loop;
return Lesser_Cycle;
end Find_First_Lower_Precedence_Cycle;
------------------------------
-- Get_Component_Attributes --
------------------------------
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));
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
pragma Assert (Present (G));
pragma Assert (Present (Edge));
return LGE_Tables.Get (G.Edge_Attributes, Edge);
end Get_LGE_Attributes;
------------------------
-- Get_LGV_Attributes --
------------------------
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));
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;
----------------------------
-- Has_Elaborate_All_Edge --
----------------------------
function Has_Elaborate_All_Edge
(G : Library_Graph;
Comp : Component_Id) return Boolean
is
Has_Edge : Boolean;
Iter : Component_Vertex_Iterator;
Vertex : Library_Graph_Vertex_Id;
begin
pragma Assert (Present (G));
pragma Assert (Present (Comp));
-- Assume that there is no Elaborate_All edge
Has_Edge := False;
-- IMPORTANT:
--
-- * The iteration must run to completion in order to unlock the
-- component vertices.
Iter := Iterate_Component_Vertices (G, Comp);
while Has_Next (Iter) loop
Next (Iter, Vertex);
Has_Edge := Has_Edge or else Has_Elaborate_All_Edge (G, Vertex);
end loop;
return Has_Edge;
end Has_Elaborate_All_Edge;
----------------------------
-- Has_Elaborate_All_Edge --
----------------------------
function Has_Elaborate_All_Edge
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id) return Boolean
is
Edge : Library_Graph_Edge_Id;
Has_Edge : Boolean;
Iter : Edges_To_Successors_Iterator;
begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
-- Assume that there is no Elaborate_All edge
Has_Edge := False;
-- IMPORTANT:
--
-- * The iteration must run to completion in order to unlock the
-- edges to successors.
Iter := Iterate_Edges_To_Successors (G, Vertex);
while Has_Next (Iter) loop
Next (Iter, Edge);
Has_Edge :=
Has_Edge or else Is_Cyclic_Elaborate_All_Edge (G, Edge);
end loop;
return Has_Edge;
end Has_Elaborate_All_Edge;
------------------------
-- Has_Elaborate_Body --
------------------------
function Has_Elaborate_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);
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;
--------------
-- Has_Next --
--------------
function Has_Next (Iter : All_Vertex_Iterator) return Boolean is
begin
return DG.Has_Next (DG.All_Vertex_Iterator (Iter));
end Has_Next;
--------------
-- Has_Next --
--------------
function Has_Next (Iter : Component_Iterator) return Boolean is
begin
return DG.Has_Next (DG.Component_Iterator (Iter));
end Has_Next;
--------------
-- Has_Next --
--------------
function Has_Next (Iter : Component_Vertex_Iterator) return Boolean is
begin
return DG.Has_Next (DG.Component_Vertex_Iterator (Iter));
end Has_Next;
--------------
-- Has_Next --
--------------
function Has_Next (Iter : Edges_Of_Cycle_Iterator) return Boolean is
begin
return LGE_Lists.Has_Next (LGE_Lists.Iterator (Iter));
end Has_Next;
--------------
-- Has_Next --
--------------
function Has_Next (Iter : Edges_To_Successors_Iterator) return Boolean is
begin
return DG.Has_Next (DG.Outgoing_Edge_Iterator (Iter));
end Has_Next;
-----------------------------
-- Has_No_Elaboration_Code --
-----------------------------
function Has_No_Elaboration_Code
(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;
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;
-----------------------------------------
-- Hash_Predecessor_Successor_Relation --
-----------------------------------------
function Hash_Predecessor_Successor_Relation
(Rel : Predecessor_Successor_Relation) return Bucket_Range_Type
is
begin
pragma Assert (Present (Rel.Predecessor));
pragma Assert (Present (Rel.Successor));
return
Hash_Two_Keys
(Bucket_Range_Type (Rel.Predecessor),
Bucket_Range_Type (Rel.Successor));
end Hash_Predecessor_Successor_Relation;
------------------------------
-- 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));
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.
else
return LGC_Lists.First (G.Cycles);
end if;
end Highest_Precedence_Cycle;
-----------------------------
-- Highest_Precedence_Edge --
-----------------------------
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;
begin
pragma Assert (Present (G));
-- 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;
--------------------------
-- In_Elaboration_Order --
--------------------------
function In_Elaboration_Order
(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;
-----------------------
-- In_Same_Component --
-----------------------
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));
return Component (G, Left) = Component (G, Right);
end In_Same_Component;
----------------------------------------
-- Increment_Library_Graph_Edge_Count --
----------------------------------------
procedure Increment_Library_Graph_Edge_Count
(G : Library_Graph;
Kind : Library_Graph_Edge_Kind)
is
pragma Assert (Present (G));
Count : Natural renames G.Counts (Kind);
begin
Count := Count + 1;
end Increment_Library_Graph_Edge_Count;
------------------------------------
-- Increment_Pending_Predecessors --
------------------------------------
procedure Increment_Pending_Predecessors
(G : Library_Graph;
Comp : Component_Id;
Edge : Library_Graph_Edge_Id)
is
Attrs : Component_Attributes;
begin
pragma Assert (Present (G));
pragma Assert (Present (Comp));
Attrs := Get_Component_Attributes (G, Comp);
Update_Pending_Predecessors
(Strong_Predecessors => Attrs.Pending_Strong_Predecessors,
Weak_Predecessors => Attrs.Pending_Weak_Predecessors,
Update_Weak => Is_Invocation_Edge (G, Edge),
Value => 1);
Set_Component_Attributes (G, Comp, Attrs);
end Increment_Pending_Predecessors;
------------------------------------
-- Increment_Pending_Predecessors --
------------------------------------
procedure Increment_Pending_Predecessors
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id;
Edge : Library_Graph_Edge_Id)
is
Attrs : Library_Graph_Vertex_Attributes;
begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
Attrs := Get_LGV_Attributes (G, Vertex);
Update_Pending_Predecessors
(Strong_Predecessors => Attrs.Pending_Strong_Predecessors,
Weak_Predecessors => Attrs.Pending_Weak_Predecessors,
Update_Weak => Is_Invocation_Edge (G, Edge),
Value => 1);
Set_LGV_Attributes (G, Vertex, Attrs);
end Increment_Pending_Predecessors;
---------------------------
-- Initialize_Components --
---------------------------
procedure Initialize_Components (G : Library_Graph) 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.
if Number_Of_Components (G) > 0 then
Component_Tables.Destroy (G.Component_Attributes);
G.Component_Attributes :=
Component_Tables.Create (Number_Of_Vertices (G));
end if;
end Initialize_Components;
---------------------------
-- Invocation_Edge_Count --
---------------------------
function Invocation_Edge_Count
(G : Library_Graph;
Cycle : Library_Graph_Cycle_Id) return Natural
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Cycle));
return Get_LGC_Attributes (G, Cycle).Invocation_Edge_Count;
end Invocation_Edge_Count;
-------------------------------
-- Invocation_Graph_Encoding --
-------------------------------
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));
return Invocation_Graph_Encoding (Unit (G, Vertex));
end Invocation_Graph_Encoding;
-------------
-- Is_Body --
-------------
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);
begin
return U_Rec.Utype = Is_Body or else U_Rec.Utype = Is_Body_Only;
end Is_Body;
-----------------------------------------
-- Is_Body_Of_Spec_With_Elaborate_Body --
-----------------------------------------
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));
if Is_Body_With_Spec (G, Vertex) then
return
Is_Spec_With_Elaborate_Body
(G => G,
Vertex => Proper_Spec (G, Vertex));
end if;
return False;
end Is_Body_Of_Spec_With_Elaborate_Body;
-----------------------
-- Is_Body_With_Spec --
-----------------------
function Is_Body_With_Spec
(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);
begin
return U_Rec.Utype = Is_Body;
end Is_Body_With_Spec;
------------------------------
-- Is_Cycle_Initiating_Edge --
------------------------------
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));
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;
--------------------
-- Is_Cyclic_Edge --
--------------------
function Is_Cyclic_Edge
(G : Library_Graph;
Edge : Library_Graph_Edge_Id) return Boolean
is
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;
----------------------------------
-- Is_Cyclic_Elaborate_All_Edge --
----------------------------------
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));
return
Is_Elaborate_All_Edge (G, Edge)
and then Links_Vertices_In_Same_Component (G, Edge);
end Is_Cyclic_Elaborate_All_Edge;
-----------------------------------
-- Is_Cyclic_Elaborate_Body_Edge --
-----------------------------------
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));
return
Is_Elaborate_Body_Edge (G, Edge)
and then Links_Vertices_In_Same_Component (G, Edge);
end Is_Cyclic_Elaborate_Body_Edge;
------------------------------
-- Is_Cyclic_Elaborate_Edge --
------------------------------
function Is_Cyclic_Elaborate_Edge
(G : Library_Graph;
Edge : Library_Graph_Edge_Id) return Boolean
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;
---------------------------
-- Is_Cyclic_Forced_Edge --
---------------------------
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));
return
Is_Forced_Edge (G, Edge)
and then Links_Vertices_In_Same_Component (G, Edge);
end Is_Cyclic_Forced_Edge;
-------------------------------
-- Is_Cyclic_Invocation_Edge --
-------------------------------
function Is_Cyclic_Invocation_Edge
(G : Library_Graph;
Edge : Library_Graph_Edge_Id) return Boolean
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Edge));
return
Is_Invocation_Edge (G, Edge)
and then Links_Vertices_In_Same_Component (G, Edge);
end Is_Cyclic_Invocation_Edge;
-------------------------
-- Is_Cyclic_With_Edge --
-------------------------
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));
-- Ignore Elaborate_Body edges because they also appear as with
-- edges, but have special successors.
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;
-------------------------------
-- Is_Dynamically_Elaborated --
-------------------------------
function Is_Dynamically_Elaborated
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id) return Boolean
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
return Is_Dynamically_Elaborated (Unit (G, Vertex));
end Is_Dynamically_Elaborated;
-----------------------------
-- Is_Elaborable_Component --
-----------------------------
function Is_Elaborable_Component
(G : Library_Graph;
Comp : Component_Id) return Boolean
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;
--------------------------
-- Is_Elaborable_Vertex --
--------------------------
function Is_Elaborable_Vertex
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id) return Boolean
is
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
-- 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;
elsif Present (Complement)
and then In_Elaboration_Order (G, Complement)
then
return False;
elsif not Is_Elaborable_Component (G, Component (G, Vertex)) then
return False;
end if;
Pending_Predecessors_For_Elaboration
(G => G,
Vertex => Vertex,
Strong_Preds => Strong_Preds,
Weak_Preds => Weak_Preds);
return Strong_Preds = 0 and then Weak_Preds = 0;
end Is_Elaborable_Vertex;
---------------------------
-- 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 (Edge));
return Kind (G, Edge) = Elaborate_All_Edge;
end Is_Elaborate_All_Edge;
----------------------------
-- Is_Elaborate_Body_Edge --
----------------------------
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
Kind (G, Edge) = With_Edge
and then Is_Vertex_With_Elaborate_Body (G, Successor (G, Edge));
end Is_Elaborate_Body_Edge;
-----------------------
-- Is_Elaborate_Edge --
-----------------------
function Is_Elaborate_Edge
(G : Library_Graph;
Edge : Library_Graph_Edge_Id) return Boolean
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Edge));
return Kind (G, Edge) = Elaborate_Edge;
end Is_Elaborate_Edge;
----------------------------
-- Is_Elaborate_Body_Pair --
----------------------------
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));
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;
--------------------
-- Is_Forced_Edge --
--------------------
function Is_Forced_Edge
(G : Library_Graph;
Edge : Library_Graph_Edge_Id) return Boolean
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Edge));
return Kind (G, Edge) = Forced_Edge;
end Is_Forced_Edge;
----------------------
-- Is_Internal_Unit --
----------------------
function Is_Internal_Unit
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id) return Boolean
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
return Is_Internal_Unit (Unit (G, Vertex));
end Is_Internal_Unit;
------------------------
-- Is_Invocation_Edge --
------------------------
function Is_Invocation_Edge
(G : Library_Graph;
Edge : Library_Graph_Edge_Id) return Boolean
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Edge));
return Kind (G, Edge) = Invocation_Edge;
end Is_Invocation_Edge;
------------------------
-- Is_Predefined_Unit --
------------------------
function Is_Predefined_Unit
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id) return Boolean
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
return Is_Predefined_Unit (Unit (G, Vertex));
end Is_Predefined_Unit;
---------------------------
-- Is_Preelaborated_Unit --
---------------------------
function Is_Preelaborated_Unit
(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);
begin
return U_Rec.Preelab or else U_Rec.Pure;
end Is_Preelaborated_Unit;
----------------------
-- Is_Recorded_Edge --
----------------------
function Is_Recorded_Edge
(G : Library_Graph;
Rel : Predecessor_Successor_Relation) return Boolean
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Rel.Predecessor));
pragma Assert (Present (Rel.Successor));
return RE_Sets.Contains (G.Recorded_Edges, Rel);
end Is_Recorded_Edge;
-------------
-- Is_Spec --
-------------
function Is_Spec
(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);
begin
return U_Rec.Utype = Is_Spec or else U_Rec.Utype = Is_Spec_Only;
end Is_Spec;
------------------------------
-- Is_Spec_Before_Body_Edge --
------------------------------
function Is_Spec_Before_Body_Edge
(G : Library_Graph;
Edge : Library_Graph_Edge_Id) return Boolean
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Edge));
return Kind (G, Edge) = Spec_Before_Body_Edge;
end Is_Spec_Before_Body_Edge;
-----------------------
-- Is_Spec_With_Body --
-----------------------
function Is_Spec_With_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);
begin
return U_Rec.Utype = Is_Spec;
end Is_Spec_With_Body;
---------------------------------
-- Is_Spec_With_Elaborate_Body --
---------------------------------
function Is_Spec_With_Elaborate_Body
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id) return Boolean
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
return
Is_Spec_With_Body (G, Vertex)
and then Has_Elaborate_Body (G, Vertex);
end Is_Spec_With_Elaborate_Body;
------------------------------
-- Is_Static_Successor_Edge --
------------------------------
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));
return
Is_Invocation_Edge (G, Edge)
and then not Is_Dynamically_Elaborated (G, Successor (G, Edge));
end Is_Static_Successor_Edge;
-----------------------------------
-- Is_Vertex_With_Elaborate_Body --
-----------------------------------
function Is_Vertex_With_Elaborate_Body
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id) return Boolean
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
return
Is_Spec_With_Elaborate_Body (G, Vertex)
or else
Is_Body_Of_Spec_With_Elaborate_Body (G, Vertex);
end Is_Vertex_With_Elaborate_Body;
---------------------------------
-- Is_Weakly_Elaborable_Vertex --
----------------------------------
function Is_Weakly_Elaborable_Vertex
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id) return Boolean
is
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
-- 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
if In_Elaboration_Order (G, Vertex) then
return False;
elsif Present (Complement)
and then In_Elaboration_Order (G, Complement)
then
return False;
elsif not Is_Elaborable_Component (G, Component (G, Vertex)) then
return False;
end if;
Pending_Predecessors_For_Elaboration
(G => G,
Vertex => Vertex,
Strong_Preds => Strong_Preds,
Weak_Preds => Weak_Preds);
return Strong_Preds = 0 and then Weak_Preds >= 1;
end Is_Weakly_Elaborable_Vertex;
------------------
-- Is_With_Edge --
------------------
function Is_With_Edge
(G : Library_Graph;
Edge : Library_Graph_Edge_Id) return Boolean
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Edge));
return Kind (G, Edge) = With_Edge;
end Is_With_Edge;
------------------------
-- Iterate_All_Cycles --
------------------------
function Iterate_All_Cycles
(G : Library_Graph) return All_Cycle_Iterator
is
begin
pragma Assert (Present (G));
return All_Cycle_Iterator (LGC_Lists.Iterate (G.Cycles));
end Iterate_All_Cycles;
-----------------------
-- Iterate_All_Edges --
-----------------------
function Iterate_All_Edges
(G : Library_Graph) return All_Edge_Iterator
is
begin
pragma Assert (Present (G));
return All_Edge_Iterator (DG.Iterate_All_Edges (G.Graph));
end Iterate_All_Edges;
--------------------------
-- Iterate_All_Vertices --
--------------------------
function Iterate_All_Vertices
(G : Library_Graph) return All_Vertex_Iterator
is
begin
pragma Assert (Present (G));
return All_Vertex_Iterator (DG.Iterate_All_Vertices (G.Graph));
end Iterate_All_Vertices;
------------------------
-- Iterate_Components --
------------------------
function Iterate_Components
(G : Library_Graph) return Component_Iterator
is
begin
pragma Assert (Present (G));
return Component_Iterator (DG.Iterate_Components (G.Graph));
end Iterate_Components;
--------------------------------
-- Iterate_Component_Vertices --
--------------------------------
function Iterate_Component_Vertices
(G : Library_Graph;
Comp : Component_Id) return Component_Vertex_Iterator
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Comp));
return
Component_Vertex_Iterator
(DG.Iterate_Component_Vertices (G.Graph, Comp));
end Iterate_Component_Vertices;
----------------------------
-- Iterate_Edges_Of_Cycle --
----------------------------
function Iterate_Edges_Of_Cycle
(G : Library_Graph;
Cycle : Library_Graph_Cycle_Id) return Edges_Of_Cycle_Iterator
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Cycle));
return Edges_Of_Cycle_Iterator (LGE_Lists.Iterate (Path (G, Cycle)));
end Iterate_Edges_Of_Cycle;
---------------------------------
-- Iterate_Edges_To_Successors --
---------------------------------
function Iterate_Edges_To_Successors
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id) return Edges_To_Successors_Iterator
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Vertex));
return
Edges_To_Successors_Iterator
(DG.Iterate_Outgoing_Edges (G.Graph, Vertex));
end Iterate_Edges_To_Successors;
----------
-- Kind --
----------
function Kind
(G : Library_Graph;
Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Kind
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Cycle));
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 Get_LGE_Attributes (G, Edge).Kind;
end Kind;
------------
-- Length --
------------
function Length
(G : Library_Graph;
Cycle : Library_Graph_Cycle_Id) return Natural
is
begin
pragma Assert (Present (G));
pragma Assert (Present (Cycle));
return LGE_Lists.Size (Path (G, Cycle));
end Length;
------------------------------
-- Library_Graph_Edge_Count --