mirror of
https://forge.sourceware.org/marek/gcc.git
synced 2026-02-22 03:47:02 -05:00
339 lines
12 KiB
Ada
339 lines
12 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- 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-2026, 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;
|