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