Disable tests for strdup/strndup on __hpux__
[official-gcc.git] / gcc / ada / bindo-graphs.adb
blob8a6c549ee439a1436c732fc5e1a41f903bfb201e
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- B I N D O . G R A P H S --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2019-2023, 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 ------------------------------------------------------------------------------
26 with Ada.Unchecked_Deallocation;
28 with Butil; use Butil;
29 with Debug; use Debug;
30 with Output; use Output;
32 with Bindo.Writers;
33 use Bindo.Writers;
34 use Bindo.Writers.Phase_Writers;
36 package body Bindo.Graphs is
38 -----------------------
39 -- Local subprograms --
40 -----------------------
42 function Sequence_Next_Cycle return Library_Graph_Cycle_Id;
43 pragma Inline (Sequence_Next_Cycle);
44 -- Generate a new unique library graph cycle handle
46 function Sequence_Next_Edge return Invocation_Graph_Edge_Id;
47 pragma Inline (Sequence_Next_Edge);
48 -- Generate a new unique invocation graph edge handle
50 function Sequence_Next_Edge return Library_Graph_Edge_Id;
51 pragma Inline (Sequence_Next_Edge);
52 -- Generate a new unique library graph edge handle
54 function Sequence_Next_Vertex return Invocation_Graph_Vertex_Id;
55 pragma Inline (Sequence_Next_Vertex);
56 -- Generate a new unique invocation graph vertex handle
58 function Sequence_Next_Vertex return Library_Graph_Vertex_Id;
59 pragma Inline (Sequence_Next_Vertex);
60 -- Generate a new unique library graph vertex handle
62 -----------------------------------
63 -- Destroy_Invocation_Graph_Edge --
64 -----------------------------------
66 procedure Destroy_Invocation_Graph_Edge
67 (Edge : in out Invocation_Graph_Edge_Id)
69 pragma Unreferenced (Edge);
70 begin
71 null;
72 end Destroy_Invocation_Graph_Edge;
74 ---------------------------------
75 -- Destroy_Library_Graph_Cycle --
76 ---------------------------------
78 procedure Destroy_Library_Graph_Cycle
79 (Cycle : in out Library_Graph_Cycle_Id)
81 pragma Unreferenced (Cycle);
82 begin
83 null;
84 end Destroy_Library_Graph_Cycle;
86 --------------------------------
87 -- Destroy_Library_Graph_Edge --
88 --------------------------------
90 procedure Destroy_Library_Graph_Edge
91 (Edge : in out Library_Graph_Edge_Id)
93 pragma Unreferenced (Edge);
94 begin
95 null;
96 end Destroy_Library_Graph_Edge;
98 ----------------------------------
99 -- Destroy_Library_Graph_Vertex --
100 ----------------------------------
102 procedure Destroy_Library_Graph_Vertex
103 (Vertex : in out Library_Graph_Vertex_Id)
105 pragma Unreferenced (Vertex);
106 begin
107 null;
108 end Destroy_Library_Graph_Vertex;
110 --------------------------------
111 -- Hash_Invocation_Graph_Edge --
112 --------------------------------
114 function Hash_Invocation_Graph_Edge
115 (Edge : Invocation_Graph_Edge_Id) return Bucket_Range_Type
117 begin
118 pragma Assert (Present (Edge));
120 return Bucket_Range_Type (Edge);
121 end Hash_Invocation_Graph_Edge;
123 ----------------------------------
124 -- Hash_Invocation_Graph_Vertex --
125 ----------------------------------
127 function Hash_Invocation_Graph_Vertex
128 (Vertex : Invocation_Graph_Vertex_Id) return Bucket_Range_Type
130 begin
131 pragma Assert (Present (Vertex));
133 return Bucket_Range_Type (Vertex);
134 end Hash_Invocation_Graph_Vertex;
136 ------------------------------
137 -- Hash_Library_Graph_Cycle --
138 ------------------------------
140 function Hash_Library_Graph_Cycle
141 (Cycle : Library_Graph_Cycle_Id) return Bucket_Range_Type
143 begin
144 pragma Assert (Present (Cycle));
146 return Bucket_Range_Type (Cycle);
147 end Hash_Library_Graph_Cycle;
149 -----------------------------
150 -- Hash_Library_Graph_Edge --
151 -----------------------------
153 function Hash_Library_Graph_Edge
154 (Edge : Library_Graph_Edge_Id) return Bucket_Range_Type
156 begin
157 pragma Assert (Present (Edge));
159 return Bucket_Range_Type (Edge);
160 end Hash_Library_Graph_Edge;
162 -------------------------------
163 -- Hash_Library_Graph_Vertex --
164 -------------------------------
166 function Hash_Library_Graph_Vertex
167 (Vertex : Library_Graph_Vertex_Id) return Bucket_Range_Type
169 begin
170 pragma Assert (Present (Vertex));
172 return Bucket_Range_Type (Vertex);
173 end Hash_Library_Graph_Vertex;
175 --------------------
176 -- Library_Graphs --
177 --------------------
179 package body Library_Graphs is
181 -----------------------
182 -- Local subprograms --
183 -----------------------
185 procedure Add_Body_Before_Spec_Edge
186 (G : Library_Graph;
187 Vertex : Library_Graph_Vertex_Id;
188 Edges : LGE_Lists.Doubly_Linked_List);
189 pragma Inline (Add_Body_Before_Spec_Edge);
190 -- Create a new edge in library graph G between vertex Vertex and its
191 -- corresponding spec or body, where the body is a predecessor and the
192 -- spec a successor. Add the edge to list Edges.
194 procedure Add_Body_Before_Spec_Edges
195 (G : Library_Graph;
196 Edges : LGE_Lists.Doubly_Linked_List);
197 pragma Inline (Add_Body_Before_Spec_Edges);
198 -- Create new edges in library graph G for all vertices and their
199 -- corresponding specs or bodies, where the body is a predecessor
200 -- and the spec is a successor. Add all edges to list Edges.
202 procedure Add_Edge_Kind_Check
203 (G : Library_Graph;
204 Pred : Library_Graph_Vertex_Id;
205 Succ : Library_Graph_Vertex_Id;
206 New_Kind : Library_Graph_Edge_Kind);
207 -- This is called by Add_Edge in the case where there is already a
208 -- Pred-->Succ edge, to assert that the New_Kind is appropriate. Raises
209 -- Program_Error if a bug is detected. The purpose is to prevent bugs
210 -- where calling Add_Edge in different orders produces different output.
212 function Add_Edge
213 (G : Library_Graph;
214 Pred : Library_Graph_Vertex_Id;
215 Succ : Library_Graph_Vertex_Id;
216 Kind : Library_Graph_Edge_Kind;
217 Activates_Task : Boolean) return Library_Graph_Edge_Id;
218 pragma Inline (Add_Edge);
219 -- Create a new edge in library graph G with source vertex Pred and
220 -- destination vertex Succ, and return its handle. Kind denotes the
221 -- nature of the edge. Activates_Task should be set when the edge
222 -- involves a task activation. If Pred and Succ are already related,
223 -- no edge is created and No_Library_Graph_Edge is returned, but if
224 -- Activates_Task is True, then the flag of the existing edge is
225 -- updated.
227 function At_Least_One_Edge_Satisfies
228 (G : Library_Graph;
229 Cycle : Library_Graph_Cycle_Id;
230 Predicate : LGE_Predicate_Ptr) return Boolean;
231 pragma Inline (At_Least_One_Edge_Satisfies);
232 -- Determine whether at least one edge of cycle Cycle of library graph G
233 -- satisfies predicate Predicate.
235 function Copy_Cycle_Path
236 (Cycle_Path : LGE_Lists.Doubly_Linked_List)
237 return LGE_Lists.Doubly_Linked_List;
238 pragma Inline (Copy_Cycle_Path);
239 -- Create a deep copy of list Cycle_Path
241 function Cycle_End_Vertices
242 (G : Library_Graph;
243 Vertex : Library_Graph_Vertex_Id;
244 Elaborate_All_Active : Boolean) return LGV_Sets.Membership_Set;
245 pragma Inline (Cycle_End_Vertices);
246 -- Part of Tarjan's enumeration of the elementary circuits of a directed
247 -- graph algorithm. Collect the vertices that terminate a cycle starting
248 -- from vertex Vertex of library graph G in a set. This is usually the
249 -- vertex itself, unless the vertex is part of an Elaborate_Body pair,
250 -- or flag Elaborate_All_Active is set. In that case the complementary
251 -- vertex is also added to the set.
253 function Cycle_Kind_Of
254 (G : Library_Graph;
255 Edge : Library_Graph_Edge_Id) return Library_Graph_Cycle_Kind;
256 pragma Inline (Cycle_Kind_Of);
257 -- Determine the cycle kind of edge Edge of library graph G if the edge
258 -- participated in a circuit.
260 function Cycle_Kind_Precedence
261 (Kind : Library_Graph_Cycle_Kind;
262 Compared_To : Library_Graph_Cycle_Kind) return Precedence_Kind;
263 pragma Inline (Cycle_Kind_Precedence);
264 -- Determine the precedence of cycle kind Kind compared to cycle kind
265 -- Compared_To.
267 function Cycle_Path_Precedence
268 (G : Library_Graph;
269 Path : LGE_Lists.Doubly_Linked_List;
270 Compared_To : LGE_Lists.Doubly_Linked_List) return Precedence_Kind;
271 pragma Inline (Cycle_Path_Precedence);
272 -- Determine the precedence of cycle path Path of library graph G
273 -- compared to path Compared_To.
275 function Cycle_Precedence
276 (G : Library_Graph;
277 Cycle : Library_Graph_Cycle_Id;
278 Compared_To : Library_Graph_Cycle_Id) return Precedence_Kind;
279 pragma Inline (Cycle_Precedence);
280 -- Determine the precedence of cycle Cycle of library graph G compared
281 -- to cycle Compared_To.
283 procedure Decrement_Library_Graph_Edge_Count
284 (G : Library_Graph;
285 Kind : Library_Graph_Edge_Kind);
286 pragma Inline (Decrement_Library_Graph_Edge_Count);
287 -- Decrement the number of edges of kind King in library graph G by one
289 procedure Delete_Body_Before_Spec_Edges
290 (G : Library_Graph;
291 Edges : LGE_Lists.Doubly_Linked_List);
292 pragma Inline (Delete_Body_Before_Spec_Edges);
293 -- Delete all edges in list Edges from library graph G, that link spec
294 -- and bodies, where the body acts as the predecessor and the spec as a
295 -- successor.
297 procedure Delete_Edge
298 (G : Library_Graph;
299 Edge : Library_Graph_Edge_Id);
300 pragma Inline (Delete_Edge);
301 -- Delete edge Edge from library graph G
303 function Edge_Precedence
304 (G : Library_Graph;
305 Edge : Library_Graph_Edge_Id;
306 Compared_To : Library_Graph_Edge_Id) return Precedence_Kind;
307 pragma Inline (Edge_Precedence);
308 -- Determine the precedence of edge Edge of library graph G compared to
309 -- edge Compared_To.
311 procedure Find_Cycles_From_Successor
312 (G : Library_Graph;
313 Edge : Library_Graph_Edge_Id;
314 End_Vertices : LGV_Sets.Membership_Set;
315 Deleted_Vertices : LGV_Sets.Membership_Set;
316 Most_Significant_Edge : Library_Graph_Edge_Id;
317 Invocation_Edge_Count : Natural;
318 Cycle_Path_Stack : LGE_Lists.Doubly_Linked_List;
319 Visited_Set : LGV_Sets.Membership_Set;
320 Visited_Stack : LGV_Lists.Doubly_Linked_List;
321 Cycle_Count : in out Natural;
322 Cycle_Limit : Natural;
323 Elaborate_All_Active : Boolean;
324 Has_Cycle : out Boolean;
325 Indent : Indentation_Level);
326 pragma Inline (Find_Cycles_From_Successor);
327 -- Part of Tarjan's enumeration of the elementary circuits of a directed
328 -- graph algorithm. Find all cycles from the successor indicated by edge
329 -- Edge of library graph G. If at least one cycle exists, set Has_Cycle
330 -- to True. The remaining parameters are as follows:
332 -- * End vertices is the set of vertices that terminate a potential
333 -- cycle.
335 -- * Deleted vertices is the set of vertices that have been expanded
336 -- during previous depth-first searches and should not be visited
337 -- for the rest of the algorithm.
339 -- * Most_Significant_Edge is the current highest-precedence edge on
340 -- the path of the potential cycle.
342 -- * Invocation_Edge_Count is the number of invocation edges on the
343 -- path of the potential cycle.
345 -- * Cycle_Path_Stack is the path of the potential cycle.
347 -- * Visited_Set is the set of vertices that have been visited during
348 -- the current depth-first search.
350 -- * Visited_Stack maintains the vertices of Visited_Set in a stack
351 -- for later unvisiting.
353 -- * Cycle_Count is the number of cycles discovered so far.
355 -- * Cycle_Limit is the upper bound of the number of cycles to be
356 -- discovered.
358 -- * Elaborate_All_Active should be set when the component currently
359 -- being examined for cycles contains an Elaborate_All edge.
361 -- * Indent in the desired indentation level for tracing.
363 procedure Find_Cycles_From_Vertex
364 (G : Library_Graph;
365 Vertex : Library_Graph_Vertex_Id;
366 End_Vertices : LGV_Sets.Membership_Set;
367 Deleted_Vertices : LGV_Sets.Membership_Set;
368 Most_Significant_Edge : Library_Graph_Edge_Id;
369 Invocation_Edge_Count : Natural;
370 Cycle_Path_Stack : LGE_Lists.Doubly_Linked_List;
371 Visited_Set : LGV_Sets.Membership_Set;
372 Visited_Stack : LGV_Lists.Doubly_Linked_List;
373 Cycle_Count : in out Natural;
374 Cycle_Limit : Natural;
375 Elaborate_All_Active : Boolean;
376 Is_Start_Vertex : Boolean;
377 Has_Cycle : out Boolean;
378 Indent : Indentation_Level);
379 pragma Inline (Find_Cycles_From_Vertex);
380 -- Part of Tarjan's enumeration of the elementary circuits of a directed
381 -- graph algorithm. Find all cycles from vertex Vertex of library graph
382 -- G. If at least one cycle exists, set Has_Cycle to True. The remaining
383 -- parameters are as follows:
385 -- * End_Vertices is the set of vertices that terminate a potential
386 -- cycle.
388 -- * Deleted_Vertices is the set of vertices that have been expanded
389 -- during previous depth-first searches and should not be visited
390 -- for the rest of the algorithm.
392 -- * Most_Significant_Edge is the current highest-precedence edge on
393 -- the path of the potential cycle.
395 -- * Invocation_Edge_Count is the number of invocation edges on the
396 -- path of the potential cycle.
398 -- * Cycle_Path_Stack is the path of the potential cycle.
400 -- * Visited_Set is the set of vertices that have been visited during
401 -- the current depth-first search.
403 -- * Visited_Stack maintains the vertices of Visited_Set in a stack
404 -- for later unvisiting.
406 -- * Cycle_Count is the number of cycles discovered so far.
408 -- * Cycle_Limit is the upper bound of the number of cycles to be
409 -- discovered.
411 -- * Elaborate_All_Active should be set when the component currently
412 -- being examined for cycles contains an Elaborate_All edge.
414 -- * Indent in the desired indentation level for tracing.
416 procedure Find_Cycles_In_Component
417 (G : Library_Graph;
418 Comp : Component_Id;
419 Cycle_Count : in out Natural;
420 Cycle_Limit : Natural);
421 pragma Inline (Find_Cycles_In_Component);
422 -- Part of Tarjan's enumeration of the elementary circuits of a directed
423 -- graph algorithm. Find all cycles in component Comp of library graph
424 -- G. The remaining parameters are as follows:
426 -- * Cycle_Count is the number of cycles discovered so far.
428 -- * Cycle_Limit is the upper bound of the number of cycles to be
429 -- discovered.
431 function Find_Edge
432 (G : Library_Graph;
433 Pred : Library_Graph_Vertex_Id;
434 Succ : Library_Graph_Vertex_Id) return Library_Graph_Edge_Id;
435 -- There must be an edge Pred-->Succ; this returns it
437 function Find_First_Lower_Precedence_Cycle
438 (G : Library_Graph;
439 Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Id;
440 pragma Inline (Find_First_Lower_Precedence_Cycle);
441 -- Inspect the list of cycles of library graph G and return the first
442 -- cycle whose precedence is lower than that of cycle Cycle. If there
443 -- is no such cycle, return No_Library_Graph_Cycle.
445 procedure Free is
446 new Ada.Unchecked_Deallocation
447 (Library_Graph_Attributes, Library_Graph);
449 function Get_Component_Attributes
450 (G : Library_Graph;
451 Comp : Component_Id) return Component_Attributes;
452 pragma Inline (Get_Component_Attributes);
453 -- Obtain the attributes of component Comp of library graph G
455 function Get_LGC_Attributes
456 (G : Library_Graph;
457 Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Attributes;
458 pragma Inline (Get_LGC_Attributes);
459 -- Obtain the attributes of cycle Cycle of library graph G
461 function Get_LGE_Attributes
462 (G : Library_Graph;
463 Edge : Library_Graph_Edge_Id)
464 return Library_Graph_Edge_Attributes;
465 pragma Inline (Get_LGE_Attributes);
466 -- Obtain the attributes of edge Edge of library graph G
468 function Get_LGV_Attributes
469 (G : Library_Graph;
470 Vertex : Library_Graph_Vertex_Id)
471 return Library_Graph_Vertex_Attributes;
472 pragma Inline (Get_LGV_Attributes);
473 -- Obtain the attributes of vertex Edge of library graph G
475 function Has_Elaborate_Body
476 (G : Library_Graph;
477 Vertex : Library_Graph_Vertex_Id) return Boolean;
478 pragma Inline (Has_Elaborate_Body);
479 -- Determine whether vertex Vertex of library graph G is subject to
480 -- pragma Elaborate_Body.
482 function Has_Elaborate_All_Edge
483 (G : Library_Graph;
484 Comp : Component_Id) return Boolean;
485 pragma Inline (Has_Elaborate_All_Edge);
486 -- Determine whether component Comp of library graph G contains an
487 -- Elaborate_All edge that links two vertices in the same component.
489 function Has_Elaborate_All_Edge
490 (G : Library_Graph;
491 Vertex : Library_Graph_Vertex_Id) return Boolean;
492 pragma Inline (Has_Elaborate_All_Edge);
493 -- Determine whether vertex Vertex of library graph G contains an
494 -- Elaborate_All edge to a successor where both the vertex and the
495 -- successor reside in the same component.
497 function Highest_Precedence_Edge
498 (G : Library_Graph;
499 Left : Library_Graph_Edge_Id;
500 Right : Library_Graph_Edge_Id) return Library_Graph_Edge_Id;
501 pragma Inline (Highest_Precedence_Edge);
502 -- Return the edge with highest precedence among edges Left and Right of
503 -- library graph G.
505 procedure Increment_Library_Graph_Edge_Count
506 (G : Library_Graph;
507 Kind : Library_Graph_Edge_Kind);
508 pragma Inline (Increment_Library_Graph_Edge_Count);
509 -- Increment the number of edges of king Kind in library graph G by one
511 procedure Increment_Pending_Predecessors
512 (G : Library_Graph;
513 Comp : Component_Id;
514 Edge : Library_Graph_Edge_Id);
515 pragma Inline (Increment_Pending_Predecessors);
516 -- Increment the number of pending predecessors component Comp which was
517 -- reached via edge Edge of library graph G must wait on before it can
518 -- be elaborated by one.
520 procedure Increment_Pending_Predecessors
521 (G : Library_Graph;
522 Vertex : Library_Graph_Vertex_Id;
523 Edge : Library_Graph_Edge_Id);
524 pragma Inline (Increment_Pending_Predecessors);
525 -- Increment the number of pending predecessors vertex Vertex which was
526 -- reached via edge Edge of library graph G must wait on before it can
527 -- be elaborated by one.
529 procedure Initialize_Components (G : Library_Graph);
530 pragma Inline (Initialize_Components);
531 -- Initialize on the initial call or re-initialize on subsequent calls
532 -- all components of library graph G.
534 function Is_Cycle_Initiating_Edge
535 (G : Library_Graph;
536 Edge : Library_Graph_Edge_Id) return Boolean;
537 pragma Inline (Is_Cycle_Initiating_Edge);
538 -- Determine whether edge Edge of library graph G starts a cycle
540 function Is_Cyclic_Edge
541 (G : Library_Graph;
542 Edge : Library_Graph_Edge_Id) return Boolean;
543 pragma Inline (Is_Cyclic_Edge);
544 -- Determine whether edge Edge of library graph G participates in a
545 -- cycle.
547 function Is_Cyclic_Elaborate_All_Edge
548 (G : Library_Graph;
549 Edge : Library_Graph_Edge_Id) return Boolean;
550 pragma Inline (Is_Cyclic_Elaborate_All_Edge);
551 -- Determine whether edge Edge of library graph G participates in a
552 -- cycle and has a predecessor that is subject to pragma Elaborate_All.
554 function Is_Cyclic_Elaborate_Body_Edge
555 (G : Library_Graph;
556 Edge : Library_Graph_Edge_Id) return Boolean;
557 pragma Inline (Is_Cyclic_Elaborate_Body_Edge);
558 -- Determine whether edge Edge of library graph G participates in a
559 -- cycle and has a successor that is either a spec subject to pragma
560 -- Elaborate_Body, or a body that completes such a spec.
562 function Is_Cyclic_Elaborate_Edge
563 (G : Library_Graph;
564 Edge : Library_Graph_Edge_Id) return Boolean;
565 pragma Inline (Is_Cyclic_Elaborate_Edge);
566 -- Determine whether edge Edge of library graph G participates in a
567 -- cycle and has a predecessor that is subject to pragma Elaborate.
569 function Is_Cyclic_Forced_Edge
570 (G : Library_Graph;
571 Edge : Library_Graph_Edge_Id) return Boolean;
572 pragma Inline (Is_Cyclic_Forced_Edge);
573 -- Determine whether edge Edge of library graph G participates in a
574 -- cycle and came from the forced-elaboration-order file.
576 function Is_Cyclic_Invocation_Edge
577 (G : Library_Graph;
578 Edge : Library_Graph_Edge_Id) return Boolean;
579 pragma Inline (Is_Cyclic_Invocation_Edge);
580 -- Determine whether edge Edge of library graph G participates in a
581 -- cycle and came from the traversal of the invocation graph.
583 function Is_Cyclic_With_Edge
584 (G : Library_Graph;
585 Edge : Library_Graph_Edge_Id) return Boolean;
586 pragma Inline (Is_Cyclic_With_Edge);
587 -- Determine whether edge Edge of library graph G participates in a
588 -- cycle and is the result of a with dependency between its successor
589 -- and predecessor.
591 function Is_Recorded_Edge
592 (G : Library_Graph;
593 Rel : Predecessor_Successor_Relation) return Boolean;
594 pragma Inline (Is_Recorded_Edge);
595 -- Determine whether a predecessor vertex and a successor vertex
596 -- described by relation Rel are already linked in library graph G.
598 function Is_Static_Successor_Edge
599 (G : Library_Graph;
600 Edge : Library_Graph_Edge_Id) return Boolean;
601 pragma Inline (Is_Static_Successor_Edge);
602 -- Determine whether the successor of invocation edge Edge represents a
603 -- unit that was compiled with the static model.
605 function Is_Vertex_With_Elaborate_Body
606 (G : Library_Graph;
607 Vertex : Library_Graph_Vertex_Id) return Boolean;
608 pragma Inline (Is_Vertex_With_Elaborate_Body);
609 -- Determine whether vertex Vertex of library graph G denotes a spec
610 -- subject to pragma Elaborate_Body or the completing body of such a
611 -- spec.
613 function Links_Vertices_In_Same_Component
614 (G : Library_Graph;
615 Edge : Library_Graph_Edge_Id) return Boolean;
616 pragma Inline (Links_Vertices_In_Same_Component);
617 -- Determine whether edge Edge of library graph G links a predecessor
618 -- and successor that reside in the same component.
620 function Maximum_Invocation_Edge_Count
621 (G : Library_Graph;
622 Edge : Library_Graph_Edge_Id;
623 Count : Natural) return Natural;
624 pragma Inline (Maximum_Invocation_Edge_Count);
625 -- Determine whether edge Edge of library graph G is an invocation edge,
626 -- and if it is return Count + 1, otherwise return Count.
628 procedure Normalize_Cycle_Path
629 (Cycle_Path : LGE_Lists.Doubly_Linked_List;
630 Most_Significant_Edge : Library_Graph_Edge_Id);
631 pragma Inline (Normalize_Cycle_Path);
632 -- Normalize cycle path Path by rotating it until its starting edge is
633 -- Sig_Edge.
635 procedure Order_Cycle
636 (G : Library_Graph;
637 Cycle : Library_Graph_Cycle_Id);
638 pragma Inline (Order_Cycle);
639 -- Insert cycle Cycle in library graph G and sort it based on its
640 -- precedence relative to all recorded cycles.
642 function Path
643 (G : Library_Graph;
644 Cycle : Library_Graph_Cycle_Id) return LGE_Lists.Doubly_Linked_List;
645 pragma Inline (Path);
646 -- Obtain the path of edges which comprises cycle Cycle of library
647 -- graph G.
649 procedure Record_Cycle
650 (G : Library_Graph;
651 Most_Significant_Edge : Library_Graph_Edge_Id;
652 Invocation_Edge_Count : Natural;
653 Cycle_Path : LGE_Lists.Doubly_Linked_List;
654 Indent : Indentation_Level);
655 pragma Inline (Record_Cycle);
656 -- Normalize a cycle described by its path Cycle_Path and add it to
657 -- library graph G. Most_Significant_Edge denotes the edge with the
658 -- highest significance along the cycle path. Invocation_Edge_Count
659 -- is the number of invocation edges along the cycle path. Indent is
660 -- the desired indentation level for tracing.
662 procedure Set_Activates_Task
663 (G : Library_Graph;
664 Edge : Library_Graph_Edge_Id);
665 -- Set the Activates_Task flag of the Edge to True
667 procedure Set_Component_Attributes
668 (G : Library_Graph;
669 Comp : Component_Id;
670 Val : Component_Attributes);
671 pragma Inline (Set_Component_Attributes);
672 -- Set the attributes of component Comp of library graph G to value Val
674 procedure Set_Corresponding_Vertex
675 (G : Library_Graph;
676 U_Id : Unit_Id;
677 Val : Library_Graph_Vertex_Id);
678 pragma Inline (Set_Corresponding_Vertex);
679 -- Associate vertex Val of library graph G with unit U_Id
681 procedure Set_Is_Recorded_Edge
682 (G : Library_Graph;
683 Rel : Predecessor_Successor_Relation);
684 pragma Inline (Set_Is_Recorded_Edge);
685 -- Mark a predecessor vertex and a successor vertex described by
686 -- relation Rel as already linked.
688 procedure Set_LGC_Attributes
689 (G : Library_Graph;
690 Cycle : Library_Graph_Cycle_Id;
691 Val : Library_Graph_Cycle_Attributes);
692 pragma Inline (Set_LGC_Attributes);
693 -- Set the attributes of cycle Cycle of library graph G to value Val
695 procedure Set_LGE_Attributes
696 (G : Library_Graph;
697 Edge : Library_Graph_Edge_Id;
698 Val : Library_Graph_Edge_Attributes);
699 pragma Inline (Set_LGE_Attributes);
700 -- Set the attributes of edge Edge of library graph G to value Val
702 procedure Set_LGV_Attributes
703 (G : Library_Graph;
704 Vertex : Library_Graph_Vertex_Id;
705 Val : Library_Graph_Vertex_Attributes);
706 pragma Inline (Set_LGV_Attributes);
707 -- Set the attributes of vertex Vertex of library graph G to value Val
709 procedure Trace_Component
710 (G : Library_Graph;
711 Comp : Component_Id;
712 Indent : Indentation_Level);
713 pragma Inline (Trace_Component);
714 -- Write the contents of component Comp of library graph G to standard
715 -- output. Indent is the desired indentation level for tracing.
717 procedure Trace_Cycle
718 (G : Library_Graph;
719 Cycle : Library_Graph_Cycle_Id;
720 Indent : Indentation_Level);
721 pragma Inline (Trace_Cycle);
722 -- Write the contents of cycle Cycle of library graph G to standard
723 -- output. Indent is the desired indentation level for tracing.
725 procedure Trace_Edge
726 (G : Library_Graph;
727 Edge : Library_Graph_Edge_Id;
728 Indent : Indentation_Level);
729 pragma Inline (Trace_Edge);
730 -- Write the contents of edge Edge of library graph G to standard
731 -- output. Indent is the desired indentation level for tracing.
733 procedure Trace_Vertex
734 (G : Library_Graph;
735 Vertex : Library_Graph_Vertex_Id;
736 Indent : Indentation_Level);
737 pragma Inline (Trace_Vertex);
738 -- Write the contents of vertex Vertex of library graph G to standard
739 -- output. Indent is the desired indentation level for tracing.
741 procedure Unvisit
742 (Vertex : Library_Graph_Vertex_Id;
743 Visited_Set : LGV_Sets.Membership_Set;
744 Visited_Stack : LGV_Lists.Doubly_Linked_List);
745 pragma Inline (Unvisit);
746 -- Part of Tarjan's enumeration of the elementary circuits of a directed
747 -- graph algorithm. Unwind the Visited_Stack by removing the top vertex
748 -- from set Visited_Set until vertex Vertex is reached, inclusive.
750 procedure Update_Pending_Predecessors
751 (Strong_Predecessors : in out Natural;
752 Weak_Predecessors : in out Natural;
753 Update_Weak : Boolean;
754 Value : Integer);
755 pragma Inline (Update_Pending_Predecessors);
756 -- Update the number of pending strong or weak predecessors denoted by
757 -- Strong_Predecessors and Weak_Predecessors respectively depending on
758 -- flag Update_Weak by adding value Value.
760 procedure Update_Pending_Predecessors_Of_Components (G : Library_Graph);
761 pragma Inline (Update_Pending_Predecessors_Of_Components);
762 -- Update the number of pending predecessors all components of library
763 -- graph G must wait on before they can be elaborated.
765 procedure Update_Pending_Predecessors_Of_Components
766 (G : Library_Graph;
767 Edge : Library_Graph_Edge_Id);
768 pragma Inline (Update_Pending_Predecessors_Of_Components);
769 -- Update the number of pending predecessors the component of edge
770 -- LGE_Is's successor vertex of library graph G must wait on before
771 -- it can be elaborated.
773 function Vertex_Precedence
774 (G : Library_Graph;
775 Vertex : Library_Graph_Vertex_Id;
776 Compared_To : Library_Graph_Vertex_Id) return Precedence_Kind;
777 pragma Inline (Vertex_Precedence);
778 -- Determine the precedence of vertex Vertex of library graph G compared
779 -- to vertex Compared_To.
781 procedure Visit
782 (Vertex : Library_Graph_Vertex_Id;
783 Visited_Set : LGV_Sets.Membership_Set;
784 Visited_Stack : LGV_Lists.Doubly_Linked_List);
785 pragma Inline (Visit);
786 -- Part of Tarjan's enumeration of the elementary circuits of a directed
787 -- graph algorithm. Push vertex Vertex on the Visited_Stack and add it
788 -- to set Visited_Set.
790 --------------------
791 -- Activates_Task --
792 --------------------
794 function Activates_Task
795 (G : Library_Graph;
796 Edge : Library_Graph_Edge_Id) return Boolean
798 begin
799 return Get_LGE_Attributes (G, Edge).Activates_Task;
800 end Activates_Task;
802 -------------------------------
803 -- Add_Body_Before_Spec_Edge --
804 -------------------------------
806 procedure Add_Body_Before_Spec_Edge
807 (G : Library_Graph;
808 Vertex : Library_Graph_Vertex_Id;
809 Edges : LGE_Lists.Doubly_Linked_List)
811 Edge : Library_Graph_Edge_Id;
813 begin
814 pragma Assert (Present (G));
815 pragma Assert (Present (Vertex));
816 pragma Assert (LGE_Lists.Present (Edges));
818 -- A vertex requires a special Body_Before_Spec edge to its
819 -- Corresponding_Item when it either denotes a
821 -- * Body that completes a previous spec
823 -- * Spec with a completing body
825 -- The edge creates an intentional circularity between the spec and
826 -- body in order to emulate a library unit, and guarantees that both
827 -- will appear in the same component.
829 -- Due to the structure of the library graph, either the spec or
830 -- the body may be visited first, yet Corresponding_Item will still
831 -- attempt to create the Body_Before_Spec edge. This is OK because
832 -- successor and predecessor are kept consistent in both cases, and
833 -- Add_Edge will prevent the creation of the second edge.
835 -- Assume that no Body_Before_Spec is necessary
837 Edge := No_Library_Graph_Edge;
839 -- A body that completes a previous spec
841 if Is_Body_With_Spec (G, Vertex) then
842 Edge :=
843 Add_Edge
844 (G => G,
845 Pred => Vertex,
846 Succ => Corresponding_Item (G, Vertex),
847 Kind => Body_Before_Spec_Edge,
848 Activates_Task => False);
850 -- A spec with a completing body
852 elsif Is_Spec_With_Body (G, Vertex) then
853 Edge :=
854 Add_Edge
855 (G => G,
856 Pred => Corresponding_Item (G, Vertex),
857 Succ => Vertex,
858 Kind => Body_Before_Spec_Edge,
859 Activates_Task => False);
860 end if;
862 if Present (Edge) then
863 LGE_Lists.Append (Edges, Edge);
864 end if;
865 end Add_Body_Before_Spec_Edge;
867 --------------------------------
868 -- Add_Body_Before_Spec_Edges --
869 --------------------------------
871 procedure Add_Body_Before_Spec_Edges
872 (G : Library_Graph;
873 Edges : LGE_Lists.Doubly_Linked_List)
875 Iter : Elaborable_Units_Iterator;
876 U_Id : Unit_Id;
878 begin
879 pragma Assert (Present (G));
880 pragma Assert (LGE_Lists.Present (Edges));
882 Iter := Iterate_Elaborable_Units;
883 while Has_Next (Iter) loop
884 Next (Iter, U_Id);
886 Add_Body_Before_Spec_Edge
887 (G => G,
888 Vertex => Corresponding_Vertex (G, U_Id),
889 Edges => Edges);
890 end loop;
891 end Add_Body_Before_Spec_Edges;
893 --------------
894 -- Add_Edge --
895 --------------
897 procedure Add_Edge
898 (G : Library_Graph;
899 Pred : Library_Graph_Vertex_Id;
900 Succ : Library_Graph_Vertex_Id;
901 Kind : Library_Graph_Edge_Kind;
902 Activates_Task : Boolean)
904 Ignore : constant Library_Graph_Edge_Id :=
905 Add_Edge
906 (G => G,
907 Pred => Pred,
908 Succ => Succ,
909 Kind => Kind,
910 Activates_Task => Activates_Task);
911 begin
912 null;
913 end Add_Edge;
915 -------------------------
916 -- Add_Edge_Kind_Check --
917 -------------------------
919 procedure Add_Edge_Kind_Check
920 (G : Library_Graph;
921 Pred : Library_Graph_Vertex_Id;
922 Succ : Library_Graph_Vertex_Id;
923 New_Kind : Library_Graph_Edge_Kind)
925 Old_Edge : constant Library_Graph_Edge_Id :=
926 Find_Edge (G, Pred, Succ);
927 Old_Kind : constant Library_Graph_Edge_Kind :=
928 Get_LGE_Attributes (G, Old_Edge).Kind;
929 OK : Boolean;
930 begin
931 case New_Kind is
932 when Spec_Before_Body_Edge =>
933 OK := False;
934 -- Spec_Before_Body_Edge comes first, and there is never more
935 -- than one Spec_Before_Body_Edge for a given unit, so we can't
936 -- have a preexisting edge in the Spec_Before_Body_Edge case.
938 when With_Edge | Elaborate_Edge | Elaborate_All_Edge
939 | Forced_Edge | Invocation_Edge =>
940 OK := Old_Kind <= New_Kind;
941 -- These edges are created in the order of the enumeration
942 -- type, and there can be duplicates; hence "<=".
944 when Body_Before_Spec_Edge =>
945 OK := Old_Kind = Body_Before_Spec_Edge
946 -- We call Add_Edge with Body_Before_Spec_Edge twice -- once
947 -- for the spec and once for the body.
949 or else Old_Kind = Forced_Edge
950 or else Old_Kind = Invocation_Edge;
951 -- The old one can be Forced_Edge or Invocation_Edge, which
952 -- necessarily results in an elaboration cycle (in the static
953 -- model), but this assertion happens before cycle detection,
954 -- so we need to allow these cases.
956 when No_Edge =>
957 OK := False;
958 end case;
960 if not OK then
961 raise Program_Error with Old_Kind'Img & "-->" & New_Kind'Img;
962 end if;
963 end Add_Edge_Kind_Check;
965 --------------
966 -- Add_Edge --
967 --------------
969 function Add_Edge
970 (G : Library_Graph;
971 Pred : Library_Graph_Vertex_Id;
972 Succ : Library_Graph_Vertex_Id;
973 Kind : Library_Graph_Edge_Kind;
974 Activates_Task : Boolean) return Library_Graph_Edge_Id
976 pragma Assert (Present (G));
977 pragma Assert (Present (Pred));
978 pragma Assert (Present (Succ));
979 pragma Assert (Kind = Invocation_Edge or else not Activates_Task);
980 -- Only invocation edges can activate tasks
982 Rel : constant Predecessor_Successor_Relation :=
983 (Predecessor => Pred, Successor => Succ);
985 Edge : Library_Graph_Edge_Id;
987 begin
988 -- If we already have a Pred-->Succ edge, we don't add another
989 -- one. But we need to update Activates_Task, in order to avoid
990 -- depending on the order of processing of edges. If we have
991 -- Pred-->Succ with Activates_Task=True, and another Pred-->Succ with
992 -- Activates_Task=False, we want Activates_Task to be True no matter
993 -- which order we processed those two Add_Edge calls.
995 if Is_Recorded_Edge (G, Rel) then
996 pragma Debug (Add_Edge_Kind_Check (G, Pred, Succ, Kind));
998 if Activates_Task then
999 Set_Activates_Task (G, Find_Edge (G, Pred, Succ));
1000 end if;
1002 return No_Library_Graph_Edge;
1003 end if;
1005 Edge := Sequence_Next_Edge;
1007 -- Add the edge to the underlying graph. Note that the predecessor
1008 -- is the source of the edge because it will later need to notify
1009 -- all its successors that it has been elaborated.
1011 DG.Add_Edge
1012 (G => G.Graph,
1013 E => Edge,
1014 Source => Pred,
1015 Destination => Succ);
1017 -- Construct and save the attributes of the edge
1019 Set_LGE_Attributes
1020 (G => G,
1021 Edge => Edge,
1022 Val =>
1023 (Activates_Task => Activates_Task,
1024 Kind => Kind));
1026 -- Mark the predecessor and successor as related by the new edge.
1027 -- This prevents all further attempts to link the same predecessor
1028 -- and successor.
1030 Set_Is_Recorded_Edge (G, Rel);
1032 -- Update the number of pending predecessors the successor must wait
1033 -- on before it is elaborated.
1035 Increment_Pending_Predecessors
1036 (G => G,
1037 Vertex => Succ,
1038 Edge => Edge);
1040 -- Update the edge statistics
1042 Increment_Library_Graph_Edge_Count (G, Kind);
1044 return Edge;
1045 end Add_Edge;
1047 ----------------
1048 -- Add_Vertex --
1049 ----------------
1051 procedure Add_Vertex
1052 (G : Library_Graph;
1053 U_Id : Unit_Id)
1055 Vertex : Library_Graph_Vertex_Id;
1057 begin
1058 pragma Assert (Present (G));
1059 pragma Assert (Present (U_Id));
1061 -- Nothing to do when the unit already has a vertex
1063 if Present (Corresponding_Vertex (G, U_Id)) then
1064 return;
1065 end if;
1067 Vertex := Sequence_Next_Vertex;
1069 -- Add the vertex to the underlying graph
1071 DG.Add_Vertex (G.Graph, Vertex);
1073 -- Construct and save the attributes of the vertex
1075 Set_LGV_Attributes
1076 (G => G,
1077 Vertex => Vertex,
1078 Val =>
1079 (Corresponding_Item => No_Library_Graph_Vertex,
1080 In_Elaboration_Order => False,
1081 Pending_Strong_Predecessors => 0,
1082 Pending_Weak_Predecessors => 0,
1083 Unit => U_Id));
1085 -- Associate the unit with its corresponding vertex
1087 Set_Corresponding_Vertex (G, U_Id, Vertex);
1088 end Add_Vertex;
1090 ---------------------------------
1091 -- At_Least_One_Edge_Satisfies --
1092 ---------------------------------
1094 function At_Least_One_Edge_Satisfies
1095 (G : Library_Graph;
1096 Cycle : Library_Graph_Cycle_Id;
1097 Predicate : LGE_Predicate_Ptr) return Boolean
1099 Edge : Library_Graph_Edge_Id;
1100 Iter : Edges_Of_Cycle_Iterator;
1101 Satisfied : Boolean;
1103 begin
1104 pragma Assert (Present (G));
1105 pragma Assert (Present (Cycle));
1106 pragma Assert (Predicate /= null);
1108 -- Assume that the predicate cannot be satisfied
1110 Satisfied := False;
1112 -- IMPORTANT:
1114 -- * The iteration must run to completion in order to unlock the
1115 -- edges of the cycle.
1117 Iter := Iterate_Edges_Of_Cycle (G, Cycle);
1118 while Has_Next (Iter) loop
1119 Next (Iter, Edge);
1121 Satisfied := Satisfied or else Predicate.all (G, Edge);
1122 end loop;
1124 return Satisfied;
1125 end At_Least_One_Edge_Satisfies;
1127 --------------------------
1128 -- Complementary_Vertex --
1129 --------------------------
1131 function Complementary_Vertex
1132 (G : Library_Graph;
1133 Vertex : Library_Graph_Vertex_Id;
1134 Force_Complement : Boolean) return Library_Graph_Vertex_Id
1136 Complement : Library_Graph_Vertex_Id;
1138 begin
1139 pragma Assert (Present (G));
1140 pragma Assert (Present (Vertex));
1142 -- Assume that there is no complementary vertex
1144 Complement := No_Library_Graph_Vertex;
1146 -- The caller requests the complement explicitly
1148 if Force_Complement then
1149 Complement := Corresponding_Item (G, Vertex);
1151 -- The vertex is a completing body of a spec subject to pragma
1152 -- Elaborate_Body. The complementary vertex is the spec.
1154 elsif Is_Body_Of_Spec_With_Elaborate_Body (G, Vertex) then
1155 Complement := Proper_Spec (G, Vertex);
1157 -- The vertex is a spec subject to pragma Elaborate_Body. The
1158 -- complementary vertex is the body.
1160 elsif Is_Spec_With_Elaborate_Body (G, Vertex) then
1161 Complement := Proper_Body (G, Vertex);
1162 end if;
1164 return Complement;
1165 end Complementary_Vertex;
1167 ---------------
1168 -- Component --
1169 ---------------
1171 function Component
1172 (G : Library_Graph;
1173 Vertex : Library_Graph_Vertex_Id) return Component_Id
1175 begin
1176 pragma Assert (Present (G));
1177 pragma Assert (Present (Vertex));
1179 return DG.Component (G.Graph, Vertex);
1180 end Component;
1182 ---------------------------------
1183 -- Contains_Elaborate_All_Edge --
1184 ---------------------------------
1186 function Contains_Elaborate_All_Edge
1187 (G : Library_Graph;
1188 Cycle : Library_Graph_Cycle_Id) return Boolean
1190 begin
1191 pragma Assert (Present (G));
1192 pragma Assert (Present (Cycle));
1194 return
1195 At_Least_One_Edge_Satisfies
1196 (G => G,
1197 Cycle => Cycle,
1198 Predicate => Is_Elaborate_All_Edge'Access);
1199 end Contains_Elaborate_All_Edge;
1201 ------------------------------------
1202 -- Contains_Static_Successor_Edge --
1203 ------------------------------------
1205 function Contains_Static_Successor_Edge
1206 (G : Library_Graph;
1207 Cycle : Library_Graph_Cycle_Id) return Boolean
1209 begin
1210 pragma Assert (Present (G));
1211 pragma Assert (Present (Cycle));
1213 return
1214 At_Least_One_Edge_Satisfies
1215 (G => G,
1216 Cycle => Cycle,
1217 Predicate => Is_Static_Successor_Edge'Access);
1218 end Contains_Static_Successor_Edge;
1220 ------------------------------
1221 -- Contains_Task_Activation --
1222 ------------------------------
1224 function Contains_Task_Activation
1225 (G : Library_Graph;
1226 Cycle : Library_Graph_Cycle_Id) return Boolean
1228 begin
1229 pragma Assert (Present (G));
1230 pragma Assert (Present (Cycle));
1232 return
1233 At_Least_One_Edge_Satisfies
1234 (G => G,
1235 Cycle => Cycle,
1236 Predicate => Activates_Task'Access);
1237 end Contains_Task_Activation;
1239 ---------------------
1240 -- Copy_Cycle_Path --
1241 ---------------------
1243 function Copy_Cycle_Path
1244 (Cycle_Path : LGE_Lists.Doubly_Linked_List)
1245 return LGE_Lists.Doubly_Linked_List
1247 Edge : Library_Graph_Edge_Id;
1248 Iter : LGE_Lists.Iterator;
1249 Path : LGE_Lists.Doubly_Linked_List;
1251 begin
1252 pragma Assert (LGE_Lists.Present (Cycle_Path));
1254 Path := LGE_Lists.Create;
1255 Iter := LGE_Lists.Iterate (Cycle_Path);
1256 while LGE_Lists.Has_Next (Iter) loop
1257 LGE_Lists.Next (Iter, Edge);
1259 LGE_Lists.Append (Path, Edge);
1260 end loop;
1262 return Path;
1263 end Copy_Cycle_Path;
1265 ------------------------
1266 -- Corresponding_Item --
1267 ------------------------
1269 function Corresponding_Item
1270 (G : Library_Graph;
1271 Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id
1273 begin
1274 pragma Assert (Present (G));
1275 pragma Assert (Present (Vertex));
1277 return Get_LGV_Attributes (G, Vertex).Corresponding_Item;
1278 end Corresponding_Item;
1280 --------------------------
1281 -- Corresponding_Vertex --
1282 --------------------------
1284 function Corresponding_Vertex
1285 (G : Library_Graph;
1286 U_Id : Unit_Id) return Library_Graph_Vertex_Id
1288 begin
1289 pragma Assert (Present (G));
1290 pragma Assert (Present (U_Id));
1292 return Unit_Tables.Get (G.Unit_To_Vertex, U_Id);
1293 end Corresponding_Vertex;
1295 ------------
1296 -- Create --
1297 ------------
1299 function Create
1300 (Initial_Vertices : Positive;
1301 Initial_Edges : Positive) return Library_Graph
1303 G : constant Library_Graph := new Library_Graph_Attributes;
1305 begin
1306 G.Component_Attributes := Component_Tables.Create (Initial_Vertices);
1307 G.Cycle_Attributes := LGC_Tables.Create (Initial_Vertices);
1308 G.Cycles := LGC_Lists.Create;
1309 G.Edge_Attributes := LGE_Tables.Create (Initial_Edges);
1310 G.Graph :=
1311 DG.Create
1312 (Initial_Vertices => Initial_Vertices,
1313 Initial_Edges => Initial_Edges);
1314 G.Recorded_Edges := RE_Sets.Create (Initial_Edges);
1315 G.Unit_To_Vertex := Unit_Tables.Create (Initial_Vertices);
1316 G.Vertex_Attributes := LGV_Tables.Create (Initial_Vertices);
1318 return G;
1319 end Create;
1321 ------------------------
1322 -- Cycle_End_Vertices --
1323 ------------------------
1325 function Cycle_End_Vertices
1326 (G : Library_Graph;
1327 Vertex : Library_Graph_Vertex_Id;
1328 Elaborate_All_Active : Boolean) return LGV_Sets.Membership_Set
1330 Complement : Library_Graph_Vertex_Id;
1331 End_Vertices : LGV_Sets.Membership_Set := LGV_Sets.Nil;
1333 begin
1334 pragma Assert (Present (G));
1335 pragma Assert (Present (Vertex));
1337 End_Vertices := LGV_Sets.Create (2);
1339 -- The input vertex always terminates a cycle path
1341 LGV_Sets.Insert (End_Vertices, Vertex);
1343 -- Add the complementary vertex to the set of cycle terminating
1344 -- vertices when either Elaborate_All is in effect, or the input
1345 -- vertex is part of an Elaborat_Body pair.
1347 if Elaborate_All_Active
1348 or else Is_Vertex_With_Elaborate_Body (G, Vertex)
1349 then
1350 Complement :=
1351 Complementary_Vertex
1352 (G => G,
1353 Vertex => Vertex,
1354 Force_Complement => Elaborate_All_Active);
1356 if Present (Complement) then
1357 LGV_Sets.Insert (End_Vertices, Complement);
1358 end if;
1359 end if;
1361 return End_Vertices;
1362 end Cycle_End_Vertices;
1364 -------------------
1365 -- Cycle_Kind_Of --
1366 -------------------
1368 function Cycle_Kind_Of
1369 (G : Library_Graph;
1370 Edge : Library_Graph_Edge_Id) return Library_Graph_Cycle_Kind
1372 pragma Assert (Present (G));
1373 pragma Assert (Present (Edge));
1375 begin
1376 if Is_Cyclic_Elaborate_All_Edge (G, Edge) then
1377 return Elaborate_All_Cycle;
1379 elsif Is_Cyclic_Elaborate_Body_Edge (G, Edge) then
1380 return Elaborate_Body_Cycle;
1382 elsif Is_Cyclic_Elaborate_Edge (G, Edge) then
1383 return Elaborate_Cycle;
1385 elsif Is_Cyclic_Forced_Edge (G, Edge) then
1386 return Forced_Cycle;
1388 elsif Is_Cyclic_Invocation_Edge (G, Edge) then
1389 return Invocation_Cycle;
1391 else
1392 return No_Cycle_Kind;
1393 end if;
1394 end Cycle_Kind_Of;
1396 ---------------------------
1397 -- Cycle_Kind_Precedence --
1398 ---------------------------
1400 function Cycle_Kind_Precedence
1401 (Kind : Library_Graph_Cycle_Kind;
1402 Compared_To : Library_Graph_Cycle_Kind) return Precedence_Kind
1404 Comp_Pos : constant Integer :=
1405 Library_Graph_Cycle_Kind'Pos (Compared_To);
1406 Kind_Pos : constant Integer := Library_Graph_Cycle_Kind'Pos (Kind);
1408 begin
1409 -- A lower ordinal indicates a higher precedence
1411 if Kind_Pos < Comp_Pos then
1412 return Higher_Precedence;
1414 elsif Kind_Pos > Comp_Pos then
1415 return Lower_Precedence;
1417 else
1418 return Equal_Precedence;
1419 end if;
1420 end Cycle_Kind_Precedence;
1422 ---------------------------
1423 -- Cycle_Path_Precedence --
1424 ---------------------------
1426 function Cycle_Path_Precedence
1427 (G : Library_Graph;
1428 Path : LGE_Lists.Doubly_Linked_List;
1429 Compared_To : LGE_Lists.Doubly_Linked_List) return Precedence_Kind
1431 procedure Next_Available
1432 (Iter : in out LGE_Lists.Iterator;
1433 Edge : out Library_Graph_Edge_Id);
1434 pragma Inline (Next_Available);
1435 -- Obtain the next edge available through iterator Iter, or return
1436 -- No_Library_Graph_Edge if the iterator has been exhausted.
1438 --------------------
1439 -- Next_Available --
1440 --------------------
1442 procedure Next_Available
1443 (Iter : in out LGE_Lists.Iterator;
1444 Edge : out Library_Graph_Edge_Id)
1446 begin
1447 -- Assume that the iterator has been exhausted
1449 Edge := No_Library_Graph_Edge;
1451 if LGE_Lists.Has_Next (Iter) then
1452 LGE_Lists.Next (Iter, Edge);
1453 end if;
1454 end Next_Available;
1456 -- Local variables
1458 Comp_Edge : Library_Graph_Edge_Id;
1459 Comp_Iter : LGE_Lists.Iterator;
1460 Path_Edge : Library_Graph_Edge_Id;
1461 Path_Iter : LGE_Lists.Iterator;
1462 Prec : Precedence_Kind;
1464 -- Start of processing for Cycle_Path_Precedence
1466 begin
1467 pragma Assert (Present (G));
1468 pragma Assert (LGE_Lists.Present (Path));
1469 pragma Assert (LGE_Lists.Present (Compared_To));
1471 -- Assume that the paths have equal precedence
1473 Prec := Equal_Precedence;
1475 Comp_Iter := LGE_Lists.Iterate (Compared_To);
1476 Path_Iter := LGE_Lists.Iterate (Path);
1478 Next_Available (Comp_Iter, Comp_Edge);
1479 Next_Available (Path_Iter, Path_Edge);
1481 -- IMPORTANT:
1483 -- * The iteration must run to completion in order to unlock the
1484 -- edges of both paths.
1486 while Present (Comp_Edge) or else Present (Path_Edge) loop
1487 if Prec = Equal_Precedence
1488 and then Present (Comp_Edge)
1489 and then Present (Path_Edge)
1490 then
1491 Prec :=
1492 Edge_Precedence
1493 (G => G,
1494 Edge => Path_Edge,
1495 Compared_To => Comp_Edge);
1496 end if;
1498 Next_Available (Comp_Iter, Comp_Edge);
1499 Next_Available (Path_Iter, Path_Edge);
1500 end loop;
1502 return Prec;
1503 end Cycle_Path_Precedence;
1505 ----------------------
1506 -- Cycle_Precedence --
1507 ----------------------
1509 function Cycle_Precedence
1510 (G : Library_Graph;
1511 Cycle : Library_Graph_Cycle_Id;
1512 Compared_To : Library_Graph_Cycle_Id) return Precedence_Kind
1514 pragma Assert (Present (G));
1515 pragma Assert (Present (Cycle));
1516 pragma Assert (Present (Compared_To));
1518 Comp_Invs : constant Natural :=
1519 Invocation_Edge_Count (G, Compared_To);
1520 Comp_Len : constant Natural := Length (G, Compared_To);
1521 Cycle_Invs : constant Natural := Invocation_Edge_Count (G, Cycle);
1522 Cycle_Len : constant Natural := Length (G, Cycle);
1523 Kind_Prec : constant Precedence_Kind :=
1524 Cycle_Kind_Precedence
1525 (Kind => Kind (G, Cycle),
1526 Compared_To => Kind (G, Compared_To));
1528 begin
1529 -- Prefer a cycle with higher precedence based on its kind
1531 if Kind_Prec = Higher_Precedence
1532 or else
1533 Kind_Prec = Lower_Precedence
1534 then
1535 return Kind_Prec;
1537 -- Prefer a shorter cycle
1539 elsif Cycle_Len < Comp_Len then
1540 return Higher_Precedence;
1542 elsif Cycle_Len > Comp_Len then
1543 return Lower_Precedence;
1545 -- Prefer a cycle wih fewer invocation edges
1547 elsif Cycle_Invs < Comp_Invs then
1548 return Higher_Precedence;
1550 elsif Cycle_Invs > Comp_Invs then
1551 return Lower_Precedence;
1553 -- Prefer a cycle with a higher path precedence
1555 else
1556 return
1557 Cycle_Path_Precedence
1558 (G => G,
1559 Path => Path (G, Cycle),
1560 Compared_To => Path (G, Compared_To));
1561 end if;
1562 end Cycle_Precedence;
1564 ----------------------------------------
1565 -- Decrement_Library_Graph_Edge_Count --
1566 ----------------------------------------
1568 procedure Decrement_Library_Graph_Edge_Count
1569 (G : Library_Graph;
1570 Kind : Library_Graph_Edge_Kind)
1572 pragma Assert (Present (G));
1574 Count : Natural renames G.Counts (Kind);
1576 begin
1577 Count := Count - 1;
1578 end Decrement_Library_Graph_Edge_Count;
1580 ------------------------------------
1581 -- Decrement_Pending_Predecessors --
1582 ------------------------------------
1584 procedure Decrement_Pending_Predecessors
1585 (G : Library_Graph;
1586 Comp : Component_Id;
1587 Edge : Library_Graph_Edge_Id)
1589 Attrs : Component_Attributes;
1591 begin
1592 pragma Assert (Present (G));
1593 pragma Assert (Present (Comp));
1595 Attrs := Get_Component_Attributes (G, Comp);
1597 Update_Pending_Predecessors
1598 (Strong_Predecessors => Attrs.Pending_Strong_Predecessors,
1599 Weak_Predecessors => Attrs.Pending_Weak_Predecessors,
1600 Update_Weak => Is_Invocation_Edge (G, Edge),
1601 Value => -1);
1603 Set_Component_Attributes (G, Comp, Attrs);
1604 end Decrement_Pending_Predecessors;
1606 ------------------------------------
1607 -- Decrement_Pending_Predecessors --
1608 ------------------------------------
1610 procedure Decrement_Pending_Predecessors
1611 (G : Library_Graph;
1612 Vertex : Library_Graph_Vertex_Id;
1613 Edge : Library_Graph_Edge_Id)
1615 Attrs : Library_Graph_Vertex_Attributes;
1617 begin
1618 pragma Assert (Present (G));
1619 pragma Assert (Present (Vertex));
1621 Attrs := Get_LGV_Attributes (G, Vertex);
1623 Update_Pending_Predecessors
1624 (Strong_Predecessors => Attrs.Pending_Strong_Predecessors,
1625 Weak_Predecessors => Attrs.Pending_Weak_Predecessors,
1626 Update_Weak => Is_Invocation_Edge (G, Edge),
1627 Value => -1);
1629 Set_LGV_Attributes (G, Vertex, Attrs);
1630 end Decrement_Pending_Predecessors;
1632 -----------------------------------
1633 -- Delete_Body_Before_Spec_Edges --
1634 -----------------------------------
1636 procedure Delete_Body_Before_Spec_Edges
1637 (G : Library_Graph;
1638 Edges : LGE_Lists.Doubly_Linked_List)
1640 Edge : Library_Graph_Edge_Id;
1641 Iter : LGE_Lists.Iterator;
1643 begin
1644 pragma Assert (Present (G));
1645 pragma Assert (LGE_Lists.Present (Edges));
1647 Iter := LGE_Lists.Iterate (Edges);
1648 while LGE_Lists.Has_Next (Iter) loop
1649 LGE_Lists.Next (Iter, Edge);
1650 pragma Assert (Kind (G, Edge) = Body_Before_Spec_Edge);
1652 Delete_Edge (G, Edge);
1653 end loop;
1654 end Delete_Body_Before_Spec_Edges;
1656 -----------------
1657 -- Delete_Edge --
1658 -----------------
1660 procedure Delete_Edge
1661 (G : Library_Graph;
1662 Edge : Library_Graph_Edge_Id)
1664 pragma Assert (Present (G));
1665 pragma Assert (Present (Edge));
1667 Pred : constant Library_Graph_Vertex_Id := Predecessor (G, Edge);
1668 Succ : constant Library_Graph_Vertex_Id := Successor (G, Edge);
1669 Rel : constant Predecessor_Successor_Relation :=
1670 (Predecessor => Pred,
1671 Successor => Succ);
1673 begin
1674 -- Update the edge statistics
1676 Decrement_Library_Graph_Edge_Count (G, Kind (G, Edge));
1678 -- Update the number of pending predecessors the successor must wait
1679 -- on before it is elaborated.
1681 Decrement_Pending_Predecessors
1682 (G => G,
1683 Vertex => Succ,
1684 Edge => Edge);
1686 -- Delete the link between the predecessor and successor. This allows
1687 -- for further attempts to link the same predecessor and successor.
1689 RE_Sets.Delete (G.Recorded_Edges, Rel);
1691 -- Delete the attributes of the edge
1693 LGE_Tables.Delete (G.Edge_Attributes, Edge);
1695 -- Delete the edge from the underlying graph
1697 DG.Delete_Edge (G.Graph, Edge);
1698 end Delete_Edge;
1700 -------------
1701 -- Destroy --
1702 -------------
1704 procedure Destroy (G : in out Library_Graph) is
1705 begin
1706 pragma Assert (Present (G));
1708 Component_Tables.Destroy (G.Component_Attributes);
1709 LGC_Tables.Destroy (G.Cycle_Attributes);
1710 LGC_Lists.Destroy (G.Cycles);
1711 LGE_Tables.Destroy (G.Edge_Attributes);
1712 DG.Destroy (G.Graph);
1713 RE_Sets.Destroy (G.Recorded_Edges);
1714 Unit_Tables.Destroy (G.Unit_To_Vertex);
1715 LGV_Tables.Destroy (G.Vertex_Attributes);
1717 Free (G);
1718 end Destroy;
1720 ----------------------------------
1721 -- Destroy_Component_Attributes --
1722 ----------------------------------
1724 procedure Destroy_Component_Attributes
1725 (Attrs : in out Component_Attributes)
1727 pragma Unreferenced (Attrs);
1728 begin
1729 null;
1730 end Destroy_Component_Attributes;
1732 --------------------------------------------
1733 -- Destroy_Library_Graph_Cycle_Attributes --
1734 --------------------------------------------
1736 procedure Destroy_Library_Graph_Cycle_Attributes
1737 (Attrs : in out Library_Graph_Cycle_Attributes)
1739 begin
1740 LGE_Lists.Destroy (Attrs.Path);
1741 end Destroy_Library_Graph_Cycle_Attributes;
1743 -------------------------------------------
1744 -- Destroy_Library_Graph_Edge_Attributes --
1745 -------------------------------------------
1747 procedure Destroy_Library_Graph_Edge_Attributes
1748 (Attrs : in out Library_Graph_Edge_Attributes)
1750 pragma Unreferenced (Attrs);
1751 begin
1752 null;
1753 end Destroy_Library_Graph_Edge_Attributes;
1755 ---------------------------------------------
1756 -- Destroy_Library_Graph_Vertex_Attributes --
1757 ---------------------------------------------
1759 procedure Destroy_Library_Graph_Vertex_Attributes
1760 (Attrs : in out Library_Graph_Vertex_Attributes)
1762 pragma Unreferenced (Attrs);
1763 begin
1764 null;
1765 end Destroy_Library_Graph_Vertex_Attributes;
1767 ---------------------
1768 -- Edge_Precedence --
1769 ---------------------
1771 function Edge_Precedence
1772 (G : Library_Graph;
1773 Edge : Library_Graph_Edge_Id;
1774 Compared_To : Library_Graph_Edge_Id) return Precedence_Kind
1776 pragma Assert (Present (G));
1777 pragma Assert (Present (Edge));
1778 pragma Assert (Present (Compared_To));
1780 Comp_Succ : constant Library_Graph_Vertex_Id :=
1781 Successor (G, Compared_To);
1782 Edge_Succ : constant Library_Graph_Vertex_Id :=
1783 Successor (G, Edge);
1784 Kind_Prec : constant Precedence_Kind :=
1785 Cycle_Kind_Precedence
1786 (Kind => Cycle_Kind_Of (G, Edge),
1787 Compared_To => Cycle_Kind_Of (G, Compared_To));
1788 Succ_Prec : constant Precedence_Kind :=
1789 Vertex_Precedence
1790 (G => G,
1791 Vertex => Edge_Succ,
1792 Compared_To => Comp_Succ);
1794 begin
1795 -- Prefer an edge with a higher cycle kind precedence
1797 if Kind_Prec = Higher_Precedence
1798 or else
1799 Kind_Prec = Lower_Precedence
1800 then
1801 return Kind_Prec;
1803 -- Prefer an edge whose successor has a higher precedence
1805 elsif Comp_Succ /= Edge_Succ
1806 and then (Succ_Prec = Higher_Precedence
1807 or else
1808 Succ_Prec = Lower_Precedence)
1809 then
1810 return Succ_Prec;
1812 -- Prefer an edge whose predecessor has a higher precedence
1814 else
1815 return
1816 Vertex_Precedence
1817 (G => G,
1818 Vertex => Predecessor (G, Edge),
1819 Compared_To => Predecessor (G, Compared_To));
1820 end if;
1821 end Edge_Precedence;
1823 ---------------
1824 -- File_Name --
1825 ---------------
1827 function File_Name
1828 (G : Library_Graph;
1829 Vertex : Library_Graph_Vertex_Id) return File_Name_Type
1831 begin
1832 pragma Assert (Present (G));
1833 pragma Assert (Present (Vertex));
1835 return File_Name (Unit (G, Vertex));
1836 end File_Name;
1838 ---------------------
1839 -- Find_Components --
1840 ---------------------
1842 procedure Find_Components (G : Library_Graph) is
1843 Edges : LGE_Lists.Doubly_Linked_List;
1845 begin
1846 pragma Assert (Present (G));
1848 Start_Phase (Component_Discovery);
1850 -- Initialize or reinitialize the components of the graph
1852 Initialize_Components (G);
1854 -- Create a set of special edges that link a predecessor body with a
1855 -- successor spec. This is an illegal dependency, however using such
1856 -- edges eliminates the need to create yet another graph, where both
1857 -- spec and body are collapsed into a single vertex.
1859 Edges := LGE_Lists.Create;
1860 Add_Body_Before_Spec_Edges (G, Edges);
1862 DG.Find_Components (G.Graph);
1864 -- Remove the special edges that link a predecessor body with a
1865 -- successor spec because they cause unresolvable circularities.
1867 Delete_Body_Before_Spec_Edges (G, Edges);
1868 LGE_Lists.Destroy (Edges);
1870 -- Update the number of predecessors various components must wait on
1871 -- before they can be elaborated.
1873 Update_Pending_Predecessors_Of_Components (G);
1874 End_Phase (Component_Discovery);
1875 end Find_Components;
1877 -----------------
1878 -- Find_Cycles --
1879 -----------------
1881 procedure Find_Cycles (G : Library_Graph) is
1882 All_Cycle_Limit : constant Natural := 64;
1883 -- The performance of Tarjan's algorithm may degrate to exponential
1884 -- when pragma Elaborate_All is in effect, or some vertex is part of
1885 -- an Elaborate_Body pair. In this case the algorithm discovers all
1886 -- combinations of edges that close a circuit starting and ending on
1887 -- some start vertex while going through different vertices. Use a
1888 -- limit on the total number of cycles within a component to guard
1889 -- against such degradation.
1891 Comp : Component_Id;
1892 Cycle_Count : Natural;
1893 Iter : Component_Iterator;
1895 begin
1896 pragma Assert (Present (G));
1898 Start_Phase (Cycle_Discovery);
1900 -- The cycles of graph G are discovered using Tarjan's enumeration
1901 -- of the elementary circuits of a directed-graph algorithm. Do not
1902 -- modify this code unless you intimately understand the algorithm.
1904 -- The logic of the algorithm is split among the following routines:
1906 -- Cycle_End_Vertices
1907 -- Find_Cycles_From_Successor
1908 -- Find_Cycles_From_Vertex
1909 -- Find_Cycles_In_Component
1910 -- Unvisit
1911 -- Visit
1913 -- The original algorithm has been significantly modified in order to
1915 -- * Accommodate the semantics of Elaborate_All and Elaborate_Body.
1917 -- * Capture cycle paths as edges rather than vertices.
1919 -- * Take advantage of graph components.
1921 -- Assume that the graph does not contain a cycle
1923 Cycle_Count := 0;
1925 -- Run the modified version of the algorithm on each component of the
1926 -- graph.
1928 Iter := Iterate_Components (G);
1929 while Has_Next (Iter) loop
1930 Next (Iter, Comp);
1932 Find_Cycles_In_Component
1933 (G => G,
1934 Comp => Comp,
1935 Cycle_Count => Cycle_Count,
1936 Cycle_Limit => All_Cycle_Limit);
1937 end loop;
1939 End_Phase (Cycle_Discovery);
1940 end Find_Cycles;
1942 --------------------------------
1943 -- Find_Cycles_From_Successor --
1944 --------------------------------
1946 procedure Find_Cycles_From_Successor
1947 (G : Library_Graph;
1948 Edge : Library_Graph_Edge_Id;
1949 End_Vertices : LGV_Sets.Membership_Set;
1950 Deleted_Vertices : LGV_Sets.Membership_Set;
1951 Most_Significant_Edge : Library_Graph_Edge_Id;
1952 Invocation_Edge_Count : Natural;
1953 Cycle_Path_Stack : LGE_Lists.Doubly_Linked_List;
1954 Visited_Set : LGV_Sets.Membership_Set;
1955 Visited_Stack : LGV_Lists.Doubly_Linked_List;
1956 Cycle_Count : in out Natural;
1957 Cycle_Limit : Natural;
1958 Elaborate_All_Active : Boolean;
1959 Has_Cycle : out Boolean;
1960 Indent : Indentation_Level)
1962 pragma Assert (Present (G));
1963 pragma Assert (Present (Edge));
1964 pragma Assert (LGV_Sets.Present (End_Vertices));
1965 pragma Assert (LGV_Sets.Present (Deleted_Vertices));
1966 pragma Assert (LGE_Lists.Present (Cycle_Path_Stack));
1967 pragma Assert (LGV_Sets.Present (Visited_Set));
1968 pragma Assert (LGV_Lists.Present (Visited_Stack));
1970 Succ : constant Library_Graph_Vertex_Id := Successor (G, Edge);
1971 Succ_Indent : constant Indentation_Level :=
1972 Indent + Nested_Indentation;
1974 begin
1975 -- Assume that the successor reached via the edge does not result in
1976 -- a cycle.
1978 Has_Cycle := False;
1980 -- Nothing to do when the edge connects two vertices residing in two
1981 -- different components.
1983 if not Is_Cyclic_Edge (G, Edge) then
1984 return;
1985 end if;
1987 Trace_Edge (G, Edge, Indent);
1989 -- The modified version does not place vertices on the "point stack",
1990 -- but instead collects the edges comprising the cycle. Prepare the
1991 -- edge for backtracking.
1993 LGE_Lists.Prepend (Cycle_Path_Stack, Edge);
1995 Find_Cycles_From_Vertex
1996 (G => G,
1997 Vertex => Succ,
1998 End_Vertices => End_Vertices,
1999 Deleted_Vertices => Deleted_Vertices,
2000 Most_Significant_Edge => Most_Significant_Edge,
2001 Invocation_Edge_Count => Invocation_Edge_Count,
2002 Cycle_Path_Stack => Cycle_Path_Stack,
2003 Visited_Set => Visited_Set,
2004 Visited_Stack => Visited_Stack,
2005 Cycle_Count => Cycle_Count,
2006 Cycle_Limit => Cycle_Limit,
2007 Elaborate_All_Active => Elaborate_All_Active,
2008 Is_Start_Vertex => False,
2009 Has_Cycle => Has_Cycle,
2010 Indent => Succ_Indent);
2012 -- The modified version does not place vertices on the "point stack",
2013 -- but instead collects the edges comprising the cycle. Backtrack the
2014 -- edge.
2016 LGE_Lists.Delete_First (Cycle_Path_Stack);
2017 end Find_Cycles_From_Successor;
2019 -----------------------------
2020 -- Find_Cycles_From_Vertex --
2021 -----------------------------
2023 procedure Find_Cycles_From_Vertex
2024 (G : Library_Graph;
2025 Vertex : Library_Graph_Vertex_Id;
2026 End_Vertices : LGV_Sets.Membership_Set;
2027 Deleted_Vertices : LGV_Sets.Membership_Set;
2028 Most_Significant_Edge : Library_Graph_Edge_Id;
2029 Invocation_Edge_Count : Natural;
2030 Cycle_Path_Stack : LGE_Lists.Doubly_Linked_List;
2031 Visited_Set : LGV_Sets.Membership_Set;
2032 Visited_Stack : LGV_Lists.Doubly_Linked_List;
2033 Cycle_Count : in out Natural;
2034 Cycle_Limit : Natural;
2035 Elaborate_All_Active : Boolean;
2036 Is_Start_Vertex : Boolean;
2037 Has_Cycle : out Boolean;
2038 Indent : Indentation_Level)
2040 Edge_Indent : constant Indentation_Level :=
2041 Indent + Nested_Indentation;
2043 Complement : Library_Graph_Vertex_Id;
2044 Edge : Library_Graph_Edge_Id;
2045 Iter : Edges_To_Successors_Iterator;
2047 Complement_Has_Cycle : Boolean;
2048 -- This flag is set when either Elaborate_All is in effect or the
2049 -- current vertex is part of an Elaborate_Body pair, and visiting
2050 -- the "complementary" vertex resulted in a cycle.
2052 Successor_Has_Cycle : Boolean;
2053 -- This flag is set when visiting at least one successor of the
2054 -- current vertex resulted in a cycle.
2056 begin
2057 pragma Assert (Present (G));
2058 pragma Assert (Present (Vertex));
2059 pragma Assert (LGV_Sets.Present (End_Vertices));
2060 pragma Assert (LGV_Sets.Present (Deleted_Vertices));
2061 pragma Assert (LGE_Lists.Present (Cycle_Path_Stack));
2062 pragma Assert (LGV_Sets.Present (Visited_Set));
2063 pragma Assert (LGV_Lists.Present (Visited_Stack));
2065 -- Assume that the vertex does not close a circuit
2067 Has_Cycle := False;
2069 -- Nothing to do when the limit on the number of saved cycles has
2070 -- been reached. This protects against a combinatorial explosion
2071 -- in components with Elaborate_All cycles.
2073 if Cycle_Count >= Cycle_Limit then
2074 return;
2076 -- The vertex closes the circuit, thus resulting in a cycle. Save
2077 -- the cycle for later diagnostics. The initial invocation of the
2078 -- routine always ignores the starting vertex, to prevent a spurious
2079 -- self-cycle.
2081 elsif not Is_Start_Vertex
2082 and then LGV_Sets.Contains (End_Vertices, Vertex)
2083 then
2084 Trace_Vertex (G, Vertex, Indent);
2086 Record_Cycle
2087 (G => G,
2088 Most_Significant_Edge => Most_Significant_Edge,
2089 Invocation_Edge_Count => Invocation_Edge_Count,
2090 Cycle_Path => Cycle_Path_Stack,
2091 Indent => Indent);
2093 Has_Cycle := True;
2094 Cycle_Count := Cycle_Count + 1;
2095 return;
2097 -- Nothing to do when the vertex has already been deleted. This
2098 -- indicates that all available cycles involving the vertex have
2099 -- been discovered, and the vertex cannot contribute further to
2100 -- the depth-first search.
2102 elsif LGV_Sets.Contains (Deleted_Vertices, Vertex) then
2103 return;
2105 -- Nothing to do when the vertex has already been visited. This
2106 -- indicates that the depth-first search initiated from some start
2107 -- vertex already encountered this vertex, and the visited stack has
2108 -- not been unrolled yet.
2110 elsif LGV_Sets.Contains (Visited_Set, Vertex) then
2111 return;
2112 end if;
2114 Trace_Vertex (G, Vertex, Indent);
2116 -- Mark the vertex as visited
2118 Visit
2119 (Vertex => Vertex,
2120 Visited_Set => Visited_Set,
2121 Visited_Stack => Visited_Stack);
2123 -- Extend the depth-first search via all the edges to successors
2125 Iter := Iterate_Edges_To_Successors (G, Vertex);
2126 while Has_Next (Iter) loop
2127 Next (Iter, Edge);
2129 Find_Cycles_From_Successor
2130 (G => G,
2131 Edge => Edge,
2132 End_Vertices => End_Vertices,
2133 Deleted_Vertices => Deleted_Vertices,
2135 -- The edge may be more important than the most important edge
2136 -- up to this point, thus "upgrading" the nature of the cycle,
2137 -- and shifting its point of normalization.
2139 Most_Significant_Edge =>
2140 Highest_Precedence_Edge
2141 (G => G,
2142 Left => Edge,
2143 Right => Most_Significant_Edge),
2145 -- The edge may be an invocation edge, in which case the count
2146 -- of invocation edges increases by one.
2148 Invocation_Edge_Count =>
2149 Maximum_Invocation_Edge_Count
2150 (G => G,
2151 Edge => Edge,
2152 Count => Invocation_Edge_Count),
2154 Cycle_Path_Stack => Cycle_Path_Stack,
2155 Visited_Set => Visited_Set,
2156 Visited_Stack => Visited_Stack,
2157 Cycle_Count => Cycle_Count,
2158 Cycle_Limit => Cycle_Limit,
2159 Elaborate_All_Active => Elaborate_All_Active,
2160 Has_Cycle => Successor_Has_Cycle,
2161 Indent => Edge_Indent);
2163 Has_Cycle := Has_Cycle or Successor_Has_Cycle;
2164 end loop;
2166 -- Visit the complementary vertex of the current vertex when pragma
2167 -- Elaborate_All is in effect, or the current vertex is part of an
2168 -- Elaborate_Body pair.
2170 if Elaborate_All_Active
2171 or else Is_Vertex_With_Elaborate_Body (G, Vertex)
2172 then
2173 Complement :=
2174 Complementary_Vertex
2175 (G => G,
2176 Vertex => Vertex,
2177 Force_Complement => Elaborate_All_Active);
2179 if Present (Complement) then
2180 Find_Cycles_From_Vertex
2181 (G => G,
2182 Vertex => Complement,
2183 End_Vertices => End_Vertices,
2184 Deleted_Vertices => Deleted_Vertices,
2185 Most_Significant_Edge => Most_Significant_Edge,
2186 Invocation_Edge_Count => Invocation_Edge_Count,
2187 Cycle_Path_Stack => Cycle_Path_Stack,
2188 Visited_Set => Visited_Set,
2189 Visited_Stack => Visited_Stack,
2190 Cycle_Count => Cycle_Count,
2191 Cycle_Limit => Cycle_Limit,
2192 Elaborate_All_Active => Elaborate_All_Active,
2193 Is_Start_Vertex => Is_Start_Vertex,
2194 Has_Cycle => Complement_Has_Cycle,
2195 Indent => Indent);
2197 Has_Cycle := Has_Cycle or Complement_Has_Cycle;
2198 end if;
2199 end if;
2201 -- The original algorithm clears the "marked stack" in two places:
2203 -- * When the depth-first search starting from the current vertex
2204 -- discovers at least one cycle, and
2206 -- * When the depth-first search initiated from a start vertex
2207 -- completes.
2209 -- The modified version handles both cases in one place.
2211 if Has_Cycle or else Is_Start_Vertex then
2212 Unvisit
2213 (Vertex => Vertex,
2214 Visited_Set => Visited_Set,
2215 Visited_Stack => Visited_Stack);
2216 end if;
2218 -- Delete a start vertex from the graph once its depth-first search
2219 -- completes. This action preserves the invariant where a cycle is
2220 -- not rediscovered "later" in some permuted form.
2222 if Is_Start_Vertex then
2223 LGV_Sets.Insert (Deleted_Vertices, Vertex);
2224 end if;
2225 end Find_Cycles_From_Vertex;
2227 ------------------------------
2228 -- Find_Cycles_In_Component --
2229 ------------------------------
2231 procedure Find_Cycles_In_Component
2232 (G : Library_Graph;
2233 Comp : Component_Id;
2234 Cycle_Count : in out Natural;
2235 Cycle_Limit : Natural)
2237 pragma Assert (Present (G));
2238 pragma Assert (Present (Comp));
2240 Num_Of_Vertices : constant Natural :=
2241 Number_Of_Component_Vertices (G, Comp);
2243 Elaborate_All_Active : constant Boolean :=
2244 Has_Elaborate_All_Edge (G, Comp);
2245 -- The presence of an Elaborate_All edge within a component causes
2246 -- all spec-body pairs to be treated as one vertex.
2248 Has_Cycle : Boolean;
2249 Iter : Component_Vertex_Iterator;
2250 Vertex : Library_Graph_Vertex_Id;
2252 Cycle_Path_Stack : LGE_Lists.Doubly_Linked_List := LGE_Lists.Nil;
2253 -- The "point stack" of Tarjan's algorithm. The original maintains
2254 -- a stack of vertices, however for diagnostic purposes using edges
2255 -- is preferable.
2257 Deleted_Vertices : LGV_Sets.Membership_Set := LGV_Sets.Nil;
2258 -- The original algorithm alters the graph by deleting vertices with
2259 -- lower ordinals compared to some starting vertex. Since the graph
2260 -- must remain intact for diagnostic purposes, vertices are instead
2261 -- inserted in this set and treated as "deleted".
2263 End_Vertices : LGV_Sets.Membership_Set := LGV_Sets.Nil;
2264 -- The original algorithm uses a single vertex to indicate the start
2265 -- and end vertex of a cycle. The semantics of pragmas Elaborate_All
2266 -- and Elaborate_Body increase this number by one. The end vertices
2267 -- are added to this set and treated as "cycle-terminating".
2269 Visited_Set : LGV_Sets.Membership_Set := LGV_Sets.Nil;
2270 -- The "mark" array of Tarjan's algorithm. Since the original visits
2271 -- all vertices in increasing ordinal number 1 .. N, the array offers
2272 -- a one-to-one mapping between a vertex and its "marked" state. The
2273 -- modified version however visits vertices within components, where
2274 -- their ordinals are not contiguous. Vertices are added to this set
2275 -- and treated as "marked".
2277 Visited_Stack : LGV_Lists.Doubly_Linked_List := LGV_Lists.Nil;
2278 -- The "marked stack" of Tarjan's algorithm
2280 begin
2281 Trace_Component (G, Comp, No_Indentation);
2283 -- Initialize all component-level data structures
2285 Cycle_Path_Stack := LGE_Lists.Create;
2286 Deleted_Vertices := LGV_Sets.Create (Num_Of_Vertices);
2287 Visited_Set := LGV_Sets.Create (Num_Of_Vertices);
2288 Visited_Stack := LGV_Lists.Create;
2290 -- The modified version does not use ordinals to visit vertices in
2291 -- 1 .. N fashion. To preserve the invariant of the original, this
2292 -- version deletes a vertex after its depth-first search completes.
2293 -- The timing of the deletion is sound because all cycles through
2294 -- that vertex have already been discovered, thus the vertex cannot
2295 -- contribute to any cycles discovered "later" in the algorithm.
2297 Iter := Iterate_Component_Vertices (G, Comp);
2298 while Has_Next (Iter) loop
2299 Next (Iter, Vertex);
2301 -- Construct the set of vertices (at most 2) that terminates a
2302 -- potential cycle that starts from the current vertex.
2304 End_Vertices :=
2305 Cycle_End_Vertices
2306 (G => G,
2307 Vertex => Vertex,
2308 Elaborate_All_Active => Elaborate_All_Active);
2310 -- The modified version maintains two additional attributes while
2311 -- performing the depth-first search:
2313 -- * The most significant edge of the current potential cycle.
2315 -- * The number of invocation edges encountered along the path
2316 -- of the current potential cycle.
2318 -- Both attributes are used in the heuristic that determines the
2319 -- importance of cycles.
2321 Find_Cycles_From_Vertex
2322 (G => G,
2323 Vertex => Vertex,
2324 End_Vertices => End_Vertices,
2325 Deleted_Vertices => Deleted_Vertices,
2326 Most_Significant_Edge => No_Library_Graph_Edge,
2327 Invocation_Edge_Count => 0,
2328 Cycle_Path_Stack => Cycle_Path_Stack,
2329 Visited_Set => Visited_Set,
2330 Visited_Stack => Visited_Stack,
2331 Cycle_Count => Cycle_Count,
2332 Cycle_Limit => Cycle_Limit,
2333 Elaborate_All_Active => Elaborate_All_Active,
2334 Is_Start_Vertex => True,
2335 Has_Cycle => Has_Cycle,
2336 Indent => Nested_Indentation);
2338 -- Destroy the cycle-terminating vertices because a new set must
2339 -- be constructed for the next vertex.
2341 LGV_Sets.Destroy (End_Vertices);
2342 end loop;
2344 -- Destroy all component-level data structures
2346 LGE_Lists.Destroy (Cycle_Path_Stack);
2347 LGV_Sets.Destroy (Deleted_Vertices);
2348 LGV_Sets.Destroy (Visited_Set);
2349 LGV_Lists.Destroy (Visited_Stack);
2350 end Find_Cycles_In_Component;
2352 ---------------
2353 -- Find_Edge --
2354 ---------------
2356 function Find_Edge
2357 (G : Library_Graph;
2358 Pred : Library_Graph_Vertex_Id;
2359 Succ : Library_Graph_Vertex_Id) return Library_Graph_Edge_Id
2361 Result : Library_Graph_Edge_Id := No_Library_Graph_Edge;
2362 Edge : Library_Graph_Edge_Id;
2363 Iter : Edges_To_Successors_Iterator :=
2364 Iterate_Edges_To_Successors (G, Pred);
2366 begin
2367 -- IMPORTANT:
2369 -- * The iteration must run to completion in order to unlock the
2370 -- edges to successors.
2372 -- This does a linear search through the successors of Pred.
2373 -- Efficiency is not a problem, because this is called only when
2374 -- Activates_Task is True, which is rare, and anyway, there aren't
2375 -- usually large numbers of successors.
2377 while Has_Next (Iter) loop
2378 Next (Iter, Edge);
2380 if Succ = Successor (G, Edge) then
2381 pragma Assert (not Present (Result));
2382 Result := Edge;
2383 end if;
2384 end loop;
2386 pragma Assert (Present (Result));
2387 return Result;
2388 end Find_Edge;
2390 ---------------------------------------
2391 -- Find_First_Lower_Precedence_Cycle --
2392 ---------------------------------------
2394 function Find_First_Lower_Precedence_Cycle
2395 (G : Library_Graph;
2396 Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Id
2398 Current_Cycle : Library_Graph_Cycle_Id;
2399 Iter : All_Cycle_Iterator;
2400 Lesser_Cycle : Library_Graph_Cycle_Id;
2402 begin
2403 pragma Assert (Present (G));
2404 pragma Assert (Present (Cycle));
2406 -- Assume that there is no lesser cycle
2408 Lesser_Cycle := No_Library_Graph_Cycle;
2410 -- Find a cycle with a slightly lower precedence than the input
2411 -- cycle.
2413 -- IMPORTANT:
2415 -- * The iterator must run to completion in order to unlock the
2416 -- list of all cycles.
2418 Iter := Iterate_All_Cycles (G);
2419 while Has_Next (Iter) loop
2420 Next (Iter, Current_Cycle);
2422 if not Present (Lesser_Cycle)
2423 and then Cycle_Precedence
2424 (G => G,
2425 Cycle => Cycle,
2426 Compared_To => Current_Cycle) = Higher_Precedence
2427 then
2428 Lesser_Cycle := Current_Cycle;
2429 end if;
2430 end loop;
2432 return Lesser_Cycle;
2433 end Find_First_Lower_Precedence_Cycle;
2435 ------------------------------
2436 -- Get_Component_Attributes --
2437 ------------------------------
2439 function Get_Component_Attributes
2440 (G : Library_Graph;
2441 Comp : Component_Id) return Component_Attributes
2443 begin
2444 pragma Assert (Present (G));
2445 pragma Assert (Present (Comp));
2447 return Component_Tables.Get (G.Component_Attributes, Comp);
2448 end Get_Component_Attributes;
2450 ------------------------
2451 -- Get_LGC_Attributes --
2452 ------------------------
2454 function Get_LGC_Attributes
2455 (G : Library_Graph;
2456 Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Attributes
2458 begin
2459 pragma Assert (Present (G));
2460 pragma Assert (Present (Cycle));
2462 return LGC_Tables.Get (G.Cycle_Attributes, Cycle);
2463 end Get_LGC_Attributes;
2465 ------------------------
2466 -- Get_LGE_Attributes --
2467 ------------------------
2469 function Get_LGE_Attributes
2470 (G : Library_Graph;
2471 Edge : Library_Graph_Edge_Id) return Library_Graph_Edge_Attributes
2473 begin
2474 pragma Assert (Present (G));
2475 pragma Assert (Present (Edge));
2477 return LGE_Tables.Get (G.Edge_Attributes, Edge);
2478 end Get_LGE_Attributes;
2480 ------------------------
2481 -- Get_LGV_Attributes --
2482 ------------------------
2484 function Get_LGV_Attributes
2485 (G : Library_Graph;
2486 Vertex : Library_Graph_Vertex_Id)
2487 return Library_Graph_Vertex_Attributes
2489 begin
2490 pragma Assert (Present (G));
2491 pragma Assert (Present (Vertex));
2493 return LGV_Tables.Get (G.Vertex_Attributes, Vertex);
2494 end Get_LGV_Attributes;
2496 -----------------------------
2497 -- Has_Elaborate_All_Cycle --
2498 -----------------------------
2500 function Has_Elaborate_All_Cycle (G : Library_Graph) return Boolean is
2501 Edge : Library_Graph_Edge_Id;
2502 Iter : All_Edge_Iterator;
2503 Seen : Boolean;
2505 begin
2506 pragma Assert (Present (G));
2508 -- Assume that no cyclic Elaborate_All edge has been seen
2510 Seen := False;
2512 -- IMPORTANT:
2514 -- * The iteration must run to completion in order to unlock the
2515 -- graph.
2517 Iter := Iterate_All_Edges (G);
2518 while Has_Next (Iter) loop
2519 Next (Iter, Edge);
2521 if not Seen and then Is_Cyclic_Elaborate_All_Edge (G, Edge) then
2522 Seen := True;
2523 end if;
2524 end loop;
2526 return Seen;
2527 end Has_Elaborate_All_Cycle;
2529 ----------------------------
2530 -- Has_Elaborate_All_Edge --
2531 ----------------------------
2533 function Has_Elaborate_All_Edge
2534 (G : Library_Graph;
2535 Comp : Component_Id) return Boolean
2537 Has_Edge : Boolean;
2538 Iter : Component_Vertex_Iterator;
2539 Vertex : Library_Graph_Vertex_Id;
2541 begin
2542 pragma Assert (Present (G));
2543 pragma Assert (Present (Comp));
2545 -- Assume that there is no Elaborate_All edge
2547 Has_Edge := False;
2549 -- IMPORTANT:
2551 -- * The iteration must run to completion in order to unlock the
2552 -- component vertices.
2554 Iter := Iterate_Component_Vertices (G, Comp);
2555 while Has_Next (Iter) loop
2556 Next (Iter, Vertex);
2558 Has_Edge := Has_Edge or else Has_Elaborate_All_Edge (G, Vertex);
2559 end loop;
2561 return Has_Edge;
2562 end Has_Elaborate_All_Edge;
2564 ----------------------------
2565 -- Has_Elaborate_All_Edge --
2566 ----------------------------
2568 function Has_Elaborate_All_Edge
2569 (G : Library_Graph;
2570 Vertex : Library_Graph_Vertex_Id) return Boolean
2572 Edge : Library_Graph_Edge_Id;
2573 Has_Edge : Boolean;
2574 Iter : Edges_To_Successors_Iterator;
2576 begin
2577 pragma Assert (Present (G));
2578 pragma Assert (Present (Vertex));
2580 -- Assume that there is no Elaborate_All edge
2582 Has_Edge := False;
2584 -- IMPORTANT:
2586 -- * The iteration must run to completion in order to unlock the
2587 -- edges to successors.
2589 Iter := Iterate_Edges_To_Successors (G, Vertex);
2590 while Has_Next (Iter) loop
2591 Next (Iter, Edge);
2593 Has_Edge :=
2594 Has_Edge or else Is_Cyclic_Elaborate_All_Edge (G, Edge);
2595 end loop;
2597 return Has_Edge;
2598 end Has_Elaborate_All_Edge;
2600 ------------------------
2601 -- Has_Elaborate_Body --
2602 ------------------------
2604 function Has_Elaborate_Body
2605 (G : Library_Graph;
2606 Vertex : Library_Graph_Vertex_Id) return Boolean
2608 pragma Assert (Present (G));
2609 pragma Assert (Present (Vertex));
2611 U_Id : constant Unit_Id := Unit (G, Vertex);
2612 U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
2614 begin
2615 -- Treat the spec and body as decoupled when switch -d_b (ignore the
2616 -- effects of pragma Elaborate_Body) is in effect.
2618 return U_Rec.Elaborate_Body and not Debug_Flag_Underscore_B;
2619 end Has_Elaborate_Body;
2621 --------------
2622 -- Has_Next --
2623 --------------
2625 function Has_Next (Iter : All_Cycle_Iterator) return Boolean is
2626 begin
2627 return LGC_Lists.Has_Next (LGC_Lists.Iterator (Iter));
2628 end Has_Next;
2630 --------------
2631 -- Has_Next --
2632 --------------
2634 function Has_Next (Iter : All_Edge_Iterator) return Boolean is
2635 begin
2636 return DG.Has_Next (DG.All_Edge_Iterator (Iter));
2637 end Has_Next;
2639 --------------
2640 -- Has_Next --
2641 --------------
2643 function Has_Next (Iter : All_Vertex_Iterator) return Boolean is
2644 begin
2645 return DG.Has_Next (DG.All_Vertex_Iterator (Iter));
2646 end Has_Next;
2648 --------------
2649 -- Has_Next --
2650 --------------
2652 function Has_Next (Iter : Component_Iterator) return Boolean is
2653 begin
2654 return DG.Has_Next (DG.Component_Iterator (Iter));
2655 end Has_Next;
2657 --------------
2658 -- Has_Next --
2659 --------------
2661 function Has_Next (Iter : Component_Vertex_Iterator) return Boolean is
2662 begin
2663 return DG.Has_Next (DG.Component_Vertex_Iterator (Iter));
2664 end Has_Next;
2666 --------------
2667 -- Has_Next --
2668 --------------
2670 function Has_Next (Iter : Edges_Of_Cycle_Iterator) return Boolean is
2671 begin
2672 return LGE_Lists.Has_Next (LGE_Lists.Iterator (Iter));
2673 end Has_Next;
2675 --------------
2676 -- Has_Next --
2677 --------------
2679 function Has_Next (Iter : Edges_To_Successors_Iterator) return Boolean is
2680 begin
2681 return DG.Has_Next (DG.Outgoing_Edge_Iterator (Iter));
2682 end Has_Next;
2684 -----------------------------
2685 -- Has_No_Elaboration_Code --
2686 -----------------------------
2688 function Has_No_Elaboration_Code
2689 (G : Library_Graph;
2690 Vertex : Library_Graph_Vertex_Id) return Boolean
2692 begin
2693 pragma Assert (Present (G));
2694 pragma Assert (Present (Vertex));
2696 return Has_No_Elaboration_Code (Unit (G, Vertex));
2697 end Has_No_Elaboration_Code;
2699 -----------------------------------------
2700 -- Hash_Library_Graph_Cycle_Attributes --
2701 -----------------------------------------
2703 function Hash_Library_Graph_Cycle_Attributes
2704 (Attrs : Library_Graph_Cycle_Attributes) return Bucket_Range_Type
2706 Edge : Library_Graph_Edge_Id;
2707 Hash : Bucket_Range_Type;
2708 Iter : LGE_Lists.Iterator;
2710 begin
2711 pragma Assert (LGE_Lists.Present (Attrs.Path));
2713 -- The hash is obtained in the following manner:
2715 -- (((edge1 * 31) + edge2) * 31) + edgeN
2717 Hash := 0;
2718 Iter := LGE_Lists.Iterate (Attrs.Path);
2719 while LGE_Lists.Has_Next (Iter) loop
2720 LGE_Lists.Next (Iter, Edge);
2722 Hash := (Hash * 31) + Bucket_Range_Type (Edge);
2723 end loop;
2725 return Hash;
2726 end Hash_Library_Graph_Cycle_Attributes;
2728 -----------------------------------------
2729 -- Hash_Predecessor_Successor_Relation --
2730 -----------------------------------------
2732 function Hash_Predecessor_Successor_Relation
2733 (Rel : Predecessor_Successor_Relation) return Bucket_Range_Type
2735 begin
2736 pragma Assert (Present (Rel.Predecessor));
2737 pragma Assert (Present (Rel.Successor));
2739 return
2740 Hash_Two_Keys
2741 (Bucket_Range_Type (Rel.Predecessor),
2742 Bucket_Range_Type (Rel.Successor));
2743 end Hash_Predecessor_Successor_Relation;
2745 ------------------------------
2746 -- Highest_Precedence_Cycle --
2747 ------------------------------
2749 function Highest_Precedence_Cycle
2750 (G : Library_Graph) return Library_Graph_Cycle_Id
2752 begin
2753 pragma Assert (Present (G));
2754 pragma Assert (LGC_Lists.Present (G.Cycles));
2756 if LGC_Lists.Is_Empty (G.Cycles) then
2757 return No_Library_Graph_Cycle;
2759 -- The highest precedence cycle is always the first in the list of
2760 -- all cycles.
2762 else
2763 return LGC_Lists.First (G.Cycles);
2764 end if;
2765 end Highest_Precedence_Cycle;
2767 -----------------------------
2768 -- Highest_Precedence_Edge --
2769 -----------------------------
2771 function Highest_Precedence_Edge
2772 (G : Library_Graph;
2773 Left : Library_Graph_Edge_Id;
2774 Right : Library_Graph_Edge_Id) return Library_Graph_Edge_Id
2776 Edge_Prec : Precedence_Kind;
2778 begin
2779 pragma Assert (Present (G));
2781 -- Both edges are available, pick the one with highest precedence
2783 if Present (Left) and then Present (Right) then
2784 Edge_Prec :=
2785 Edge_Precedence
2786 (G => G,
2787 Edge => Left,
2788 Compared_To => Right);
2790 if Edge_Prec = Higher_Precedence then
2791 return Left;
2793 -- The precedence rules for edges are such that no two edges can
2794 -- ever have the same precedence.
2796 else
2797 pragma Assert (Edge_Prec = Lower_Precedence);
2798 return Right;
2799 end if;
2801 -- Otherwise at least one edge must be present
2803 elsif Present (Left) then
2804 return Left;
2806 else
2807 pragma Assert (Present (Right));
2809 return Right;
2810 end if;
2811 end Highest_Precedence_Edge;
2813 --------------------------
2814 -- In_Elaboration_Order --
2815 --------------------------
2817 function In_Elaboration_Order
2818 (G : Library_Graph;
2819 Vertex : Library_Graph_Vertex_Id) return Boolean
2821 begin
2822 pragma Assert (Present (G));
2823 pragma Assert (Present (Vertex));
2825 return Get_LGV_Attributes (G, Vertex).In_Elaboration_Order;
2826 end In_Elaboration_Order;
2828 -----------------------
2829 -- In_Same_Component --
2830 -----------------------
2832 function In_Same_Component
2833 (G : Library_Graph;
2834 Left : Library_Graph_Vertex_Id;
2835 Right : Library_Graph_Vertex_Id) return Boolean
2837 begin
2838 pragma Assert (Present (G));
2839 pragma Assert (Present (Left));
2840 pragma Assert (Present (Right));
2842 return Component (G, Left) = Component (G, Right);
2843 end In_Same_Component;
2845 ----------------------------------------
2846 -- Increment_Library_Graph_Edge_Count --
2847 ----------------------------------------
2849 procedure Increment_Library_Graph_Edge_Count
2850 (G : Library_Graph;
2851 Kind : Library_Graph_Edge_Kind)
2853 pragma Assert (Present (G));
2855 Count : Natural renames G.Counts (Kind);
2857 begin
2858 Count := Count + 1;
2859 end Increment_Library_Graph_Edge_Count;
2861 ------------------------------------
2862 -- Increment_Pending_Predecessors --
2863 ------------------------------------
2865 procedure Increment_Pending_Predecessors
2866 (G : Library_Graph;
2867 Comp : Component_Id;
2868 Edge : Library_Graph_Edge_Id)
2870 Attrs : Component_Attributes;
2872 begin
2873 pragma Assert (Present (G));
2874 pragma Assert (Present (Comp));
2876 Attrs := Get_Component_Attributes (G, Comp);
2878 Update_Pending_Predecessors
2879 (Strong_Predecessors => Attrs.Pending_Strong_Predecessors,
2880 Weak_Predecessors => Attrs.Pending_Weak_Predecessors,
2881 Update_Weak => Is_Invocation_Edge (G, Edge),
2882 Value => 1);
2884 Set_Component_Attributes (G, Comp, Attrs);
2885 end Increment_Pending_Predecessors;
2887 ------------------------------------
2888 -- Increment_Pending_Predecessors --
2889 ------------------------------------
2891 procedure Increment_Pending_Predecessors
2892 (G : Library_Graph;
2893 Vertex : Library_Graph_Vertex_Id;
2894 Edge : Library_Graph_Edge_Id)
2896 Attrs : Library_Graph_Vertex_Attributes;
2898 begin
2899 pragma Assert (Present (G));
2900 pragma Assert (Present (Vertex));
2902 Attrs := Get_LGV_Attributes (G, Vertex);
2904 Update_Pending_Predecessors
2905 (Strong_Predecessors => Attrs.Pending_Strong_Predecessors,
2906 Weak_Predecessors => Attrs.Pending_Weak_Predecessors,
2907 Update_Weak => Is_Invocation_Edge (G, Edge),
2908 Value => 1);
2910 Set_LGV_Attributes (G, Vertex, Attrs);
2911 end Increment_Pending_Predecessors;
2913 ---------------------------
2914 -- Initialize_Components --
2915 ---------------------------
2917 procedure Initialize_Components (G : Library_Graph) is
2918 begin
2919 pragma Assert (Present (G));
2921 -- The graph already contains a set of components. Reinitialize
2922 -- them in order to accommodate the new set of components about to
2923 -- be computed.
2925 if Number_Of_Components (G) > 0 then
2926 Component_Tables.Destroy (G.Component_Attributes);
2928 G.Component_Attributes :=
2929 Component_Tables.Create (Number_Of_Vertices (G));
2930 end if;
2931 end Initialize_Components;
2933 ---------------------------
2934 -- Invocation_Edge_Count --
2935 ---------------------------
2937 function Invocation_Edge_Count
2938 (G : Library_Graph;
2939 Cycle : Library_Graph_Cycle_Id) return Natural
2941 begin
2942 pragma Assert (Present (G));
2943 pragma Assert (Present (Cycle));
2945 return Get_LGC_Attributes (G, Cycle).Invocation_Edge_Count;
2946 end Invocation_Edge_Count;
2948 -------------------------------
2949 -- Invocation_Graph_Encoding --
2950 -------------------------------
2952 function Invocation_Graph_Encoding
2953 (G : Library_Graph;
2954 Vertex : Library_Graph_Vertex_Id)
2955 return Invocation_Graph_Encoding_Kind
2957 begin
2958 pragma Assert (Present (G));
2959 pragma Assert (Present (Vertex));
2961 return Invocation_Graph_Encoding (Unit (G, Vertex));
2962 end Invocation_Graph_Encoding;
2964 -------------
2965 -- Is_Body --
2966 -------------
2968 function Is_Body
2969 (G : Library_Graph;
2970 Vertex : Library_Graph_Vertex_Id) return Boolean
2972 pragma Assert (Present (G));
2973 pragma Assert (Present (Vertex));
2975 U_Id : constant Unit_Id := Unit (G, Vertex);
2976 U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
2978 begin
2979 return U_Rec.Utype = Is_Body or else U_Rec.Utype = Is_Body_Only;
2980 end Is_Body;
2982 -----------------------------------------
2983 -- Is_Body_Of_Spec_With_Elaborate_Body --
2984 -----------------------------------------
2986 function Is_Body_Of_Spec_With_Elaborate_Body
2987 (G : Library_Graph;
2988 Vertex : Library_Graph_Vertex_Id) return Boolean
2990 begin
2991 pragma Assert (Present (G));
2992 pragma Assert (Present (Vertex));
2994 if Is_Body_With_Spec (G, Vertex) then
2995 return
2996 Is_Spec_With_Elaborate_Body
2997 (G => G,
2998 Vertex => Proper_Spec (G, Vertex));
2999 end if;
3001 return False;
3002 end Is_Body_Of_Spec_With_Elaborate_Body;
3004 -----------------------
3005 -- Is_Body_With_Spec --
3006 -----------------------
3008 function Is_Body_With_Spec
3009 (G : Library_Graph;
3010 Vertex : Library_Graph_Vertex_Id) return Boolean
3012 pragma Assert (Present (G));
3013 pragma Assert (Present (Vertex));
3015 U_Id : constant Unit_Id := Unit (G, Vertex);
3016 U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
3018 begin
3019 return U_Rec.Utype = Is_Body;
3020 end Is_Body_With_Spec;
3022 ------------------------------
3023 -- Is_Cycle_Initiating_Edge --
3024 ------------------------------
3026 function Is_Cycle_Initiating_Edge
3027 (G : Library_Graph;
3028 Edge : Library_Graph_Edge_Id) return Boolean
3030 begin
3031 pragma Assert (Present (G));
3032 pragma Assert (Present (Edge));
3034 return
3035 Is_Cyclic_Elaborate_All_Edge (G, Edge)
3036 or else Is_Cyclic_Elaborate_Body_Edge (G, Edge)
3037 or else Is_Cyclic_Elaborate_Edge (G, Edge)
3038 or else Is_Cyclic_Forced_Edge (G, Edge)
3039 or else Is_Cyclic_Invocation_Edge (G, Edge);
3040 end Is_Cycle_Initiating_Edge;
3042 --------------------
3043 -- Is_Cyclic_Edge --
3044 --------------------
3046 function Is_Cyclic_Edge
3047 (G : Library_Graph;
3048 Edge : Library_Graph_Edge_Id) return Boolean
3050 begin
3051 pragma Assert (Present (G));
3052 pragma Assert (Present (Edge));
3054 return
3055 Is_Cycle_Initiating_Edge (G, Edge)
3056 or else Is_Cyclic_With_Edge (G, Edge);
3057 end Is_Cyclic_Edge;
3059 ----------------------------------
3060 -- Is_Cyclic_Elaborate_All_Edge --
3061 ----------------------------------
3063 function Is_Cyclic_Elaborate_All_Edge
3064 (G : Library_Graph;
3065 Edge : Library_Graph_Edge_Id) return Boolean
3067 begin
3068 pragma Assert (Present (G));
3069 pragma Assert (Present (Edge));
3071 return
3072 Is_Elaborate_All_Edge (G, Edge)
3073 and then Links_Vertices_In_Same_Component (G, Edge);
3074 end Is_Cyclic_Elaborate_All_Edge;
3076 -----------------------------------
3077 -- Is_Cyclic_Elaborate_Body_Edge --
3078 -----------------------------------
3080 function Is_Cyclic_Elaborate_Body_Edge
3081 (G : Library_Graph;
3082 Edge : Library_Graph_Edge_Id) return Boolean
3084 begin
3085 pragma Assert (Present (G));
3086 pragma Assert (Present (Edge));
3088 return
3089 Is_Elaborate_Body_Edge (G, Edge)
3090 and then Links_Vertices_In_Same_Component (G, Edge);
3091 end Is_Cyclic_Elaborate_Body_Edge;
3093 ------------------------------
3094 -- Is_Cyclic_Elaborate_Edge --
3095 ------------------------------
3097 function Is_Cyclic_Elaborate_Edge
3098 (G : Library_Graph;
3099 Edge : Library_Graph_Edge_Id) return Boolean
3101 begin
3102 pragma Assert (Present (G));
3103 pragma Assert (Present (Edge));
3105 return
3106 Is_Elaborate_Edge (G, Edge)
3107 and then Links_Vertices_In_Same_Component (G, Edge);
3108 end Is_Cyclic_Elaborate_Edge;
3110 ---------------------------
3111 -- Is_Cyclic_Forced_Edge --
3112 ---------------------------
3114 function Is_Cyclic_Forced_Edge
3115 (G : Library_Graph;
3116 Edge : Library_Graph_Edge_Id) return Boolean
3118 begin
3119 pragma Assert (Present (G));
3120 pragma Assert (Present (Edge));
3122 return
3123 Is_Forced_Edge (G, Edge)
3124 and then Links_Vertices_In_Same_Component (G, Edge);
3125 end Is_Cyclic_Forced_Edge;
3127 -------------------------------
3128 -- Is_Cyclic_Invocation_Edge --
3129 -------------------------------
3131 function Is_Cyclic_Invocation_Edge
3132 (G : Library_Graph;
3133 Edge : Library_Graph_Edge_Id) return Boolean
3135 begin
3136 pragma Assert (Present (G));
3137 pragma Assert (Present (Edge));
3139 return
3140 Is_Invocation_Edge (G, Edge)
3141 and then Links_Vertices_In_Same_Component (G, Edge);
3142 end Is_Cyclic_Invocation_Edge;
3144 -------------------------
3145 -- Is_Cyclic_With_Edge --
3146 -------------------------
3148 function Is_Cyclic_With_Edge
3149 (G : Library_Graph;
3150 Edge : Library_Graph_Edge_Id) return Boolean
3152 begin
3153 pragma Assert (Present (G));
3154 pragma Assert (Present (Edge));
3156 -- Ignore Elaborate_Body edges because they also appear as with
3157 -- edges, but have special successors.
3159 return
3160 Is_With_Edge (G, Edge)
3161 and then Links_Vertices_In_Same_Component (G, Edge)
3162 and then not Is_Elaborate_Body_Edge (G, Edge);
3163 end Is_Cyclic_With_Edge;
3165 -------------------------------
3166 -- Is_Dynamically_Elaborated --
3167 -------------------------------
3169 function Is_Dynamically_Elaborated
3170 (G : Library_Graph;
3171 Vertex : Library_Graph_Vertex_Id) return Boolean
3173 begin
3174 pragma Assert (Present (G));
3175 pragma Assert (Present (Vertex));
3177 return Is_Dynamically_Elaborated (Unit (G, Vertex));
3178 end Is_Dynamically_Elaborated;
3180 -----------------------------
3181 -- Is_Elaborable_Component --
3182 -----------------------------
3184 function Is_Elaborable_Component
3185 (G : Library_Graph;
3186 Comp : Component_Id) return Boolean
3188 begin
3189 pragma Assert (Present (G));
3190 pragma Assert (Present (Comp));
3192 -- A component is elaborable when:
3194 -- * It is not waiting on strong predecessors, and
3195 -- * It is not waiting on weak predecessors
3197 return
3198 Pending_Strong_Predecessors (G, Comp) = 0
3199 and then Pending_Weak_Predecessors (G, Comp) = 0;
3200 end Is_Elaborable_Component;
3202 --------------------------
3203 -- Is_Elaborable_Vertex --
3204 --------------------------
3206 function Is_Elaborable_Vertex
3207 (G : Library_Graph;
3208 Vertex : Library_Graph_Vertex_Id) return Boolean
3210 pragma Assert (Present (G));
3211 pragma Assert (Present (Vertex));
3213 Complement : constant Library_Graph_Vertex_Id :=
3214 Complementary_Vertex
3215 (G => G,
3216 Vertex => Vertex,
3217 Force_Complement => False);
3219 Strong_Preds : Natural;
3220 Weak_Preds : Natural;
3222 begin
3223 -- A vertex is elaborable when:
3225 -- * It has not been elaborated yet, and
3226 -- * The complement vertex of an Elaborate_Body pair has not been
3227 -- elaborated yet, and
3228 -- * It resides within an elaborable component, and
3229 -- * It is not waiting on strong predecessors, and
3230 -- * It is not waiting on weak predecessors
3232 if In_Elaboration_Order (G, Vertex) then
3233 return False;
3235 elsif Present (Complement)
3236 and then In_Elaboration_Order (G, Complement)
3237 then
3238 return False;
3240 elsif not Is_Elaborable_Component (G, Component (G, Vertex)) then
3241 return False;
3242 end if;
3244 Pending_Predecessors_For_Elaboration
3245 (G => G,
3246 Vertex => Vertex,
3247 Strong_Preds => Strong_Preds,
3248 Weak_Preds => Weak_Preds);
3250 return Strong_Preds = 0 and then Weak_Preds = 0;
3251 end Is_Elaborable_Vertex;
3253 ---------------------------
3254 -- Is_Elaborate_All_Edge --
3255 ---------------------------
3257 function Is_Elaborate_All_Edge
3258 (G : Library_Graph;
3259 Edge : Library_Graph_Edge_Id) return Boolean
3261 begin
3262 pragma Assert (Present (G));
3263 pragma Assert (Present (Edge));
3265 return Kind (G, Edge) = Elaborate_All_Edge;
3266 end Is_Elaborate_All_Edge;
3268 ----------------------------
3269 -- Is_Elaborate_Body_Edge --
3270 ----------------------------
3272 function Is_Elaborate_Body_Edge
3273 (G : Library_Graph;
3274 Edge : Library_Graph_Edge_Id) return Boolean
3276 begin
3277 pragma Assert (Present (G));
3278 pragma Assert (Present (Edge));
3280 return
3281 Kind (G, Edge) = With_Edge
3282 and then Is_Vertex_With_Elaborate_Body (G, Successor (G, Edge));
3283 end Is_Elaborate_Body_Edge;
3285 -----------------------
3286 -- Is_Elaborate_Edge --
3287 -----------------------
3289 function Is_Elaborate_Edge
3290 (G : Library_Graph;
3291 Edge : Library_Graph_Edge_Id) return Boolean
3293 begin
3294 pragma Assert (Present (G));
3295 pragma Assert (Present (Edge));
3297 return Kind (G, Edge) = Elaborate_Edge;
3298 end Is_Elaborate_Edge;
3300 ----------------------------
3301 -- Is_Elaborate_Body_Pair --
3302 ----------------------------
3304 function Is_Elaborate_Body_Pair
3305 (G : Library_Graph;
3306 Spec_Vertex : Library_Graph_Vertex_Id;
3307 Body_Vertex : Library_Graph_Vertex_Id) return Boolean
3309 begin
3310 pragma Assert (Present (G));
3311 pragma Assert (Present (Spec_Vertex));
3312 pragma Assert (Present (Body_Vertex));
3314 return
3315 Is_Spec_With_Elaborate_Body (G, Spec_Vertex)
3316 and then Is_Body_Of_Spec_With_Elaborate_Body (G, Body_Vertex)
3317 and then Proper_Body (G, Spec_Vertex) = Body_Vertex;
3318 end Is_Elaborate_Body_Pair;
3320 --------------------
3321 -- Is_Forced_Edge --
3322 --------------------
3324 function Is_Forced_Edge
3325 (G : Library_Graph;
3326 Edge : Library_Graph_Edge_Id) return Boolean
3328 begin
3329 pragma Assert (Present (G));
3330 pragma Assert (Present (Edge));
3332 return Kind (G, Edge) = Forced_Edge;
3333 end Is_Forced_Edge;
3335 ----------------------
3336 -- Is_Internal_Unit --
3337 ----------------------
3339 function Is_Internal_Unit
3340 (G : Library_Graph;
3341 Vertex : Library_Graph_Vertex_Id) return Boolean
3343 begin
3344 pragma Assert (Present (G));
3345 pragma Assert (Present (Vertex));
3347 return Is_Internal_Unit (Unit (G, Vertex));
3348 end Is_Internal_Unit;
3350 ------------------------
3351 -- Is_Invocation_Edge --
3352 ------------------------
3354 function Is_Invocation_Edge
3355 (G : Library_Graph;
3356 Edge : Library_Graph_Edge_Id) return Boolean
3358 begin
3359 pragma Assert (Present (G));
3360 pragma Assert (Present (Edge));
3362 return Kind (G, Edge) = Invocation_Edge;
3363 end Is_Invocation_Edge;
3365 ------------------------
3366 -- Is_Predefined_Unit --
3367 ------------------------
3369 function Is_Predefined_Unit
3370 (G : Library_Graph;
3371 Vertex : Library_Graph_Vertex_Id) return Boolean
3373 begin
3374 pragma Assert (Present (G));
3375 pragma Assert (Present (Vertex));
3377 return Is_Predefined_Unit (Unit (G, Vertex));
3378 end Is_Predefined_Unit;
3380 ---------------------------
3381 -- Is_Preelaborated_Unit --
3382 ---------------------------
3384 function Is_Preelaborated_Unit
3385 (G : Library_Graph;
3386 Vertex : Library_Graph_Vertex_Id) return Boolean
3388 pragma Assert (Present (G));
3389 pragma Assert (Present (Vertex));
3391 U_Id : constant Unit_Id := Unit (G, Vertex);
3392 U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
3394 begin
3395 return U_Rec.Preelab or else U_Rec.Pure;
3396 end Is_Preelaborated_Unit;
3398 ----------------------
3399 -- Is_Recorded_Edge --
3400 ----------------------
3402 function Is_Recorded_Edge
3403 (G : Library_Graph;
3404 Rel : Predecessor_Successor_Relation) return Boolean
3406 begin
3407 pragma Assert (Present (G));
3408 pragma Assert (Present (Rel.Predecessor));
3409 pragma Assert (Present (Rel.Successor));
3411 return RE_Sets.Contains (G.Recorded_Edges, Rel);
3412 end Is_Recorded_Edge;
3414 -------------
3415 -- Is_Spec --
3416 -------------
3418 function Is_Spec
3419 (G : Library_Graph;
3420 Vertex : Library_Graph_Vertex_Id) return Boolean
3422 pragma Assert (Present (G));
3423 pragma Assert (Present (Vertex));
3425 U_Id : constant Unit_Id := Unit (G, Vertex);
3426 U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
3428 begin
3429 return U_Rec.Utype = Is_Spec or else U_Rec.Utype = Is_Spec_Only;
3430 end Is_Spec;
3432 ------------------------------
3433 -- Is_Spec_Before_Body_Edge --
3434 ------------------------------
3436 function Is_Spec_Before_Body_Edge
3437 (G : Library_Graph;
3438 Edge : Library_Graph_Edge_Id) return Boolean
3440 begin
3441 pragma Assert (Present (G));
3442 pragma Assert (Present (Edge));
3444 return Kind (G, Edge) = Spec_Before_Body_Edge;
3445 end Is_Spec_Before_Body_Edge;
3447 -----------------------
3448 -- Is_Spec_With_Body --
3449 -----------------------
3451 function Is_Spec_With_Body
3452 (G : Library_Graph;
3453 Vertex : Library_Graph_Vertex_Id) return Boolean
3455 pragma Assert (Present (G));
3456 pragma Assert (Present (Vertex));
3458 U_Id : constant Unit_Id := Unit (G, Vertex);
3459 U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
3461 begin
3462 return U_Rec.Utype = Is_Spec;
3463 end Is_Spec_With_Body;
3465 ---------------------------------
3466 -- Is_Spec_With_Elaborate_Body --
3467 ---------------------------------
3469 function Is_Spec_With_Elaborate_Body
3470 (G : Library_Graph;
3471 Vertex : Library_Graph_Vertex_Id) return Boolean
3473 begin
3474 pragma Assert (Present (G));
3475 pragma Assert (Present (Vertex));
3477 return
3478 Is_Spec_With_Body (G, Vertex)
3479 and then Has_Elaborate_Body (G, Vertex);
3480 end Is_Spec_With_Elaborate_Body;
3482 ------------------------------
3483 -- Is_Static_Successor_Edge --
3484 ------------------------------
3486 function Is_Static_Successor_Edge
3487 (G : Library_Graph;
3488 Edge : Library_Graph_Edge_Id) return Boolean
3490 begin
3491 pragma Assert (Present (G));
3492 pragma Assert (Present (Edge));
3494 return
3495 Is_Invocation_Edge (G, Edge)
3496 and then not Is_Dynamically_Elaborated (G, Successor (G, Edge));
3497 end Is_Static_Successor_Edge;
3499 -----------------------------------
3500 -- Is_Vertex_With_Elaborate_Body --
3501 -----------------------------------
3503 function Is_Vertex_With_Elaborate_Body
3504 (G : Library_Graph;
3505 Vertex : Library_Graph_Vertex_Id) return Boolean
3507 begin
3508 pragma Assert (Present (G));
3509 pragma Assert (Present (Vertex));
3511 return
3512 Is_Spec_With_Elaborate_Body (G, Vertex)
3513 or else
3514 Is_Body_Of_Spec_With_Elaborate_Body (G, Vertex);
3515 end Is_Vertex_With_Elaborate_Body;
3517 ---------------------------------
3518 -- Is_Weakly_Elaborable_Vertex --
3519 ----------------------------------
3521 function Is_Weakly_Elaborable_Vertex
3522 (G : Library_Graph;
3523 Vertex : Library_Graph_Vertex_Id) return Boolean
3525 pragma Assert (Present (G));
3526 pragma Assert (Present (Vertex));
3528 Complement : constant Library_Graph_Vertex_Id :=
3529 Complementary_Vertex
3530 (G => G,
3531 Vertex => Vertex,
3532 Force_Complement => False);
3534 Strong_Preds : Natural;
3535 Weak_Preds : Natural;
3537 begin
3538 -- A vertex is weakly elaborable when:
3540 -- * It has not been elaborated yet, and
3541 -- * The complement vertex of an Elaborate_Body pair has not been
3542 -- elaborated yet, and
3543 -- * It resides within an elaborable component, and
3544 -- * It is not waiting on strong predecessors, and
3545 -- * It is waiting on at least one weak predecessor
3547 if In_Elaboration_Order (G, Vertex) then
3548 return False;
3550 elsif Present (Complement)
3551 and then In_Elaboration_Order (G, Complement)
3552 then
3553 return False;
3555 elsif not Is_Elaborable_Component (G, Component (G, Vertex)) then
3556 return False;
3557 end if;
3559 Pending_Predecessors_For_Elaboration
3560 (G => G,
3561 Vertex => Vertex,
3562 Strong_Preds => Strong_Preds,
3563 Weak_Preds => Weak_Preds);
3565 return Strong_Preds = 0 and then Weak_Preds >= 1;
3566 end Is_Weakly_Elaborable_Vertex;
3568 ------------------
3569 -- Is_With_Edge --
3570 ------------------
3572 function Is_With_Edge
3573 (G : Library_Graph;
3574 Edge : Library_Graph_Edge_Id) return Boolean
3576 begin
3577 pragma Assert (Present (G));
3578 pragma Assert (Present (Edge));
3580 return Kind (G, Edge) = With_Edge;
3581 end Is_With_Edge;
3583 ------------------------
3584 -- Iterate_All_Cycles --
3585 ------------------------
3587 function Iterate_All_Cycles
3588 (G : Library_Graph) return All_Cycle_Iterator
3590 begin
3591 pragma Assert (Present (G));
3593 return All_Cycle_Iterator (LGC_Lists.Iterate (G.Cycles));
3594 end Iterate_All_Cycles;
3596 -----------------------
3597 -- Iterate_All_Edges --
3598 -----------------------
3600 function Iterate_All_Edges
3601 (G : Library_Graph) return All_Edge_Iterator
3603 begin
3604 pragma Assert (Present (G));
3606 return All_Edge_Iterator (DG.Iterate_All_Edges (G.Graph));
3607 end Iterate_All_Edges;
3609 --------------------------
3610 -- Iterate_All_Vertices --
3611 --------------------------
3613 function Iterate_All_Vertices
3614 (G : Library_Graph) return All_Vertex_Iterator
3616 begin
3617 pragma Assert (Present (G));
3619 return All_Vertex_Iterator (DG.Iterate_All_Vertices (G.Graph));
3620 end Iterate_All_Vertices;
3622 ------------------------
3623 -- Iterate_Components --
3624 ------------------------
3626 function Iterate_Components
3627 (G : Library_Graph) return Component_Iterator
3629 begin
3630 pragma Assert (Present (G));
3632 return Component_Iterator (DG.Iterate_Components (G.Graph));
3633 end Iterate_Components;
3635 --------------------------------
3636 -- Iterate_Component_Vertices --
3637 --------------------------------
3639 function Iterate_Component_Vertices
3640 (G : Library_Graph;
3641 Comp : Component_Id) return Component_Vertex_Iterator
3643 begin
3644 pragma Assert (Present (G));
3645 pragma Assert (Present (Comp));
3647 return
3648 Component_Vertex_Iterator
3649 (DG.Iterate_Component_Vertices (G.Graph, Comp));
3650 end Iterate_Component_Vertices;
3652 ----------------------------
3653 -- Iterate_Edges_Of_Cycle --
3654 ----------------------------
3656 function Iterate_Edges_Of_Cycle
3657 (G : Library_Graph;
3658 Cycle : Library_Graph_Cycle_Id) return Edges_Of_Cycle_Iterator
3660 begin
3661 pragma Assert (Present (G));
3662 pragma Assert (Present (Cycle));
3664 return Edges_Of_Cycle_Iterator (LGE_Lists.Iterate (Path (G, Cycle)));
3665 end Iterate_Edges_Of_Cycle;
3667 ---------------------------------
3668 -- Iterate_Edges_To_Successors --
3669 ---------------------------------
3671 function Iterate_Edges_To_Successors
3672 (G : Library_Graph;
3673 Vertex : Library_Graph_Vertex_Id) return Edges_To_Successors_Iterator
3675 begin
3676 pragma Assert (Present (G));
3677 pragma Assert (Present (Vertex));
3679 return
3680 Edges_To_Successors_Iterator
3681 (DG.Iterate_Outgoing_Edges (G.Graph, Vertex));
3682 end Iterate_Edges_To_Successors;
3684 ----------
3685 -- Kind --
3686 ----------
3688 function Kind
3689 (G : Library_Graph;
3690 Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Kind
3692 begin
3693 pragma Assert (Present (G));
3694 pragma Assert (Present (Cycle));
3696 return Get_LGC_Attributes (G, Cycle).Kind;
3697 end Kind;
3699 ----------
3700 -- Kind --
3701 ----------
3703 function Kind
3704 (G : Library_Graph;
3705 Edge : Library_Graph_Edge_Id) return Library_Graph_Edge_Kind
3707 begin
3708 return Get_LGE_Attributes (G, Edge).Kind;
3709 end Kind;
3711 ------------
3712 -- Length --
3713 ------------
3715 function Length
3716 (G : Library_Graph;
3717 Cycle : Library_Graph_Cycle_Id) return Natural
3719 begin
3720 pragma Assert (Present (G));
3721 pragma Assert (Present (Cycle));
3723 return LGE_Lists.Size (Path (G, Cycle));
3724 end Length;
3726 ------------------------------
3727 -- Library_Graph_Edge_Count --
3728 ------------------------------
3730 function Library_Graph_Edge_Count
3731 (G : Library_Graph;
3732 Kind : Library_Graph_Edge_Kind) return Natural
3734 begin
3735 pragma Assert (Present (G));
3737 return G.Counts (Kind);
3738 end Library_Graph_Edge_Count;
3740 --------------------------------------
3741 -- Links_Vertices_In_Same_Component --
3742 --------------------------------------
3744 function Links_Vertices_In_Same_Component
3745 (G : Library_Graph;
3746 Edge : Library_Graph_Edge_Id) return Boolean
3748 begin
3749 pragma Assert (Present (G));
3750 pragma Assert (Present (Edge));
3752 -- An edge is part of a cycle when both the successor and predecessor
3753 -- reside in the same component.
3755 return
3756 In_Same_Component
3757 (G => G,
3758 Left => Predecessor (G, Edge),
3759 Right => Successor (G, Edge));
3760 end Links_Vertices_In_Same_Component;
3762 -----------------------------------
3763 -- Maximum_Invocation_Edge_Count --
3764 -----------------------------------
3766 function Maximum_Invocation_Edge_Count
3767 (G : Library_Graph;
3768 Edge : Library_Graph_Edge_Id;
3769 Count : Natural) return Natural
3771 New_Count : Natural;
3773 begin
3774 pragma Assert (Present (G));
3776 New_Count := Count;
3778 if Present (Edge) and then Is_Invocation_Edge (G, Edge) then
3779 New_Count := New_Count + 1;
3780 end if;
3782 return New_Count;
3783 end Maximum_Invocation_Edge_Count;
3785 ----------
3786 -- Name --
3787 ----------
3789 function Name
3790 (G : Library_Graph;
3791 Vertex : Library_Graph_Vertex_Id) return Unit_Name_Type
3793 begin
3794 pragma Assert (Present (G));
3795 pragma Assert (Present (Vertex));
3797 return Name (Unit (G, Vertex));
3798 end Name;
3800 -----------------------
3801 -- Needs_Elaboration --
3802 -----------------------
3804 function Needs_Elaboration
3805 (G : Library_Graph;
3806 Vertex : Library_Graph_Vertex_Id) return Boolean
3808 begin
3809 pragma Assert (Present (G));
3810 pragma Assert (Present (Vertex));
3812 return Needs_Elaboration (Unit (G, Vertex));
3813 end Needs_Elaboration;
3815 ----------
3816 -- Next --
3817 ----------
3819 procedure Next
3820 (Iter : in out All_Cycle_Iterator;
3821 Cycle : out Library_Graph_Cycle_Id)
3823 begin
3824 LGC_Lists.Next (LGC_Lists.Iterator (Iter), Cycle);
3825 end Next;
3827 ----------
3828 -- Next --
3829 ----------
3831 procedure Next
3832 (Iter : in out All_Edge_Iterator;
3833 Edge : out Library_Graph_Edge_Id)
3835 begin
3836 DG.Next (DG.All_Edge_Iterator (Iter), Edge);
3837 end Next;
3839 ----------
3840 -- Next --
3841 ----------
3843 procedure Next
3844 (Iter : in out All_Vertex_Iterator;
3845 Vertex : out Library_Graph_Vertex_Id)
3847 begin
3848 DG.Next (DG.All_Vertex_Iterator (Iter), Vertex);
3849 end Next;
3851 ----------
3852 -- Next --
3853 ----------
3855 procedure Next
3856 (Iter : in out Edges_Of_Cycle_Iterator;
3857 Edge : out Library_Graph_Edge_Id)
3859 begin
3860 LGE_Lists.Next (LGE_Lists.Iterator (Iter), Edge);
3861 end Next;
3863 ----------
3864 -- Next --
3865 ----------
3867 procedure Next
3868 (Iter : in out Component_Iterator;
3869 Comp : out Component_Id)
3871 begin
3872 DG.Next (DG.Component_Iterator (Iter), Comp);
3873 end Next;
3875 ----------
3876 -- Next --
3877 ----------
3879 procedure Next
3880 (Iter : in out Edges_To_Successors_Iterator;
3881 Edge : out Library_Graph_Edge_Id)
3883 begin
3884 DG.Next (DG.Outgoing_Edge_Iterator (Iter), Edge);
3885 end Next;
3887 ----------
3888 -- Next --
3889 ----------
3891 procedure Next
3892 (Iter : in out Component_Vertex_Iterator;
3893 Vertex : out Library_Graph_Vertex_Id)
3895 begin
3896 DG.Next (DG.Component_Vertex_Iterator (Iter), Vertex);
3897 end Next;
3899 --------------------------
3900 -- Normalize_Cycle_Path --
3901 --------------------------
3903 procedure Normalize_Cycle_Path
3904 (Cycle_Path : LGE_Lists.Doubly_Linked_List;
3905 Most_Significant_Edge : Library_Graph_Edge_Id)
3907 Edge : Library_Graph_Edge_Id;
3909 begin
3910 pragma Assert (LGE_Lists.Present (Cycle_Path));
3911 pragma Assert (Present (Most_Significant_Edge));
3913 -- Perform at most |Cycle_Path| rotations in case the cycle is
3914 -- malformed and the significant edge does not appear within.
3916 for Rotation in 1 .. LGE_Lists.Size (Cycle_Path) loop
3917 Edge := LGE_Lists.First (Cycle_Path);
3919 -- The cycle is already rotated such that the most significant
3920 -- edge is first.
3922 if Edge = Most_Significant_Edge then
3923 return;
3925 -- Otherwise rotate the cycle by relocating the current edge from
3926 -- the start to the end of the path. This preserves the order of
3927 -- the path.
3929 else
3930 LGE_Lists.Delete_First (Cycle_Path);
3931 LGE_Lists.Append (Cycle_Path, Edge);
3932 end if;
3933 end loop;
3935 pragma Assert (False);
3936 end Normalize_Cycle_Path;
3938 ----------------------------------
3939 -- Number_Of_Component_Vertices --
3940 ----------------------------------
3942 function Number_Of_Component_Vertices
3943 (G : Library_Graph;
3944 Comp : Component_Id) return Natural
3946 begin
3947 pragma Assert (Present (G));
3948 pragma Assert (Present (Comp));
3950 return DG.Number_Of_Component_Vertices (G.Graph, Comp);
3951 end Number_Of_Component_Vertices;
3953 --------------------------
3954 -- Number_Of_Components --
3955 --------------------------
3957 function Number_Of_Components (G : Library_Graph) return Natural is
3958 begin
3959 pragma Assert (Present (G));
3961 return DG.Number_Of_Components (G.Graph);
3962 end Number_Of_Components;
3964 ----------------------
3965 -- Number_Of_Cycles --
3966 ----------------------
3968 function Number_Of_Cycles (G : Library_Graph) return Natural is
3969 begin
3970 pragma Assert (Present (G));
3972 return LGC_Lists.Size (G.Cycles);
3973 end Number_Of_Cycles;
3975 ---------------------
3976 -- Number_Of_Edges --
3977 ---------------------
3979 function Number_Of_Edges (G : Library_Graph) return Natural is
3980 begin
3981 pragma Assert (Present (G));
3983 return DG.Number_Of_Edges (G.Graph);
3984 end Number_Of_Edges;
3986 -----------------------------------
3987 -- Number_Of_Edges_To_Successors --
3988 -----------------------------------
3990 function Number_Of_Edges_To_Successors
3991 (G : Library_Graph;
3992 Vertex : Library_Graph_Vertex_Id) return Natural
3994 begin
3995 pragma Assert (Present (G));
3997 return DG.Number_Of_Outgoing_Edges (G.Graph, Vertex);
3998 end Number_Of_Edges_To_Successors;
4000 ------------------------
4001 -- Number_Of_Vertices --
4002 ------------------------
4004 function Number_Of_Vertices (G : Library_Graph) return Natural is
4005 begin
4006 pragma Assert (Present (G));
4008 return DG.Number_Of_Vertices (G.Graph);
4009 end Number_Of_Vertices;
4011 -----------------
4012 -- Order_Cycle --
4013 -----------------
4015 procedure Order_Cycle
4016 (G : Library_Graph;
4017 Cycle : Library_Graph_Cycle_Id)
4019 Lesser_Cycle : Library_Graph_Cycle_Id;
4021 begin
4022 pragma Assert (Present (G));
4023 pragma Assert (Present (Cycle));
4024 pragma Assert (LGC_Lists.Present (G.Cycles));
4026 -- The input cycle is the first to be inserted
4028 if LGC_Lists.Is_Empty (G.Cycles) then
4029 LGC_Lists.Prepend (G.Cycles, Cycle);
4031 -- Otherwise the list of all cycles contains at least one cycle.
4032 -- Insert the input cycle based on its precedence.
4034 else
4035 Lesser_Cycle := Find_First_Lower_Precedence_Cycle (G, Cycle);
4037 -- The list contains at least one cycle, and the input cycle has a
4038 -- higher precedence compared to some cycle in the list.
4040 if Present (Lesser_Cycle) then
4041 LGC_Lists.Insert_Before
4042 (L => G.Cycles,
4043 Before => Lesser_Cycle,
4044 Elem => Cycle);
4046 -- Otherwise the input cycle has the lowest precedence among all
4047 -- cycles.
4049 else
4050 LGC_Lists.Append (G.Cycles, Cycle);
4051 end if;
4052 end if;
4053 end Order_Cycle;
4055 ----------
4056 -- Path --
4057 ----------
4059 function Path
4060 (G : Library_Graph;
4061 Cycle : Library_Graph_Cycle_Id) return LGE_Lists.Doubly_Linked_List
4063 begin
4064 pragma Assert (Present (G));
4065 pragma Assert (Present (Cycle));
4067 return Get_LGC_Attributes (G, Cycle).Path;
4068 end Path;
4070 ------------------------------------------
4071 -- Pending_Predecessors_For_Elaboration --
4072 ------------------------------------------
4074 procedure Pending_Predecessors_For_Elaboration
4075 (G : Library_Graph;
4076 Vertex : Library_Graph_Vertex_Id;
4077 Strong_Preds : out Natural;
4078 Weak_Preds : out Natural)
4080 Complement : Library_Graph_Vertex_Id;
4081 Spec_Vertex : Library_Graph_Vertex_Id;
4082 Total_Strong_Preds : Natural;
4083 Total_Weak_Preds : Natural;
4085 begin
4086 pragma Assert (Present (G));
4087 pragma Assert (Present (Vertex));
4089 Total_Strong_Preds := Pending_Strong_Predecessors (G, Vertex);
4090 Total_Weak_Preds := Pending_Weak_Predecessors (G, Vertex);
4092 -- Assume that there is no complementary vertex that needs to be
4093 -- examined.
4095 Complement := No_Library_Graph_Vertex;
4096 Spec_Vertex := No_Library_Graph_Vertex;
4098 if Is_Body_Of_Spec_With_Elaborate_Body (G, Vertex) then
4099 Complement := Proper_Spec (G, Vertex);
4100 Spec_Vertex := Complement;
4102 elsif Is_Spec_With_Elaborate_Body (G, Vertex) then
4103 Complement := Proper_Body (G, Vertex);
4104 Spec_Vertex := Vertex;
4105 end if;
4107 -- The vertex is part of an Elaborate_Body pair. Take into account
4108 -- the strong and weak predecessors of the complementary vertex.
4110 if Present (Complement) then
4111 Total_Strong_Preds :=
4112 Pending_Strong_Predecessors (G, Complement) + Total_Strong_Preds;
4113 Total_Weak_Preds :=
4114 Pending_Weak_Predecessors (G, Complement) + Total_Weak_Preds;
4116 -- The body of an Elaborate_Body pair is the successor of a strong
4117 -- edge where the predecessor is the spec. This edge must not be
4118 -- considered for elaboration purposes because the pair is treated
4119 -- as one vertex. Account for the edge only when the spec has not
4120 -- been elaborated yet.
4122 if not In_Elaboration_Order (G, Spec_Vertex) then
4123 Total_Strong_Preds := Total_Strong_Preds - 1;
4124 end if;
4125 end if;
4127 Strong_Preds := Total_Strong_Preds;
4128 Weak_Preds := Total_Weak_Preds;
4129 end Pending_Predecessors_For_Elaboration;
4131 ---------------------------------
4132 -- Pending_Strong_Predecessors --
4133 ---------------------------------
4135 function Pending_Strong_Predecessors
4136 (G : Library_Graph;
4137 Comp : Component_Id) return Natural
4139 begin
4140 pragma Assert (Present (G));
4141 pragma Assert (Present (Comp));
4143 return Get_Component_Attributes (G, Comp).Pending_Strong_Predecessors;
4144 end Pending_Strong_Predecessors;
4146 ---------------------------------
4147 -- Pending_Strong_Predecessors --
4148 ---------------------------------
4150 function Pending_Strong_Predecessors
4151 (G : Library_Graph;
4152 Vertex : Library_Graph_Vertex_Id) return Natural
4154 begin
4155 pragma Assert (Present (G));
4156 pragma Assert (Present (Vertex));
4158 return Get_LGV_Attributes (G, Vertex).Pending_Strong_Predecessors;
4159 end Pending_Strong_Predecessors;
4161 -------------------------------
4162 -- Pending_Weak_Predecessors --
4163 -------------------------------
4165 function Pending_Weak_Predecessors
4166 (G : Library_Graph;
4167 Comp : Component_Id) return Natural
4169 begin
4170 pragma Assert (Present (G));
4171 pragma Assert (Present (Comp));
4173 return Get_Component_Attributes (G, Comp).Pending_Weak_Predecessors;
4174 end Pending_Weak_Predecessors;
4176 -------------------------------
4177 -- Pending_Weak_Predecessors --
4178 -------------------------------
4180 function Pending_Weak_Predecessors
4181 (G : Library_Graph;
4182 Vertex : Library_Graph_Vertex_Id) return Natural
4184 begin
4185 pragma Assert (Present (G));
4186 pragma Assert (Present (Vertex));
4188 return Get_LGV_Attributes (G, Vertex).Pending_Weak_Predecessors;
4189 end Pending_Weak_Predecessors;
4191 -----------------
4192 -- Predecessor --
4193 -----------------
4195 function Predecessor
4196 (G : Library_Graph;
4197 Edge : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id
4199 begin
4200 pragma Assert (Present (G));
4201 pragma Assert (Present (Edge));
4203 return DG.Source_Vertex (G.Graph, Edge);
4204 end Predecessor;
4206 -------------
4207 -- Present --
4208 -------------
4210 function Present (G : Library_Graph) return Boolean is
4211 begin
4212 return G /= Nil;
4213 end Present;
4215 -----------------
4216 -- Proper_Body --
4217 -----------------
4219 function Proper_Body
4220 (G : Library_Graph;
4221 Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id
4223 begin
4224 pragma Assert (Present (G));
4225 pragma Assert (Present (Vertex));
4227 -- When the vertex denotes a spec with a completing body, return the
4228 -- body.
4230 if Is_Spec_With_Body (G, Vertex) then
4231 return Corresponding_Item (G, Vertex);
4233 -- Otherwise the vertex must be a body
4235 else
4236 pragma Assert (Is_Body (G, Vertex));
4237 return Vertex;
4238 end if;
4239 end Proper_Body;
4241 -----------------
4242 -- Proper_Spec --
4243 -----------------
4245 function Proper_Spec
4246 (G : Library_Graph;
4247 Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id
4249 begin
4250 pragma Assert (Present (G));
4251 pragma Assert (Present (Vertex));
4253 -- When the vertex denotes a body that completes a spec, return the
4254 -- spec.
4256 if Is_Body_With_Spec (G, Vertex) then
4257 return Corresponding_Item (G, Vertex);
4259 -- Otherwise the vertex must denote a spec
4261 else
4262 pragma Assert (Is_Spec (G, Vertex));
4263 return Vertex;
4264 end if;
4265 end Proper_Spec;
4267 ------------------
4268 -- Record_Cycle --
4269 ------------------
4271 procedure Record_Cycle
4272 (G : Library_Graph;
4273 Most_Significant_Edge : Library_Graph_Edge_Id;
4274 Invocation_Edge_Count : Natural;
4275 Cycle_Path : LGE_Lists.Doubly_Linked_List;
4276 Indent : Indentation_Level)
4278 Cycle : Library_Graph_Cycle_Id;
4279 Path : LGE_Lists.Doubly_Linked_List;
4281 begin
4282 pragma Assert (Present (G));
4283 pragma Assert (Present (Most_Significant_Edge));
4284 pragma Assert (LGE_Lists.Present (Cycle_Path));
4286 -- Replicate the path of the cycle in order to avoid sharing lists
4288 Path := Copy_Cycle_Path (Cycle_Path);
4290 -- Normalize the path of the cycle such that its most significant
4291 -- edge is the first in the list of edges.
4293 Normalize_Cycle_Path
4294 (Cycle_Path => Path,
4295 Most_Significant_Edge => Most_Significant_Edge);
4297 -- Save the cycle for diagnostic purposes. Its kind is determined by
4298 -- its most significant edge.
4300 Cycle := Sequence_Next_Cycle;
4302 Set_LGC_Attributes
4303 (G => G,
4304 Cycle => Cycle,
4305 Val =>
4306 (Invocation_Edge_Count => Invocation_Edge_Count,
4307 Kind =>
4308 Cycle_Kind_Of
4309 (G => G,
4310 Edge => Most_Significant_Edge),
4311 Path => Path));
4313 Trace_Cycle (G, Cycle, Indent);
4315 -- Order the cycle based on its precedence relative to previously
4316 -- discovered cycles.
4318 Order_Cycle (G, Cycle);
4319 end Record_Cycle;
4321 -----------------------------------------
4322 -- Same_Library_Graph_Cycle_Attributes --
4323 -----------------------------------------
4325 function Same_Library_Graph_Cycle_Attributes
4326 (Left : Library_Graph_Cycle_Attributes;
4327 Right : Library_Graph_Cycle_Attributes) return Boolean
4329 begin
4330 -- Two cycles are the same when
4332 -- * They are of the same kind
4333 -- * They have the same number of invocation edges in their paths
4334 -- * Their paths are the same length
4335 -- * The edges comprising their paths are the same
4337 return
4338 Left.Invocation_Edge_Count = Right.Invocation_Edge_Count
4339 and then Left.Kind = Right.Kind
4340 and then LGE_Lists.Equal (Left.Path, Right.Path);
4341 end Same_Library_Graph_Cycle_Attributes;
4343 ------------------------
4344 -- Set_Activates_Task --
4345 ------------------------
4347 procedure Set_Activates_Task
4348 (G : Library_Graph;
4349 Edge : Library_Graph_Edge_Id)
4351 Attributes : Library_Graph_Edge_Attributes :=
4352 Get_LGE_Attributes (G, Edge);
4353 begin
4354 Attributes.Activates_Task := True;
4355 Set_LGE_Attributes (G, Edge, Attributes);
4356 end Set_Activates_Task;
4358 ------------------------------
4359 -- Set_Component_Attributes --
4360 ------------------------------
4362 procedure Set_Component_Attributes
4363 (G : Library_Graph;
4364 Comp : Component_Id;
4365 Val : Component_Attributes)
4367 begin
4368 pragma Assert (Present (G));
4369 pragma Assert (Present (Comp));
4371 Component_Tables.Put (G.Component_Attributes, Comp, Val);
4372 end Set_Component_Attributes;
4374 ----------------------------
4375 -- Set_Corresponding_Item --
4376 ----------------------------
4378 procedure Set_Corresponding_Item
4379 (G : Library_Graph;
4380 Vertex : Library_Graph_Vertex_Id;
4381 Val : Library_Graph_Vertex_Id)
4383 Attrs : Library_Graph_Vertex_Attributes;
4385 begin
4386 pragma Assert (Present (G));
4387 pragma Assert (Present (Vertex));
4389 Attrs := Get_LGV_Attributes (G, Vertex);
4390 Attrs.Corresponding_Item := Val;
4391 Set_LGV_Attributes (G, Vertex, Attrs);
4392 end Set_Corresponding_Item;
4394 ------------------------------
4395 -- Set_Corresponding_Vertex --
4396 ------------------------------
4398 procedure Set_Corresponding_Vertex
4399 (G : Library_Graph;
4400 U_Id : Unit_Id;
4401 Val : Library_Graph_Vertex_Id)
4403 begin
4404 pragma Assert (Present (G));
4405 pragma Assert (Present (U_Id));
4407 Unit_Tables.Put (G.Unit_To_Vertex, U_Id, Val);
4408 end Set_Corresponding_Vertex;
4410 ------------------------------
4411 -- Set_In_Elaboration_Order --
4412 ------------------------------
4414 procedure Set_In_Elaboration_Order
4415 (G : Library_Graph;
4416 Vertex : Library_Graph_Vertex_Id;
4417 Val : Boolean := True)
4419 Attrs : Library_Graph_Vertex_Attributes;
4421 begin
4422 pragma Assert (Present (G));
4423 pragma Assert (Present (Vertex));
4425 Attrs := Get_LGV_Attributes (G, Vertex);
4426 Attrs.In_Elaboration_Order := Val;
4427 Set_LGV_Attributes (G, Vertex, Attrs);
4428 end Set_In_Elaboration_Order;
4430 --------------------------
4431 -- Set_Is_Recorded_Edge --
4432 --------------------------
4434 procedure Set_Is_Recorded_Edge
4435 (G : Library_Graph;
4436 Rel : Predecessor_Successor_Relation)
4438 begin
4439 pragma Assert (Present (G));
4440 pragma Assert (Present (Rel.Predecessor));
4441 pragma Assert (Present (Rel.Successor));
4443 RE_Sets.Insert (G.Recorded_Edges, Rel);
4444 end Set_Is_Recorded_Edge;
4446 ------------------------
4447 -- Set_LGC_Attributes --
4448 ------------------------
4450 procedure Set_LGC_Attributes
4451 (G : Library_Graph;
4452 Cycle : Library_Graph_Cycle_Id;
4453 Val : Library_Graph_Cycle_Attributes)
4455 begin
4456 pragma Assert (Present (G));
4457 pragma Assert (Present (Cycle));
4459 LGC_Tables.Put (G.Cycle_Attributes, Cycle, Val);
4460 end Set_LGC_Attributes;
4462 ------------------------
4463 -- Set_LGE_Attributes --
4464 ------------------------
4466 procedure Set_LGE_Attributes
4467 (G : Library_Graph;
4468 Edge : Library_Graph_Edge_Id;
4469 Val : Library_Graph_Edge_Attributes)
4471 begin
4472 pragma Assert (Present (G));
4473 pragma Assert (Present (Edge));
4475 LGE_Tables.Put (G.Edge_Attributes, Edge, Val);
4476 end Set_LGE_Attributes;
4478 ------------------------
4479 -- Set_LGV_Attributes --
4480 ------------------------
4482 procedure Set_LGV_Attributes
4483 (G : Library_Graph;
4484 Vertex : Library_Graph_Vertex_Id;
4485 Val : Library_Graph_Vertex_Attributes)
4487 begin
4488 pragma Assert (Present (G));
4489 pragma Assert (Present (Vertex));
4491 LGV_Tables.Put (G.Vertex_Attributes, Vertex, Val);
4492 end Set_LGV_Attributes;
4494 ---------------
4495 -- Successor --
4496 ---------------
4498 function Successor
4499 (G : Library_Graph;
4500 Edge : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id
4502 begin
4503 pragma Assert (Present (G));
4504 pragma Assert (Present (Edge));
4506 return DG.Destination_Vertex (G.Graph, Edge);
4507 end Successor;
4509 ---------------------
4510 -- Trace_Component --
4511 ---------------------
4513 procedure Trace_Component
4514 (G : Library_Graph;
4515 Comp : Component_Id;
4516 Indent : Indentation_Level)
4518 begin
4519 pragma Assert (Present (G));
4520 pragma Assert (Present (Comp));
4522 -- Nothing to do when switch -d_t (output cycle-detection trace
4523 -- information) is not in effect.
4525 if not Debug_Flag_Underscore_T then
4526 return;
4527 end if;
4529 Write_Eol;
4530 Indent_By (Indent);
4531 Write_Str ("component (Comp_");
4532 Write_Int (Int (Comp));
4533 Write_Str (")");
4534 Write_Eol;
4535 end Trace_Component;
4537 -----------------
4538 -- Trace_Cycle --
4539 -----------------
4541 procedure Trace_Cycle
4542 (G : Library_Graph;
4543 Cycle : Library_Graph_Cycle_Id;
4544 Indent : Indentation_Level)
4546 Attr_Indent : constant Indentation_Level :=
4547 Indent + Nested_Indentation;
4548 Edge_Indent : constant Indentation_Level :=
4549 Attr_Indent + Nested_Indentation;
4551 Edge : Library_Graph_Edge_Id;
4552 Iter : Edges_Of_Cycle_Iterator;
4554 begin
4555 pragma Assert (Present (G));
4556 pragma Assert (Present (Cycle));
4558 -- Nothing to do when switch -d_t (output cycle-detection trace
4559 -- information) is not in effect.
4561 if not Debug_Flag_Underscore_T then
4562 return;
4563 end if;
4565 Indent_By (Indent);
4566 Write_Str ("cycle (LGC_Id_");
4567 Write_Int (Int (Cycle));
4568 Write_Str (")");
4569 Write_Eol;
4571 Indent_By (Attr_Indent);
4572 Write_Str ("kind = ");
4573 Write_Str (Kind (G, Cycle)'Img);
4574 Write_Eol;
4576 Indent_By (Attr_Indent);
4577 Write_Str ("invocation edges = ");
4578 Write_Int (Int (Invocation_Edge_Count (G, Cycle)));
4579 Write_Eol;
4581 Indent_By (Attr_Indent);
4582 Write_Str ("length: ");
4583 Write_Int (Int (Length (G, Cycle)));
4584 Write_Eol;
4586 Iter := Iterate_Edges_Of_Cycle (G, Cycle);
4587 while Has_Next (Iter) loop
4588 Next (Iter, Edge);
4590 Indent_By (Edge_Indent);
4591 Write_Str ("library graph edge (LGE_Id_");
4592 Write_Int (Int (Edge));
4593 Write_Str (")");
4594 Write_Eol;
4595 end loop;
4596 end Trace_Cycle;
4598 ----------------
4599 -- Trace_Edge --
4600 ----------------
4602 procedure Trace_Edge
4603 (G : Library_Graph;
4604 Edge : Library_Graph_Edge_Id;
4605 Indent : Indentation_Level)
4607 pragma Assert (Present (G));
4608 pragma Assert (Present (Edge));
4610 Attr_Indent : constant Indentation_Level :=
4611 Indent + Nested_Indentation;
4613 Pred : constant Library_Graph_Vertex_Id := Predecessor (G, Edge);
4614 Succ : constant Library_Graph_Vertex_Id := Successor (G, Edge);
4616 begin
4617 -- Nothing to do when switch -d_t (output cycle-detection trace
4618 -- information) is not in effect.
4620 if not Debug_Flag_Underscore_T then
4621 return;
4622 end if;
4624 Indent_By (Indent);
4625 Write_Str ("library graph edge (LGE_Id_");
4626 Write_Int (Int (Edge));
4627 Write_Str (")");
4628 Write_Eol;
4630 Indent_By (Attr_Indent);
4631 Write_Str ("kind = ");
4632 Write_Str (Kind (G, Edge)'Img);
4633 Write_Eol;
4635 Indent_By (Attr_Indent);
4636 Write_Str ("Predecessor (LGV_Id_");
4637 Write_Int (Int (Pred));
4638 Write_Str (") name = ");
4639 Write_Name (Name (G, Pred));
4640 Write_Eol;
4642 Indent_By (Attr_Indent);
4643 Write_Str ("Successor (LGV_Id_");
4644 Write_Int (Int (Succ));
4645 Write_Str (") name = ");
4646 Write_Name (Name (G, Succ));
4647 Write_Eol;
4648 end Trace_Edge;
4650 ------------------
4651 -- Trace_Vertex --
4652 ------------------
4654 procedure Trace_Vertex
4655 (G : Library_Graph;
4656 Vertex : Library_Graph_Vertex_Id;
4657 Indent : Indentation_Level)
4659 Attr_Indent : constant Indentation_Level :=
4660 Indent + Nested_Indentation;
4662 begin
4663 pragma Assert (Present (G));
4664 pragma Assert (Present (Vertex));
4666 -- Nothing to do when switch -d_t (output cycle-detection trace
4667 -- information) is not in effect.
4669 if not Debug_Flag_Underscore_T then
4670 return;
4671 end if;
4673 Indent_By (Indent);
4674 Write_Str ("library graph vertex (LGV_Id_");
4675 Write_Int (Int (Vertex));
4676 Write_Str (")");
4677 Write_Eol;
4679 Indent_By (Attr_Indent);
4680 Write_Str ("Unit (U_Id_");
4681 Write_Int (Int (Unit (G, Vertex)));
4682 Write_Str (") name = ");
4683 Write_Name (Name (G, Vertex));
4684 Write_Eol;
4685 end Trace_Vertex;
4687 ----------
4688 -- Unit --
4689 ----------
4691 function Unit
4692 (G : Library_Graph;
4693 Vertex : Library_Graph_Vertex_Id) return Unit_Id
4695 begin
4696 pragma Assert (Present (G));
4697 pragma Assert (Present (Vertex));
4699 return Get_LGV_Attributes (G, Vertex).Unit;
4700 end Unit;
4702 -------------
4703 -- Unvisit --
4704 -------------
4706 procedure Unvisit
4707 (Vertex : Library_Graph_Vertex_Id;
4708 Visited_Set : LGV_Sets.Membership_Set;
4709 Visited_Stack : LGV_Lists.Doubly_Linked_List)
4711 Current_Vertex : Library_Graph_Vertex_Id;
4713 begin
4714 pragma Assert (Present (Vertex));
4715 pragma Assert (LGV_Sets.Present (Visited_Set));
4716 pragma Assert (LGV_Lists.Present (Visited_Stack));
4718 while not LGV_Lists.Is_Empty (Visited_Stack) loop
4719 Current_Vertex := LGV_Lists.First (Visited_Stack);
4721 LGV_Lists.Delete_First (Visited_Stack);
4722 LGV_Sets.Delete (Visited_Set, Current_Vertex);
4724 exit when Current_Vertex = Vertex;
4725 end loop;
4726 end Unvisit;
4728 ---------------------------------
4729 -- Update_Pending_Predecessors --
4730 ---------------------------------
4732 procedure Update_Pending_Predecessors
4733 (Strong_Predecessors : in out Natural;
4734 Weak_Predecessors : in out Natural;
4735 Update_Weak : Boolean;
4736 Value : Integer)
4738 begin
4739 if Update_Weak then
4740 Weak_Predecessors := Weak_Predecessors + Value;
4741 else
4742 Strong_Predecessors := Strong_Predecessors + Value;
4743 end if;
4744 end Update_Pending_Predecessors;
4746 -----------------------------------------------
4747 -- Update_Pending_Predecessors_Of_Components --
4748 -----------------------------------------------
4750 procedure Update_Pending_Predecessors_Of_Components
4751 (G : Library_Graph)
4753 Edge : Library_Graph_Edge_Id;
4754 Iter : All_Edge_Iterator;
4756 begin
4757 pragma Assert (Present (G));
4759 Iter := Iterate_All_Edges (G);
4760 while Has_Next (Iter) loop
4761 Next (Iter, Edge);
4763 Update_Pending_Predecessors_Of_Components (G, Edge);
4764 end loop;
4765 end Update_Pending_Predecessors_Of_Components;
4767 -----------------------------------------------
4768 -- Update_Pending_Predecessors_Of_Components --
4769 -----------------------------------------------
4771 procedure Update_Pending_Predecessors_Of_Components
4772 (G : Library_Graph;
4773 Edge : Library_Graph_Edge_Id)
4775 pragma Assert (Present (G));
4776 pragma Assert (Present (Edge));
4778 Pred_Comp : constant Component_Id :=
4779 Component (G, Predecessor (G, Edge));
4780 Succ_Comp : constant Component_Id :=
4781 Component (G, Successor (G, Edge));
4783 pragma Assert (Present (Pred_Comp));
4784 pragma Assert (Present (Succ_Comp));
4786 begin
4787 -- The edge links a successor and a predecessor coming from two
4788 -- different SCCs. This indicates that the SCC of the successor
4789 -- must wait on another predecessor until it can be elaborated.
4791 if Pred_Comp /= Succ_Comp then
4792 Increment_Pending_Predecessors
4793 (G => G,
4794 Comp => Succ_Comp,
4795 Edge => Edge);
4796 end if;
4797 end Update_Pending_Predecessors_Of_Components;
4799 -----------------------
4800 -- Vertex_Precedence --
4801 -----------------------
4803 function Vertex_Precedence
4804 (G : Library_Graph;
4805 Vertex : Library_Graph_Vertex_Id;
4806 Compared_To : Library_Graph_Vertex_Id) return Precedence_Kind
4808 begin
4809 pragma Assert (Present (G));
4810 pragma Assert (Present (Vertex));
4811 pragma Assert (Present (Compared_To));
4813 -- Use lexicographical order to determine precedence and ensure
4814 -- deterministic behavior.
4816 if Uname_Less (Name (G, Vertex), Name (G, Compared_To)) then
4817 return Higher_Precedence;
4818 else
4819 return Lower_Precedence;
4820 end if;
4821 end Vertex_Precedence;
4823 -----------
4824 -- Visit --
4825 -----------
4827 procedure Visit
4828 (Vertex : Library_Graph_Vertex_Id;
4829 Visited_Set : LGV_Sets.Membership_Set;
4830 Visited_Stack : LGV_Lists.Doubly_Linked_List)
4832 begin
4833 pragma Assert (Present (Vertex));
4834 pragma Assert (LGV_Sets.Present (Visited_Set));
4835 pragma Assert (LGV_Lists.Present (Visited_Stack));
4837 LGV_Sets.Insert (Visited_Set, Vertex);
4838 LGV_Lists.Prepend (Visited_Stack, Vertex);
4839 end Visit;
4840 end Library_Graphs;
4842 -----------------------
4843 -- Invocation_Graphs --
4844 -----------------------
4846 package body Invocation_Graphs is
4848 -----------------------
4849 -- Local subprograms --
4850 -----------------------
4852 procedure Free is
4853 new Ada.Unchecked_Deallocation
4854 (Invocation_Graph_Attributes, Invocation_Graph);
4856 function Get_IGE_Attributes
4857 (G : Invocation_Graph;
4858 Edge : Invocation_Graph_Edge_Id)
4859 return Invocation_Graph_Edge_Attributes;
4860 pragma Inline (Get_IGE_Attributes);
4861 -- Obtain the attributes of edge Edge of invocation graph G
4863 function Get_IGV_Attributes
4864 (G : Invocation_Graph;
4865 Vertex : Invocation_Graph_Vertex_Id)
4866 return Invocation_Graph_Vertex_Attributes;
4867 pragma Inline (Get_IGV_Attributes);
4868 -- Obtain the attributes of vertex Vertex of invocation graph G
4870 procedure Increment_Invocation_Graph_Edge_Count
4871 (G : Invocation_Graph;
4872 Kind : Invocation_Kind);
4873 pragma Inline (Increment_Invocation_Graph_Edge_Count);
4874 -- Increment the number of edges of king Kind in invocation graph G by
4875 -- one.
4877 function Is_Elaboration_Root
4878 (G : Invocation_Graph;
4879 Vertex : Invocation_Graph_Vertex_Id) return Boolean;
4880 pragma Inline (Is_Elaboration_Root);
4881 -- Determine whether vertex Vertex of invocation graph denotes the
4882 -- elaboration procedure of a spec or a body.
4884 function Is_Existing_Source_Target_Relation
4885 (G : Invocation_Graph;
4886 Rel : Source_Target_Relation) return Boolean;
4887 pragma Inline (Is_Existing_Source_Target_Relation);
4888 -- Determine whether a source vertex and a target vertex described by
4889 -- relation Rel are already related in invocation graph G.
4891 procedure Save_Elaboration_Root
4892 (G : Invocation_Graph;
4893 Root : Invocation_Graph_Vertex_Id);
4894 pragma Inline (Save_Elaboration_Root);
4895 -- Save elaboration root Root of invocation graph G
4897 procedure Set_Corresponding_Vertex
4898 (G : Invocation_Graph;
4899 IS_Id : Invocation_Signature_Id;
4900 Vertex : Invocation_Graph_Vertex_Id);
4901 pragma Inline (Set_Corresponding_Vertex);
4902 -- Associate vertex Vertex of invocation graph G with signature IS_Id
4904 procedure Set_Is_Existing_Source_Target_Relation
4905 (G : Invocation_Graph;
4906 Rel : Source_Target_Relation);
4907 pragma Inline (Set_Is_Existing_Source_Target_Relation);
4908 -- Mark a source vertex and a target vertex described by relation Rel as
4909 -- already related in invocation graph G.
4911 procedure Set_IGE_Attributes
4912 (G : Invocation_Graph;
4913 Edge : Invocation_Graph_Edge_Id;
4914 Val : Invocation_Graph_Edge_Attributes);
4915 pragma Inline (Set_IGE_Attributes);
4916 -- Set the attributes of edge Edge of invocation graph G to value Val
4918 procedure Set_IGV_Attributes
4919 (G : Invocation_Graph;
4920 Vertex : Invocation_Graph_Vertex_Id;
4921 Val : Invocation_Graph_Vertex_Attributes);
4922 pragma Inline (Set_IGV_Attributes);
4923 -- Set the attributes of vertex Vertex of invocation graph G to value
4924 -- Val.
4926 --------------
4927 -- Add_Edge --
4928 --------------
4930 procedure Add_Edge
4931 (G : Invocation_Graph;
4932 Source : Invocation_Graph_Vertex_Id;
4933 Target : Invocation_Graph_Vertex_Id;
4934 IR_Id : Invocation_Relation_Id)
4936 pragma Assert (Present (G));
4937 pragma Assert (Present (Source));
4938 pragma Assert (Present (Target));
4939 pragma Assert (Present (IR_Id));
4941 Rel : constant Source_Target_Relation :=
4942 (Source => Source,
4943 Target => Target);
4945 Edge : Invocation_Graph_Edge_Id;
4947 begin
4948 -- Nothing to do when the source and target are already related by an
4949 -- edge.
4951 if Is_Existing_Source_Target_Relation (G, Rel) then
4952 return;
4953 end if;
4955 Edge := Sequence_Next_Edge;
4957 -- Add the edge to the underlying graph
4959 DG.Add_Edge
4960 (G => G.Graph,
4961 E => Edge,
4962 Source => Source,
4963 Destination => Target);
4965 -- Build and save the attributes of the edge
4967 Set_IGE_Attributes
4968 (G => G,
4969 Edge => Edge,
4970 Val => (Relation => IR_Id));
4972 -- Mark the source and target as related by the new edge. This
4973 -- prevents all further attempts to link the same source and target.
4975 Set_Is_Existing_Source_Target_Relation (G, Rel);
4977 -- Update the edge statistics
4979 Increment_Invocation_Graph_Edge_Count (G, Kind (IR_Id));
4980 end Add_Edge;
4982 ----------------
4983 -- Add_Vertex --
4984 ----------------
4986 procedure Add_Vertex
4987 (G : Invocation_Graph;
4988 IC_Id : Invocation_Construct_Id;
4989 Body_Vertex : Library_Graph_Vertex_Id;
4990 Spec_Vertex : Library_Graph_Vertex_Id)
4992 pragma Assert (Present (G));
4993 pragma Assert (Present (IC_Id));
4994 pragma Assert (Present (Body_Vertex));
4995 pragma Assert (Present (Spec_Vertex));
4997 Construct_Signature : constant Invocation_Signature_Id :=
4998 Signature (IC_Id);
4999 Vertex : Invocation_Graph_Vertex_Id;
5001 begin
5002 -- Nothing to do when the construct already has a vertex
5004 if Present (Corresponding_Vertex (G, Construct_Signature)) then
5005 return;
5006 end if;
5008 Vertex := Sequence_Next_Vertex;
5010 -- Add the vertex to the underlying graph
5012 DG.Add_Vertex (G.Graph, Vertex);
5014 -- Build and save the attributes of the vertex
5016 Set_IGV_Attributes
5017 (G => G,
5018 Vertex => Vertex,
5019 Val => (Body_Vertex => Body_Vertex,
5020 Construct => IC_Id,
5021 Spec_Vertex => Spec_Vertex));
5023 -- Associate the construct with its corresponding vertex
5025 Set_Corresponding_Vertex (G, Construct_Signature, Vertex);
5027 -- Save the vertex for later processing when it denotes a spec or
5028 -- body elaboration procedure.
5030 if Is_Elaboration_Root (G, Vertex) then
5031 Save_Elaboration_Root (G, Vertex);
5032 end if;
5033 end Add_Vertex;
5035 -----------------
5036 -- Body_Vertex --
5037 -----------------
5039 function Body_Vertex
5040 (G : Invocation_Graph;
5041 Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id
5043 begin
5044 pragma Assert (Present (G));
5045 pragma Assert (Present (Vertex));
5047 return Get_IGV_Attributes (G, Vertex).Body_Vertex;
5048 end Body_Vertex;
5050 ------------
5051 -- Column --
5052 ------------
5054 function Column
5055 (G : Invocation_Graph;
5056 Vertex : Invocation_Graph_Vertex_Id) return Nat
5058 begin
5059 pragma Assert (Present (G));
5060 pragma Assert (Present (Vertex));
5062 return Column (Signature (Construct (G, Vertex)));
5063 end Column;
5065 ---------------
5066 -- Construct --
5067 ---------------
5069 function Construct
5070 (G : Invocation_Graph;
5071 Vertex : Invocation_Graph_Vertex_Id) return Invocation_Construct_Id
5073 begin
5074 pragma Assert (Present (G));
5075 pragma Assert (Present (Vertex));
5077 return Get_IGV_Attributes (G, Vertex).Construct;
5078 end Construct;
5080 --------------------------
5081 -- Corresponding_Vertex --
5082 --------------------------
5084 function Corresponding_Vertex
5085 (G : Invocation_Graph;
5086 IS_Id : Invocation_Signature_Id) return Invocation_Graph_Vertex_Id
5088 begin
5089 pragma Assert (Present (G));
5090 pragma Assert (Present (IS_Id));
5092 return Signature_Tables.Get (G.Signature_To_Vertex, IS_Id);
5093 end Corresponding_Vertex;
5095 ------------
5096 -- Create --
5097 ------------
5099 function Create
5100 (Initial_Vertices : Positive;
5101 Initial_Edges : Positive;
5102 Lib_Graph : Library_Graphs.Library_Graph)
5103 return Invocation_Graph
5105 G : constant Invocation_Graph := new Invocation_Graph_Attributes'
5106 (Counts => <>,
5107 Edge_Attributes => IGE_Tables.Create (Initial_Edges),
5108 Graph =>
5109 DG.Create
5110 (Initial_Vertices => Initial_Vertices,
5111 Initial_Edges => Initial_Edges),
5112 Relations => Relation_Sets.Create (Initial_Edges),
5113 Roots => IGV_Sets.Create (Initial_Vertices),
5114 Signature_To_Vertex => Signature_Tables.Create (Initial_Vertices),
5115 Vertex_Attributes => IGV_Tables.Create (Initial_Vertices),
5116 Lib_Graph => Lib_Graph);
5117 begin
5118 return G;
5119 end Create;
5121 -------------
5122 -- Destroy --
5123 -------------
5125 procedure Destroy (G : in out Invocation_Graph) is
5126 begin
5127 pragma Assert (Present (G));
5129 IGE_Tables.Destroy (G.Edge_Attributes);
5130 DG.Destroy (G.Graph);
5131 Relation_Sets.Destroy (G.Relations);
5132 IGV_Sets.Destroy (G.Roots);
5133 Signature_Tables.Destroy (G.Signature_To_Vertex);
5134 IGV_Tables.Destroy (G.Vertex_Attributes);
5136 Free (G);
5137 end Destroy;
5139 -----------------------------------
5140 -- Destroy_Invocation_Graph_Edge --
5141 -----------------------------------
5143 procedure Destroy_Invocation_Graph_Edge
5144 (Edge : in out Invocation_Graph_Edge_Id)
5146 pragma Unreferenced (Edge);
5147 begin
5148 null;
5149 end Destroy_Invocation_Graph_Edge;
5151 ----------------------------------------------
5152 -- Destroy_Invocation_Graph_Edge_Attributes --
5153 ----------------------------------------------
5155 procedure Destroy_Invocation_Graph_Edge_Attributes
5156 (Attrs : in out Invocation_Graph_Edge_Attributes)
5158 pragma Unreferenced (Attrs);
5159 begin
5160 null;
5161 end Destroy_Invocation_Graph_Edge_Attributes;
5163 -------------------------------------
5164 -- Destroy_Invocation_Graph_Vertex --
5165 -------------------------------------
5167 procedure Destroy_Invocation_Graph_Vertex
5168 (Vertex : in out Invocation_Graph_Vertex_Id)
5170 pragma Unreferenced (Vertex);
5171 begin
5172 null;
5173 end Destroy_Invocation_Graph_Vertex;
5175 ------------------------------------------------
5176 -- Destroy_Invocation_Graph_Vertex_Attributes --
5177 ------------------------------------------------
5179 procedure Destroy_Invocation_Graph_Vertex_Attributes
5180 (Attrs : in out Invocation_Graph_Vertex_Attributes)
5182 pragma Unreferenced (Attrs);
5183 begin
5184 null;
5185 end Destroy_Invocation_Graph_Vertex_Attributes;
5187 -----------
5188 -- Extra --
5189 -----------
5191 function Extra
5192 (G : Invocation_Graph;
5193 Edge : Invocation_Graph_Edge_Id) return Name_Id
5195 begin
5196 pragma Assert (Present (G));
5197 pragma Assert (Present (Edge));
5199 return Extra (Relation (G, Edge));
5200 end Extra;
5202 ------------------------
5203 -- Get_IGE_Attributes --
5204 ------------------------
5206 function Get_IGE_Attributes
5207 (G : Invocation_Graph;
5208 Edge : Invocation_Graph_Edge_Id)
5209 return Invocation_Graph_Edge_Attributes
5211 begin
5212 pragma Assert (Present (G));
5213 pragma Assert (Present (Edge));
5215 return IGE_Tables.Get (G.Edge_Attributes, Edge);
5216 end Get_IGE_Attributes;
5218 ------------------------
5219 -- Get_IGV_Attributes --
5220 ------------------------
5222 function Get_IGV_Attributes
5223 (G : Invocation_Graph;
5224 Vertex : Invocation_Graph_Vertex_Id)
5225 return Invocation_Graph_Vertex_Attributes
5227 begin
5228 pragma Assert (Present (G));
5229 pragma Assert (Present (Vertex));
5231 return IGV_Tables.Get (G.Vertex_Attributes, Vertex);
5232 end Get_IGV_Attributes;
5234 --------------
5235 -- Has_Next --
5236 --------------
5238 function Has_Next (Iter : All_Edge_Iterator) return Boolean is
5239 begin
5240 return DG.Has_Next (DG.All_Edge_Iterator (Iter));
5241 end Has_Next;
5243 --------------
5244 -- Has_Next --
5245 --------------
5247 function Has_Next (Iter : All_Vertex_Iterator) return Boolean is
5248 begin
5249 return DG.Has_Next (DG.All_Vertex_Iterator (Iter));
5250 end Has_Next;
5252 --------------
5253 -- Has_Next --
5254 --------------
5256 function Has_Next (Iter : Edges_To_Targets_Iterator) return Boolean is
5257 begin
5258 return DG.Has_Next (DG.Outgoing_Edge_Iterator (Iter));
5259 end Has_Next;
5261 --------------
5262 -- Has_Next --
5263 --------------
5265 function Has_Next (Iter : Elaboration_Root_Iterator) return Boolean is
5266 begin
5267 return IGV_Sets.Has_Next (IGV_Sets.Iterator (Iter));
5268 end Has_Next;
5270 -------------------------------
5271 -- Hash_Invocation_Signature --
5272 -------------------------------
5274 function Hash_Invocation_Signature
5275 (IS_Id : Invocation_Signature_Id) return Bucket_Range_Type
5277 begin
5278 pragma Assert (Present (IS_Id));
5280 return Bucket_Range_Type (IS_Id);
5281 end Hash_Invocation_Signature;
5283 ---------------------------------
5284 -- Hash_Source_Target_Relation --
5285 ---------------------------------
5287 function Hash_Source_Target_Relation
5288 (Rel : Source_Target_Relation) return Bucket_Range_Type
5290 begin
5291 pragma Assert (Present (Rel.Source));
5292 pragma Assert (Present (Rel.Target));
5294 return
5295 Hash_Two_Keys
5296 (Bucket_Range_Type (Rel.Source),
5297 Bucket_Range_Type (Rel.Target));
5298 end Hash_Source_Target_Relation;
5300 -------------------------------------------
5301 -- Increment_Invocation_Graph_Edge_Count --
5302 -------------------------------------------
5304 procedure Increment_Invocation_Graph_Edge_Count
5305 (G : Invocation_Graph;
5306 Kind : Invocation_Kind)
5308 pragma Assert (Present (G));
5310 Count : Natural renames G.Counts (Kind);
5312 begin
5313 Count := Count + 1;
5314 end Increment_Invocation_Graph_Edge_Count;
5316 ---------------------------------
5317 -- Invocation_Graph_Edge_Count --
5318 ---------------------------------
5320 function Invocation_Graph_Edge_Count
5321 (G : Invocation_Graph;
5322 Kind : Invocation_Kind) return Natural
5324 begin
5325 pragma Assert (Present (G));
5327 return G.Counts (Kind);
5328 end Invocation_Graph_Edge_Count;
5330 -------------------------
5331 -- Is_Elaboration_Root --
5332 -------------------------
5334 function Is_Elaboration_Root
5335 (G : Invocation_Graph;
5336 Vertex : Invocation_Graph_Vertex_Id) return Boolean
5338 pragma Assert (Present (G));
5339 pragma Assert (Present (Vertex));
5341 Vertex_Kind : constant Invocation_Construct_Kind :=
5342 Kind (Construct (G, Vertex));
5344 begin
5345 return
5346 Vertex_Kind = Elaborate_Body_Procedure
5347 or else
5348 Vertex_Kind = Elaborate_Spec_Procedure;
5349 end Is_Elaboration_Root;
5351 ----------------------------------------
5352 -- Is_Existing_Source_Target_Relation --
5353 ----------------------------------------
5355 function Is_Existing_Source_Target_Relation
5356 (G : Invocation_Graph;
5357 Rel : Source_Target_Relation) return Boolean
5359 begin
5360 pragma Assert (Present (G));
5362 return Relation_Sets.Contains (G.Relations, Rel);
5363 end Is_Existing_Source_Target_Relation;
5365 -----------------------
5366 -- Iterate_All_Edges --
5367 -----------------------
5369 function Iterate_All_Edges
5370 (G : Invocation_Graph) return All_Edge_Iterator
5372 begin
5373 pragma Assert (Present (G));
5375 return All_Edge_Iterator (DG.Iterate_All_Edges (G.Graph));
5376 end Iterate_All_Edges;
5378 --------------------------
5379 -- Iterate_All_Vertices --
5380 --------------------------
5382 function Iterate_All_Vertices
5383 (G : Invocation_Graph) return All_Vertex_Iterator
5385 begin
5386 pragma Assert (Present (G));
5388 return All_Vertex_Iterator (DG.Iterate_All_Vertices (G.Graph));
5389 end Iterate_All_Vertices;
5391 ------------------------------
5392 -- Iterate_Edges_To_Targets --
5393 ------------------------------
5395 function Iterate_Edges_To_Targets
5396 (G : Invocation_Graph;
5397 Vertex : Invocation_Graph_Vertex_Id) return Edges_To_Targets_Iterator
5399 begin
5400 pragma Assert (Present (G));
5401 pragma Assert (Present (Vertex));
5403 return
5404 Edges_To_Targets_Iterator
5405 (DG.Iterate_Outgoing_Edges (G.Graph, Vertex));
5406 end Iterate_Edges_To_Targets;
5408 -------------------------------
5409 -- Iterate_Elaboration_Roots --
5410 -------------------------------
5412 function Iterate_Elaboration_Roots
5413 (G : Invocation_Graph) return Elaboration_Root_Iterator
5415 begin
5416 pragma Assert (Present (G));
5418 return Elaboration_Root_Iterator (IGV_Sets.Iterate (G.Roots));
5419 end Iterate_Elaboration_Roots;
5421 ----------
5422 -- Kind --
5423 ----------
5425 function Kind
5426 (G : Invocation_Graph;
5427 Edge : Invocation_Graph_Edge_Id) return Invocation_Kind
5429 begin
5430 pragma Assert (Present (G));
5431 pragma Assert (Present (Edge));
5433 return Kind (Relation (G, Edge));
5434 end Kind;
5436 -------------------
5437 -- Get_Lib_Graph --
5438 -------------------
5440 function Get_Lib_Graph
5441 (G : Invocation_Graph) return Library_Graphs.Library_Graph
5443 pragma Assert (Present (G));
5444 begin
5445 return G.Lib_Graph;
5446 end Get_Lib_Graph;
5448 ----------
5449 -- Line --
5450 ----------
5452 function Line
5453 (G : Invocation_Graph;
5454 Vertex : Invocation_Graph_Vertex_Id) return Nat
5456 begin
5457 pragma Assert (Present (G));
5458 pragma Assert (Present (Vertex));
5460 return Line (Signature (Construct (G, Vertex)));
5461 end Line;
5463 ----------
5464 -- Name --
5465 ----------
5467 function Name
5468 (G : Invocation_Graph;
5469 Vertex : Invocation_Graph_Vertex_Id) return Name_Id
5471 begin
5472 pragma Assert (Present (G));
5473 pragma Assert (Present (Vertex));
5475 return Name (Signature (Construct (G, Vertex)));
5476 end Name;
5478 ----------
5479 -- Next --
5480 ----------
5482 procedure Next
5483 (Iter : in out All_Edge_Iterator;
5484 Edge : out Invocation_Graph_Edge_Id)
5486 begin
5487 DG.Next (DG.All_Edge_Iterator (Iter), Edge);
5488 end Next;
5490 ----------
5491 -- Next --
5492 ----------
5494 procedure Next
5495 (Iter : in out All_Vertex_Iterator;
5496 Vertex : out Invocation_Graph_Vertex_Id)
5498 begin
5499 DG.Next (DG.All_Vertex_Iterator (Iter), Vertex);
5500 end Next;
5502 ----------
5503 -- Next --
5504 ----------
5506 procedure Next
5507 (Iter : in out Edges_To_Targets_Iterator;
5508 Edge : out Invocation_Graph_Edge_Id)
5510 begin
5511 DG.Next (DG.Outgoing_Edge_Iterator (Iter), Edge);
5512 end Next;
5514 ----------
5515 -- Next --
5516 ----------
5518 procedure Next
5519 (Iter : in out Elaboration_Root_Iterator;
5520 Root : out Invocation_Graph_Vertex_Id)
5522 begin
5523 IGV_Sets.Next (IGV_Sets.Iterator (Iter), Root);
5524 end Next;
5526 ---------------------
5527 -- Number_Of_Edges --
5528 ---------------------
5530 function Number_Of_Edges (G : Invocation_Graph) return Natural is
5531 begin
5532 pragma Assert (Present (G));
5534 return DG.Number_Of_Edges (G.Graph);
5535 end Number_Of_Edges;
5537 --------------------------------
5538 -- Number_Of_Edges_To_Targets --
5539 --------------------------------
5541 function Number_Of_Edges_To_Targets
5542 (G : Invocation_Graph;
5543 Vertex : Invocation_Graph_Vertex_Id) return Natural
5545 begin
5546 pragma Assert (Present (G));
5547 pragma Assert (Present (Vertex));
5549 return DG.Number_Of_Outgoing_Edges (G.Graph, Vertex);
5550 end Number_Of_Edges_To_Targets;
5552 ---------------------------------
5553 -- Number_Of_Elaboration_Roots --
5554 ---------------------------------
5556 function Number_Of_Elaboration_Roots
5557 (G : Invocation_Graph) return Natural
5559 begin
5560 pragma Assert (Present (G));
5562 return IGV_Sets.Size (G.Roots);
5563 end Number_Of_Elaboration_Roots;
5565 ------------------------
5566 -- Number_Of_Vertices --
5567 ------------------------
5569 function Number_Of_Vertices (G : Invocation_Graph) return Natural is
5570 begin
5571 pragma Assert (Present (G));
5573 return DG.Number_Of_Vertices (G.Graph);
5574 end Number_Of_Vertices;
5576 -------------
5577 -- Present --
5578 -------------
5580 function Present (G : Invocation_Graph) return Boolean is
5581 begin
5582 return G /= Nil;
5583 end Present;
5585 --------------
5586 -- Relation --
5587 --------------
5589 function Relation
5590 (G : Invocation_Graph;
5591 Edge : Invocation_Graph_Edge_Id) return Invocation_Relation_Id
5593 begin
5594 pragma Assert (Present (G));
5595 pragma Assert (Present (Edge));
5597 return Get_IGE_Attributes (G, Edge).Relation;
5598 end Relation;
5600 ---------------------------
5601 -- Save_Elaboration_Root --
5602 ---------------------------
5604 procedure Save_Elaboration_Root
5605 (G : Invocation_Graph;
5606 Root : Invocation_Graph_Vertex_Id)
5608 begin
5609 pragma Assert (Present (G));
5610 pragma Assert (Present (Root));
5612 IGV_Sets.Insert (G.Roots, Root);
5613 end Save_Elaboration_Root;
5615 ------------------------------
5616 -- Set_Corresponding_Vertex --
5617 ------------------------------
5619 procedure Set_Corresponding_Vertex
5620 (G : Invocation_Graph;
5621 IS_Id : Invocation_Signature_Id;
5622 Vertex : Invocation_Graph_Vertex_Id)
5624 begin
5625 pragma Assert (Present (G));
5626 pragma Assert (Present (IS_Id));
5627 pragma Assert (Present (Vertex));
5629 Signature_Tables.Put (G.Signature_To_Vertex, IS_Id, Vertex);
5630 end Set_Corresponding_Vertex;
5632 --------------------------------------------
5633 -- Set_Is_Existing_Source_Target_Relation --
5634 --------------------------------------------
5636 procedure Set_Is_Existing_Source_Target_Relation
5637 (G : Invocation_Graph;
5638 Rel : Source_Target_Relation)
5640 begin
5641 pragma Assert (Present (G));
5642 pragma Assert (Present (Rel.Source));
5643 pragma Assert (Present (Rel.Target));
5645 Relation_Sets.Insert (G.Relations, Rel);
5646 end Set_Is_Existing_Source_Target_Relation;
5648 ------------------------
5649 -- Set_IGE_Attributes --
5650 ------------------------
5652 procedure Set_IGE_Attributes
5653 (G : Invocation_Graph;
5654 Edge : Invocation_Graph_Edge_Id;
5655 Val : Invocation_Graph_Edge_Attributes)
5657 begin
5658 pragma Assert (Present (G));
5659 pragma Assert (Present (Edge));
5661 IGE_Tables.Put (G.Edge_Attributes, Edge, Val);
5662 end Set_IGE_Attributes;
5664 ------------------------
5665 -- Set_IGV_Attributes --
5666 ------------------------
5668 procedure Set_IGV_Attributes
5669 (G : Invocation_Graph;
5670 Vertex : Invocation_Graph_Vertex_Id;
5671 Val : Invocation_Graph_Vertex_Attributes)
5673 begin
5674 pragma Assert (Present (G));
5675 pragma Assert (Present (Vertex));
5677 IGV_Tables.Put (G.Vertex_Attributes, Vertex, Val);
5678 end Set_IGV_Attributes;
5680 -----------------
5681 -- Spec_Vertex --
5682 -----------------
5684 function Spec_Vertex
5685 (G : Invocation_Graph;
5686 Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id
5688 begin
5689 pragma Assert (Present (G));
5690 pragma Assert (Present (Vertex));
5692 return Get_IGV_Attributes (G, Vertex).Spec_Vertex;
5693 end Spec_Vertex;
5695 ------------
5696 -- Target --
5697 ------------
5699 function Target
5700 (G : Invocation_Graph;
5701 Edge : Invocation_Graph_Edge_Id) return Invocation_Graph_Vertex_Id
5703 begin
5704 pragma Assert (Present (G));
5705 pragma Assert (Present (Edge));
5707 return DG.Destination_Vertex (G.Graph, Edge);
5708 end Target;
5709 end Invocation_Graphs;
5711 -------------
5712 -- Present --
5713 -------------
5715 function Present (Edge : Invocation_Graph_Edge_Id) return Boolean is
5716 begin
5717 return Edge /= No_Invocation_Graph_Edge;
5718 end Present;
5720 -------------
5721 -- Present --
5722 -------------
5724 function Present (Vertex : Invocation_Graph_Vertex_Id) return Boolean is
5725 begin
5726 return Vertex /= No_Invocation_Graph_Vertex;
5727 end Present;
5729 -------------
5730 -- Present --
5731 -------------
5733 function Present (Cycle : Library_Graph_Cycle_Id) return Boolean is
5734 begin
5735 return Cycle /= No_Library_Graph_Cycle;
5736 end Present;
5738 -------------
5739 -- Present --
5740 -------------
5742 function Present (Edge : Library_Graph_Edge_Id) return Boolean is
5743 begin
5744 return Edge /= No_Library_Graph_Edge;
5745 end Present;
5747 -------------
5748 -- Present --
5749 -------------
5751 function Present (Vertex : Library_Graph_Vertex_Id) return Boolean is
5752 begin
5753 return Vertex /= No_Library_Graph_Vertex;
5754 end Present;
5756 --------------------------
5757 -- Sequence_Next_Edge --
5758 --------------------------
5760 IGE_Sequencer : Invocation_Graph_Edge_Id := First_Invocation_Graph_Edge;
5761 -- The counter for invocation graph edges. Do not directly manipulate its
5762 -- value.
5764 function Sequence_Next_Edge return Invocation_Graph_Edge_Id is
5765 Edge : constant Invocation_Graph_Edge_Id := IGE_Sequencer;
5767 begin
5768 IGE_Sequencer := IGE_Sequencer + 1;
5769 return Edge;
5770 end Sequence_Next_Edge;
5772 --------------------------
5773 -- Sequence_Next_Vertex --
5774 --------------------------
5776 IGV_Sequencer : Invocation_Graph_Vertex_Id := First_Invocation_Graph_Vertex;
5777 -- The counter for invocation graph vertices. Do not directly manipulate
5778 -- its value.
5780 function Sequence_Next_Vertex return Invocation_Graph_Vertex_Id is
5781 Vertex : constant Invocation_Graph_Vertex_Id := IGV_Sequencer;
5783 begin
5784 IGV_Sequencer := IGV_Sequencer + 1;
5785 return Vertex;
5786 end Sequence_Next_Vertex;
5788 --------------------------
5789 -- Sequence_Next_Cycle --
5790 --------------------------
5792 LGC_Sequencer : Library_Graph_Cycle_Id := First_Library_Graph_Cycle;
5793 -- The counter for library graph cycles. Do not directly manipulate its
5794 -- value.
5796 function Sequence_Next_Cycle return Library_Graph_Cycle_Id is
5797 Cycle : constant Library_Graph_Cycle_Id := LGC_Sequencer;
5799 begin
5800 LGC_Sequencer := LGC_Sequencer + 1;
5801 return Cycle;
5802 end Sequence_Next_Cycle;
5804 --------------------------
5805 -- Sequence_Next_Edge --
5806 --------------------------
5808 LGE_Sequencer : Library_Graph_Edge_Id := First_Library_Graph_Edge;
5809 -- The counter for library graph edges. Do not directly manipulate its
5810 -- value.
5812 function Sequence_Next_Edge return Library_Graph_Edge_Id is
5813 Edge : constant Library_Graph_Edge_Id := LGE_Sequencer;
5815 begin
5816 LGE_Sequencer := LGE_Sequencer + 1;
5817 return Edge;
5818 end Sequence_Next_Edge;
5820 --------------------------
5821 -- Sequence_Next_Vertex --
5822 --------------------------
5824 LGV_Sequencer : Library_Graph_Vertex_Id := First_Library_Graph_Vertex;
5825 -- The counter for library graph vertices. Do not directly manipulate its
5826 -- value.
5828 function Sequence_Next_Vertex return Library_Graph_Vertex_Id is
5829 Vertex : constant Library_Graph_Vertex_Id := LGV_Sequencer;
5831 begin
5832 LGV_Sequencer := LGV_Sequencer + 1;
5833 return Vertex;
5834 end Sequence_Next_Vertex;
5836 end Bindo.Graphs;