------------------------------------------------------------------------------ | |

-- -- | |

-- 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; |