|
145
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- B I N D O . B U I L D E 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
|
|
|
26 with Binderr; use Binderr;
|
|
|
27 with Butil; use Butil;
|
|
|
28 with Debug; use Debug;
|
|
|
29 with Opt; use Opt;
|
|
|
30 with Output; use Output;
|
|
|
31 with Types; use Types;
|
|
|
32
|
|
|
33 with Bindo.Units; use Bindo.Units;
|
|
|
34
|
|
|
35 with Bindo.Validators;
|
|
|
36 use Bindo.Validators;
|
|
|
37 use Bindo.Validators.Invocation_Graph_Validators;
|
|
|
38 use Bindo.Validators.Library_Graph_Validators;
|
|
|
39
|
|
|
40 with Bindo.Writers;
|
|
|
41 use Bindo.Writers;
|
|
|
42 use Bindo.Writers.Phase_Writers;
|
|
|
43
|
|
|
44 with GNAT; use GNAT;
|
|
|
45 with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables;
|
|
|
46
|
|
|
47 package body Bindo.Builders is
|
|
|
48
|
|
|
49 -------------------------------
|
|
|
50 -- Invocation_Graph_Builders --
|
|
|
51 -------------------------------
|
|
|
52
|
|
|
53 package body Invocation_Graph_Builders is
|
|
|
54
|
|
|
55 -----------------
|
|
|
56 -- Global data --
|
|
|
57 -----------------
|
|
|
58
|
|
|
59 Inv_Graph : Invocation_Graph := Invocation_Graphs.Nil;
|
|
|
60 Lib_Graph : Library_Graph := Library_Graphs.Nil;
|
|
|
61
|
|
|
62 -----------------------
|
|
|
63 -- Local subprograms --
|
|
|
64 -----------------------
|
|
|
65
|
|
|
66 procedure Create_Edge (IR_Id : Invocation_Relation_Id);
|
|
|
67 pragma Inline (Create_Edge);
|
|
|
68 -- Create a new edge for invocation relation IR_Id in invocation graph
|
|
|
69 -- Inv_Graph.
|
|
|
70
|
|
|
71 procedure Create_Edges (U_Id : Unit_Id);
|
|
|
72 pragma Inline (Create_Edges);
|
|
|
73 -- Create new edges for all invocation relations of unit U_Id
|
|
|
74
|
|
|
75 procedure Create_Vertex
|
|
|
76 (IC_Id : Invocation_Construct_Id;
|
|
|
77 Vertex : Library_Graph_Vertex_Id);
|
|
|
78 pragma Inline (Create_Vertex);
|
|
|
79 -- Create a new vertex for invocation construct IC_Id in invocation
|
|
|
80 -- graph Inv_Graph. The vertex is linked to vertex Vertex of library
|
|
|
81 -- graph Lib_Graph.
|
|
|
82
|
|
|
83 procedure Create_Vertices (U_Id : Unit_Id);
|
|
|
84 pragma Inline (Create_Vertices);
|
|
|
85 -- Create new vertices for all invocation constructs of unit U_Id in
|
|
|
86 -- invocation graph Inv_Graph.
|
|
|
87
|
|
|
88 function Declaration_Placement_Vertex
|
|
|
89 (Vertex : Library_Graph_Vertex_Id;
|
|
|
90 Placement : Declaration_Placement_Kind)
|
|
|
91 return Library_Graph_Vertex_Id;
|
|
|
92 pragma Inline (Declaration_Placement_Vertex);
|
|
|
93 -- Obtain the spec or body of vertex Vertex depending on the requested
|
|
|
94 -- placement in Placement.
|
|
|
95
|
|
|
96 ----------------------------
|
|
|
97 -- Build_Invocation_Graph --
|
|
|
98 ----------------------------
|
|
|
99
|
|
|
100 function Build_Invocation_Graph
|
|
|
101 (Lib_G : Library_Graph) return Invocation_Graph
|
|
|
102 is
|
|
|
103 begin
|
|
|
104 pragma Assert (Present (Lib_G));
|
|
|
105
|
|
|
106 Start_Phase (Invocation_Graph_Construction);
|
|
|
107
|
|
|
108 -- Prepare the global data
|
|
|
109
|
|
|
110 Inv_Graph :=
|
|
|
111 Create
|
|
|
112 (Initial_Vertices => Number_Of_Elaborable_Units,
|
|
|
113 Initial_Edges => Number_Of_Elaborable_Units);
|
|
|
114 Lib_Graph := Lib_G;
|
|
|
115
|
|
|
116 For_Each_Elaborable_Unit (Create_Vertices'Access);
|
|
|
117 For_Each_Elaborable_Unit (Create_Edges'Access);
|
|
|
118
|
|
|
119 Validate_Invocation_Graph (Inv_Graph);
|
|
|
120 End_Phase (Invocation_Graph_Construction);
|
|
|
121
|
|
|
122 return Inv_Graph;
|
|
|
123 end Build_Invocation_Graph;
|
|
|
124
|
|
|
125 -----------------
|
|
|
126 -- Create_Edge --
|
|
|
127 -----------------
|
|
|
128
|
|
|
129 procedure Create_Edge (IR_Id : Invocation_Relation_Id) is
|
|
|
130 pragma Assert (Present (Inv_Graph));
|
|
|
131 pragma Assert (Present (Lib_Graph));
|
|
|
132 pragma Assert (Present (IR_Id));
|
|
|
133
|
|
|
134 Invoker_Sig : constant Invocation_Signature_Id := Invoker (IR_Id);
|
|
|
135 Target_Sig : constant Invocation_Signature_Id := Target (IR_Id);
|
|
|
136
|
|
|
137 pragma Assert (Present (Invoker_Sig));
|
|
|
138 pragma Assert (Present (Target_Sig));
|
|
|
139
|
|
|
140 begin
|
|
|
141 -- Nothing to do when the target denotes an invocation construct that
|
|
|
142 -- resides in a unit which will never be elaborated.
|
|
|
143
|
|
|
144 if not Needs_Elaboration (Target_Sig) then
|
|
|
145 return;
|
|
|
146 end if;
|
|
|
147
|
|
|
148 Add_Edge
|
|
|
149 (G => Inv_Graph,
|
|
|
150 Source => Corresponding_Vertex (Inv_Graph, Invoker_Sig),
|
|
|
151 Target => Corresponding_Vertex (Inv_Graph, Target_Sig),
|
|
|
152 IR_Id => IR_Id);
|
|
|
153 end Create_Edge;
|
|
|
154
|
|
|
155 ------------------
|
|
|
156 -- Create_Edges --
|
|
|
157 ------------------
|
|
|
158
|
|
|
159 procedure Create_Edges (U_Id : Unit_Id) is
|
|
|
160 pragma Assert (Present (Inv_Graph));
|
|
|
161 pragma Assert (Present (Lib_Graph));
|
|
|
162 pragma Assert (Present (U_Id));
|
|
|
163
|
|
|
164 U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
|
|
|
165
|
|
|
166 begin
|
|
|
167 for IR_Id in U_Rec.First_Invocation_Relation ..
|
|
|
168 U_Rec.Last_Invocation_Relation
|
|
|
169 loop
|
|
|
170 Create_Edge (IR_Id);
|
|
|
171 end loop;
|
|
|
172 end Create_Edges;
|
|
|
173
|
|
|
174 -------------------
|
|
|
175 -- Create_Vertex --
|
|
|
176 -------------------
|
|
|
177
|
|
|
178 procedure Create_Vertex
|
|
|
179 (IC_Id : Invocation_Construct_Id;
|
|
|
180 Vertex : Library_Graph_Vertex_Id)
|
|
|
181 is
|
|
|
182 begin
|
|
|
183 pragma Assert (Present (Inv_Graph));
|
|
|
184 pragma Assert (Present (Lib_Graph));
|
|
|
185 pragma Assert (Present (IC_Id));
|
|
|
186 pragma Assert (Present (Vertex));
|
|
|
187
|
|
|
188 Add_Vertex
|
|
|
189 (G => Inv_Graph,
|
|
|
190 IC_Id => IC_Id,
|
|
|
191 Body_Vertex =>
|
|
|
192 Declaration_Placement_Vertex
|
|
|
193 (Vertex => Vertex,
|
|
|
194 Placement => Body_Placement (IC_Id)),
|
|
|
195 Spec_Vertex =>
|
|
|
196 Declaration_Placement_Vertex
|
|
|
197 (Vertex => Vertex,
|
|
|
198 Placement => Spec_Placement (IC_Id)));
|
|
|
199 end Create_Vertex;
|
|
|
200
|
|
|
201 ---------------------
|
|
|
202 -- Create_Vertices --
|
|
|
203 ---------------------
|
|
|
204
|
|
|
205 procedure Create_Vertices (U_Id : Unit_Id) is
|
|
|
206 pragma Assert (Present (Inv_Graph));
|
|
|
207 pragma Assert (Present (Lib_Graph));
|
|
|
208 pragma Assert (Present (U_Id));
|
|
|
209
|
|
|
210 U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
|
|
|
211 Vertex : constant Library_Graph_Vertex_Id :=
|
|
|
212 Corresponding_Vertex (Lib_Graph, U_Id);
|
|
|
213
|
|
|
214 begin
|
|
|
215 for IC_Id in U_Rec.First_Invocation_Construct ..
|
|
|
216 U_Rec.Last_Invocation_Construct
|
|
|
217 loop
|
|
|
218 Create_Vertex (IC_Id, Vertex);
|
|
|
219 end loop;
|
|
|
220 end Create_Vertices;
|
|
|
221
|
|
|
222 ----------------------------------
|
|
|
223 -- Declaration_Placement_Vertex --
|
|
|
224 ----------------------------------
|
|
|
225
|
|
|
226 function Declaration_Placement_Vertex
|
|
|
227 (Vertex : Library_Graph_Vertex_Id;
|
|
|
228 Placement : Declaration_Placement_Kind)
|
|
|
229 return Library_Graph_Vertex_Id
|
|
|
230 is
|
|
|
231 begin
|
|
|
232 pragma Assert (Present (Lib_Graph));
|
|
|
233 pragma Assert (Present (Vertex));
|
|
|
234
|
|
|
235 if Placement = In_Body then
|
|
|
236 return Proper_Body (Lib_Graph, Vertex);
|
|
|
237 else
|
|
|
238 pragma Assert (Placement = In_Spec);
|
|
|
239 return Proper_Spec (Lib_Graph, Vertex);
|
|
|
240 end if;
|
|
|
241 end Declaration_Placement_Vertex;
|
|
|
242 end Invocation_Graph_Builders;
|
|
|
243
|
|
|
244 ----------------------------
|
|
|
245 -- Library_Graph_Builders --
|
|
|
246 ----------------------------
|
|
|
247
|
|
|
248 package body Library_Graph_Builders is
|
|
|
249
|
|
|
250 ---------------------
|
|
|
251 -- Data structures --
|
|
|
252 ---------------------
|
|
|
253
|
|
|
254 procedure Destroy_Line_Number (Line : in out Logical_Line_Number);
|
|
|
255 pragma Inline (Destroy_Line_Number);
|
|
|
256 -- Destroy line number Line
|
|
|
257
|
|
|
258 function Hash_Unit (U_Id : Unit_Id) return Bucket_Range_Type;
|
|
|
259 pragma Inline (Hash_Unit);
|
|
|
260 -- Obtain the hash value of key U_Id
|
|
|
261
|
|
|
262 package Unit_Line_Tables is new Dynamic_Hash_Tables
|
|
|
263 (Key_Type => Unit_Id,
|
|
|
264 Value_Type => Logical_Line_Number,
|
|
|
265 No_Value => No_Line_Number,
|
|
|
266 Expansion_Threshold => 1.5,
|
|
|
267 Expansion_Factor => 2,
|
|
|
268 Compression_Threshold => 0.3,
|
|
|
269 Compression_Factor => 2,
|
|
|
270 "=" => "=",
|
|
|
271 Destroy_Value => Destroy_Line_Number,
|
|
|
272 Hash => Hash_Unit);
|
|
|
273
|
|
|
274 -----------------
|
|
|
275 -- Global data --
|
|
|
276 -----------------
|
|
|
277
|
|
|
278 Lib_Graph : Library_Graph := Library_Graphs.Nil;
|
|
|
279
|
|
|
280 Unit_To_Line : Unit_Line_Tables.Dynamic_Hash_Table :=
|
|
|
281 Unit_Line_Tables.Nil;
|
|
|
282 -- The map of unit name -> line number, used to detect duplicate unit
|
|
|
283 -- names in the forced-elaboration-order file and report errors.
|
|
|
284
|
|
|
285 -----------------------
|
|
|
286 -- Local subprograms --
|
|
|
287 -----------------------
|
|
|
288
|
|
|
289 procedure Add_Unit
|
|
|
290 (U_Id : Unit_Id;
|
|
|
291 Line : Logical_Line_Number);
|
|
|
292 pragma Inline (Add_Unit);
|
|
|
293 -- Create a relationship between unit U_Id and its declaration line in
|
|
|
294 -- map Unit_To_Line.
|
|
|
295
|
|
|
296 procedure Create_Forced_Edge
|
|
|
297 (Pred : Unit_Id;
|
|
|
298 Succ : Unit_Id);
|
|
|
299 pragma Inline (Create_Forced_Edge);
|
|
|
300 -- Create a new forced edge between predecessor unit Pred and successor
|
|
|
301 -- unit Succ.
|
|
|
302
|
|
|
303 procedure Create_Forced_Edges;
|
|
|
304 pragma Inline (Create_Forced_Edges);
|
|
|
305 -- Inspect the contents of the forced-elaboration-order file, and create
|
|
|
306 -- specialized edges for each valid pair of units listed within.
|
|
|
307
|
|
|
308 procedure Create_Spec_And_Body_Edge (U_Id : Unit_Id);
|
|
|
309 pragma Inline (Create_Spec_And_Body_Edge);
|
|
|
310 -- Establish a link between the spec and body of unit U_Id. In certain
|
|
|
311 -- cases this may result in a new edge which is added to library graph
|
|
|
312 -- Lib_Graph.
|
|
|
313
|
|
|
314 procedure Create_Vertex (U_Id : Unit_Id);
|
|
|
315 pragma Inline (Create_Vertex);
|
|
|
316 -- Create a new vertex for unit U_Id in library graph Lib_Graph
|
|
|
317
|
|
|
318 procedure Create_With_Edge
|
|
|
319 (W_Id : With_Id;
|
|
|
320 Succ : Library_Graph_Vertex_Id);
|
|
|
321 pragma Inline (Create_With_Edge);
|
|
|
322 -- Create a new edge for with W_Id where the predecessor is the library
|
|
|
323 -- graph vertex of the withed unit, and the successor is Succ. The edge
|
|
|
324 -- is added to library graph Lib_Graph.
|
|
|
325
|
|
|
326 procedure Create_With_Edges (U_Id : Unit_Id);
|
|
|
327 pragma Inline (Create_With_Edges);
|
|
|
328 -- Establish links between unit U_Id and its predecessor units. The new
|
|
|
329 -- edges are added to library graph Lib_Graph.
|
|
|
330
|
|
|
331 procedure Create_With_Edges
|
|
|
332 (U_Id : Unit_Id;
|
|
|
333 Succ : Library_Graph_Vertex_Id);
|
|
|
334 pragma Inline (Create_With_Edges);
|
|
|
335 -- Create new edges for all withs of unit U_Id where the predecessor is
|
|
|
336 -- some withed unit, and the successor is Succ. The edges are added to
|
|
|
337 -- library graph Lib_Graph.
|
|
|
338
|
|
|
339 procedure Duplicate_Unit_Error
|
|
|
340 (U_Id : Unit_Id;
|
|
|
341 Nam : Unit_Name_Type;
|
|
|
342 Line : Logical_Line_Number);
|
|
|
343 pragma Inline (Duplicate_Unit_Error);
|
|
|
344 -- Emit an error concerning the duplication of unit U_Id with name Nam
|
|
|
345 -- that is redeclared in the forced-elaboration-order file at line Line.
|
|
|
346
|
|
|
347 procedure Internal_Unit_Info (Nam : Unit_Name_Type);
|
|
|
348 pragma Inline (Internal_Unit_Info);
|
|
|
349 -- Emit an information message concerning the omission of an internal
|
|
|
350 -- unit with name Nam from the creation of forced edges.
|
|
|
351
|
|
|
352 function Is_Duplicate_Unit (U_Id : Unit_Id) return Boolean;
|
|
|
353 pragma Inline (Is_Duplicate_Unit);
|
|
|
354 -- Determine whether unit U_Id is already recorded in map Unit_To_Line
|
|
|
355
|
|
|
356 function Is_Significant_With (W_Id : With_Id) return Boolean;
|
|
|
357 pragma Inline (Is_Significant_With);
|
|
|
358 -- Determine whether with W_Id plays a significant role in elaboration
|
|
|
359
|
|
|
360 procedure Missing_Unit_Info (Nam : Unit_Name_Type);
|
|
|
361 pragma Inline (Missing_Unit_Info);
|
|
|
362 -- Emit an information message concerning the omission of an undefined
|
|
|
363 -- unit found in the forced-elaboration-order file.
|
|
|
364
|
|
|
365 --------------
|
|
|
366 -- Add_Unit --
|
|
|
367 --------------
|
|
|
368
|
|
|
369 procedure Add_Unit
|
|
|
370 (U_Id : Unit_Id;
|
|
|
371 Line : Logical_Line_Number)
|
|
|
372 is
|
|
|
373 begin
|
|
|
374 pragma Assert (Present (U_Id));
|
|
|
375
|
|
|
376 Unit_Line_Tables.Put (Unit_To_Line, U_Id, Line);
|
|
|
377 end Add_Unit;
|
|
|
378
|
|
|
379 -------------------------
|
|
|
380 -- Build_Library_Graph --
|
|
|
381 -------------------------
|
|
|
382
|
|
|
383 function Build_Library_Graph return Library_Graph is
|
|
|
384 begin
|
|
|
385 Start_Phase (Library_Graph_Construction);
|
|
|
386
|
|
|
387 -- Prepare the global data
|
|
|
388
|
|
|
389 Lib_Graph :=
|
|
|
390 Create
|
|
|
391 (Initial_Vertices => Number_Of_Elaborable_Units,
|
|
|
392 Initial_Edges => Number_Of_Elaborable_Units);
|
|
|
393
|
|
|
394 For_Each_Elaborable_Unit (Create_Vertex'Access);
|
|
|
395 For_Each_Elaborable_Unit (Create_Spec_And_Body_Edge'Access);
|
|
|
396 For_Each_Elaborable_Unit (Create_With_Edges'Access);
|
|
|
397 Create_Forced_Edges;
|
|
|
398
|
|
|
399 Validate_Library_Graph (Lib_Graph);
|
|
|
400 End_Phase (Library_Graph_Construction);
|
|
|
401
|
|
|
402 return Lib_Graph;
|
|
|
403 end Build_Library_Graph;
|
|
|
404
|
|
|
405 ------------------------
|
|
|
406 -- Create_Forced_Edge --
|
|
|
407 ------------------------
|
|
|
408
|
|
|
409 procedure Create_Forced_Edge
|
|
|
410 (Pred : Unit_Id;
|
|
|
411 Succ : Unit_Id)
|
|
|
412 is
|
|
|
413 pragma Assert (Present (Pred));
|
|
|
414 pragma Assert (Present (Succ));
|
|
|
415
|
|
|
416 Pred_Vertex : constant Library_Graph_Vertex_Id :=
|
|
|
417 Corresponding_Vertex (Lib_Graph, Pred);
|
|
|
418 Succ_Vertex : constant Library_Graph_Vertex_Id :=
|
|
|
419 Corresponding_Vertex (Lib_Graph, Succ);
|
|
|
420
|
|
|
421 begin
|
|
|
422 Write_Unit_Name (Name (Pred));
|
|
|
423 Write_Str (" <-- ");
|
|
|
424 Write_Unit_Name (Name (Succ));
|
|
|
425 Write_Eol;
|
|
|
426
|
|
|
427 Add_Edge
|
|
|
428 (G => Lib_Graph,
|
|
|
429 Pred => Pred_Vertex,
|
|
|
430 Succ => Succ_Vertex,
|
|
|
431 Kind => Forced_Edge,
|
|
|
432 Activates_Task => False);
|
|
|
433 end Create_Forced_Edge;
|
|
|
434
|
|
|
435 -------------------------
|
|
|
436 -- Create_Forced_Edges --
|
|
|
437 -------------------------
|
|
|
438
|
|
|
439 procedure Create_Forced_Edges is
|
|
|
440 Current_Unit : Unit_Id;
|
|
|
441 Iter : Forced_Units_Iterator;
|
|
|
442 Previous_Unit : Unit_Id;
|
|
|
443 Unit_Line : Logical_Line_Number;
|
|
|
444 Unit_Name : Unit_Name_Type;
|
|
|
445
|
|
|
446 begin
|
|
|
447 Previous_Unit := No_Unit_Id;
|
|
|
448 Unit_To_Line := Unit_Line_Tables.Create (20);
|
|
|
449
|
|
|
450 -- Inspect the contents of the forced-elaboration-order file supplied
|
|
|
451 -- to the binder using switch -f, and diagnose each unit accordingly.
|
|
|
452
|
|
|
453 Iter := Iterate_Forced_Units;
|
|
|
454 while Has_Next (Iter) loop
|
|
|
455 Next (Iter, Unit_Name, Unit_Line);
|
|
|
456
|
|
|
457 Current_Unit := Corresponding_Unit (Unit_Name);
|
|
|
458
|
|
|
459 if not Present (Current_Unit) then
|
|
|
460 Missing_Unit_Info (Unit_Name);
|
|
|
461
|
|
|
462 elsif Is_Internal_Unit (Current_Unit) then
|
|
|
463 Internal_Unit_Info (Unit_Name);
|
|
|
464
|
|
|
465 elsif Is_Duplicate_Unit (Current_Unit) then
|
|
|
466 Duplicate_Unit_Error (Current_Unit, Unit_Name, Unit_Line);
|
|
|
467
|
|
|
468 -- Otherwise the unit is a valid candidate for a vertex. Create a
|
|
|
469 -- forced edge between each pair of units.
|
|
|
470
|
|
|
471 else
|
|
|
472 Add_Unit (Current_Unit, Unit_Line);
|
|
|
473
|
|
|
474 if Present (Previous_Unit) then
|
|
|
475 Create_Forced_Edge
|
|
|
476 (Pred => Previous_Unit,
|
|
|
477 Succ => Current_Unit);
|
|
|
478 end if;
|
|
|
479
|
|
|
480 Previous_Unit := Current_Unit;
|
|
|
481 end if;
|
|
|
482 end loop;
|
|
|
483
|
|
|
484 Unit_Line_Tables.Destroy (Unit_To_Line);
|
|
|
485 end Create_Forced_Edges;
|
|
|
486
|
|
|
487 -------------------------------
|
|
|
488 -- Create_Spec_And_Body_Edge --
|
|
|
489 -------------------------------
|
|
|
490
|
|
|
491 procedure Create_Spec_And_Body_Edge (U_Id : Unit_Id) is
|
|
|
492 Extra_Vertex : Library_Graph_Vertex_Id;
|
|
|
493 Vertex : Library_Graph_Vertex_Id;
|
|
|
494
|
|
|
495 begin
|
|
|
496 pragma Assert (Present (Lib_Graph));
|
|
|
497 pragma Assert (Present (U_Id));
|
|
|
498
|
|
|
499 Vertex := Corresponding_Vertex (Lib_Graph, U_Id);
|
|
|
500
|
|
|
501 -- The unit denotes a body that completes a previous spec. Link the
|
|
|
502 -- spec and body. Add an edge between the predecessor spec and the
|
|
|
503 -- successor body.
|
|
|
504
|
|
|
505 if Is_Body_With_Spec (Lib_Graph, Vertex) then
|
|
|
506 Extra_Vertex :=
|
|
|
507 Corresponding_Vertex (Lib_Graph, Corresponding_Spec (U_Id));
|
|
|
508 Set_Corresponding_Item (Lib_Graph, Vertex, Extra_Vertex);
|
|
|
509
|
|
|
510 Add_Edge
|
|
|
511 (G => Lib_Graph,
|
|
|
512 Pred => Extra_Vertex,
|
|
|
513 Succ => Vertex,
|
|
|
514 Kind => Spec_Before_Body_Edge,
|
|
|
515 Activates_Task => False);
|
|
|
516
|
|
|
517 -- The unit denotes a spec with a completing body. Link the spec and
|
|
|
518 -- body.
|
|
|
519
|
|
|
520 elsif Is_Spec_With_Body (Lib_Graph, Vertex) then
|
|
|
521 Extra_Vertex :=
|
|
|
522 Corresponding_Vertex (Lib_Graph, Corresponding_Body (U_Id));
|
|
|
523 Set_Corresponding_Item (Lib_Graph, Vertex, Extra_Vertex);
|
|
|
524 end if;
|
|
|
525 end Create_Spec_And_Body_Edge;
|
|
|
526
|
|
|
527 -------------------
|
|
|
528 -- Create_Vertex --
|
|
|
529 -------------------
|
|
|
530
|
|
|
531 procedure Create_Vertex (U_Id : Unit_Id) is
|
|
|
532 begin
|
|
|
533 pragma Assert (Present (Lib_Graph));
|
|
|
534 pragma Assert (Present (U_Id));
|
|
|
535
|
|
|
536 Add_Vertex
|
|
|
537 (G => Lib_Graph,
|
|
|
538 U_Id => U_Id);
|
|
|
539 end Create_Vertex;
|
|
|
540
|
|
|
541 ----------------------
|
|
|
542 -- Create_With_Edge --
|
|
|
543 ----------------------
|
|
|
544
|
|
|
545 procedure Create_With_Edge
|
|
|
546 (W_Id : With_Id;
|
|
|
547 Succ : Library_Graph_Vertex_Id)
|
|
|
548 is
|
|
|
549 pragma Assert (Present (Lib_Graph));
|
|
|
550 pragma Assert (Present (W_Id));
|
|
|
551 pragma Assert (Present (Succ));
|
|
|
552
|
|
|
553 Withed_Rec : With_Record renames Withs.Table (W_Id);
|
|
|
554 Withed_U_Id : constant Unit_Id :=
|
|
|
555 Corresponding_Unit (Withed_Rec.Uname);
|
|
|
556
|
|
|
557 Kind : Library_Graph_Edge_Kind;
|
|
|
558 Withed_Vertex : Library_Graph_Vertex_Id;
|
|
|
559
|
|
|
560 begin
|
|
|
561 -- Nothing to do when the withed unit does not need to be elaborated.
|
|
|
562 -- This prevents spurious dependencies that can never be satisfied.
|
|
|
563
|
|
|
564 if not Needs_Elaboration (Withed_U_Id) then
|
|
|
565 return;
|
|
|
566 end if;
|
|
|
567
|
|
|
568 Withed_Vertex := Corresponding_Vertex (Lib_Graph, Withed_U_Id);
|
|
|
569
|
|
|
570 -- The with comes with pragma Elaborate. Treat the edge as a with
|
|
|
571 -- edge when switch -d_e (ignore the effects of pragma Elaborate)
|
|
|
572 -- is in effect.
|
|
|
573
|
|
|
574 if Withed_Rec.Elaborate
|
|
|
575 and then not Debug_Flag_Underscore_E
|
|
|
576 then
|
|
|
577 Kind := Elaborate_Edge;
|
|
|
578
|
|
|
579 -- The withed unit is a spec with a completing body. Add an edge
|
|
|
580 -- between the body of the withed predecessor and the withing
|
|
|
581 -- successor.
|
|
|
582
|
|
|
583 if Is_Spec_With_Body (Lib_Graph, Withed_Vertex) then
|
|
|
584 Add_Edge
|
|
|
585 (G => Lib_Graph,
|
|
|
586 Pred =>
|
|
|
587 Corresponding_Vertex
|
|
|
588 (Lib_Graph, Corresponding_Body (Withed_U_Id)),
|
|
|
589 Succ => Succ,
|
|
|
590 Kind => Kind,
|
|
|
591 Activates_Task => False);
|
|
|
592 end if;
|
|
|
593
|
|
|
594 -- The with comes with pragma Elaborate_All. Treat the edge as a with
|
|
|
595 -- edge when switch -d_a (ignore the effects of pragma Elaborate_All)
|
|
|
596 -- is in effect.
|
|
|
597
|
|
|
598 elsif Withed_Rec.Elaborate_All
|
|
|
599 and then not Debug_Flag_Underscore_A
|
|
|
600 then
|
|
|
601 Kind := Elaborate_All_Edge;
|
|
|
602
|
|
|
603 -- Otherwise this is a regular with
|
|
|
604
|
|
|
605 else
|
|
|
606 Kind := With_Edge;
|
|
|
607 end if;
|
|
|
608
|
|
|
609 -- Add an edge between the withed predecessor unit and the withing
|
|
|
610 -- successor.
|
|
|
611
|
|
|
612 Add_Edge
|
|
|
613 (G => Lib_Graph,
|
|
|
614 Pred => Withed_Vertex,
|
|
|
615 Succ => Succ,
|
|
|
616 Kind => Kind,
|
|
|
617 Activates_Task => False);
|
|
|
618 end Create_With_Edge;
|
|
|
619
|
|
|
620 -----------------------
|
|
|
621 -- Create_With_Edges --
|
|
|
622 -----------------------
|
|
|
623
|
|
|
624 procedure Create_With_Edges (U_Id : Unit_Id) is
|
|
|
625 begin
|
|
|
626 pragma Assert (Present (Lib_Graph));
|
|
|
627 pragma Assert (Present (U_Id));
|
|
|
628
|
|
|
629 Create_With_Edges
|
|
|
630 (U_Id => U_Id,
|
|
|
631 Succ => Corresponding_Vertex (Lib_Graph, U_Id));
|
|
|
632 end Create_With_Edges;
|
|
|
633
|
|
|
634 -----------------------
|
|
|
635 -- Create_With_Edges --
|
|
|
636 -----------------------
|
|
|
637
|
|
|
638 procedure Create_With_Edges
|
|
|
639 (U_Id : Unit_Id;
|
|
|
640 Succ : Library_Graph_Vertex_Id)
|
|
|
641 is
|
|
|
642 pragma Assert (Present (Lib_Graph));
|
|
|
643 pragma Assert (Present (U_Id));
|
|
|
644 pragma Assert (Present (Succ));
|
|
|
645
|
|
|
646 U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
|
|
|
647
|
|
|
648 begin
|
|
|
649 for W_Id in U_Rec.First_With .. U_Rec.Last_With loop
|
|
|
650 if Is_Significant_With (W_Id) then
|
|
|
651 Create_With_Edge (W_Id, Succ);
|
|
|
652 end if;
|
|
|
653 end loop;
|
|
|
654 end Create_With_Edges;
|
|
|
655
|
|
|
656 ------------------
|
|
|
657 -- Destroy_Unit --
|
|
|
658 ------------------
|
|
|
659
|
|
|
660 procedure Destroy_Line_Number (Line : in out Logical_Line_Number) is
|
|
|
661 pragma Unreferenced (Line);
|
|
|
662 begin
|
|
|
663 null;
|
|
|
664 end Destroy_Line_Number;
|
|
|
665
|
|
|
666 --------------------------
|
|
|
667 -- Duplicate_Unit_Error --
|
|
|
668 --------------------------
|
|
|
669
|
|
|
670 procedure Duplicate_Unit_Error
|
|
|
671 (U_Id : Unit_Id;
|
|
|
672 Nam : Unit_Name_Type;
|
|
|
673 Line : Logical_Line_Number)
|
|
|
674 is
|
|
|
675 pragma Assert (Present (U_Id));
|
|
|
676 pragma Assert (Present (Nam));
|
|
|
677
|
|
|
678 Prev_Line : constant Logical_Line_Number :=
|
|
|
679 Unit_Line_Tables.Get (Unit_To_Line, U_Id);
|
|
|
680
|
|
|
681 begin
|
|
|
682 Error_Msg_Nat_1 := Nat (Line);
|
|
|
683 Error_Msg_Nat_2 := Nat (Prev_Line);
|
|
|
684 Error_Msg_Unit_1 := Nam;
|
|
|
685
|
|
|
686 Error_Msg
|
|
|
687 (Force_Elab_Order_File.all
|
|
|
688 & ":#: duplicate unit name $ from line #");
|
|
|
689 end Duplicate_Unit_Error;
|
|
|
690
|
|
|
691 ---------------
|
|
|
692 -- Hash_Unit --
|
|
|
693 ---------------
|
|
|
694
|
|
|
695 function Hash_Unit (U_Id : Unit_Id) return Bucket_Range_Type is
|
|
|
696 begin
|
|
|
697 pragma Assert (Present (U_Id));
|
|
|
698
|
|
|
699 return Bucket_Range_Type (U_Id);
|
|
|
700 end Hash_Unit;
|
|
|
701
|
|
|
702 ------------------------
|
|
|
703 -- Internal_Unit_Info --
|
|
|
704 ------------------------
|
|
|
705
|
|
|
706 procedure Internal_Unit_Info (Nam : Unit_Name_Type) is
|
|
|
707 begin
|
|
|
708 pragma Assert (Present (Nam));
|
|
|
709
|
|
|
710 Write_Line
|
|
|
711 ("""" & Get_Name_String (Nam) & """: predefined unit ignored");
|
|
|
712 end Internal_Unit_Info;
|
|
|
713
|
|
|
714 -----------------------
|
|
|
715 -- Is_Duplicate_Unit --
|
|
|
716 -----------------------
|
|
|
717
|
|
|
718 function Is_Duplicate_Unit (U_Id : Unit_Id) return Boolean is
|
|
|
719 begin
|
|
|
720 pragma Assert (Present (U_Id));
|
|
|
721
|
|
|
722 return Unit_Line_Tables.Contains (Unit_To_Line, U_Id);
|
|
|
723 end Is_Duplicate_Unit;
|
|
|
724
|
|
|
725 -------------------------
|
|
|
726 -- Is_Significant_With --
|
|
|
727 -------------------------
|
|
|
728
|
|
|
729 function Is_Significant_With (W_Id : With_Id) return Boolean is
|
|
|
730 pragma Assert (Present (W_Id));
|
|
|
731
|
|
|
732 Withed_Rec : With_Record renames Withs.Table (W_Id);
|
|
|
733 Withed_U_Id : constant Unit_Id :=
|
|
|
734 Corresponding_Unit (Withed_Rec.Uname);
|
|
|
735
|
|
|
736 begin
|
|
|
737 -- Nothing to do for a unit which does not exist any more
|
|
|
738
|
|
|
739 if not Present (Withed_U_Id) then
|
|
|
740 return False;
|
|
|
741
|
|
|
742 -- Nothing to do for a limited with
|
|
|
743
|
|
|
744 elsif Withed_Rec.Limited_With then
|
|
|
745 return False;
|
|
|
746
|
|
|
747 -- Nothing to do when the unit does not need to be elaborated
|
|
|
748
|
|
|
749 elsif not Needs_Elaboration (Withed_U_Id) then
|
|
|
750 return False;
|
|
|
751 end if;
|
|
|
752
|
|
|
753 return True;
|
|
|
754 end Is_Significant_With;
|
|
|
755
|
|
|
756 -----------------------
|
|
|
757 -- Missing_Unit_Info --
|
|
|
758 -----------------------
|
|
|
759
|
|
|
760 procedure Missing_Unit_Info (Nam : Unit_Name_Type) is
|
|
|
761 begin
|
|
|
762 pragma Assert (Present (Nam));
|
|
|
763
|
|
|
764 Write_Line
|
|
|
765 ("""" & Get_Name_String (Nam) & """: not present; ignored");
|
|
|
766 end Missing_Unit_Info;
|
|
|
767 end Library_Graph_Builders;
|
|
|
768
|
|
|
769 end Bindo.Builders;
|
