1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- B I N D O . G R A P H S --
9 -- Copyright (C) 2019-2023, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Ada
.Unchecked_Deallocation
;
28 with Butil
; use Butil
;
29 with Debug
; use Debug
;
30 with Output
; use Output
;
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
);
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
);
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
);
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
);
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
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
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
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
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
170 pragma Assert
(Present
(Vertex
));
172 return Bucket_Range_Type
(Vertex
);
173 end Hash_Library_Graph_Vertex
;
179 package body Library_Graphs
is
181 -----------------------
182 -- Local subprograms --
183 -----------------------
185 procedure Add_Body_Before_Spec_Edge
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
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
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.
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
227 function At_Least_One_Edge_Satisfies
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
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
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
267 function Cycle_Path_Precedence
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
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
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
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
297 procedure Delete_Edge
299 Edge
: Library_Graph_Edge_Id
);
300 pragma Inline
(Delete_Edge
);
301 -- Delete edge Edge from library graph G
303 function Edge_Precedence
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
311 procedure Find_Cycles_From_Successor
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
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
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
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
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
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
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
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
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.
446 new Ada
.Unchecked_Deallocation
447 (Library_Graph_Attributes
, Library_Graph
);
449 function Get_Component_Attributes
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
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
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
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
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
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
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
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
505 procedure Increment_Library_Graph_Edge_Count
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
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
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
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
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
547 function Is_Cyclic_Elaborate_All_Edge
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
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
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
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
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
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
591 function Is_Recorded_Edge
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
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
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
613 function Links_Vertices_In_Same_Component
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
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
635 procedure Order_Cycle
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.
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
649 procedure Record_Cycle
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
664 Edge
: Library_Graph_Edge_Id
);
665 -- Set the Activates_Task flag of the Edge to True
667 procedure Set_Component_Attributes
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
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
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
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
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
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
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
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.
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
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.
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;
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
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
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.
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.
794 function Activates_Task
796 Edge
: Library_Graph_Edge_Id
) return Boolean
799 return Get_LGE_Attributes
(G
, Edge
).Activates_Task
;
802 -------------------------------
803 -- Add_Body_Before_Spec_Edge --
804 -------------------------------
806 procedure Add_Body_Before_Spec_Edge
808 Vertex
: Library_Graph_Vertex_Id
;
809 Edges
: LGE_Lists
.Doubly_Linked_List
)
811 Edge
: Library_Graph_Edge_Id
;
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
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
856 Pred
=> Corresponding_Item
(G
, Vertex
),
858 Kind
=> Body_Before_Spec_Edge
,
859 Activates_Task
=> False);
862 if Present
(Edge
) then
863 LGE_Lists
.Append
(Edges
, Edge
);
865 end Add_Body_Before_Spec_Edge
;
867 --------------------------------
868 -- Add_Body_Before_Spec_Edges --
869 --------------------------------
871 procedure Add_Body_Before_Spec_Edges
873 Edges
: LGE_Lists
.Doubly_Linked_List
)
875 Iter
: Elaborable_Units_Iterator
;
879 pragma Assert
(Present
(G
));
880 pragma Assert
(LGE_Lists
.Present
(Edges
));
882 Iter
:= Iterate_Elaborable_Units
;
883 while Has_Next
(Iter
) loop
886 Add_Body_Before_Spec_Edge
888 Vertex
=> Corresponding_Vertex
(G
, U_Id
),
891 end Add_Body_Before_Spec_Edges
;
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
:=
910 Activates_Task
=> Activates_Task
);
915 -------------------------
916 -- Add_Edge_Kind_Check --
917 -------------------------
919 procedure Add_Edge_Kind_Check
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
;
932 when Spec_Before_Body_Edge
=>
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.
961 raise Program_Error
with Old_Kind
'Img & "-->" & New_Kind
'Img;
963 end Add_Edge_Kind_Check
;
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
;
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
));
1002 return No_Library_Graph_Edge
;
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.
1015 Destination
=> Succ
);
1017 -- Construct and save the attributes of the edge
1023 (Activates_Task
=> Activates_Task
,
1026 -- Mark the predecessor and successor as related by the new edge.
1027 -- This prevents all further attempts to link the same predecessor
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
1040 -- Update the edge statistics
1042 Increment_Library_Graph_Edge_Count
(G
, Kind
);
1051 procedure Add_Vertex
1055 Vertex
: Library_Graph_Vertex_Id
;
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
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
1079 (Corresponding_Item
=> No_Library_Graph_Vertex
,
1080 In_Elaboration_Order
=> False,
1081 Pending_Strong_Predecessors
=> 0,
1082 Pending_Weak_Predecessors
=> 0,
1085 -- Associate the unit with its corresponding vertex
1087 Set_Corresponding_Vertex
(G
, U_Id
, Vertex
);
1090 ---------------------------------
1091 -- At_Least_One_Edge_Satisfies --
1092 ---------------------------------
1094 function At_Least_One_Edge_Satisfies
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;
1104 pragma Assert
(Present
(G
));
1105 pragma Assert
(Present
(Cycle
));
1106 pragma Assert
(Predicate
/= null);
1108 -- Assume that the predicate cannot be satisfied
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
1121 Satisfied
:= Satisfied
or else Predicate
.all (G
, Edge
);
1125 end At_Least_One_Edge_Satisfies
;
1127 --------------------------
1128 -- Complementary_Vertex --
1129 --------------------------
1131 function Complementary_Vertex
1133 Vertex
: Library_Graph_Vertex_Id
;
1134 Force_Complement
: Boolean) return Library_Graph_Vertex_Id
1136 Complement
: Library_Graph_Vertex_Id
;
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
);
1165 end Complementary_Vertex
;
1173 Vertex
: Library_Graph_Vertex_Id
) return Component_Id
1176 pragma Assert
(Present
(G
));
1177 pragma Assert
(Present
(Vertex
));
1179 return DG
.Component
(G
.Graph
, Vertex
);
1182 ---------------------------------
1183 -- Contains_Elaborate_All_Edge --
1184 ---------------------------------
1186 function Contains_Elaborate_All_Edge
1188 Cycle
: Library_Graph_Cycle_Id
) return Boolean
1191 pragma Assert
(Present
(G
));
1192 pragma Assert
(Present
(Cycle
));
1195 At_Least_One_Edge_Satisfies
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
1207 Cycle
: Library_Graph_Cycle_Id
) return Boolean
1210 pragma Assert
(Present
(G
));
1211 pragma Assert
(Present
(Cycle
));
1214 At_Least_One_Edge_Satisfies
1217 Predicate
=> Is_Static_Successor_Edge
'Access);
1218 end Contains_Static_Successor_Edge
;
1220 ------------------------------
1221 -- Contains_Task_Activation --
1222 ------------------------------
1224 function Contains_Task_Activation
1226 Cycle
: Library_Graph_Cycle_Id
) return Boolean
1229 pragma Assert
(Present
(G
));
1230 pragma Assert
(Present
(Cycle
));
1233 At_Least_One_Edge_Satisfies
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
;
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
);
1263 end Copy_Cycle_Path
;
1265 ------------------------
1266 -- Corresponding_Item --
1267 ------------------------
1269 function Corresponding_Item
1271 Vertex
: Library_Graph_Vertex_Id
) return Library_Graph_Vertex_Id
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
1286 U_Id
: Unit_Id
) return Library_Graph_Vertex_Id
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
;
1300 (Initial_Vertices
: Positive;
1301 Initial_Edges
: Positive) return Library_Graph
1303 G
: constant Library_Graph
:= new Library_Graph_Attributes
;
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
);
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
);
1321 ------------------------
1322 -- Cycle_End_Vertices --
1323 ------------------------
1325 function Cycle_End_Vertices
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
;
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
)
1351 Complementary_Vertex
1354 Force_Complement
=> Elaborate_All_Active
);
1356 if Present
(Complement
) then
1357 LGV_Sets
.Insert
(End_Vertices
, Complement
);
1361 return End_Vertices
;
1362 end Cycle_End_Vertices
;
1368 function Cycle_Kind_Of
1370 Edge
: Library_Graph_Edge_Id
) return Library_Graph_Cycle_Kind
1372 pragma Assert
(Present
(G
));
1373 pragma Assert
(Present
(Edge
));
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
;
1392 return No_Cycle_Kind
;
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
);
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
;
1418 return Equal_Precedence
;
1420 end Cycle_Kind_Precedence
;
1422 ---------------------------
1423 -- Cycle_Path_Precedence --
1424 ---------------------------
1426 function Cycle_Path_Precedence
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
)
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
);
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
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
);
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
)
1495 Compared_To
=> Comp_Edge
);
1498 Next_Available
(Comp_Iter
, Comp_Edge
);
1499 Next_Available
(Path_Iter
, Path_Edge
);
1503 end Cycle_Path_Precedence
;
1505 ----------------------
1506 -- Cycle_Precedence --
1507 ----------------------
1509 function Cycle_Precedence
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
));
1529 -- Prefer a cycle with higher precedence based on its kind
1531 if Kind_Prec
= Higher_Precedence
1533 Kind_Prec
= Lower_Precedence
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
1557 Cycle_Path_Precedence
1559 Path
=> Path
(G
, Cycle
),
1560 Compared_To
=> Path
(G
, Compared_To
));
1562 end Cycle_Precedence
;
1564 ----------------------------------------
1565 -- Decrement_Library_Graph_Edge_Count --
1566 ----------------------------------------
1568 procedure Decrement_Library_Graph_Edge_Count
1570 Kind
: Library_Graph_Edge_Kind
)
1572 pragma Assert
(Present
(G
));
1574 Count
: Natural renames G
.Counts
(Kind
);
1578 end Decrement_Library_Graph_Edge_Count
;
1580 ------------------------------------
1581 -- Decrement_Pending_Predecessors --
1582 ------------------------------------
1584 procedure Decrement_Pending_Predecessors
1586 Comp
: Component_Id
;
1587 Edge
: Library_Graph_Edge_Id
)
1589 Attrs
: Component_Attributes
;
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
),
1603 Set_Component_Attributes
(G
, Comp
, Attrs
);
1604 end Decrement_Pending_Predecessors
;
1606 ------------------------------------
1607 -- Decrement_Pending_Predecessors --
1608 ------------------------------------
1610 procedure Decrement_Pending_Predecessors
1612 Vertex
: Library_Graph_Vertex_Id
;
1613 Edge
: Library_Graph_Edge_Id
)
1615 Attrs
: Library_Graph_Vertex_Attributes
;
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
),
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
1638 Edges
: LGE_Lists
.Doubly_Linked_List
)
1640 Edge
: Library_Graph_Edge_Id
;
1641 Iter
: LGE_Lists
.Iterator
;
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
);
1654 end Delete_Body_Before_Spec_Edges
;
1660 procedure Delete_Edge
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
,
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
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
);
1704 procedure Destroy
(G
: in out Library_Graph
) is
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
);
1720 ----------------------------------
1721 -- Destroy_Component_Attributes --
1722 ----------------------------------
1724 procedure Destroy_Component_Attributes
1725 (Attrs
: in out Component_Attributes
)
1727 pragma Unreferenced
(Attrs
);
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
)
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
);
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
);
1765 end Destroy_Library_Graph_Vertex_Attributes
;
1767 ---------------------
1768 -- Edge_Precedence --
1769 ---------------------
1771 function Edge_Precedence
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
:=
1791 Vertex
=> Edge_Succ
,
1792 Compared_To
=> Comp_Succ
);
1795 -- Prefer an edge with a higher cycle kind precedence
1797 if Kind_Prec
= Higher_Precedence
1799 Kind_Prec
= Lower_Precedence
1803 -- Prefer an edge whose successor has a higher precedence
1805 elsif Comp_Succ
/= Edge_Succ
1806 and then (Succ_Prec
= Higher_Precedence
1808 Succ_Prec
= Lower_Precedence
)
1812 -- Prefer an edge whose predecessor has a higher precedence
1818 Vertex
=> Predecessor
(G
, Edge
),
1819 Compared_To
=> Predecessor
(G
, Compared_To
));
1821 end Edge_Precedence
;
1829 Vertex
: Library_Graph_Vertex_Id
) return File_Name_Type
1832 pragma Assert
(Present
(G
));
1833 pragma Assert
(Present
(Vertex
));
1835 return File_Name
(Unit
(G
, Vertex
));
1838 ---------------------
1839 -- Find_Components --
1840 ---------------------
1842 procedure Find_Components
(G
: Library_Graph
) is
1843 Edges
: LGE_Lists
.Doubly_Linked_List
;
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
;
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
;
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
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
1925 -- Run the modified version of the algorithm on each component of the
1928 Iter
:= Iterate_Components
(G
);
1929 while Has_Next
(Iter
) loop
1932 Find_Cycles_In_Component
1935 Cycle_Count
=> Cycle_Count
,
1936 Cycle_Limit
=> All_Cycle_Limit
);
1939 End_Phase
(Cycle_Discovery
);
1942 --------------------------------
1943 -- Find_Cycles_From_Successor --
1944 --------------------------------
1946 procedure Find_Cycles_From_Successor
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
;
1975 -- Assume that the successor reached via the edge does not result in
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
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
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
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
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.
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
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
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
2081 elsif not Is_Start_Vertex
2082 and then LGV_Sets
.Contains
(End_Vertices
, Vertex
)
2084 Trace_Vertex
(G
, Vertex
, Indent
);
2088 Most_Significant_Edge
=> Most_Significant_Edge
,
2089 Invocation_Edge_Count
=> Invocation_Edge_Count
,
2090 Cycle_Path
=> Cycle_Path_Stack
,
2094 Cycle_Count
:= Cycle_Count
+ 1;
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
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
2114 Trace_Vertex
(G
, Vertex
, Indent
);
2116 -- Mark the vertex as visited
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
2129 Find_Cycles_From_Successor
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
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
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
;
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
)
2174 Complementary_Vertex
2177 Force_Complement
=> Elaborate_All_Active
);
2179 if Present
(Complement
) then
2180 Find_Cycles_From_Vertex
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
,
2197 Has_Cycle
:= Has_Cycle
or Complement_Has_Cycle
;
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
2209 -- The modified version handles both cases in one place.
2211 if Has_Cycle
or else Is_Start_Vertex
then
2214 Visited_Set
=> Visited_Set
,
2215 Visited_Stack
=> Visited_Stack
);
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
);
2225 end Find_Cycles_From_Vertex
;
2227 ------------------------------
2228 -- Find_Cycles_In_Component --
2229 ------------------------------
2231 procedure Find_Cycles_In_Component
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
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
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.
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
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
);
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
;
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
);
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
2380 if Succ
= Successor
(G
, Edge
) then
2381 pragma Assert
(not Present
(Result
));
2386 pragma Assert
(Present
(Result
));
2390 ---------------------------------------
2391 -- Find_First_Lower_Precedence_Cycle --
2392 ---------------------------------------
2394 function Find_First_Lower_Precedence_Cycle
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
;
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
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
2426 Compared_To
=> Current_Cycle
) = Higher_Precedence
2428 Lesser_Cycle
:= Current_Cycle
;
2432 return Lesser_Cycle
;
2433 end Find_First_Lower_Precedence_Cycle
;
2435 ------------------------------
2436 -- Get_Component_Attributes --
2437 ------------------------------
2439 function Get_Component_Attributes
2441 Comp
: Component_Id
) return Component_Attributes
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
2456 Cycle
: Library_Graph_Cycle_Id
) return Library_Graph_Cycle_Attributes
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
2471 Edge
: Library_Graph_Edge_Id
) return Library_Graph_Edge_Attributes
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
2486 Vertex
: Library_Graph_Vertex_Id
)
2487 return Library_Graph_Vertex_Attributes
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
;
2506 pragma Assert
(Present
(G
));
2508 -- Assume that no cyclic Elaborate_All edge has been seen
2514 -- * The iteration must run to completion in order to unlock the
2517 Iter
:= Iterate_All_Edges
(G
);
2518 while Has_Next
(Iter
) loop
2521 if not Seen
and then Is_Cyclic_Elaborate_All_Edge
(G
, Edge
) then
2527 end Has_Elaborate_All_Cycle
;
2529 ----------------------------
2530 -- Has_Elaborate_All_Edge --
2531 ----------------------------
2533 function Has_Elaborate_All_Edge
2535 Comp
: Component_Id
) return Boolean
2538 Iter
: Component_Vertex_Iterator
;
2539 Vertex
: Library_Graph_Vertex_Id
;
2542 pragma Assert
(Present
(G
));
2543 pragma Assert
(Present
(Comp
));
2545 -- Assume that there is no Elaborate_All edge
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
);
2562 end Has_Elaborate_All_Edge
;
2564 ----------------------------
2565 -- Has_Elaborate_All_Edge --
2566 ----------------------------
2568 function Has_Elaborate_All_Edge
2570 Vertex
: Library_Graph_Vertex_Id
) return Boolean
2572 Edge
: Library_Graph_Edge_Id
;
2574 Iter
: Edges_To_Successors_Iterator
;
2577 pragma Assert
(Present
(G
));
2578 pragma Assert
(Present
(Vertex
));
2580 -- Assume that there is no Elaborate_All edge
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
2594 Has_Edge
or else Is_Cyclic_Elaborate_All_Edge
(G
, Edge
);
2598 end Has_Elaborate_All_Edge
;
2600 ------------------------
2601 -- Has_Elaborate_Body --
2602 ------------------------
2604 function Has_Elaborate_Body
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
);
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
;
2625 function Has_Next
(Iter
: All_Cycle_Iterator
) return Boolean is
2627 return LGC_Lists
.Has_Next
(LGC_Lists
.Iterator
(Iter
));
2634 function Has_Next
(Iter
: All_Edge_Iterator
) return Boolean is
2636 return DG
.Has_Next
(DG
.All_Edge_Iterator
(Iter
));
2643 function Has_Next
(Iter
: All_Vertex_Iterator
) return Boolean is
2645 return DG
.Has_Next
(DG
.All_Vertex_Iterator
(Iter
));
2652 function Has_Next
(Iter
: Component_Iterator
) return Boolean is
2654 return DG
.Has_Next
(DG
.Component_Iterator
(Iter
));
2661 function Has_Next
(Iter
: Component_Vertex_Iterator
) return Boolean is
2663 return DG
.Has_Next
(DG
.Component_Vertex_Iterator
(Iter
));
2670 function Has_Next
(Iter
: Edges_Of_Cycle_Iterator
) return Boolean is
2672 return LGE_Lists
.Has_Next
(LGE_Lists
.Iterator
(Iter
));
2679 function Has_Next
(Iter
: Edges_To_Successors_Iterator
) return Boolean is
2681 return DG
.Has_Next
(DG
.Outgoing_Edge_Iterator
(Iter
));
2684 -----------------------------
2685 -- Has_No_Elaboration_Code --
2686 -----------------------------
2688 function Has_No_Elaboration_Code
2690 Vertex
: Library_Graph_Vertex_Id
) return Boolean
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
;
2711 pragma Assert
(LGE_Lists
.Present
(Attrs
.Path
));
2713 -- The hash is obtained in the following manner:
2715 -- (((edge1 * 31) + edge2) * 31) + edgeN
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
);
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
2736 pragma Assert
(Present
(Rel
.Predecessor
));
2737 pragma Assert
(Present
(Rel
.Successor
));
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
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
2763 return LGC_Lists
.First
(G
.Cycles
);
2765 end Highest_Precedence_Cycle
;
2767 -----------------------------
2768 -- Highest_Precedence_Edge --
2769 -----------------------------
2771 function Highest_Precedence_Edge
2773 Left
: Library_Graph_Edge_Id
;
2774 Right
: Library_Graph_Edge_Id
) return Library_Graph_Edge_Id
2776 Edge_Prec
: Precedence_Kind
;
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
2788 Compared_To
=> Right
);
2790 if Edge_Prec
= Higher_Precedence
then
2793 -- The precedence rules for edges are such that no two edges can
2794 -- ever have the same precedence.
2797 pragma Assert
(Edge_Prec
= Lower_Precedence
);
2801 -- Otherwise at least one edge must be present
2803 elsif Present
(Left
) then
2807 pragma Assert
(Present
(Right
));
2811 end Highest_Precedence_Edge
;
2813 --------------------------
2814 -- In_Elaboration_Order --
2815 --------------------------
2817 function In_Elaboration_Order
2819 Vertex
: Library_Graph_Vertex_Id
) return Boolean
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
2834 Left
: Library_Graph_Vertex_Id
;
2835 Right
: Library_Graph_Vertex_Id
) return Boolean
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
2851 Kind
: Library_Graph_Edge_Kind
)
2853 pragma Assert
(Present
(G
));
2855 Count
: Natural renames G
.Counts
(Kind
);
2859 end Increment_Library_Graph_Edge_Count
;
2861 ------------------------------------
2862 -- Increment_Pending_Predecessors --
2863 ------------------------------------
2865 procedure Increment_Pending_Predecessors
2867 Comp
: Component_Id
;
2868 Edge
: Library_Graph_Edge_Id
)
2870 Attrs
: Component_Attributes
;
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
),
2884 Set_Component_Attributes
(G
, Comp
, Attrs
);
2885 end Increment_Pending_Predecessors
;
2887 ------------------------------------
2888 -- Increment_Pending_Predecessors --
2889 ------------------------------------
2891 procedure Increment_Pending_Predecessors
2893 Vertex
: Library_Graph_Vertex_Id
;
2894 Edge
: Library_Graph_Edge_Id
)
2896 Attrs
: Library_Graph_Vertex_Attributes
;
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
),
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
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
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
));
2931 end Initialize_Components
;
2933 ---------------------------
2934 -- Invocation_Edge_Count --
2935 ---------------------------
2937 function Invocation_Edge_Count
2939 Cycle
: Library_Graph_Cycle_Id
) return Natural
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
2954 Vertex
: Library_Graph_Vertex_Id
)
2955 return Invocation_Graph_Encoding_Kind
2958 pragma Assert
(Present
(G
));
2959 pragma Assert
(Present
(Vertex
));
2961 return Invocation_Graph_Encoding
(Unit
(G
, Vertex
));
2962 end Invocation_Graph_Encoding
;
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
);
2979 return U_Rec
.Utype
= Is_Body
or else U_Rec
.Utype
= Is_Body_Only
;
2982 -----------------------------------------
2983 -- Is_Body_Of_Spec_With_Elaborate_Body --
2984 -----------------------------------------
2986 function Is_Body_Of_Spec_With_Elaborate_Body
2988 Vertex
: Library_Graph_Vertex_Id
) return Boolean
2991 pragma Assert
(Present
(G
));
2992 pragma Assert
(Present
(Vertex
));
2994 if Is_Body_With_Spec
(G
, Vertex
) then
2996 Is_Spec_With_Elaborate_Body
2998 Vertex
=> Proper_Spec
(G
, Vertex
));
3002 end Is_Body_Of_Spec_With_Elaborate_Body
;
3004 -----------------------
3005 -- Is_Body_With_Spec --
3006 -----------------------
3008 function Is_Body_With_Spec
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
);
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
3028 Edge
: Library_Graph_Edge_Id
) return Boolean
3031 pragma Assert
(Present
(G
));
3032 pragma Assert
(Present
(Edge
));
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
3048 Edge
: Library_Graph_Edge_Id
) return Boolean
3051 pragma Assert
(Present
(G
));
3052 pragma Assert
(Present
(Edge
));
3055 Is_Cycle_Initiating_Edge
(G
, Edge
)
3056 or else Is_Cyclic_With_Edge
(G
, Edge
);
3059 ----------------------------------
3060 -- Is_Cyclic_Elaborate_All_Edge --
3061 ----------------------------------
3063 function Is_Cyclic_Elaborate_All_Edge
3065 Edge
: Library_Graph_Edge_Id
) return Boolean
3068 pragma Assert
(Present
(G
));
3069 pragma Assert
(Present
(Edge
));
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
3082 Edge
: Library_Graph_Edge_Id
) return Boolean
3085 pragma Assert
(Present
(G
));
3086 pragma Assert
(Present
(Edge
));
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
3099 Edge
: Library_Graph_Edge_Id
) return Boolean
3102 pragma Assert
(Present
(G
));
3103 pragma Assert
(Present
(Edge
));
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
3116 Edge
: Library_Graph_Edge_Id
) return Boolean
3119 pragma Assert
(Present
(G
));
3120 pragma Assert
(Present
(Edge
));
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
3133 Edge
: Library_Graph_Edge_Id
) return Boolean
3136 pragma Assert
(Present
(G
));
3137 pragma Assert
(Present
(Edge
));
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
3150 Edge
: Library_Graph_Edge_Id
) return Boolean
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.
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
3171 Vertex
: Library_Graph_Vertex_Id
) return Boolean
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
3186 Comp
: Component_Id
) return Boolean
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
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
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
3217 Force_Complement
=> False);
3219 Strong_Preds
: Natural;
3220 Weak_Preds
: Natural;
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
3235 elsif Present
(Complement
)
3236 and then In_Elaboration_Order
(G
, Complement
)
3240 elsif not Is_Elaborable_Component
(G
, Component
(G
, Vertex
)) then
3244 Pending_Predecessors_For_Elaboration
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
3259 Edge
: Library_Graph_Edge_Id
) return Boolean
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
3274 Edge
: Library_Graph_Edge_Id
) return Boolean
3277 pragma Assert
(Present
(G
));
3278 pragma Assert
(Present
(Edge
));
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
3291 Edge
: Library_Graph_Edge_Id
) return Boolean
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
3306 Spec_Vertex
: Library_Graph_Vertex_Id
;
3307 Body_Vertex
: Library_Graph_Vertex_Id
) return Boolean
3310 pragma Assert
(Present
(G
));
3311 pragma Assert
(Present
(Spec_Vertex
));
3312 pragma Assert
(Present
(Body_Vertex
));
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
3326 Edge
: Library_Graph_Edge_Id
) return Boolean
3329 pragma Assert
(Present
(G
));
3330 pragma Assert
(Present
(Edge
));
3332 return Kind
(G
, Edge
) = Forced_Edge
;
3335 ----------------------
3336 -- Is_Internal_Unit --
3337 ----------------------
3339 function Is_Internal_Unit
3341 Vertex
: Library_Graph_Vertex_Id
) return Boolean
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
3356 Edge
: Library_Graph_Edge_Id
) return Boolean
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
3371 Vertex
: Library_Graph_Vertex_Id
) return Boolean
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
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
);
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
3404 Rel
: Predecessor_Successor_Relation
) return Boolean
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
;
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
);
3429 return U_Rec
.Utype
= Is_Spec
or else U_Rec
.Utype
= Is_Spec_Only
;
3432 ------------------------------
3433 -- Is_Spec_Before_Body_Edge --
3434 ------------------------------
3436 function Is_Spec_Before_Body_Edge
3438 Edge
: Library_Graph_Edge_Id
) return Boolean
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
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
);
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
3471 Vertex
: Library_Graph_Vertex_Id
) return Boolean
3474 pragma Assert
(Present
(G
));
3475 pragma Assert
(Present
(Vertex
));
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
3488 Edge
: Library_Graph_Edge_Id
) return Boolean
3491 pragma Assert
(Present
(G
));
3492 pragma Assert
(Present
(Edge
));
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
3505 Vertex
: Library_Graph_Vertex_Id
) return Boolean
3508 pragma Assert
(Present
(G
));
3509 pragma Assert
(Present
(Vertex
));
3512 Is_Spec_With_Elaborate_Body
(G
, Vertex
)
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
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
3532 Force_Complement
=> False);
3534 Strong_Preds
: Natural;
3535 Weak_Preds
: Natural;
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
3550 elsif Present
(Complement
)
3551 and then In_Elaboration_Order
(G
, Complement
)
3555 elsif not Is_Elaborable_Component
(G
, Component
(G
, Vertex
)) then
3559 Pending_Predecessors_For_Elaboration
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
;
3572 function Is_With_Edge
3574 Edge
: Library_Graph_Edge_Id
) return Boolean
3577 pragma Assert
(Present
(G
));
3578 pragma Assert
(Present
(Edge
));
3580 return Kind
(G
, Edge
) = With_Edge
;
3583 ------------------------
3584 -- Iterate_All_Cycles --
3585 ------------------------
3587 function Iterate_All_Cycles
3588 (G
: Library_Graph
) return All_Cycle_Iterator
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
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
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
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
3641 Comp
: Component_Id
) return Component_Vertex_Iterator
3644 pragma Assert
(Present
(G
));
3645 pragma Assert
(Present
(Comp
));
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
3658 Cycle
: Library_Graph_Cycle_Id
) return Edges_Of_Cycle_Iterator
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
3673 Vertex
: Library_Graph_Vertex_Id
) return Edges_To_Successors_Iterator
3676 pragma Assert
(Present
(G
));
3677 pragma Assert
(Present
(Vertex
));
3680 Edges_To_Successors_Iterator
3681 (DG
.Iterate_Outgoing_Edges
(G
.Graph
, Vertex
));
3682 end Iterate_Edges_To_Successors
;
3690 Cycle
: Library_Graph_Cycle_Id
) return Library_Graph_Cycle_Kind
3693 pragma Assert
(Present
(G
));
3694 pragma Assert
(Present
(Cycle
));
3696 return Get_LGC_Attributes
(G
, Cycle
).Kind
;
3705 Edge
: Library_Graph_Edge_Id
) return Library_Graph_Edge_Kind
3708 return Get_LGE_Attributes
(G
, Edge
).Kind
;
3717 Cycle
: Library_Graph_Cycle_Id
) return Natural
3720 pragma Assert
(Present
(G
));
3721 pragma Assert
(Present
(Cycle
));
3723 return LGE_Lists
.Size
(Path
(G
, Cycle
));
3726 ------------------------------
3727 -- Library_Graph_Edge_Count --
3728 ------------------------------
3730 function Library_Graph_Edge_Count
3732 Kind
: Library_Graph_Edge_Kind
) return Natural
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
3746 Edge
: Library_Graph_Edge_Id
) return Boolean
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.
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
3768 Edge
: Library_Graph_Edge_Id
;
3769 Count
: Natural) return Natural
3771 New_Count
: Natural;
3774 pragma Assert
(Present
(G
));
3778 if Present
(Edge
) and then Is_Invocation_Edge
(G
, Edge
) then
3779 New_Count
:= New_Count
+ 1;
3783 end Maximum_Invocation_Edge_Count
;
3791 Vertex
: Library_Graph_Vertex_Id
) return Unit_Name_Type
3794 pragma Assert
(Present
(G
));
3795 pragma Assert
(Present
(Vertex
));
3797 return Name
(Unit
(G
, Vertex
));
3800 -----------------------
3801 -- Needs_Elaboration --
3802 -----------------------
3804 function Needs_Elaboration
3806 Vertex
: Library_Graph_Vertex_Id
) return Boolean
3809 pragma Assert
(Present
(G
));
3810 pragma Assert
(Present
(Vertex
));
3812 return Needs_Elaboration
(Unit
(G
, Vertex
));
3813 end Needs_Elaboration
;
3820 (Iter
: in out All_Cycle_Iterator
;
3821 Cycle
: out Library_Graph_Cycle_Id
)
3824 LGC_Lists
.Next
(LGC_Lists
.Iterator
(Iter
), Cycle
);
3832 (Iter
: in out All_Edge_Iterator
;
3833 Edge
: out Library_Graph_Edge_Id
)
3836 DG
.Next
(DG
.All_Edge_Iterator
(Iter
), Edge
);
3844 (Iter
: in out All_Vertex_Iterator
;
3845 Vertex
: out Library_Graph_Vertex_Id
)
3848 DG
.Next
(DG
.All_Vertex_Iterator
(Iter
), Vertex
);
3856 (Iter
: in out Edges_Of_Cycle_Iterator
;
3857 Edge
: out Library_Graph_Edge_Id
)
3860 LGE_Lists
.Next
(LGE_Lists
.Iterator
(Iter
), Edge
);
3868 (Iter
: in out Component_Iterator
;
3869 Comp
: out Component_Id
)
3872 DG
.Next
(DG
.Component_Iterator
(Iter
), Comp
);
3880 (Iter
: in out Edges_To_Successors_Iterator
;
3881 Edge
: out Library_Graph_Edge_Id
)
3884 DG
.Next
(DG
.Outgoing_Edge_Iterator
(Iter
), Edge
);
3892 (Iter
: in out Component_Vertex_Iterator
;
3893 Vertex
: out Library_Graph_Vertex_Id
)
3896 DG
.Next
(DG
.Component_Vertex_Iterator
(Iter
), Vertex
);
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
;
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
3922 if Edge
= Most_Significant_Edge
then
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
3930 LGE_Lists
.Delete_First
(Cycle_Path
);
3931 LGE_Lists
.Append
(Cycle_Path
, Edge
);
3935 pragma Assert
(False);
3936 end Normalize_Cycle_Path
;
3938 ----------------------------------
3939 -- Number_Of_Component_Vertices --
3940 ----------------------------------
3942 function Number_Of_Component_Vertices
3944 Comp
: Component_Id
) return Natural
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
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
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
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
3992 Vertex
: Library_Graph_Vertex_Id
) return Natural
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
4006 pragma Assert
(Present
(G
));
4008 return DG
.Number_Of_Vertices
(G
.Graph
);
4009 end Number_Of_Vertices
;
4015 procedure Order_Cycle
4017 Cycle
: Library_Graph_Cycle_Id
)
4019 Lesser_Cycle
: Library_Graph_Cycle_Id
;
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.
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
4043 Before
=> Lesser_Cycle
,
4046 -- Otherwise the input cycle has the lowest precedence among all
4050 LGC_Lists
.Append
(G
.Cycles
, Cycle
);
4061 Cycle
: Library_Graph_Cycle_Id
) return LGE_Lists
.Doubly_Linked_List
4064 pragma Assert
(Present
(G
));
4065 pragma Assert
(Present
(Cycle
));
4067 return Get_LGC_Attributes
(G
, Cycle
).Path
;
4070 ------------------------------------------
4071 -- Pending_Predecessors_For_Elaboration --
4072 ------------------------------------------
4074 procedure Pending_Predecessors_For_Elaboration
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;
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
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
;
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
;
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;
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
4137 Comp
: Component_Id
) return Natural
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
4152 Vertex
: Library_Graph_Vertex_Id
) return Natural
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
4167 Comp
: Component_Id
) return Natural
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
4182 Vertex
: Library_Graph_Vertex_Id
) return Natural
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
;
4195 function Predecessor
4197 Edge
: Library_Graph_Edge_Id
) return Library_Graph_Vertex_Id
4200 pragma Assert
(Present
(G
));
4201 pragma Assert
(Present
(Edge
));
4203 return DG
.Source_Vertex
(G
.Graph
, Edge
);
4210 function Present
(G
: Library_Graph
) return Boolean is
4219 function Proper_Body
4221 Vertex
: Library_Graph_Vertex_Id
) return Library_Graph_Vertex_Id
4224 pragma Assert
(Present
(G
));
4225 pragma Assert
(Present
(Vertex
));
4227 -- When the vertex denotes a spec with a completing body, return the
4230 if Is_Spec_With_Body
(G
, Vertex
) then
4231 return Corresponding_Item
(G
, Vertex
);
4233 -- Otherwise the vertex must be a body
4236 pragma Assert
(Is_Body
(G
, Vertex
));
4245 function Proper_Spec
4247 Vertex
: Library_Graph_Vertex_Id
) return Library_Graph_Vertex_Id
4250 pragma Assert
(Present
(G
));
4251 pragma Assert
(Present
(Vertex
));
4253 -- When the vertex denotes a body that completes a spec, return the
4256 if Is_Body_With_Spec
(G
, Vertex
) then
4257 return Corresponding_Item
(G
, Vertex
);
4259 -- Otherwise the vertex must denote a spec
4262 pragma Assert
(Is_Spec
(G
, Vertex
));
4271 procedure Record_Cycle
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
;
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
;
4306 (Invocation_Edge_Count
=> Invocation_Edge_Count
,
4310 Edge
=> Most_Significant_Edge
),
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
);
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
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
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
4349 Edge
: Library_Graph_Edge_Id
)
4351 Attributes
: Library_Graph_Edge_Attributes
:=
4352 Get_LGE_Attributes
(G
, Edge
);
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
4364 Comp
: Component_Id
;
4365 Val
: Component_Attributes
)
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
4380 Vertex
: Library_Graph_Vertex_Id
;
4381 Val
: Library_Graph_Vertex_Id
)
4383 Attrs
: Library_Graph_Vertex_Attributes
;
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
4401 Val
: Library_Graph_Vertex_Id
)
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
4416 Vertex
: Library_Graph_Vertex_Id
;
4417 Val
: Boolean := True)
4419 Attrs
: Library_Graph_Vertex_Attributes
;
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
4436 Rel
: Predecessor_Successor_Relation
)
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
4452 Cycle
: Library_Graph_Cycle_Id
;
4453 Val
: Library_Graph_Cycle_Attributes
)
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
4468 Edge
: Library_Graph_Edge_Id
;
4469 Val
: Library_Graph_Edge_Attributes
)
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
4484 Vertex
: Library_Graph_Vertex_Id
;
4485 Val
: Library_Graph_Vertex_Attributes
)
4488 pragma Assert
(Present
(G
));
4489 pragma Assert
(Present
(Vertex
));
4491 LGV_Tables
.Put
(G
.Vertex_Attributes
, Vertex
, Val
);
4492 end Set_LGV_Attributes
;
4500 Edge
: Library_Graph_Edge_Id
) return Library_Graph_Vertex_Id
4503 pragma Assert
(Present
(G
));
4504 pragma Assert
(Present
(Edge
));
4506 return DG
.Destination_Vertex
(G
.Graph
, Edge
);
4509 ---------------------
4510 -- Trace_Component --
4511 ---------------------
4513 procedure Trace_Component
4515 Comp
: Component_Id
;
4516 Indent
: Indentation_Level
)
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
4531 Write_Str
("component (Comp_");
4532 Write_Int
(Int
(Comp
));
4535 end Trace_Component
;
4541 procedure Trace_Cycle
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
;
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
4566 Write_Str
("cycle (LGC_Id_");
4567 Write_Int
(Int
(Cycle
));
4571 Indent_By
(Attr_Indent
);
4572 Write_Str
("kind = ");
4573 Write_Str
(Kind
(G
, Cycle
)'Img);
4576 Indent_By
(Attr_Indent
);
4577 Write_Str
("invocation edges = ");
4578 Write_Int
(Int
(Invocation_Edge_Count
(G
, Cycle
)));
4581 Indent_By
(Attr_Indent
);
4582 Write_Str
("length: ");
4583 Write_Int
(Int
(Length
(G
, Cycle
)));
4586 Iter
:= Iterate_Edges_Of_Cycle
(G
, Cycle
);
4587 while Has_Next
(Iter
) loop
4590 Indent_By
(Edge_Indent
);
4591 Write_Str
("library graph edge (LGE_Id_");
4592 Write_Int
(Int
(Edge
));
4602 procedure Trace_Edge
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
);
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
4625 Write_Str
("library graph edge (LGE_Id_");
4626 Write_Int
(Int
(Edge
));
4630 Indent_By
(Attr_Indent
);
4631 Write_Str
("kind = ");
4632 Write_Str
(Kind
(G
, Edge
)'Img);
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
));
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
));
4654 procedure Trace_Vertex
4656 Vertex
: Library_Graph_Vertex_Id
;
4657 Indent
: Indentation_Level
)
4659 Attr_Indent
: constant Indentation_Level
:=
4660 Indent
+ Nested_Indentation
;
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
4674 Write_Str
("library graph vertex (LGV_Id_");
4675 Write_Int
(Int
(Vertex
));
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
));
4693 Vertex
: Library_Graph_Vertex_Id
) return Unit_Id
4696 pragma Assert
(Present
(G
));
4697 pragma Assert
(Present
(Vertex
));
4699 return Get_LGV_Attributes
(G
, Vertex
).Unit
;
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
;
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
;
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;
4740 Weak_Predecessors
:= Weak_Predecessors
+ Value
;
4742 Strong_Predecessors
:= Strong_Predecessors
+ Value
;
4744 end Update_Pending_Predecessors
;
4746 -----------------------------------------------
4747 -- Update_Pending_Predecessors_Of_Components --
4748 -----------------------------------------------
4750 procedure Update_Pending_Predecessors_Of_Components
4753 Edge
: Library_Graph_Edge_Id
;
4754 Iter
: All_Edge_Iterator
;
4757 pragma Assert
(Present
(G
));
4759 Iter
:= Iterate_All_Edges
(G
);
4760 while Has_Next
(Iter
) loop
4763 Update_Pending_Predecessors_Of_Components
(G
, Edge
);
4765 end Update_Pending_Predecessors_Of_Components
;
4767 -----------------------------------------------
4768 -- Update_Pending_Predecessors_Of_Components --
4769 -----------------------------------------------
4771 procedure Update_Pending_Predecessors_Of_Components
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
));
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
4797 end Update_Pending_Predecessors_Of_Components
;
4799 -----------------------
4800 -- Vertex_Precedence --
4801 -----------------------
4803 function Vertex_Precedence
4805 Vertex
: Library_Graph_Vertex_Id
;
4806 Compared_To
: Library_Graph_Vertex_Id
) return Precedence_Kind
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
;
4819 return Lower_Precedence
;
4821 end Vertex_Precedence
;
4828 (Vertex
: Library_Graph_Vertex_Id
;
4829 Visited_Set
: LGV_Sets
.Membership_Set
;
4830 Visited_Stack
: LGV_Lists
.Doubly_Linked_List
)
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
);
4842 -----------------------
4843 -- Invocation_Graphs --
4844 -----------------------
4846 package body Invocation_Graphs
is
4848 -----------------------
4849 -- Local subprograms --
4850 -----------------------
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
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
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
:=
4945 Edge
: Invocation_Graph_Edge_Id
;
4948 -- Nothing to do when the source and target are already related by an
4951 if Is_Existing_Source_Target_Relation
(G
, Rel
) then
4955 Edge
:= Sequence_Next_Edge
;
4957 -- Add the edge to the underlying graph
4963 Destination
=> Target
);
4965 -- Build and save the attributes of the 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
));
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
:=
4999 Vertex
: Invocation_Graph_Vertex_Id
;
5002 -- Nothing to do when the construct already has a vertex
5004 if Present
(Corresponding_Vertex
(G
, Construct_Signature
)) then
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
5019 Val
=> (Body_Vertex
=> Body_Vertex
,
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
);
5039 function Body_Vertex
5040 (G
: Invocation_Graph
;
5041 Vertex
: Invocation_Graph_Vertex_Id
) return Library_Graph_Vertex_Id
5044 pragma Assert
(Present
(G
));
5045 pragma Assert
(Present
(Vertex
));
5047 return Get_IGV_Attributes
(G
, Vertex
).Body_Vertex
;
5055 (G
: Invocation_Graph
;
5056 Vertex
: Invocation_Graph_Vertex_Id
) return Nat
5059 pragma Assert
(Present
(G
));
5060 pragma Assert
(Present
(Vertex
));
5062 return Column
(Signature
(Construct
(G
, Vertex
)));
5070 (G
: Invocation_Graph
;
5071 Vertex
: Invocation_Graph_Vertex_Id
) return Invocation_Construct_Id
5074 pragma Assert
(Present
(G
));
5075 pragma Assert
(Present
(Vertex
));
5077 return Get_IGV_Attributes
(G
, Vertex
).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
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
;
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
'
5107 Edge_Attributes => IGE_Tables.Create (Initial_Edges),
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);
5125 procedure Destroy (G : in out Invocation_Graph) is
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);
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);
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);
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);
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);
5185 end Destroy_Invocation_Graph_Vertex_Attributes;
5192 (G : Invocation_Graph;
5193 Edge : Invocation_Graph_Edge_Id) return Name_Id
5196 pragma Assert (Present (G));
5197 pragma Assert (Present (Edge));
5199 return Extra (Relation (G, Edge));
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
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
5228 pragma Assert (Present (G));
5229 pragma Assert (Present (Vertex));
5231 return IGV_Tables.Get (G.Vertex_Attributes, Vertex);
5232 end Get_IGV_Attributes;
5238 function Has_Next (Iter : All_Edge_Iterator) return Boolean is
5240 return DG.Has_Next (DG.All_Edge_Iterator (Iter));
5247 function Has_Next (Iter : All_Vertex_Iterator) return Boolean is
5249 return DG.Has_Next (DG.All_Vertex_Iterator (Iter));
5256 function Has_Next (Iter : Edges_To_Targets_Iterator) return Boolean is
5258 return DG.Has_Next (DG.Outgoing_Edge_Iterator (Iter));
5265 function Has_Next (Iter : Elaboration_Root_Iterator) return Boolean is
5267 return IGV_Sets.Has_Next (IGV_Sets.Iterator (Iter));
5270 -------------------------------
5271 -- Hash_Invocation_Signature --
5272 -------------------------------
5274 function Hash_Invocation_Signature
5275 (IS_Id : Invocation_Signature_Id) return Bucket_Range_Type
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
5291 pragma Assert (Present (Rel.Source));
5292 pragma Assert (Present (Rel.Target));
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);
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
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));
5346 Vertex_Kind = Elaborate_Body_Procedure
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
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
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
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
5400 pragma Assert (Present (G));
5401 pragma Assert (Present (Vertex));
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
5416 pragma Assert (Present (G));
5418 return Elaboration_Root_Iterator (IGV_Sets.Iterate (G.Roots));
5419 end Iterate_Elaboration_Roots;
5426 (G : Invocation_Graph;
5427 Edge : Invocation_Graph_Edge_Id) return Invocation_Kind
5430 pragma Assert (Present (G));
5431 pragma Assert (Present (Edge));
5433 return Kind (Relation (G, Edge));
5440 function Get_Lib_Graph
5441 (G : Invocation_Graph) return Library_Graphs.Library_Graph
5443 pragma Assert (Present (G));
5453 (G : Invocation_Graph;
5454 Vertex : Invocation_Graph_Vertex_Id) return Nat
5457 pragma Assert (Present (G));
5458 pragma Assert (Present (Vertex));
5460 return Line (Signature (Construct (G, Vertex)));
5468 (G : Invocation_Graph;
5469 Vertex : Invocation_Graph_Vertex_Id) return Name_Id
5472 pragma Assert (Present (G));
5473 pragma Assert (Present (Vertex));
5475 return Name (Signature (Construct (G, Vertex)));
5483 (Iter : in out All_Edge_Iterator;
5484 Edge : out Invocation_Graph_Edge_Id)
5487 DG.Next (DG.All_Edge_Iterator (Iter), Edge);
5495 (Iter : in out All_Vertex_Iterator;
5496 Vertex : out Invocation_Graph_Vertex_Id)
5499 DG.Next (DG.All_Vertex_Iterator (Iter), Vertex);
5507 (Iter : in out Edges_To_Targets_Iterator;
5508 Edge : out Invocation_Graph_Edge_Id)
5511 DG.Next (DG.Outgoing_Edge_Iterator (Iter), Edge);
5519 (Iter : in out Elaboration_Root_Iterator;
5520 Root : out Invocation_Graph_Vertex_Id)
5523 IGV_Sets.Next (IGV_Sets.Iterator (Iter), Root);
5526 ---------------------
5527 -- Number_Of_Edges --
5528 ---------------------
5530 function Number_Of_Edges (G : Invocation_Graph) return Natural is
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
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
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
5571 pragma Assert (Present (G));
5573 return DG.Number_Of_Vertices (G.Graph);
5574 end Number_Of_Vertices;
5580 function Present (G : Invocation_Graph) return Boolean is
5590 (G : Invocation_Graph;
5591 Edge : Invocation_Graph_Edge_Id) return Invocation_Relation_Id
5594 pragma Assert (Present (G));
5595 pragma Assert (Present (Edge));
5597 return Get_IGE_Attributes (G, Edge).Relation;
5600 ---------------------------
5601 -- Save_Elaboration_Root --
5602 ---------------------------
5604 procedure Save_Elaboration_Root
5605 (G : Invocation_Graph;
5606 Root : Invocation_Graph_Vertex_Id)
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)
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)
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)
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)
5674 pragma Assert (Present (G));
5675 pragma Assert (Present (Vertex));
5677 IGV_Tables.Put (G.Vertex_Attributes, Vertex, Val);
5678 end Set_IGV_Attributes;
5684 function Spec_Vertex
5685 (G : Invocation_Graph;
5686 Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id
5689 pragma Assert (Present (G));
5690 pragma Assert (Present (Vertex));
5692 return Get_IGV_Attributes (G, Vertex).Spec_Vertex;
5700 (G : Invocation_Graph;
5701 Edge : Invocation_Graph_Edge_Id) return Invocation_Graph_Vertex_Id
5704 pragma Assert (Present (G));
5705 pragma Assert (Present (Edge));
5707 return DG.Destination_Vertex (G.Graph, Edge);
5709 end Invocation_Graphs;
5715 function Present (Edge : Invocation_Graph_Edge_Id) return Boolean is
5717 return Edge /= No_Invocation_Graph_Edge;
5724 function Present (Vertex : Invocation_Graph_Vertex_Id) return Boolean is
5726 return Vertex /= No_Invocation_Graph_Vertex;
5733 function Present (Cycle : Library_Graph_Cycle_Id) return Boolean is
5735 return Cycle /= No_Library_Graph_Cycle;
5742 function Present (Edge : Library_Graph_Edge_Id) return Boolean is
5744 return Edge /= No_Library_Graph_Edge;
5751 function Present (Vertex : Library_Graph_Vertex_Id) return Boolean is
5753 return Vertex /= No_Library_Graph_Vertex;
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
5764 function Sequence_Next_Edge return Invocation_Graph_Edge_Id is
5765 Edge : constant Invocation_Graph_Edge_Id := IGE_Sequencer;
5768 IGE_Sequencer := IGE_Sequencer + 1;
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
5780 function Sequence_Next_Vertex return Invocation_Graph_Vertex_Id is
5781 Vertex : constant Invocation_Graph_Vertex_Id := IGV_Sequencer;
5784 IGV_Sequencer := IGV_Sequencer + 1;
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
5796 function Sequence_Next_Cycle return Library_Graph_Cycle_Id is
5797 Cycle : constant Library_Graph_Cycle_Id := LGC_Sequencer;
5800 LGC_Sequencer := LGC_Sequencer + 1;
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
5812 function Sequence_Next_Edge return Library_Graph_Edge_Id is
5813 Edge : constant Library_Graph_Edge_Id := LGE_Sequencer;
5816 LGE_Sequencer := LGE_Sequencer + 1;
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
5828 function Sequence_Next_Vertex return Library_Graph_Vertex_Id is
5829 Vertex : constant Library_Graph_Vertex_Id := LGV_Sequencer;
5832 LGV_Sequencer := LGV_Sequencer + 1;
5834 end Sequence_Next_Vertex;