1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- B I N D O . B U I L D E R S --
9 -- Copyright (C) 2019-2024, Free Software Foundation, Inc. --
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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Binderr
; use Binderr
;
27 with Butil
; use Butil
;
28 with Debug
; use Debug
;
30 with Output
; use Output
;
31 with Types
; use Types
;
33 with Bindo
.Units
; use Bindo
.Units
;
35 with Bindo
.Validators
;
37 use Bindo
.Validators
.Invocation_Graph_Validators
;
38 use Bindo
.Validators
.Library_Graph_Validators
;
42 use Bindo
.Writers
.Phase_Writers
;
45 with GNAT
.Dynamic_HTables
; use GNAT
.Dynamic_HTables
;
47 package body Bindo
.Builders
is
49 -------------------------------
50 -- Invocation_Graph_Builders --
51 -------------------------------
53 package body Invocation_Graph_Builders
is
59 Inv_Graph
: Invocation_Graph
:= Invocation_Graphs
.Nil
;
60 Lib_Graph
: Library_Graph
:= Library_Graphs
.Nil
;
62 -----------------------
63 -- Local subprograms --
64 -----------------------
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
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
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
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.
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.
96 ----------------------------
97 -- Build_Invocation_Graph --
98 ----------------------------
100 function Build_Invocation_Graph
101 (Lib_G
: Library_Graph
) return Invocation_Graph
104 pragma Assert
(Present
(Lib_G
));
106 Start_Phase
(Invocation_Graph_Construction
);
108 -- Prepare the global data
112 (Initial_Vertices
=> Number_Of_Elaborable_Units
,
113 Initial_Edges
=> Number_Of_Elaborable_Units
,
117 For_Each_Elaborable_Unit
(Create_Vertices
'Access);
118 For_Each_Elaborable_Unit
(Create_Edges
'Access);
120 Validate_Invocation_Graph
(Inv_Graph
);
121 End_Phase
(Invocation_Graph_Construction
);
124 end Build_Invocation_Graph
;
130 procedure Create_Edge
(IR_Id
: Invocation_Relation_Id
) is
131 pragma Assert
(Present
(Inv_Graph
));
132 pragma Assert
(Present
(Lib_Graph
));
133 pragma Assert
(Present
(IR_Id
));
135 Invoker_Sig
: constant Invocation_Signature_Id
:= Invoker
(IR_Id
);
136 Target_Sig
: constant Invocation_Signature_Id
:= Target
(IR_Id
);
138 pragma Assert
(Present
(Invoker_Sig
));
139 pragma Assert
(Present
(Target_Sig
));
142 -- Nothing to do when the target denotes an invocation construct that
143 -- resides in a unit which will never be elaborated.
145 if not Needs_Elaboration
(Target_Sig
) then
151 Source
=> Corresponding_Vertex
(Inv_Graph
, Invoker_Sig
),
152 Target
=> Corresponding_Vertex
(Inv_Graph
, Target_Sig
),
160 procedure Create_Edges
(U_Id
: Unit_Id
) is
161 pragma Assert
(Present
(Inv_Graph
));
162 pragma Assert
(Present
(Lib_Graph
));
163 pragma Assert
(Present
(U_Id
));
165 U_Rec
: Unit_Record
renames ALI
.Units
.Table
(U_Id
);
168 for IR_Id
in U_Rec
.First_Invocation_Relation
..
169 U_Rec
.Last_Invocation_Relation
179 procedure Create_Vertex
180 (IC_Id
: Invocation_Construct_Id
;
181 Vertex
: Library_Graph_Vertex_Id
)
184 pragma Assert
(Present
(Inv_Graph
));
185 pragma Assert
(Present
(Lib_Graph
));
186 pragma Assert
(Present
(IC_Id
));
187 pragma Assert
(Present
(Vertex
));
193 Declaration_Placement_Vertex
195 Placement
=> Body_Placement
(IC_Id
)),
197 Declaration_Placement_Vertex
199 Placement
=> Spec_Placement
(IC_Id
)));
202 ---------------------
203 -- Create_Vertices --
204 ---------------------
206 procedure Create_Vertices
(U_Id
: Unit_Id
) is
207 pragma Assert
(Present
(Inv_Graph
));
208 pragma Assert
(Present
(Lib_Graph
));
209 pragma Assert
(Present
(U_Id
));
211 U_Rec
: Unit_Record
renames ALI
.Units
.Table
(U_Id
);
212 Vertex
: constant Library_Graph_Vertex_Id
:=
213 Corresponding_Vertex
(Lib_Graph
, U_Id
);
216 for IC_Id
in U_Rec
.First_Invocation_Construct
..
217 U_Rec
.Last_Invocation_Construct
219 Create_Vertex
(IC_Id
, Vertex
);
223 ----------------------------------
224 -- Declaration_Placement_Vertex --
225 ----------------------------------
227 function Declaration_Placement_Vertex
228 (Vertex
: Library_Graph_Vertex_Id
;
229 Placement
: Declaration_Placement_Kind
)
230 return Library_Graph_Vertex_Id
233 pragma Assert
(Present
(Lib_Graph
));
234 pragma Assert
(Present
(Vertex
));
236 if Placement
= In_Body
then
237 return Proper_Body
(Lib_Graph
, Vertex
);
239 pragma Assert
(Placement
= In_Spec
);
240 return Proper_Spec
(Lib_Graph
, Vertex
);
242 end Declaration_Placement_Vertex
;
243 end Invocation_Graph_Builders
;
245 ----------------------------
246 -- Library_Graph_Builders --
247 ----------------------------
249 package body Library_Graph_Builders
is
251 ---------------------
252 -- Data structures --
253 ---------------------
255 procedure Destroy_Line_Number
(Line
: in out Logical_Line_Number
);
256 pragma Inline
(Destroy_Line_Number
);
257 -- Destroy line number Line
259 function Hash_Unit
(U_Id
: Unit_Id
) return Bucket_Range_Type
;
260 pragma Inline
(Hash_Unit
);
261 -- Obtain the hash value of key U_Id
263 package Unit_Line_Tables
is new Dynamic_Hash_Tables
264 (Key_Type
=> Unit_Id
,
265 Value_Type
=> Logical_Line_Number
,
266 No_Value
=> No_Line_Number
,
267 Expansion_Threshold
=> 1.5,
268 Expansion_Factor
=> 2,
269 Compression_Threshold
=> 0.3,
270 Compression_Factor
=> 2,
272 Destroy_Value
=> Destroy_Line_Number
,
279 Lib_Graph
: Library_Graph
:= Library_Graphs
.Nil
;
281 Unit_To_Line
: Unit_Line_Tables
.Dynamic_Hash_Table
:=
282 Unit_Line_Tables
.Nil
;
283 -- The map of unit name -> line number, used to detect duplicate unit
284 -- names in the forced-elaboration-order file and report errors.
286 -----------------------
287 -- Local subprograms --
288 -----------------------
292 Line
: Logical_Line_Number
);
293 pragma Inline
(Add_Unit
);
294 -- Create a relationship between unit U_Id and its declaration line in
297 procedure Create_Forced_Edge
300 pragma Inline
(Create_Forced_Edge
);
301 -- Create a new forced edge between predecessor unit Pred and successor
304 procedure Create_Forced_Edges
;
305 pragma Inline
(Create_Forced_Edges
);
306 -- Inspect the contents of the forced-elaboration-order file, and create
307 -- specialized edges for each valid pair of units listed within.
309 procedure Create_Spec_And_Body_Edge
(U_Id
: Unit_Id
);
310 pragma Inline
(Create_Spec_And_Body_Edge
);
311 -- Establish a link between the spec and body of unit U_Id. In certain
312 -- cases this may result in a new edge which is added to library graph
315 procedure Create_Vertex
(U_Id
: Unit_Id
);
316 pragma Inline
(Create_Vertex
);
317 -- Create a new vertex for unit U_Id in library graph Lib_Graph
319 procedure Create_With_Edge
321 Succ
: Library_Graph_Vertex_Id
);
322 pragma Inline
(Create_With_Edge
);
323 -- Create a new edge for with W_Id where the predecessor is the library
324 -- graph vertex of the withed unit, and the successor is Succ. The edge
325 -- is added to library graph Lib_Graph.
327 procedure Create_With_Edges
(U_Id
: Unit_Id
);
328 pragma Inline
(Create_With_Edges
);
329 -- Establish links between unit U_Id and its predecessor units. The new
330 -- edges are added to library graph Lib_Graph.
332 procedure Create_With_Edges
334 Succ
: Library_Graph_Vertex_Id
);
335 pragma Inline
(Create_With_Edges
);
336 -- Create new edges for all withs of unit U_Id where the predecessor is
337 -- some withed unit, and the successor is Succ. The edges are added to
338 -- library graph Lib_Graph.
340 procedure Duplicate_Unit_Error
342 Nam
: Unit_Name_Type
;
343 Line
: Logical_Line_Number
);
344 pragma Inline
(Duplicate_Unit_Error
);
345 -- Emit an error concerning the duplication of unit U_Id with name Nam
346 -- that is redeclared in the forced-elaboration-order file at line Line.
348 procedure Internal_Unit_Info
(Nam
: Unit_Name_Type
);
349 pragma Inline
(Internal_Unit_Info
);
350 -- Emit an information message concerning the omission of an internal
351 -- unit with name Nam from the creation of forced edges.
353 function Is_Duplicate_Unit
(U_Id
: Unit_Id
) return Boolean;
354 pragma Inline
(Is_Duplicate_Unit
);
355 -- Determine whether unit U_Id is already recorded in map Unit_To_Line
357 function Is_Significant_With
(W_Id
: With_Id
) return Boolean;
358 pragma Inline
(Is_Significant_With
);
359 -- Determine whether with W_Id plays a significant role in elaboration
361 procedure Missing_Unit_Info
(Nam
: Unit_Name_Type
);
362 pragma Inline
(Missing_Unit_Info
);
363 -- Emit an information message concerning the omission of an undefined
364 -- unit found in the forced-elaboration-order file.
372 Line
: Logical_Line_Number
)
375 pragma Assert
(Present
(U_Id
));
377 Unit_Line_Tables
.Put
(Unit_To_Line
, U_Id
, Line
);
380 -------------------------
381 -- Build_Library_Graph --
382 -------------------------
384 function Build_Library_Graph
return Library_Graph
is
386 Start_Phase
(Library_Graph_Construction
);
388 -- Prepare the global data
392 (Initial_Vertices
=> Number_Of_Elaborable_Units
,
393 Initial_Edges
=> Number_Of_Elaborable_Units
);
395 For_Each_Elaborable_Unit
(Create_Vertex
'Access);
396 For_Each_Elaborable_Unit
(Create_Spec_And_Body_Edge
'Access);
397 For_Each_Elaborable_Unit
(Create_With_Edges
'Access);
400 Validate_Library_Graph
(Lib_Graph
);
401 End_Phase
(Library_Graph_Construction
);
404 end Build_Library_Graph
;
406 ------------------------
407 -- Create_Forced_Edge --
408 ------------------------
410 procedure Create_Forced_Edge
414 pragma Assert
(Present
(Pred
));
415 pragma Assert
(Present
(Succ
));
417 Pred_Vertex
: constant Library_Graph_Vertex_Id
:=
418 Corresponding_Vertex
(Lib_Graph
, Pred
);
419 Succ_Vertex
: constant Library_Graph_Vertex_Id
:=
420 Corresponding_Vertex
(Lib_Graph
, Succ
);
423 Write_Unit_Name
(Name
(Pred
));
425 Write_Unit_Name
(Name
(Succ
));
433 Activates_Task
=> False);
434 end Create_Forced_Edge
;
436 -------------------------
437 -- Create_Forced_Edges --
438 -------------------------
440 procedure Create_Forced_Edges
is
441 Current_Unit
: Unit_Id
;
442 Iter
: Forced_Units_Iterator
;
443 Previous_Unit
: Unit_Id
;
444 Unit_Line
: Logical_Line_Number
;
445 Unit_Name
: Unit_Name_Type
;
448 Previous_Unit
:= No_Unit_Id
;
449 Unit_To_Line
:= Unit_Line_Tables
.Create
(20);
451 -- Inspect the contents of the forced-elaboration-order file supplied
452 -- to the binder using switch -f, and diagnose each unit accordingly.
454 Iter
:= Iterate_Forced_Units
;
455 while Has_Next
(Iter
) loop
456 Next
(Iter
, Unit_Name
, Unit_Line
);
458 Current_Unit
:= Corresponding_Unit
(Unit_Name
);
460 if not Present
(Current_Unit
) then
461 Missing_Unit_Info
(Unit_Name
);
463 elsif Is_Internal_Unit
(Current_Unit
) then
464 Internal_Unit_Info
(Unit_Name
);
466 elsif Is_Duplicate_Unit
(Current_Unit
) then
467 Duplicate_Unit_Error
(Current_Unit
, Unit_Name
, Unit_Line
);
469 -- Otherwise the unit is a valid candidate for a vertex. Create a
470 -- forced edge between each pair of units.
473 Add_Unit
(Current_Unit
, Unit_Line
);
475 if Present
(Previous_Unit
) then
477 (Pred
=> Previous_Unit
,
478 Succ
=> Current_Unit
);
481 Previous_Unit
:= Current_Unit
;
485 Unit_Line_Tables
.Destroy
(Unit_To_Line
);
486 end Create_Forced_Edges
;
488 -------------------------------
489 -- Create_Spec_And_Body_Edge --
490 -------------------------------
492 procedure Create_Spec_And_Body_Edge
(U_Id
: Unit_Id
) is
493 Extra_Vertex
: Library_Graph_Vertex_Id
;
494 Vertex
: Library_Graph_Vertex_Id
;
497 pragma Assert
(Present
(Lib_Graph
));
498 pragma Assert
(Present
(U_Id
));
500 Vertex
:= Corresponding_Vertex
(Lib_Graph
, U_Id
);
502 -- The unit denotes a body that completes a previous spec. Link the
503 -- spec and body. Add an edge between the predecessor spec and the
506 if Is_Body_With_Spec
(Lib_Graph
, Vertex
) then
508 Corresponding_Vertex
(Lib_Graph
, Corresponding_Spec
(U_Id
));
509 Set_Corresponding_Item
(Lib_Graph
, Vertex
, Extra_Vertex
);
513 Pred
=> Extra_Vertex
,
515 Kind
=> Spec_Before_Body_Edge
,
516 Activates_Task
=> False);
518 -- The unit denotes a spec with a completing body. Link the spec and
521 elsif Is_Spec_With_Body
(Lib_Graph
, Vertex
) then
523 Corresponding_Vertex
(Lib_Graph
, Corresponding_Body
(U_Id
));
524 Set_Corresponding_Item
(Lib_Graph
, Vertex
, Extra_Vertex
);
526 end Create_Spec_And_Body_Edge
;
532 procedure Create_Vertex
(U_Id
: Unit_Id
) is
534 pragma Assert
(Present
(Lib_Graph
));
535 pragma Assert
(Present
(U_Id
));
542 ----------------------
543 -- Create_With_Edge --
544 ----------------------
546 procedure Create_With_Edge
548 Succ
: Library_Graph_Vertex_Id
)
550 pragma Assert
(Present
(Lib_Graph
));
551 pragma Assert
(Present
(W_Id
));
552 pragma Assert
(Present
(Succ
));
554 Withed_Rec
: With_Record
renames Withs
.Table
(W_Id
);
555 Withed_U_Id
: constant Unit_Id
:=
556 Corresponding_Unit
(Withed_Rec
.Uname
);
558 Kind
: Library_Graph_Edge_Kind
;
559 Withed_Vertex
: Library_Graph_Vertex_Id
;
562 -- Nothing to do when the withed unit does not need to be elaborated.
563 -- This prevents spurious dependencies that can never be satisfied.
565 if not Needs_Elaboration
(Withed_U_Id
) then
569 Withed_Vertex
:= Corresponding_Vertex
(Lib_Graph
, Withed_U_Id
);
571 -- The with comes with pragma Elaborate. Treat the edge as a with
572 -- edge when switch -d_e (ignore the effects of pragma Elaborate)
575 if Withed_Rec
.Elaborate
576 and then not Debug_Flag_Underscore_E
578 Kind
:= Elaborate_Edge
;
580 -- The withed unit is a spec with a completing body. Add an edge
581 -- between the body of the withed predecessor and the withing
584 if Is_Spec_With_Body
(Lib_Graph
, Withed_Vertex
) then
589 (Lib_Graph
, Corresponding_Body
(Withed_U_Id
)),
592 Activates_Task
=> False);
595 -- The with comes with pragma Elaborate_All. Treat the edge as a with
596 -- edge when switch -d_a (ignore the effects of pragma Elaborate_All)
599 elsif Withed_Rec
.Elaborate_All
600 and then not Debug_Flag_Underscore_A
602 Kind
:= Elaborate_All_Edge
;
604 -- Otherwise this is a regular with
610 -- Add an edge between the withed predecessor unit and the withing
615 Pred
=> Withed_Vertex
,
618 Activates_Task
=> False);
619 end Create_With_Edge
;
621 -----------------------
622 -- Create_With_Edges --
623 -----------------------
625 procedure Create_With_Edges
(U_Id
: Unit_Id
) is
627 pragma Assert
(Present
(Lib_Graph
));
628 pragma Assert
(Present
(U_Id
));
632 Succ
=> Corresponding_Vertex
(Lib_Graph
, U_Id
));
633 end Create_With_Edges
;
635 -----------------------
636 -- Create_With_Edges --
637 -----------------------
639 procedure Create_With_Edges
641 Succ
: Library_Graph_Vertex_Id
)
643 pragma Assert
(Present
(Lib_Graph
));
644 pragma Assert
(Present
(U_Id
));
645 pragma Assert
(Present
(Succ
));
647 U_Rec
: Unit_Record
renames ALI
.Units
.Table
(U_Id
);
650 for W_Id
in U_Rec
.First_With
.. U_Rec
.Last_With
loop
651 if Is_Significant_With
(W_Id
) then
652 Create_With_Edge
(W_Id
, Succ
);
655 end Create_With_Edges
;
661 procedure Destroy_Line_Number
(Line
: in out Logical_Line_Number
) is
662 pragma Unreferenced
(Line
);
665 end Destroy_Line_Number
;
667 --------------------------
668 -- Duplicate_Unit_Error --
669 --------------------------
671 procedure Duplicate_Unit_Error
673 Nam
: Unit_Name_Type
;
674 Line
: Logical_Line_Number
)
676 pragma Assert
(Present
(U_Id
));
677 pragma Assert
(Present
(Nam
));
679 Prev_Line
: constant Logical_Line_Number
:=
680 Unit_Line_Tables
.Get
(Unit_To_Line
, U_Id
);
683 Error_Msg_Nat_1
:= Nat
(Line
);
684 Error_Msg_Nat_2
:= Nat
(Prev_Line
);
685 Error_Msg_Unit_1
:= Nam
;
688 (Force_Elab_Order_File
.all
689 & ":#: duplicate unit name $ from line #");
690 end Duplicate_Unit_Error
;
696 function Hash_Unit
(U_Id
: Unit_Id
) return Bucket_Range_Type
is
698 pragma Assert
(Present
(U_Id
));
700 return Bucket_Range_Type
(U_Id
);
703 ------------------------
704 -- Internal_Unit_Info --
705 ------------------------
707 procedure Internal_Unit_Info
(Nam
: Unit_Name_Type
) is
709 pragma Assert
(Present
(Nam
));
712 ("""" & Get_Name_String
(Nam
) & """: predefined unit ignored");
713 end Internal_Unit_Info
;
715 -----------------------
716 -- Is_Duplicate_Unit --
717 -----------------------
719 function Is_Duplicate_Unit
(U_Id
: Unit_Id
) return Boolean is
721 pragma Assert
(Present
(U_Id
));
723 return Unit_Line_Tables
.Contains
(Unit_To_Line
, U_Id
);
724 end Is_Duplicate_Unit
;
726 -------------------------
727 -- Is_Significant_With --
728 -------------------------
730 function Is_Significant_With
(W_Id
: With_Id
) return Boolean is
731 pragma Assert
(Present
(W_Id
));
733 Withed_Rec
: With_Record
renames Withs
.Table
(W_Id
);
734 Withed_U_Id
: constant Unit_Id
:=
735 Corresponding_Unit
(Withed_Rec
.Uname
);
738 -- Nothing to do for a unit which does not exist any more
740 if not Present
(Withed_U_Id
) then
743 -- Nothing to do for a limited with
745 elsif Withed_Rec
.Limited_With
then
748 -- Nothing to do when the unit does not need to be elaborated
750 elsif not Needs_Elaboration
(Withed_U_Id
) then
755 end Is_Significant_With
;
757 -----------------------
758 -- Missing_Unit_Info --
759 -----------------------
761 procedure Missing_Unit_Info
(Nam
: Unit_Name_Type
) is
763 pragma Assert
(Present
(Nam
));
766 ("""" & Get_Name_String
(Nam
) & """: not present; ignored");
767 end Missing_Unit_Info
;
768 end Library_Graph_Builders
;