]>
Commit | Line | Data |
---|---|---|
69e6ee2f HK |
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 | ||
76b4158b HK |
26 | with Binderr; use Binderr; |
27 | with Butil; use Butil; | |
92c7734d | 28 | with Debug; use Debug; |
76b4158b HK |
29 | with Opt; use Opt; |
30 | with Output; use Output; | |
31 | with Types; use Types; | |
32 | ||
69e6ee2f HK |
33 | with Bindo.Units; use Bindo.Units; |
34 | ||
92c7734d HK |
35 | with Bindo.Validators; |
36 | use Bindo.Validators; | |
37 | use Bindo.Validators.Invocation_Graph_Validators; | |
38 | use Bindo.Validators.Library_Graph_Validators; | |
39 | ||
490ed9ba HK |
40 | with Bindo.Writers; |
41 | use Bindo.Writers; | |
42 | use Bindo.Writers.Phase_Writers; | |
43 | ||
76b4158b HK |
44 | with GNAT; use GNAT; |
45 | with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables; | |
46 | ||
69e6ee2f HK |
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; | |
9795b203 | 77 | Vertex : Library_Graph_Vertex_Id); |
69e6ee2f HK |
78 | pragma Inline (Create_Vertex); |
79 | -- Create a new vertex for invocation construct IC_Id in invocation | |
9795b203 | 80 | -- graph Inv_Graph. The vertex is linked to vertex Vertex of library |
69e6ee2f HK |
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 | ||
9795b203 HK |
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 | ||
69e6ee2f HK |
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 | ||
490ed9ba HK |
106 | Start_Phase (Invocation_Graph_Construction); |
107 | ||
69e6ee2f HK |
108 | -- Prepare the global data |
109 | ||
110 | Inv_Graph := | |
9795b203 HK |
111 | Create |
112 | (Initial_Vertices => Number_Of_Elaborable_Units, | |
113 | Initial_Edges => Number_Of_Elaborable_Units); | |
69e6ee2f HK |
114 | Lib_Graph := Lib_G; |
115 | ||
116 | For_Each_Elaborable_Unit (Create_Vertices'Access); | |
117 | For_Each_Elaborable_Unit (Create_Edges'Access); | |
118 | ||
92c7734d | 119 | Validate_Invocation_Graph (Inv_Graph); |
490ed9ba | 120 | End_Phase (Invocation_Graph_Construction); |
92c7734d | 121 | |
69e6ee2f HK |
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 | ||
9795b203 HK |
134 | Invoker_Sig : constant Invocation_Signature_Id := Invoker (IR_Id); |
135 | Target_Sig : constant Invocation_Signature_Id := Target (IR_Id); | |
69e6ee2f | 136 | |
9795b203 HK |
137 | pragma Assert (Present (Invoker_Sig)); |
138 | pragma Assert (Present (Target_Sig)); | |
69e6ee2f HK |
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 | ||
9795b203 | 144 | if not Needs_Elaboration (Target_Sig) then |
69e6ee2f HK |
145 | return; |
146 | end if; | |
147 | ||
69e6ee2f HK |
148 | Add_Edge |
149 | (G => Inv_Graph, | |
9795b203 HK |
150 | Source => Corresponding_Vertex (Inv_Graph, Invoker_Sig), |
151 | Target => Corresponding_Vertex (Inv_Graph, Target_Sig), | |
69e6ee2f HK |
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; | |
9795b203 | 180 | Vertex : Library_Graph_Vertex_Id) |
69e6ee2f | 181 | is |
9795b203 | 182 | begin |
69e6ee2f HK |
183 | pragma Assert (Present (Inv_Graph)); |
184 | pragma Assert (Present (Lib_Graph)); | |
185 | pragma Assert (Present (IC_Id)); | |
9795b203 | 186 | pragma Assert (Present (Vertex)); |
69e6ee2f HK |
187 | |
188 | Add_Vertex | |
9795b203 HK |
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))); | |
69e6ee2f HK |
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); | |
9795b203 | 211 | Vertex : constant Library_Graph_Vertex_Id := |
69e6ee2f HK |
212 | Corresponding_Vertex (Lib_Graph, U_Id); |
213 | ||
69e6ee2f HK |
214 | begin |
215 | for IC_Id in U_Rec.First_Invocation_Construct .. | |
216 | U_Rec.Last_Invocation_Construct | |
217 | loop | |
9795b203 | 218 | Create_Vertex (IC_Id, Vertex); |
69e6ee2f HK |
219 | end loop; |
220 | end Create_Vertices; | |
9795b203 HK |
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; | |
69e6ee2f HK |
242 | end Invocation_Graph_Builders; |
243 | ||
244 | ---------------------------- | |
245 | -- Library_Graph_Builders -- | |
246 | ---------------------------- | |
247 | ||
248 | package body Library_Graph_Builders is | |
249 | ||
76b4158b HK |
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 | ||
9795b203 | 262 | package Unit_Line_Tables is new Dynamic_Hash_Tables |
76b4158b HK |
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 | ||
69e6ee2f HK |
274 | ----------------- |
275 | -- Global data -- | |
276 | ----------------- | |
277 | ||
278 | Lib_Graph : Library_Graph := Library_Graphs.Nil; | |
279 | ||
9795b203 HK |
280 | Unit_To_Line : Unit_Line_Tables.Dynamic_Hash_Table := |
281 | Unit_Line_Tables.Nil; | |
76b4158b | 282 | -- The map of unit name -> line number, used to detect duplicate unit |
9795b203 | 283 | -- names in the forced-elaboration-order file and report errors. |
76b4158b | 284 | |
69e6ee2f HK |
285 | ----------------------- |
286 | -- Local subprograms -- | |
287 | ----------------------- | |
288 | ||
76b4158b HK |
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 | ||
69e6ee2f HK |
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 | ||
76b4158b HK |
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 | ||
69e6ee2f HK |
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 | ||
76b4158b HK |
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 | ||
9795b203 | 376 | Unit_Line_Tables.Put (Unit_To_Line, U_Id, Line); |
76b4158b HK |
377 | end Add_Unit; |
378 | ||
69e6ee2f HK |
379 | ------------------------- |
380 | -- Build_Library_Graph -- | |
381 | ------------------------- | |
382 | ||
92c7734d | 383 | function Build_Library_Graph return Library_Graph is |
69e6ee2f | 384 | begin |
490ed9ba HK |
385 | Start_Phase (Library_Graph_Construction); |
386 | ||
69e6ee2f HK |
387 | -- Prepare the global data |
388 | ||
389 | Lib_Graph := | |
9795b203 | 390 | Create |
92c7734d HK |
391 | (Initial_Vertices => Number_Of_Elaborable_Units, |
392 | Initial_Edges => Number_Of_Elaborable_Units); | |
69e6ee2f HK |
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); | |
76b4158b HK |
397 | Create_Forced_Edges; |
398 | ||
92c7734d | 399 | Validate_Library_Graph (Lib_Graph); |
490ed9ba | 400 | End_Phase (Library_Graph_Construction); |
92c7734d | 401 | |
69e6ee2f HK |
402 | return Lib_Graph; |
403 | end Build_Library_Graph; | |
404 | ||
76b4158b HK |
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 | ||
9795b203 | 416 | Pred_Vertex : constant Library_Graph_Vertex_Id := |
76b4158b | 417 | Corresponding_Vertex (Lib_Graph, Pred); |
9795b203 | 418 | Succ_Vertex : constant Library_Graph_Vertex_Id := |
76b4158b HK |
419 | Corresponding_Vertex (Lib_Graph, Succ); |
420 | ||
76b4158b HK |
421 | begin |
422 | Write_Unit_Name (Name (Pred)); | |
423 | Write_Str (" <-- "); | |
424 | Write_Unit_Name (Name (Succ)); | |
425 | Write_Eol; | |
426 | ||
427 | Add_Edge | |
75cfda8b HK |
428 | (G => Lib_Graph, |
429 | Pred => Pred_Vertex, | |
430 | Succ => Succ_Vertex, | |
431 | Kind => Forced_Edge, | |
432 | Activates_Task => False); | |
76b4158b HK |
433 | end Create_Forced_Edge; |
434 | ||
435 | ------------------------- | |
436 | -- Create_Forced_Edges -- | |
437 | ------------------------- | |
438 | ||
439 | procedure Create_Forced_Edges is | |
9795b203 HK |
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; | |
76b4158b HK |
445 | |
446 | begin | |
9795b203 HK |
447 | Previous_Unit := No_Unit_Id; |
448 | Unit_To_Line := Unit_Line_Tables.Create (20); | |
76b4158b HK |
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); | |
76b4158b | 456 | |
9795b203 | 457 | Current_Unit := Corresponding_Unit (Unit_Name); |
76b4158b | 458 | |
9795b203 | 459 | if not Present (Current_Unit) then |
76b4158b HK |
460 | Missing_Unit_Info (Unit_Name); |
461 | ||
9795b203 | 462 | elsif Is_Internal_Unit (Current_Unit) then |
76b4158b HK |
463 | Internal_Unit_Info (Unit_Name); |
464 | ||
9795b203 HK |
465 | elsif Is_Duplicate_Unit (Current_Unit) then |
466 | Duplicate_Unit_Error (Current_Unit, Unit_Name, Unit_Line); | |
76b4158b HK |
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 | |
9795b203 | 472 | Add_Unit (Current_Unit, Unit_Line); |
76b4158b | 473 | |
9795b203 | 474 | if Present (Previous_Unit) then |
76b4158b | 475 | Create_Forced_Edge |
9795b203 HK |
476 | (Pred => Previous_Unit, |
477 | Succ => Current_Unit); | |
76b4158b HK |
478 | end if; |
479 | ||
9795b203 | 480 | Previous_Unit := Current_Unit; |
76b4158b HK |
481 | end if; |
482 | end loop; | |
483 | ||
9795b203 | 484 | Unit_Line_Tables.Destroy (Unit_To_Line); |
76b4158b HK |
485 | end Create_Forced_Edges; |
486 | ||
69e6ee2f HK |
487 | ------------------------------- |
488 | -- Create_Spec_And_Body_Edge -- | |
489 | ------------------------------- | |
490 | ||
491 | procedure Create_Spec_And_Body_Edge (U_Id : Unit_Id) is | |
9795b203 HK |
492 | Extra_Vertex : Library_Graph_Vertex_Id; |
493 | Vertex : Library_Graph_Vertex_Id; | |
69e6ee2f HK |
494 | |
495 | begin | |
496 | pragma Assert (Present (Lib_Graph)); | |
497 | pragma Assert (Present (U_Id)); | |
498 | ||
9795b203 | 499 | Vertex := Corresponding_Vertex (Lib_Graph, U_Id); |
69e6ee2f HK |
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 | ||
9795b203 HK |
505 | if Is_Body_With_Spec (Lib_Graph, Vertex) then |
506 | Extra_Vertex := | |
69e6ee2f | 507 | Corresponding_Vertex (Lib_Graph, Corresponding_Spec (U_Id)); |
9795b203 | 508 | Set_Corresponding_Item (Lib_Graph, Vertex, Extra_Vertex); |
69e6ee2f HK |
509 | |
510 | Add_Edge | |
75cfda8b HK |
511 | (G => Lib_Graph, |
512 | Pred => Extra_Vertex, | |
513 | Succ => Vertex, | |
514 | Kind => Spec_Before_Body_Edge, | |
515 | Activates_Task => False); | |
69e6ee2f HK |
516 | |
517 | -- The unit denotes a spec with a completing body. Link the spec and | |
518 | -- body. | |
519 | ||
9795b203 HK |
520 | elsif Is_Spec_With_Body (Lib_Graph, Vertex) then |
521 | Extra_Vertex := | |
69e6ee2f | 522 | Corresponding_Vertex (Lib_Graph, Corresponding_Body (U_Id)); |
9795b203 | 523 | Set_Corresponding_Item (Lib_Graph, Vertex, Extra_Vertex); |
69e6ee2f HK |
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 | ||
69e6ee2f | 557 | Kind : Library_Graph_Edge_Kind; |
9795b203 | 558 | Withed_Vertex : Library_Graph_Vertex_Id; |
69e6ee2f HK |
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 | ||
9795b203 | 568 | Withed_Vertex := Corresponding_Vertex (Lib_Graph, Withed_U_Id); |
69e6ee2f | 569 | |
92c7734d HK |
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. | |
69e6ee2f | 573 | |
92c7734d HK |
574 | if Withed_Rec.Elaborate |
575 | and then not Debug_Flag_Underscore_E | |
576 | then | |
69e6ee2f HK |
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 | ||
9795b203 | 583 | if Is_Spec_With_Body (Lib_Graph, Withed_Vertex) then |
69e6ee2f | 584 | Add_Edge |
75cfda8b HK |
585 | (G => Lib_Graph, |
586 | Pred => | |
9795b203 HK |
587 | Corresponding_Vertex |
588 | (Lib_Graph, Corresponding_Body (Withed_U_Id)), | |
75cfda8b HK |
589 | Succ => Succ, |
590 | Kind => Kind, | |
591 | Activates_Task => False); | |
69e6ee2f HK |
592 | end if; |
593 | ||
92c7734d HK |
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. | |
69e6ee2f | 597 | |
92c7734d HK |
598 | elsif Withed_Rec.Elaborate_All |
599 | and then not Debug_Flag_Underscore_A | |
600 | then | |
69e6ee2f HK |
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 | |
75cfda8b HK |
613 | (G => Lib_Graph, |
614 | Pred => Withed_Vertex, | |
615 | Succ => Succ, | |
616 | Kind => Kind, | |
617 | Activates_Task => False); | |
69e6ee2f HK |
618 | end Create_With_Edge; |
619 | ||
620 | ----------------------- | |
621 | -- Create_With_Edges -- | |
622 | ----------------------- | |
623 | ||
624 | procedure Create_With_Edges (U_Id : Unit_Id) is | |
69e6ee2f HK |
625 | begin |
626 | pragma Assert (Present (Lib_Graph)); | |
627 | pragma Assert (Present (U_Id)); | |
628 | ||
69e6ee2f HK |
629 | Create_With_Edges |
630 | (U_Id => U_Id, | |
9795b203 | 631 | Succ => Corresponding_Vertex (Lib_Graph, U_Id)); |
69e6ee2f HK |
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 | ||
76b4158b HK |
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 := | |
9795b203 | 679 | Unit_Line_Tables.Get (Unit_To_Line, U_Id); |
76b4158b HK |
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 | ||
9795b203 | 722 | return Unit_Line_Tables.Contains (Unit_To_Line, U_Id); |
76b4158b HK |
723 | end Is_Duplicate_Unit; |
724 | ||
69e6ee2f HK |
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; | |
76b4158b HK |
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; | |
69e6ee2f HK |
767 | end Library_Graph_Builders; |
768 | ||
769 | end Bindo.Builders; |