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, 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         Lib_Graph : Library_Graph;
61         Root      : Invocation_Graph_Vertex_Id);
62      pragma Inline (Visit_Elaboration_Root);
63      --  Start a DFS traversal from elaboration root Root to:
64      --
65      --    * Detect transitions between units.
66      --
67      --    * Create invocation edges for each such transition where the
68      --      successor is Root.
69
70      procedure Visit_Elaboration_Roots
71        (Inv_Graph : Invocation_Graph;
72         Lib_Graph : Library_Graph);
73      pragma Inline (Visit_Elaboration_Roots);
74      --  Start a DFS traversal from all elaboration roots to:
75      --
76      --    * Detect transitions between units.
77      --
78      --    * Create invocation edges for each such transition where the
79      --      successor is the current root.
80
81      procedure Visit_Vertex
82        (Inv_Graph                  : Invocation_Graph;
83         Lib_Graph                  : Library_Graph;
84         Invoker                    : Invocation_Graph_Vertex_Id;
85         Last_Vertex                : Library_Graph_Vertex_Id;
86         Root_Vertex                : Library_Graph_Vertex_Id;
87         Visited_Invokers           : IGV_Sets.Membership_Set;
88         Activates_Task             : Boolean;
89         Internal_Controlled_Action : Boolean;
90         Path                       : Natural);
91      pragma Inline (Visit_Vertex);
92      --  Visit invocation graph vertex Invoker to:
93      --
94      --    * Detect a transition from the last library graph vertex denoted by
95      --      Last_Vertex to the library graph vertex of Invoker.
96      --
97      --    * Create an invocation edge in library graph Lib_Graph to reflect
98      --      the transition, where the predecessor is the library graph vertex
99      --      or Invoker, and the successor is Root_Vertex.
100      --
101      --    * Visit the neighbours of Invoker.
102      --
103      --  Flag Internal_Controlled_Action should be set when the DFS traversal
104      --  visited an internal controlled invocation edge. Path is the length of
105      --  the path.
106
107      procedure Write_Statistics;
108      pragma Inline (Write_Statistics);
109      --  Write the statistical information of the augmentation to standard
110      --  output.
111
112      ---------------------------
113      -- Augment_Library_Graph --
114      ---------------------------
115
116      procedure Augment_Library_Graph
117        (Inv_Graph : Invocation_Graph;
118         Lib_Graph : Library_Graph)
119      is
120      begin
121         pragma Assert (Present (Lib_Graph));
122
123         --  Nothing to do when there is no invocation graph
124
125         if not Present (Inv_Graph) then
126            return;
127         end if;
128
129         Start_Phase (Library_Graph_Augmentation);
130
131         --  Prepare the statistics data
132
133         Longest_Path  := 0;
134         Total_Visited := 0;
135
136         Visit_Elaboration_Roots (Inv_Graph, Lib_Graph);
137         Write_Statistics;
138
139         End_Phase (Library_Graph_Augmentation);
140      end Augment_Library_Graph;
141
142      ----------------------------
143      -- Visit_Elaboration_Root --
144      ----------------------------
145
146      procedure Visit_Elaboration_Root
147        (Inv_Graph : Invocation_Graph;
148         Lib_Graph : Library_Graph;
149         Root      : Invocation_Graph_Vertex_Id)
150      is
151         pragma Assert (Present (Inv_Graph));
152         pragma Assert (Present (Lib_Graph));
153         pragma Assert (Present (Root));
154
155         Root_Vertex : constant Library_Graph_Vertex_Id :=
156                         Body_Vertex (Inv_Graph, Root);
157
158         Visited : IGV_Sets.Membership_Set;
159
160      begin
161         --  Nothing to do when the unit where the elaboration root resides
162         --  lacks elaboration code. This implies that any invocation edges
163         --  going out of the unit are unwanted. This behavior emulates the
164         --  old elaboration order mechanism.
165
166         if Has_No_Elaboration_Code (Lib_Graph, Root_Vertex) then
167            return;
168         end if;
169
170         --  Prepare the global data
171
172         Visited := IGV_Sets.Create (Number_Of_Vertices (Inv_Graph));
173
174         Visit_Vertex
175           (Inv_Graph                  => Inv_Graph,
176            Lib_Graph                  => Lib_Graph,
177            Invoker                    => Root,
178            Last_Vertex                => Root_Vertex,
179            Root_Vertex                => Root_Vertex,
180            Visited_Invokers           => Visited,
181            Activates_Task             => False,
182            Internal_Controlled_Action => False,
183            Path                       => 0);
184
185         IGV_Sets.Destroy (Visited);
186      end Visit_Elaboration_Root;
187
188      -----------------------------
189      -- Visit_Elaboration_Roots --
190      -----------------------------
191
192      procedure Visit_Elaboration_Roots
193        (Inv_Graph : Invocation_Graph;
194         Lib_Graph : Library_Graph)
195      is
196         Iter : Elaboration_Root_Iterator;
197         Root : Invocation_Graph_Vertex_Id;
198
199      begin
200         pragma Assert (Present (Inv_Graph));
201         pragma Assert (Present (Lib_Graph));
202
203         Iter := Iterate_Elaboration_Roots (Inv_Graph);
204         while Has_Next (Iter) loop
205            Next (Iter, Root);
206
207            Visit_Elaboration_Root
208              (Inv_Graph => Inv_Graph,
209               Lib_Graph => Lib_Graph,
210               Root      => Root);
211         end loop;
212      end Visit_Elaboration_Roots;
213
214      ------------------
215      -- Visit_Vertex --
216      ------------------
217
218      procedure Visit_Vertex
219        (Inv_Graph                  : Invocation_Graph;
220         Lib_Graph                  : Library_Graph;
221         Invoker                    : Invocation_Graph_Vertex_Id;
222         Last_Vertex                : Library_Graph_Vertex_Id;
223         Root_Vertex                : Library_Graph_Vertex_Id;
224         Visited_Invokers           : IGV_Sets.Membership_Set;
225         Activates_Task             : Boolean;
226         Internal_Controlled_Action : Boolean;
227         Path                       : Natural)
228      is
229         New_Path : constant Natural := Path + 1;
230
231         Edge           : Invocation_Graph_Edge_Id;
232         Edge_Kind      : Invocation_Kind;
233         Invoker_Vertex : Library_Graph_Vertex_Id;
234         Iter           : Edges_To_Targets_Iterator;
235
236      begin
237         pragma Assert (Present (Inv_Graph));
238         pragma Assert (Present (Lib_Graph));
239         pragma Assert (Present (Invoker));
240         pragma Assert (Present (Last_Vertex));
241         pragma Assert (Present (Root_Vertex));
242         pragma Assert (IGV_Sets.Present (Visited_Invokers));
243
244         --  Nothing to do when the current invocation graph vertex has already
245         --  been visited.
246
247         if IGV_Sets.Contains (Visited_Invokers, Invoker) then
248            return;
249         end if;
250
251         IGV_Sets.Insert (Visited_Invokers, Invoker);
252
253         --  Update the statistics
254
255         Longest_Path  := Natural'Max (Longest_Path, New_Path);
256         Total_Visited := Total_Visited + 1;
257
258         --  The library graph vertex of the current invocation graph vertex
259         --  differs from that of the previous invocation graph vertex. This
260         --  indicates that elaboration is transitioning from one unit to
261         --  another. Add a library graph edge to capture this dependency.
262
263         Invoker_Vertex := Body_Vertex (Inv_Graph, Invoker);
264         pragma Assert (Present (Invoker_Vertex));
265
266         if Invoker_Vertex /= Last_Vertex then
267
268            --  The path ultimately reaches back into the unit where the root
269            --  resides, resulting in a self dependency. In most cases this is
270            --  a valid circularity, except when the path went through one of
271            --  the Deep_xxx finalization-related routines. Do not create a
272            --  library graph edge because the circularity is the result of
273            --  expansion and thus spurious.
274
275            if Invoker_Vertex = Root_Vertex
276              and then Internal_Controlled_Action
277            then
278               null;
279
280            --  Otherwise create the library graph edge, even if this results
281            --  in a self dependency.
282
283            else
284               Add_Edge
285                 (G              => Lib_Graph,
286                  Pred           => Invoker_Vertex,
287                  Succ           => Root_Vertex,
288                  Kind           => Invocation_Edge,
289                  Activates_Task => Activates_Task);
290            end if;
291         end if;
292
293         --  Extend the DFS traversal to all targets of the invocation graph
294         --  vertex.
295
296         Iter := Iterate_Edges_To_Targets (Inv_Graph, Invoker);
297         while Has_Next (Iter) loop
298            Next (Iter, Edge);
299            Edge_Kind := Kind (Inv_Graph, Edge);
300
301            Visit_Vertex
302              (Inv_Graph                  => Inv_Graph,
303               Lib_Graph                  => Lib_Graph,
304               Invoker                    => Target (Inv_Graph, Edge),
305               Last_Vertex                => Invoker_Vertex,
306               Root_Vertex                => Root_Vertex,
307               Visited_Invokers           => Visited_Invokers,
308               Activates_Task             =>
309                 Activates_Task
310                   or else Edge_Kind = Task_Activation,
311               Internal_Controlled_Action =>
312                 Internal_Controlled_Action
313                   or else Edge_Kind in Internal_Controlled_Invocation_Kind,
314               Path                       => New_Path);
315         end loop;
316      end Visit_Vertex;
317
318      ----------------------
319      -- Write_Statistics --
320      ----------------------
321
322      procedure Write_Statistics is
323      begin
324         --  Nothing to do when switch -d_L (output library item graph) is not
325         --  in effect.
326
327         if not Debug_Flag_Underscore_LL then
328            return;
329         end if;
330
331         Write_Str ("Library Graph Augmentation");
332         Write_Eol;
333         Write_Eol;
334
335         Write_Str ("Vertices visited   : ");
336         Write_Num (Int (Total_Visited));
337         Write_Eol;
338
339         Write_Str ("Longest path length: ");
340         Write_Num (Int (Longest_Path));
341         Write_Eol;
342         Write_Eol;
343
344         Write_Str ("Library Graph Augmentation end");
345         Write_Eol;
346         Write_Eol;
347      end Write_Statistics;
348   end Library_Graph_Augmentors;
349
350end Bindo.Augmentors;
351