blob: d2f3c8a25b3ed638df839aa4a1d86a89eeaa78b9 [file] [log] [blame]
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- B I N D O . A U G M E N T O R S --
-- --
-- B o d y --
-- --
-- Copyright (C) 2019-2022, 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 Debug; use Debug;
with Output; use Output;
with Types; use Types;
with Bindo.Writers;
use Bindo.Writers;
use Bindo.Writers.Phase_Writers;
package body Bindo.Augmentors is
------------------------------
-- Library_Graph_Augmentors --
------------------------------
package body Library_Graph_Augmentors is
----------------
-- Statistics --
----------------
Longest_Path : Natural := 0;
-- The length of the longest path found during the traversal of the
-- invocation graph.
Total_Visited : Natural := 0;
-- The number of visited invocation graph vertices during the process
-- of augmentation.
-----------------------
-- Local subprograms --
-----------------------
procedure Visit_Elaboration_Root
(Inv_Graph : Invocation_Graph;
Root : Invocation_Graph_Vertex_Id);
pragma Inline (Visit_Elaboration_Root);
-- Start a DFS traversal from elaboration root Root to:
--
-- * Detect transitions between units.
--
-- * Create invocation edges for each such transition where the
-- successor is Root.
procedure Visit_Elaboration_Roots (Inv_Graph : Invocation_Graph);
pragma Inline (Visit_Elaboration_Roots);
-- Start a DFS traversal from all elaboration roots to:
--
-- * Detect transitions between units.
--
-- * Create invocation edges for each such transition where the
-- successor is the current root.
procedure Visit_Vertex
(Inv_Graph : Invocation_Graph;
Invoker : Invocation_Graph_Vertex_Id;
Last_Vertex : Library_Graph_Vertex_Id;
Root_Vertex : Library_Graph_Vertex_Id;
Visited_Invokers : IGV_Sets.Membership_Set;
Activates_Task : Boolean;
Internal_Controlled_Action : Boolean;
Path : Natural);
pragma Inline (Visit_Vertex);
-- Visit invocation graph vertex Invoker to:
--
-- * Detect a transition from the last library graph vertex denoted by
-- Last_Vertex to the library graph vertex of Invoker.
--
-- * Create an invocation edge in library graph Lib_Graph to reflect
-- the transition, where the predecessor is the library graph vertex
-- or Invoker, and the successor is Root_Vertex.
--
-- * Visit the neighbours of Invoker.
--
-- Flag Internal_Controlled_Action should be set when the DFS traversal
-- visited an internal controlled invocation edge. Path is the length of
-- the path.
procedure Write_Statistics;
pragma Inline (Write_Statistics);
-- Write the statistical information of the augmentation to standard
-- output.
---------------------------
-- Augment_Library_Graph --
---------------------------
procedure Augment_Library_Graph (Inv_Graph : Invocation_Graph) is
Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph);
begin
pragma Assert (Present (Lib_Graph));
-- Nothing to do when there is no invocation graph
if not Present (Inv_Graph) then
return;
end if;
Start_Phase (Library_Graph_Augmentation);
-- Prepare the statistics data
Longest_Path := 0;
Total_Visited := 0;
Visit_Elaboration_Roots (Inv_Graph);
Write_Statistics;
End_Phase (Library_Graph_Augmentation);
end Augment_Library_Graph;
----------------------------
-- Visit_Elaboration_Root --
----------------------------
procedure Visit_Elaboration_Root
(Inv_Graph : Invocation_Graph;
Root : Invocation_Graph_Vertex_Id)
is
Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph);
pragma Assert (Present (Inv_Graph));
pragma Assert (Present (Lib_Graph));
pragma Assert (Present (Root));
Root_Vertex : constant Library_Graph_Vertex_Id :=
Body_Vertex (Inv_Graph, Root);
Visited : IGV_Sets.Membership_Set;
begin
-- Nothing to do when the unit where the elaboration root resides
-- lacks elaboration code. This implies that any invocation edges
-- going out of the unit are unwanted. This behavior emulates the
-- old elaboration order mechanism.
if Has_No_Elaboration_Code (Lib_Graph, Root_Vertex) then
return;
end if;
-- Prepare the global data
Visited := IGV_Sets.Create (Number_Of_Vertices (Inv_Graph));
Visit_Vertex
(Inv_Graph => Inv_Graph,
Invoker => Root,
Last_Vertex => Root_Vertex,
Root_Vertex => Root_Vertex,
Visited_Invokers => Visited,
Activates_Task => False,
Internal_Controlled_Action => False,
Path => 0);
IGV_Sets.Destroy (Visited);
end Visit_Elaboration_Root;
-----------------------------
-- Visit_Elaboration_Roots --
-----------------------------
procedure Visit_Elaboration_Roots (Inv_Graph : Invocation_Graph) is
Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph);
pragma Assert (Present (Inv_Graph));
pragma Assert (Present (Lib_Graph));
Iter : Elaboration_Root_Iterator;
Root : Invocation_Graph_Vertex_Id;
begin
Iter := Iterate_Elaboration_Roots (Inv_Graph);
while Has_Next (Iter) loop
Next (Iter, Root);
Visit_Elaboration_Root (Inv_Graph => Inv_Graph, Root => Root);
end loop;
end Visit_Elaboration_Roots;
------------------
-- Visit_Vertex --
------------------
procedure Visit_Vertex
(Inv_Graph : Invocation_Graph;
Invoker : Invocation_Graph_Vertex_Id;
Last_Vertex : Library_Graph_Vertex_Id;
Root_Vertex : Library_Graph_Vertex_Id;
Visited_Invokers : IGV_Sets.Membership_Set;
Activates_Task : Boolean;
Internal_Controlled_Action : Boolean;
Path : Natural)
is
Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph);
New_Path : constant Natural := Path + 1;
Edge : Invocation_Graph_Edge_Id;
Edge_Kind : Invocation_Kind;
Invoker_Vertex : Library_Graph_Vertex_Id;
Iter : Edges_To_Targets_Iterator;
begin
pragma Assert (Present (Inv_Graph));
pragma Assert (Present (Lib_Graph));
pragma Assert (Present (Invoker));
pragma Assert (Present (Last_Vertex));
pragma Assert (Present (Root_Vertex));
pragma Assert (IGV_Sets.Present (Visited_Invokers));
-- Nothing to do when the current invocation graph vertex has already
-- been visited.
if IGV_Sets.Contains (Visited_Invokers, Invoker) then
return;
end if;
IGV_Sets.Insert (Visited_Invokers, Invoker);
-- Update the statistics
Longest_Path := Natural'Max (Longest_Path, New_Path);
Total_Visited := Total_Visited + 1;
-- The library graph vertex of the current invocation graph vertex
-- differs from that of the previous invocation graph vertex. This
-- indicates that elaboration is transitioning from one unit to
-- another. Add a library graph edge to capture this dependency.
Invoker_Vertex := Body_Vertex (Inv_Graph, Invoker);
pragma Assert (Present (Invoker_Vertex));
if Invoker_Vertex /= Last_Vertex then
-- The path ultimately reaches back into the unit where the root
-- resides, resulting in a self dependency. In most cases this is
-- a valid circularity, except when the path went through one of
-- the Deep_xxx finalization-related routines. Do not create a
-- library graph edge because the circularity is the result of
-- expansion and thus spurious.
if Invoker_Vertex = Root_Vertex
and then Internal_Controlled_Action
then
null;
-- Otherwise create the library graph edge, even if this results
-- in a self dependency.
else
Add_Edge
(G => Lib_Graph,
Pred => Invoker_Vertex,
Succ => Root_Vertex,
Kind => Invocation_Edge,
Activates_Task => Activates_Task);
end if;
end if;
-- Extend the DFS traversal to all targets of the invocation graph
-- vertex.
Iter := Iterate_Edges_To_Targets (Inv_Graph, Invoker);
while Has_Next (Iter) loop
Next (Iter, Edge);
Edge_Kind := Kind (Inv_Graph, Edge);
Visit_Vertex
(Inv_Graph => Inv_Graph,
Invoker => Target (Inv_Graph, Edge),
Last_Vertex => Invoker_Vertex,
Root_Vertex => Root_Vertex,
Visited_Invokers => Visited_Invokers,
Activates_Task =>
Activates_Task
or else Edge_Kind = Task_Activation,
Internal_Controlled_Action =>
Internal_Controlled_Action
or else Edge_Kind in Internal_Controlled_Invocation_Kind,
Path => New_Path);
end loop;
end Visit_Vertex;
----------------------
-- Write_Statistics --
----------------------
procedure Write_Statistics is
begin
-- Nothing to do when switch -d_L (output library item graph) is not
-- in effect.
if not Debug_Flag_Underscore_LL then
return;
end if;
Write_Str ("Library Graph Augmentation");
Write_Eol;
Write_Eol;
Write_Str ("Vertices visited : ");
Write_Num (Int (Total_Visited));
Write_Eol;
Write_Str ("Longest path length: ");
Write_Num (Int (Longest_Path));
Write_Eol;
Write_Eol;
Write_Str ("Library Graph Augmentation end");
Write_Eol;
Write_Eol;
end Write_Statistics;
end Library_Graph_Augmentors;
end Bindo.Augmentors;