1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT COMPILER COMPONENTS                         --
4--                                                                          --
5--                      B I N D O . A U G M E N T O R S                     --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--             Copyright (C) 2019-2020, Free Software Foundation, Inc.      --
10--                                                                          --
11-- GNAT is free software;  you can  redistribute it  and/or modify it under --
12-- terms of the  GNU General Public License as published  by the Free Soft- --
13-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
17-- for  more details.  You should have  received  a copy of the GNU General --
18-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
19-- http://www.gnu.org/licenses for a complete copy of the license.          --
20--                                                                          --
21-- GNAT was originally developed  by the GNAT team at  New York University. --
22-- Extensive contributions were provided by Ada Core Technologies Inc.      --
23--                                                                          --
24------------------------------------------------------------------------------
25
26with Debug;  use Debug;
27with Output; use Output;
28with Types;  use Types;
29
30with Bindo.Writers;
31use  Bindo.Writers;
32use  Bindo.Writers.Phase_Writers;
33
34package body Bindo.Augmentors is
35
36   ------------------------------
37   -- Library_Graph_Augmentors --
38   ------------------------------
39
40   package body Library_Graph_Augmentors is
41
42      ----------------
43      -- Statistics --
44      ----------------
45
46      Longest_Path : Natural := 0;
47      --  The length of the longest path found during the traversal of the
48      --  invocation graph.
49
50      Total_Visited : Natural := 0;
51      --  The number of visited invocation graph vertices during the process
52      --  of augmentation.
53
54      -----------------------
55      -- Local subprograms --
56      -----------------------
57
58      procedure Visit_Elaboration_Root
59        (Inv_Graph : Invocation_Graph;
60         Root      : Invocation_Graph_Vertex_Id);
61      pragma Inline (Visit_Elaboration_Root);
62      --  Start a DFS traversal from elaboration root Root to:
63      --
64      --    * Detect transitions between units.
65      --
66      --    * Create invocation edges for each such transition where the
67      --      successor is Root.
68
69      procedure Visit_Elaboration_Roots (Inv_Graph : Invocation_Graph);
70      pragma Inline (Visit_Elaboration_Roots);
71      --  Start a DFS traversal from all elaboration roots to:
72      --
73      --    * Detect transitions between units.
74      --
75      --    * Create invocation edges for each such transition where the
76      --      successor is the current root.
77
78      procedure Visit_Vertex
79        (Inv_Graph                  : Invocation_Graph;
80         Invoker                    : Invocation_Graph_Vertex_Id;
81         Last_Vertex                : Library_Graph_Vertex_Id;
82         Root_Vertex                : Library_Graph_Vertex_Id;
83         Visited_Invokers           : IGV_Sets.Membership_Set;
84         Activates_Task             : Boolean;
85         Internal_Controlled_Action : Boolean;
86         Path                       : Natural);
87      pragma Inline (Visit_Vertex);
88      --  Visit invocation graph vertex Invoker to:
89      --
90      --    * Detect a transition from the last library graph vertex denoted by
91      --      Last_Vertex to the library graph vertex of Invoker.
92      --
93      --    * Create an invocation edge in library graph Lib_Graph to reflect
94      --      the transition, where the predecessor is the library graph vertex
95      --      or Invoker, and the successor is Root_Vertex.
96      --
97      --    * Visit the neighbours of Invoker.
98      --
99      --  Flag Internal_Controlled_Action should be set when the DFS traversal
100      --  visited an internal controlled invocation edge. Path is the length of
101      --  the path.
102
103      procedure Write_Statistics;
104      pragma Inline (Write_Statistics);
105      --  Write the statistical information of the augmentation to standard
106      --  output.
107
108      ---------------------------
109      -- Augment_Library_Graph --
110      ---------------------------
111
112      procedure Augment_Library_Graph (Inv_Graph : Invocation_Graph) is
113         Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph);
114      begin
115         pragma Assert (Present (Lib_Graph));
116
117         --  Nothing to do when there is no invocation graph
118
119         if not Present (Inv_Graph) then
120            return;
121         end if;
122
123         Start_Phase (Library_Graph_Augmentation);
124
125         --  Prepare the statistics data
126
127         Longest_Path  := 0;
128         Total_Visited := 0;
129
130         Visit_Elaboration_Roots (Inv_Graph);
131         Write_Statistics;
132
133         End_Phase (Library_Graph_Augmentation);
134      end Augment_Library_Graph;
135
136      ----------------------------
137      -- Visit_Elaboration_Root --
138      ----------------------------
139
140      procedure Visit_Elaboration_Root
141        (Inv_Graph : Invocation_Graph;
142         Root      : Invocation_Graph_Vertex_Id)
143      is
144         Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph);
145         pragma Assert (Present (Inv_Graph));
146         pragma Assert (Present (Lib_Graph));
147         pragma Assert (Present (Root));
148
149         Root_Vertex : constant Library_Graph_Vertex_Id :=
150                         Body_Vertex (Inv_Graph, Root);
151
152         Visited : IGV_Sets.Membership_Set;
153
154      begin
155         --  Nothing to do when the unit where the elaboration root resides
156         --  lacks elaboration code. This implies that any invocation edges
157         --  going out of the unit are unwanted. This behavior emulates the
158         --  old elaboration order mechanism.
159
160         if Has_No_Elaboration_Code (Lib_Graph, Root_Vertex) then
161            return;
162         end if;
163
164         --  Prepare the global data
165
166         Visited := IGV_Sets.Create (Number_Of_Vertices (Inv_Graph));
167
168         Visit_Vertex
169           (Inv_Graph                  => Inv_Graph,
170            Invoker                    => Root,
171            Last_Vertex                => Root_Vertex,
172            Root_Vertex                => Root_Vertex,
173            Visited_Invokers           => Visited,
174            Activates_Task             => False,
175            Internal_Controlled_Action => False,
176            Path                       => 0);
177
178         IGV_Sets.Destroy (Visited);
179      end Visit_Elaboration_Root;
180
181      -----------------------------
182      -- Visit_Elaboration_Roots --
183      -----------------------------
184
185      procedure Visit_Elaboration_Roots (Inv_Graph : Invocation_Graph) is
186         Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph);
187         pragma Assert (Present (Inv_Graph));
188         pragma Assert (Present (Lib_Graph));
189
190         Iter : Elaboration_Root_Iterator;
191         Root : Invocation_Graph_Vertex_Id;
192
193      begin
194         Iter := Iterate_Elaboration_Roots (Inv_Graph);
195         while Has_Next (Iter) loop
196            Next (Iter, Root);
197
198            Visit_Elaboration_Root (Inv_Graph => Inv_Graph, Root => Root);
199         end loop;
200      end Visit_Elaboration_Roots;
201
202      ------------------
203      -- Visit_Vertex --
204      ------------------
205
206      procedure Visit_Vertex
207        (Inv_Graph                  : Invocation_Graph;
208         Invoker                    : Invocation_Graph_Vertex_Id;
209         Last_Vertex                : Library_Graph_Vertex_Id;
210         Root_Vertex                : Library_Graph_Vertex_Id;
211         Visited_Invokers           : IGV_Sets.Membership_Set;
212         Activates_Task             : Boolean;
213         Internal_Controlled_Action : Boolean;
214         Path                       : Natural)
215      is
216         Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph);
217
218         New_Path : constant Natural := Path + 1;
219
220         Edge           : Invocation_Graph_Edge_Id;
221         Edge_Kind      : Invocation_Kind;
222         Invoker_Vertex : Library_Graph_Vertex_Id;
223         Iter           : Edges_To_Targets_Iterator;
224
225      begin
226         pragma Assert (Present (Inv_Graph));
227         pragma Assert (Present (Lib_Graph));
228         pragma Assert (Present (Invoker));
229         pragma Assert (Present (Last_Vertex));
230         pragma Assert (Present (Root_Vertex));
231         pragma Assert (IGV_Sets.Present (Visited_Invokers));
232
233         --  Nothing to do when the current invocation graph vertex has already
234         --  been visited.
235
236         if IGV_Sets.Contains (Visited_Invokers, Invoker) then
237            return;
238         end if;
239
240         IGV_Sets.Insert (Visited_Invokers, Invoker);
241
242         --  Update the statistics
243
244         Longest_Path  := Natural'Max (Longest_Path, New_Path);
245         Total_Visited := Total_Visited + 1;
246
247         --  The library graph vertex of the current invocation graph vertex
248         --  differs from that of the previous invocation graph vertex. This
249         --  indicates that elaboration is transitioning from one unit to
250         --  another. Add a library graph edge to capture this dependency.
251
252         Invoker_Vertex := Body_Vertex (Inv_Graph, Invoker);
253         pragma Assert (Present (Invoker_Vertex));
254
255         if Invoker_Vertex /= Last_Vertex then
256
257            --  The path ultimately reaches back into the unit where the root
258            --  resides, resulting in a self dependency. In most cases this is
259            --  a valid circularity, except when the path went through one of
260            --  the Deep_xxx finalization-related routines. Do not create a
261            --  library graph edge because the circularity is the result of
262            --  expansion and thus spurious.
263
264            if Invoker_Vertex = Root_Vertex
265              and then Internal_Controlled_Action
266            then
267               null;
268
269            --  Otherwise create the library graph edge, even if this results
270            --  in a self dependency.
271
272            else
273               Add_Edge
274                 (G              => Lib_Graph,
275                  Pred           => Invoker_Vertex,
276                  Succ           => Root_Vertex,
277                  Kind           => Invocation_Edge,
278                  Activates_Task => Activates_Task);
279            end if;
280         end if;
281
282         --  Extend the DFS traversal to all targets of the invocation graph
283         --  vertex.
284
285         Iter := Iterate_Edges_To_Targets (Inv_Graph, Invoker);
286         while Has_Next (Iter) loop
287            Next (Iter, Edge);
288            Edge_Kind := Kind (Inv_Graph, Edge);
289
290            Visit_Vertex
291              (Inv_Graph                  => Inv_Graph,
292               Invoker                    => Target (Inv_Graph, Edge),
293               Last_Vertex                => Invoker_Vertex,
294               Root_Vertex                => Root_Vertex,
295               Visited_Invokers           => Visited_Invokers,
296               Activates_Task             =>
297                 Activates_Task
298                   or else Edge_Kind = Task_Activation,
299               Internal_Controlled_Action =>
300                 Internal_Controlled_Action
301                   or else Edge_Kind in Internal_Controlled_Invocation_Kind,
302               Path                       => New_Path);
303         end loop;
304      end Visit_Vertex;
305
306      ----------------------
307      -- Write_Statistics --
308      ----------------------
309
310      procedure Write_Statistics is
311      begin
312         --  Nothing to do when switch -d_L (output library item graph) is not
313         --  in effect.
314
315         if not Debug_Flag_Underscore_LL then
316            return;
317         end if;
318
319         Write_Str ("Library Graph Augmentation");
320         Write_Eol;
321         Write_Eol;
322
323         Write_Str ("Vertices visited   : ");
324         Write_Num (Int (Total_Visited));
325         Write_Eol;
326
327         Write_Str ("Longest path length: ");
328         Write_Num (Int (Longest_Path));
329         Write_Eol;
330         Write_Eol;
331
332         Write_Str ("Library Graph Augmentation end");
333         Write_Eol;
334         Write_Eol;
335      end Write_Statistics;
336   end Library_Graph_Augmentors;
337
338end Bindo.Augmentors;
339