From: Bob Duff Date: Fri, 28 Feb 2020 18:50:49 +0000 (-0500) Subject: [Ada] Write_Invocation_Graph_Vertex: include lib item name X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=7bf5f4d985c59e4c5a64e8d7b263af92c9ec6339;p=gcc.git [Ada] Write_Invocation_Graph_Vertex: include lib item name 2020-06-09 Bob Duff gcc/ada/ * bindo-graphs.adb, bindo-graphs.ads: For each invocation graph, record the corresponding library graph. * bindo-writers.adb (Write_Invocation_Graph_Vertex): Print the lib item name. Remove library graph parameters. * bindo-augmentors.adb, bindo-augmentors.ads, bindo-builders.adb, bindo-diagnostics.adb, bindo-diagnostics.ads, bindo-elaborators.adb: Remove library graph parameters. --- diff --git a/gcc/ada/bindo-augmentors.adb b/gcc/ada/bindo-augmentors.adb index b7ea1309d7a..a2a1de01d0d 100644 --- a/gcc/ada/bindo-augmentors.adb +++ b/gcc/ada/bindo-augmentors.adb @@ -57,7 +57,6 @@ package body Bindo.Augmentors is procedure Visit_Elaboration_Root (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Root : Invocation_Graph_Vertex_Id); pragma Inline (Visit_Elaboration_Root); -- Start a DFS traversal from elaboration root Root to: @@ -67,9 +66,7 @@ package body Bindo.Augmentors is -- * Create invocation edges for each such transition where the -- successor is Root. - procedure Visit_Elaboration_Roots - (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph); + procedure Visit_Elaboration_Roots (Inv_Graph : Invocation_Graph); pragma Inline (Visit_Elaboration_Roots); -- Start a DFS traversal from all elaboration roots to: -- @@ -80,7 +77,6 @@ package body Bindo.Augmentors is procedure Visit_Vertex (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Invoker : Invocation_Graph_Vertex_Id; Last_Vertex : Library_Graph_Vertex_Id; Root_Vertex : Library_Graph_Vertex_Id; @@ -113,10 +109,8 @@ package body Bindo.Augmentors is -- Augment_Library_Graph -- --------------------------- - procedure Augment_Library_Graph - (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph) - is + procedure Augment_Library_Graph (Inv_Graph : Invocation_Graph) is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph); begin pragma Assert (Present (Lib_Graph)); @@ -133,7 +127,7 @@ package body Bindo.Augmentors is Longest_Path := 0; Total_Visited := 0; - Visit_Elaboration_Roots (Inv_Graph, Lib_Graph); + Visit_Elaboration_Roots (Inv_Graph); Write_Statistics; End_Phase (Library_Graph_Augmentation); @@ -145,9 +139,9 @@ package body Bindo.Augmentors is procedure Visit_Elaboration_Root (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Root : Invocation_Graph_Vertex_Id) is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph); pragma Assert (Present (Inv_Graph)); pragma Assert (Present (Lib_Graph)); pragma Assert (Present (Root)); @@ -173,7 +167,6 @@ package body Bindo.Augmentors is Visit_Vertex (Inv_Graph => Inv_Graph, - Lib_Graph => Lib_Graph, Invoker => Root, Last_Vertex => Root_Vertex, Root_Vertex => Root_Vertex, @@ -189,25 +182,20 @@ package body Bindo.Augmentors is -- Visit_Elaboration_Roots -- ----------------------------- - procedure Visit_Elaboration_Roots - (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph) - is + procedure Visit_Elaboration_Roots (Inv_Graph : Invocation_Graph) is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph); + pragma Assert (Present (Inv_Graph)); + pragma Assert (Present (Lib_Graph)); + Iter : Elaboration_Root_Iterator; Root : Invocation_Graph_Vertex_Id; begin - pragma Assert (Present (Inv_Graph)); - pragma Assert (Present (Lib_Graph)); - Iter := Iterate_Elaboration_Roots (Inv_Graph); while Has_Next (Iter) loop Next (Iter, Root); - Visit_Elaboration_Root - (Inv_Graph => Inv_Graph, - Lib_Graph => Lib_Graph, - Root => Root); + Visit_Elaboration_Root (Inv_Graph => Inv_Graph, Root => Root); end loop; end Visit_Elaboration_Roots; @@ -217,7 +205,6 @@ package body Bindo.Augmentors is procedure Visit_Vertex (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Invoker : Invocation_Graph_Vertex_Id; Last_Vertex : Library_Graph_Vertex_Id; Root_Vertex : Library_Graph_Vertex_Id; @@ -226,6 +213,8 @@ package body Bindo.Augmentors is Internal_Controlled_Action : Boolean; Path : Natural) is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph); + New_Path : constant Natural := Path + 1; Edge : Invocation_Graph_Edge_Id; @@ -300,7 +289,6 @@ package body Bindo.Augmentors is Visit_Vertex (Inv_Graph => Inv_Graph, - Lib_Graph => Lib_Graph, Invoker => Target (Inv_Graph, Edge), Last_Vertex => Invoker_Vertex, Root_Vertex => Root_Vertex, diff --git a/gcc/ada/bindo-augmentors.ads b/gcc/ada/bindo-augmentors.ads index 534c0276186..a8fa1586e81 100644 --- a/gcc/ada/bindo-augmentors.ads +++ b/gcc/ada/bindo-augmentors.ads @@ -42,11 +42,9 @@ package Bindo.Augmentors is ------------------------------ package Library_Graph_Augmentors is - procedure Augment_Library_Graph - (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph); - -- Augment library graph Lib_Graph with information from invocation - -- graph Inv_Graph as follows: + procedure Augment_Library_Graph (Inv_Graph : Invocation_Graph); + -- Augment the library graph of Inv_Graph with information from + -- invocation graph Inv_Graph as follows: -- -- 1) Traverse the invocation graph starting from each elaboration -- procedure of unit Root. diff --git a/gcc/ada/bindo-builders.adb b/gcc/ada/bindo-builders.adb index a0e771b8548..66801f443ba 100644 --- a/gcc/ada/bindo-builders.adb +++ b/gcc/ada/bindo-builders.adb @@ -110,7 +110,8 @@ package body Bindo.Builders is Inv_Graph := Create (Initial_Vertices => Number_Of_Elaborable_Units, - Initial_Edges => Number_Of_Elaborable_Units); + Initial_Edges => Number_Of_Elaborable_Units, + Lib_Graph => Lib_G); Lib_Graph := Lib_G; For_Each_Elaborable_Unit (Create_Vertices'Access); diff --git a/gcc/ada/bindo-diagnostics.adb b/gcc/ada/bindo-diagnostics.adb index 444bc1d7c09..c2ffe447b3f 100644 --- a/gcc/ada/bindo-diagnostics.adb +++ b/gcc/ada/bindo-diagnostics.adb @@ -44,22 +44,18 @@ package body Bindo.Diagnostics is -- Local subprograms -- ----------------------- - procedure Diagnose_All_Cycles - (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph); + procedure Diagnose_All_Cycles (Inv_Graph : Invocation_Graph); pragma Inline (Diagnose_All_Cycles); -- Emit diagnostics for all cycles of library graph G procedure Diagnose_Cycle (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Cycle : Library_Graph_Cycle_Id); pragma Inline (Diagnose_Cycle); -- Emit diagnostics for cycle Cycle of library graph G procedure Find_And_Output_Invocation_Paths (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Source : Library_Graph_Vertex_Id; Destination : Library_Graph_Vertex_Id); pragma Inline (Find_And_Output_Invocation_Paths); @@ -69,7 +65,6 @@ package body Bindo.Diagnostics is function Find_Elaboration_Root (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Vertex : Library_Graph_Vertex_Id) return Invocation_Graph_Vertex_Id; pragma Inline (Find_Elaboration_Root); -- Find the elaboration root in invocation graph Inv_Graph that corresponds @@ -171,7 +166,6 @@ package body Bindo.Diagnostics is procedure Output_Invocation_Path (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Elaborated_Vertex : Library_Graph_Vertex_Id; Path : IGE_Lists.Doubly_Linked_List; Path_Id : in out Nat); @@ -182,11 +176,10 @@ package body Bindo.Diagnostics is procedure Output_Invocation_Path_Transition (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Edge : Invocation_Graph_Edge_Id); pragma Inline (Output_Invocation_Path_Transition); -- Output a transition through edge Edge of invocation graph G, which is - -- part of an invocation path. Lib_Graph is the related library graph. + -- part of an invocation path. procedure Output_Invocation_Related_Suggestions (G : Library_Graph; @@ -197,7 +190,6 @@ package body Bindo.Diagnostics is procedure Output_Invocation_Transition (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Source : Library_Graph_Vertex_Id; Destination : Library_Graph_Vertex_Id); pragma Inline (Output_Invocation_Transition); @@ -222,7 +214,6 @@ package body Bindo.Diagnostics is procedure Output_Transition (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Current_Edge : Library_Graph_Edge_Id; Next_Edge : Library_Graph_Edge_Id; Elaborate_All_Active : Boolean); @@ -247,7 +238,6 @@ package body Bindo.Diagnostics is procedure Visit_Vertex (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Invoker : Invocation_Graph_Vertex_Id; Invoker_Vertex : Library_Graph_Vertex_Id; Last_Vertex : Library_Graph_Vertex_Id; @@ -269,10 +259,9 @@ package body Bindo.Diagnostics is -- Diagnose_All_Cycles -- ------------------------- - procedure Diagnose_All_Cycles - (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph) - is + procedure Diagnose_All_Cycles (Inv_Graph : Invocation_Graph) is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph); + Cycle : Library_Graph_Cycle_Id; Iter : All_Cycle_Iterator; @@ -284,10 +273,7 @@ package body Bindo.Diagnostics is while Has_Next (Iter) loop Next (Iter, Cycle); - Diagnose_Cycle - (Inv_Graph => Inv_Graph, - Lib_Graph => Lib_Graph, - Cycle => Cycle); + Diagnose_Cycle (Inv_Graph => Inv_Graph, Cycle => Cycle); end loop; end Diagnose_All_Cycles; @@ -295,10 +281,8 @@ package body Bindo.Diagnostics is -- Diagnose_Circularities -- ---------------------------- - procedure Diagnose_Circularities - (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph) - is + procedure Diagnose_Circularities (Inv_Graph : Invocation_Graph) is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph); begin pragma Assert (Present (Inv_Graph)); pragma Assert (Present (Lib_Graph)); @@ -313,14 +297,13 @@ package body Bindo.Diagnostics is -- switch -d_C (diagnose all cycles) is in effect. if Debug_Flag_Underscore_CC then - Diagnose_All_Cycles (Inv_Graph, Lib_Graph); + Diagnose_All_Cycles (Inv_Graph); -- Otherwise diagnose the most important cycle in the graph else Diagnose_Cycle (Inv_Graph => Inv_Graph, - Lib_Graph => Lib_Graph, Cycle => Highest_Precedence_Cycle (Lib_Graph)); end if; end Diagnose_Circularities; @@ -331,9 +314,10 @@ package body Bindo.Diagnostics is procedure Diagnose_Cycle (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Cycle : Library_Graph_Cycle_Id) is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph); + pragma Assert (Present (Inv_Graph)); pragma Assert (Present (Lib_Graph)); pragma Assert (Present (Cycle)); @@ -382,7 +366,6 @@ package body Bindo.Diagnostics is Output_Transition (Inv_Graph => Inv_Graph, - Lib_Graph => Lib_Graph, Current_Edge => Current_Edge, Next_Edge => Next_Edge, Elaborate_All_Active => Elaborate_All_Active); @@ -394,7 +377,6 @@ package body Bindo.Diagnostics is Output_Transition (Inv_Graph => Inv_Graph, - Lib_Graph => Lib_Graph, Current_Edge => Current_Edge, Next_Edge => First_Edge, Elaborate_All_Active => Elaborate_All_Active); @@ -415,10 +397,11 @@ package body Bindo.Diagnostics is procedure Find_And_Output_Invocation_Paths (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Source : Library_Graph_Vertex_Id; Destination : Library_Graph_Vertex_Id) is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph); + Path : IGE_Lists.Doubly_Linked_List; Path_Id : Nat; Visited : IGV_Sets.Membership_Set; @@ -449,11 +432,9 @@ package body Bindo.Diagnostics is Visit_Vertex (Inv_Graph => Inv_Graph, - Lib_Graph => Lib_Graph, Invoker => Find_Elaboration_Root (Inv_Graph => Inv_Graph, - Lib_Graph => Lib_Graph, Vertex => Source), Invoker_Vertex => Source, Last_Vertex => Source, @@ -473,9 +454,10 @@ package body Bindo.Diagnostics is function Find_Elaboration_Root (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Vertex : Library_Graph_Vertex_Id) return Invocation_Graph_Vertex_Id is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph); + Current_Vertex : Invocation_Graph_Vertex_Id; Iter : Elaboration_Root_Iterator; Root_Vertex : Invocation_Graph_Vertex_Id; @@ -982,11 +964,12 @@ package body Bindo.Diagnostics is procedure Output_Invocation_Path (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Elaborated_Vertex : Library_Graph_Vertex_Id; Path : IGE_Lists.Doubly_Linked_List; Path_Id : in out Nat) is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph); + Edge : Invocation_Graph_Edge_Id; Iter : IGE_Lists.Iterator; @@ -1007,9 +990,7 @@ package body Bindo.Diagnostics is IGE_Lists.Next (Iter, Edge); Output_Invocation_Path_Transition - (Inv_Graph => Inv_Graph, - Lib_Graph => Lib_Graph, - Edge => Edge); + (Inv_Graph => Inv_Graph, Edge => Edge); end loop; Path_Id := Path_Id + 1; @@ -1021,9 +1002,10 @@ package body Bindo.Diagnostics is procedure Output_Invocation_Path_Transition (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Edge : Invocation_Graph_Edge_Id) is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph); + pragma Assert (Present (Inv_Graph)); pragma Assert (Present (Lib_Graph)); pragma Assert (Present (Edge)); @@ -1186,10 +1168,10 @@ package body Bindo.Diagnostics is procedure Output_Invocation_Transition (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Source : Library_Graph_Vertex_Id; Destination : Library_Graph_Vertex_Id) is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph); begin pragma Assert (Present (Inv_Graph)); pragma Assert (Present (Lib_Graph)); @@ -1203,7 +1185,6 @@ package body Bindo.Diagnostics is Find_And_Output_Invocation_Paths (Inv_Graph => Inv_Graph, - Lib_Graph => Lib_Graph, Source => Source, Destination => Destination); end Output_Invocation_Transition; @@ -1302,11 +1283,12 @@ package body Bindo.Diagnostics is procedure Output_Transition (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Current_Edge : Library_Graph_Edge_Id; Next_Edge : Library_Graph_Edge_Id; Elaborate_All_Active : Boolean) is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph); + pragma Assert (Present (Inv_Graph)); pragma Assert (Present (Lib_Graph)); pragma Assert (Present (Current_Edge)); @@ -1353,7 +1335,6 @@ package body Bindo.Diagnostics is elsif Is_Invocation_Edge (Lib_Graph, Current_Edge) then Output_Invocation_Transition (Inv_Graph => Inv_Graph, - Lib_Graph => Lib_Graph, Source => Source, Destination => Expected_Destination); @@ -1466,7 +1447,6 @@ package body Bindo.Diagnostics is procedure Visit_Vertex (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph; Invoker : Invocation_Graph_Vertex_Id; Invoker_Vertex : Library_Graph_Vertex_Id; Last_Vertex : Library_Graph_Vertex_Id; @@ -1476,6 +1456,8 @@ package body Bindo.Diagnostics is Path : IGE_Lists.Doubly_Linked_List; Path_Id : in out Nat) is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (Inv_Graph); + Edge : Invocation_Graph_Edge_Id; Iter : Edges_To_Targets_Iterator; Targ : Invocation_Graph_Vertex_Id; @@ -1500,7 +1482,6 @@ package body Bindo.Diagnostics is then Output_Invocation_Path (Inv_Graph => Inv_Graph, - Lib_Graph => Lib_Graph, Elaborated_Vertex => Elaborated_Vertex, Path => Path, Path_Id => Path_Id); @@ -1531,7 +1512,6 @@ package body Bindo.Diagnostics is Visit_Vertex (Inv_Graph => Inv_Graph, - Lib_Graph => Lib_Graph, Invoker => Targ, Invoker_Vertex => Body_Vertex (Inv_Graph, Targ), Last_Vertex => Invoker_Vertex, diff --git a/gcc/ada/bindo-diagnostics.ads b/gcc/ada/bindo-diagnostics.ads index 9c24c14f5cf..24f4f521d3a 100644 --- a/gcc/ada/bindo-diagnostics.ads +++ b/gcc/ada/bindo-diagnostics.ads @@ -51,11 +51,9 @@ package Bindo.Diagnostics is -- API -- --------- - procedure Diagnose_Circularities - (Inv_Graph : Invocation_Graph; - Lib_Graph : Library_Graph); + procedure Diagnose_Circularities (Inv_Graph : Invocation_Graph); pragma Inline (Diagnose_Circularities); - -- Diagnose all cycles of library graph Lib_Graph with matching invocation - -- graph Inv_Graph. + -- Diagnose all cycles of the library graph of Inv_Graph with matching + -- invocation graph Inv_Graph. end Bindo.Diagnostics; diff --git a/gcc/ada/bindo-elaborators.adb b/gcc/ada/bindo-elaborators.adb index d5459d151fc..f36b9156fe7 100644 --- a/gcc/ada/bindo-elaborators.adb +++ b/gcc/ada/bindo-elaborators.adb @@ -733,7 +733,7 @@ package body Bindo.Elaborators is -- order to discover transitions of the execution flow from a unit -- to a unit that result in extra edges within the library graph. - Augment_Library_Graph (Inv_Graph, Lib_Graph); + Augment_Library_Graph (Inv_Graph); -- Create the component graph by collapsing all library items into -- library units and traversing the library graph. @@ -780,7 +780,7 @@ package body Bindo.Elaborators is -- Otherwise the library graph contains at least one circularity else - Diagnose_Circularities (Inv_Graph, Lib_Graph); + Diagnose_Circularities (Inv_Graph); end if; Destroy (Inv_Graph); diff --git a/gcc/ada/bindo-graphs.adb b/gcc/ada/bindo-graphs.adb index c6a091fb24a..3b2b7532002 100644 --- a/gcc/ada/bindo-graphs.adb +++ b/gcc/ada/bindo-graphs.adb @@ -172,2038 +172,2000 @@ package body Bindo.Graphs is return Bucket_Range_Type (Vertex); end Hash_Library_Graph_Vertex; - ----------------------- - -- Invocation_Graphs -- - ----------------------- + -------------------- + -- Library_Graphs -- + -------------------- - package body Invocation_Graphs is + package body Library_Graphs is ----------------------- -- Local subprograms -- ----------------------- - procedure Free is - new Ada.Unchecked_Deallocation - (Invocation_Graph_Attributes, Invocation_Graph); + procedure Add_Body_Before_Spec_Edge + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id; + Edges : LGE_Lists.Doubly_Linked_List); + pragma Inline (Add_Body_Before_Spec_Edge); + -- Create a new edge in library graph G between vertex Vertex and its + -- corresponding spec or body, where the body is a predecessor and the + -- spec a successor. Add the edge to list Edges. - function Get_IGE_Attributes - (G : Invocation_Graph; - Edge : Invocation_Graph_Edge_Id) - return Invocation_Graph_Edge_Attributes; - pragma Inline (Get_IGE_Attributes); - -- Obtain the attributes of edge Edge of invocation graph G + procedure Add_Body_Before_Spec_Edges + (G : Library_Graph; + Edges : LGE_Lists.Doubly_Linked_List); + pragma Inline (Add_Body_Before_Spec_Edges); + -- Create new edges in library graph G for all vertices and their + -- corresponding specs or bodies, where the body is a predecessor + -- and the spec is a successor. Add all edges to list Edges. - function Get_IGV_Attributes - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) - return Invocation_Graph_Vertex_Attributes; - pragma Inline (Get_IGV_Attributes); - -- Obtain the attributes of vertex Vertex of invocation graph G + procedure Add_Edge_Kind_Check + (G : Library_Graph; + Pred : Library_Graph_Vertex_Id; + Succ : Library_Graph_Vertex_Id; + New_Kind : Library_Graph_Edge_Kind); + -- This is called by Add_Edge in the case where there is already a + -- Pred-->Succ edge, to assert that the New_Kind is appropriate. Raises + -- Program_Error if a bug is detected. The purpose is to prevent bugs + -- where calling Add_Edge in different orders produces different output. - procedure Increment_Invocation_Graph_Edge_Count - (G : Invocation_Graph; - Kind : Invocation_Kind); - pragma Inline (Increment_Invocation_Graph_Edge_Count); - -- Increment the number of edges of king Kind in invocation graph G by - -- one. + function Add_Edge + (G : Library_Graph; + Pred : Library_Graph_Vertex_Id; + Succ : Library_Graph_Vertex_Id; + Kind : Library_Graph_Edge_Kind; + Activates_Task : Boolean) return Library_Graph_Edge_Id; + pragma Inline (Add_Edge); + -- Create a new edge in library graph G with source vertex Pred and + -- destination vertex Succ, and return its handle. Kind denotes the + -- nature of the edge. Activates_Task should be set when the edge + -- involves a task activation. If Pred and Succ are already related, + -- no edge is created and No_Library_Graph_Edge is returned, but if + -- Activates_Task is True, then the flag of the existing edge is + -- updated. - function Is_Elaboration_Root - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Boolean; - pragma Inline (Is_Elaboration_Root); - -- Determine whether vertex Vertex of invocation graph denotes the - -- elaboration procedure of a spec or a body. + function At_Least_One_Edge_Satisfies + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id; + Predicate : LGE_Predicate_Ptr) return Boolean; + pragma Inline (At_Least_One_Edge_Satisfies); + -- Determine whether at least one edge of cycle Cycle of library graph G + -- satisfies predicate Predicate. - function Is_Existing_Source_Target_Relation - (G : Invocation_Graph; - Rel : Source_Target_Relation) return Boolean; - pragma Inline (Is_Existing_Source_Target_Relation); - -- Determine whether a source vertex and a target vertex described by - -- relation Rel are already related in invocation graph G. + function Copy_Cycle_Path + (Cycle_Path : LGE_Lists.Doubly_Linked_List) + return LGE_Lists.Doubly_Linked_List; + pragma Inline (Copy_Cycle_Path); + -- Create a deep copy of list Cycle_Path - procedure Save_Elaboration_Root - (G : Invocation_Graph; - Root : Invocation_Graph_Vertex_Id); - pragma Inline (Save_Elaboration_Root); - -- Save elaboration root Root of invocation graph G + function Cycle_End_Vertices + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id; + Elaborate_All_Active : Boolean) return LGV_Sets.Membership_Set; + pragma Inline (Cycle_End_Vertices); + -- Part of Tarjan's enumeration of the elementary circuits of a directed + -- graph algorithm. Collect the vertices that terminate a cycle starting + -- from vertex Vertex of library graph G in a set. This is usually the + -- vertex itself, unless the vertex is part of an Elaborate_Body pair, + -- or flag Elaborate_All_Active is set. In that case the complementary + -- vertex is also added to the set. - procedure Set_Corresponding_Vertex - (G : Invocation_Graph; - IS_Id : Invocation_Signature_Id; - Vertex : Invocation_Graph_Vertex_Id); - pragma Inline (Set_Corresponding_Vertex); - -- Associate vertex Vertex of invocation graph G with signature IS_Id + function Cycle_Kind_Of + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Library_Graph_Cycle_Kind; + pragma Inline (Cycle_Kind_Of); + -- Determine the cycle kind of edge Edge of library graph G if the edge + -- participated in a circuit. - procedure Set_Is_Existing_Source_Target_Relation - (G : Invocation_Graph; - Rel : Source_Target_Relation; - Val : Boolean := True); - pragma Inline (Set_Is_Existing_Source_Target_Relation); - -- Mark a source vertex and a target vertex described by relation Rel as - -- already related in invocation graph G depending on value Val. + function Cycle_Kind_Precedence + (Kind : Library_Graph_Cycle_Kind; + Compared_To : Library_Graph_Cycle_Kind) return Precedence_Kind; + pragma Inline (Cycle_Kind_Precedence); + -- Determine the precedence of cycle kind Kind compared to cycle kind + -- Compared_To. - procedure Set_IGE_Attributes - (G : Invocation_Graph; - Edge : Invocation_Graph_Edge_Id; - Val : Invocation_Graph_Edge_Attributes); - pragma Inline (Set_IGE_Attributes); - -- Set the attributes of edge Edge of invocation graph G to value Val + function Cycle_Path_Precedence + (G : Library_Graph; + Path : LGE_Lists.Doubly_Linked_List; + Compared_To : LGE_Lists.Doubly_Linked_List) return Precedence_Kind; + pragma Inline (Cycle_Path_Precedence); + -- Determine the precedence of cycle path Path of library graph G + -- compared to path Compared_To. - procedure Set_IGV_Attributes - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id; - Val : Invocation_Graph_Vertex_Attributes); - pragma Inline (Set_IGV_Attributes); - -- Set the attributes of vertex Vertex of invocation graph G to value - -- Val. + function Cycle_Precedence + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id; + Compared_To : Library_Graph_Cycle_Id) return Precedence_Kind; + pragma Inline (Cycle_Precedence); + -- Determine the precedence of cycle Cycle of library graph G compared + -- to cycle Compared_To. - -------------- - -- Add_Edge -- - -------------- + procedure Decrement_Library_Graph_Edge_Count + (G : Library_Graph; + Kind : Library_Graph_Edge_Kind); + pragma Inline (Decrement_Library_Graph_Edge_Count); + -- Decrement the number of edges of kind King in library graph G by one - procedure Add_Edge - (G : Invocation_Graph; - Source : Invocation_Graph_Vertex_Id; - Target : Invocation_Graph_Vertex_Id; - IR_Id : Invocation_Relation_Id) - is - pragma Assert (Present (G)); - pragma Assert (Present (Source)); - pragma Assert (Present (Target)); - pragma Assert (Present (IR_Id)); + procedure Delete_Body_Before_Spec_Edges + (G : Library_Graph; + Edges : LGE_Lists.Doubly_Linked_List); + pragma Inline (Delete_Body_Before_Spec_Edges); + -- Delete all edges in list Edges from library graph G, that link spec + -- and bodies, where the body acts as the predecessor and the spec as a + -- successor. - Rel : constant Source_Target_Relation := - (Source => Source, - Target => Target); + procedure Delete_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id); + pragma Inline (Delete_Edge); + -- Delete edge Edge from library graph G - Edge : Invocation_Graph_Edge_Id; + function Edge_Precedence + (G : Library_Graph; + Edge : Library_Graph_Edge_Id; + Compared_To : Library_Graph_Edge_Id) return Precedence_Kind; + pragma Inline (Edge_Precedence); + -- Determine the precedence of edge Edge of library graph G compared to + -- edge Compared_To. - begin - -- Nothing to do when the source and target are already related by an - -- edge. + procedure Find_Cycles_From_Successor + (G : Library_Graph; + Edge : Library_Graph_Edge_Id; + End_Vertices : LGV_Sets.Membership_Set; + Deleted_Vertices : LGV_Sets.Membership_Set; + Most_Significant_Edge : Library_Graph_Edge_Id; + Invocation_Edge_Count : Natural; + Cycle_Path_Stack : LGE_Lists.Doubly_Linked_List; + Visited_Set : LGV_Sets.Membership_Set; + Visited_Stack : LGV_Lists.Doubly_Linked_List; + Cycle_Count : in out Natural; + Cycle_Limit : Natural; + Elaborate_All_Active : Boolean; + Has_Cycle : out Boolean; + Indent : Indentation_Level); + pragma Inline (Find_Cycles_From_Successor); + -- Part of Tarjan's enumeration of the elementary circuits of a directed + -- graph algorithm. Find all cycles from the successor indicated by edge + -- Edge of library graph G. If at least one cycle exists, set Has_Cycle + -- to True. The remaining parameters are as follows: + -- + -- * End vertices is the set of vertices that terminate a potential + -- cycle. + -- + -- * Deleted vertices is the set of vertices that have been expanded + -- during previous depth-first searches and should not be visited + -- for the rest of the algorithm. + -- + -- * Most_Significant_Edge is the current highest-precedence edge on + -- the path of the potential cycle. + -- + -- * Invocation_Edge_Count is the number of invocation edges on the + -- path of the potential cycle. + -- + -- * Cycle_Path_Stack is the path of the potential cycle. + -- + -- * Visited_Set is the set of vertices that have been visited during + -- the current depth-first search. + -- + -- * Visited_Stack maintains the vertices of Visited_Set in a stack + -- for later unvisiting. + -- + -- * Cycle_Count is the number of cycles discovered so far. + -- + -- * Cycle_Limit is the upper bound of the number of cycles to be + -- discovered. + -- + -- * Elaborate_All_Active should be set when the component currently + -- being examined for cycles contains an Elaborate_All edge. + -- + -- * Indent in the desired indentation level for tracing. - if Is_Existing_Source_Target_Relation (G, Rel) then - return; - end if; + procedure Find_Cycles_From_Vertex + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id; + End_Vertices : LGV_Sets.Membership_Set; + Deleted_Vertices : LGV_Sets.Membership_Set; + Most_Significant_Edge : Library_Graph_Edge_Id; + Invocation_Edge_Count : Natural; + Cycle_Path_Stack : LGE_Lists.Doubly_Linked_List; + Visited_Set : LGV_Sets.Membership_Set; + Visited_Stack : LGV_Lists.Doubly_Linked_List; + Cycle_Count : in out Natural; + Cycle_Limit : Natural; + Elaborate_All_Active : Boolean; + Is_Start_Vertex : Boolean; + Has_Cycle : out Boolean; + Indent : Indentation_Level); + pragma Inline (Find_Cycles_From_Vertex); + -- Part of Tarjan's enumeration of the elementary circuits of a directed + -- graph algorithm. Find all cycles from vertex Vertex of library graph + -- G. If at least one cycle exists, set Has_Cycle to True. The remaining + -- parameters are as follows: + -- + -- * End_Vertices is the set of vertices that terminate a potential + -- cycle. + -- + -- * Deleted_Vertices is the set of vertices that have been expanded + -- during previous depth-first searches and should not be visited + -- for the rest of the algorithm. + -- + -- * Most_Significant_Edge is the current highest-precedence edge on + -- the path of the potential cycle. + -- + -- * Invocation_Edge_Count is the number of invocation edges on the + -- path of the potential cycle. + -- + -- * Cycle_Path_Stack is the path of the potential cycle. + -- + -- * Visited_Set is the set of vertices that have been visited during + -- the current depth-first search. + -- + -- * Visited_Stack maintains the vertices of Visited_Set in a stack + -- for later unvisiting. + -- + -- * Cycle_Count is the number of cycles discovered so far. + -- + -- * Cycle_Limit is the upper bound of the number of cycles to be + -- discovered. + -- + -- * Elaborate_All_Active should be set when the component currently + -- being examined for cycles contains an Elaborate_All edge. + -- + -- * Indent in the desired indentation level for tracing. - Edge := Sequence_Next_Edge; + procedure Find_Cycles_In_Component + (G : Library_Graph; + Comp : Component_Id; + Cycle_Count : in out Natural; + Cycle_Limit : Natural); + pragma Inline (Find_Cycles_In_Component); + -- Part of Tarjan's enumeration of the elementary circuits of a directed + -- graph algorithm. Find all cycles in component Comp of library graph + -- G. The remaining parameters are as follows: + -- + -- * Cycle_Count is the number of cycles discovered so far. + -- + -- * Cycle_Limit is the upper bound of the number of cycles to be + -- discovered. - -- Add the edge to the underlying graph + function Find_Edge + (G : Library_Graph; + Pred : Library_Graph_Vertex_Id; + Succ : Library_Graph_Vertex_Id) return Library_Graph_Edge_Id; + -- There must be an edge Pred-->Succ; this returns it - DG.Add_Edge - (G => G.Graph, - E => Edge, - Source => Source, - Destination => Target); + function Find_First_Lower_Precedence_Cycle + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Id; + pragma Inline (Find_First_Lower_Precedence_Cycle); + -- Inspect the list of cycles of library graph G and return the first + -- cycle whose precedence is lower than that of cycle Cycle. If there + -- is no such cycle, return No_Library_Graph_Cycle. - -- Build and save the attributes of the edge + procedure Free is + new Ada.Unchecked_Deallocation + (Library_Graph_Attributes, Library_Graph); - Set_IGE_Attributes - (G => G, - Edge => Edge, - Val => (Relation => IR_Id)); + function Get_Component_Attributes + (G : Library_Graph; + Comp : Component_Id) return Component_Attributes; + pragma Inline (Get_Component_Attributes); + -- Obtain the attributes of component Comp of library graph G - -- Mark the source and target as related by the new edge. This - -- prevents all further attempts to link the same source and target. + function Get_LGC_Attributes + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Attributes; + pragma Inline (Get_LGC_Attributes); + -- Obtain the attributes of cycle Cycle of library graph G - Set_Is_Existing_Source_Target_Relation (G, Rel); + function Get_LGE_Attributes + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) + return Library_Graph_Edge_Attributes; + pragma Inline (Get_LGE_Attributes); + -- Obtain the attributes of edge Edge of library graph G - -- Update the edge statistics + function Get_LGV_Attributes + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) + return Library_Graph_Vertex_Attributes; + pragma Inline (Get_LGV_Attributes); + -- Obtain the attributes of vertex Edge of library graph G - Increment_Invocation_Graph_Edge_Count (G, Kind (IR_Id)); - end Add_Edge; + function Has_Elaborate_Body + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean; + pragma Inline (Has_Elaborate_Body); + -- Determine whether vertex Vertex of library graph G is subject to + -- pragma Elaborate_Body. - ---------------- - -- Add_Vertex -- - ---------------- + function Has_Elaborate_All_Edge + (G : Library_Graph; + Comp : Component_Id) return Boolean; + pragma Inline (Has_Elaborate_All_Edge); + -- Determine whether component Comp of library graph G contains an + -- Elaborate_All edge that links two vertices in the same component. - procedure Add_Vertex - (G : Invocation_Graph; - IC_Id : Invocation_Construct_Id; - Body_Vertex : Library_Graph_Vertex_Id; - Spec_Vertex : Library_Graph_Vertex_Id) - is - pragma Assert (Present (G)); - pragma Assert (Present (IC_Id)); - pragma Assert (Present (Body_Vertex)); - pragma Assert (Present (Spec_Vertex)); + function Has_Elaborate_All_Edge + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean; + pragma Inline (Has_Elaborate_All_Edge); + -- Determine whether vertex Vertex of library graph G contains an + -- Elaborate_All edge to a successor where both the vertex and the + -- successor reside in the same component. - Construct_Signature : constant Invocation_Signature_Id := - Signature (IC_Id); - Vertex : Invocation_Graph_Vertex_Id; + function Highest_Precedence_Edge + (G : Library_Graph; + Left : Library_Graph_Edge_Id; + Right : Library_Graph_Edge_Id) return Library_Graph_Edge_Id; + pragma Inline (Highest_Precedence_Edge); + -- Return the edge with highest precedence among edges Left and Right of + -- library graph G. - begin - -- Nothing to do when the construct already has a vertex + procedure Increment_Library_Graph_Edge_Count + (G : Library_Graph; + Kind : Library_Graph_Edge_Kind); + pragma Inline (Increment_Library_Graph_Edge_Count); + -- Increment the number of edges of king Kind in library graph G by one - if Present (Corresponding_Vertex (G, Construct_Signature)) then - return; - end if; + procedure Increment_Pending_Predecessors + (G : Library_Graph; + Comp : Component_Id; + Edge : Library_Graph_Edge_Id); + pragma Inline (Increment_Pending_Predecessors); + -- Increment the number of pending predecessors component Comp which was + -- reached via edge Edge of library graph G must wait on before it can + -- be elaborated by one. - Vertex := Sequence_Next_Vertex; + procedure Increment_Pending_Predecessors + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id; + Edge : Library_Graph_Edge_Id); + pragma Inline (Increment_Pending_Predecessors); + -- Increment the number of pending predecessors vertex Vertex which was + -- reached via edge Edge of library graph G must wait on before it can + -- be elaborated by one. - -- Add the vertex to the underlying graph + procedure Initialize_Components (G : Library_Graph); + pragma Inline (Initialize_Components); + -- Initialize on the initial call or re-initialize on subsequent calls + -- all components of library graph G. - DG.Add_Vertex (G.Graph, Vertex); + function Is_Cycle_Initiating_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean; + pragma Inline (Is_Cycle_Initiating_Edge); + -- Determine whether edge Edge of library graph G starts a cycle - -- Build and save the attributes of the vertex + function Is_Cyclic_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean; + pragma Inline (Is_Cyclic_Edge); + -- Determine whether edge Edge of library graph G participates in a + -- cycle. - Set_IGV_Attributes - (G => G, - Vertex => Vertex, - Val => (Body_Vertex => Body_Vertex, - Construct => IC_Id, - Spec_Vertex => Spec_Vertex)); + function Is_Cyclic_Elaborate_All_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean; + pragma Inline (Is_Cyclic_Elaborate_All_Edge); + -- Determine whether edge Edge of library graph G participates in a + -- cycle and has a predecessor that is subject to pragma Elaborate_All. - -- Associate the construct with its corresponding vertex + function Is_Cyclic_Elaborate_Body_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean; + pragma Inline (Is_Cyclic_Elaborate_Body_Edge); + -- Determine whether edge Edge of library graph G participates in a + -- cycle and has a successor that is either a spec subject to pragma + -- Elaborate_Body, or a body that completes such a spec. - Set_Corresponding_Vertex (G, Construct_Signature, Vertex); + function Is_Cyclic_Elaborate_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean; + pragma Inline (Is_Cyclic_Elaborate_Edge); + -- Determine whether edge Edge of library graph G participates in a + -- cycle and has a predecessor that is subject to pragma Elaborate. - -- Save the vertex for later processing when it denotes a spec or - -- body elaboration procedure. + function Is_Cyclic_Forced_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean; + pragma Inline (Is_Cyclic_Forced_Edge); + -- Determine whether edge Edge of library graph G participates in a + -- cycle and came from the forced-elaboration-order file. - if Is_Elaboration_Root (G, Vertex) then - Save_Elaboration_Root (G, Vertex); - end if; - end Add_Vertex; + function Is_Cyclic_Invocation_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean; + pragma Inline (Is_Cyclic_Invocation_Edge); + -- Determine whether edge Edge of library graph G participates in a + -- cycle and came from the traversal of the invocation graph. - ----------------- - -- Body_Vertex -- - ----------------- - - function Body_Vertex - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); + function Is_Cyclic_With_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean; + pragma Inline (Is_Cyclic_With_Edge); + -- Determine whether edge Edge of library graph G participates in a + -- cycle and is the result of a with dependency between its successor + -- and predecessor. - return Get_IGV_Attributes (G, Vertex).Body_Vertex; - end Body_Vertex; + function Is_Recorded_Edge + (G : Library_Graph; + Rel : Predecessor_Successor_Relation) return Boolean; + pragma Inline (Is_Recorded_Edge); + -- Determine whether a predecessor vertex and a successor vertex + -- described by relation Rel are already linked in library graph G. - ------------ - -- Column -- - ------------ + function Is_Static_Successor_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean; + pragma Inline (Is_Static_Successor_Edge); + -- Determine whether the successor of invocation edge Edge represents a + -- unit that was compiled with the static model. - function Column - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Nat - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); + function Is_Vertex_With_Elaborate_Body + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean; + pragma Inline (Is_Vertex_With_Elaborate_Body); + -- Determine whether vertex Vertex of library graph G denotes a spec + -- subject to pragma Elaborate_Body or the completing body of such a + -- spec. - return Column (Signature (Construct (G, Vertex))); - end Column; + function Links_Vertices_In_Same_Component + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean; + pragma Inline (Links_Vertices_In_Same_Component); + -- Determine whether edge Edge of library graph G links a predecessor + -- and successor that reside in the same component. - --------------- - -- Construct -- - --------------- + function Maximum_Invocation_Edge_Count + (G : Library_Graph; + Edge : Library_Graph_Edge_Id; + Count : Natural) return Natural; + pragma Inline (Maximum_Invocation_Edge_Count); + -- Determine whether edge Edge of library graph G is an invocation edge, + -- and if it is return Count + 1, otherwise return Count. - function Construct - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Invocation_Construct_Id - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); + procedure Normalize_Cycle_Path + (Cycle_Path : LGE_Lists.Doubly_Linked_List; + Most_Significant_Edge : Library_Graph_Edge_Id); + pragma Inline (Normalize_Cycle_Path); + -- Normalize cycle path Path by rotating it until its starting edge is + -- Sig_Edge. - return Get_IGV_Attributes (G, Vertex).Construct; - end Construct; + procedure Order_Cycle + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id); + pragma Inline (Order_Cycle); + -- Insert cycle Cycle in library graph G and sort it based on its + -- precedence relative to all recorded cycles. - -------------------------- - -- Corresponding_Vertex -- - -------------------------- + function Path + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) return LGE_Lists.Doubly_Linked_List; + pragma Inline (Path); + -- Obtain the path of edges which comprises cycle Cycle of library + -- graph G. - function Corresponding_Vertex - (G : Invocation_Graph; - IS_Id : Invocation_Signature_Id) return Invocation_Graph_Vertex_Id - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (IS_Id)); + procedure Record_Cycle + (G : Library_Graph; + Most_Significant_Edge : Library_Graph_Edge_Id; + Invocation_Edge_Count : Natural; + Cycle_Path : LGE_Lists.Doubly_Linked_List; + Indent : Indentation_Level); + pragma Inline (Record_Cycle); + -- Normalize a cycle described by its path Cycle_Path and add it to + -- library graph G. Most_Significant_Edge denotes the edge with the + -- highest significance along the cycle path. Invocation_Edge_Count + -- is the number of invocation edges along the cycle path. Indent is + -- the desired indentation level for tracing. - return Signature_Tables.Get (G.Signature_To_Vertex, IS_Id); - end Corresponding_Vertex; + procedure Set_Activates_Task + (G : Library_Graph; + Edge : Library_Graph_Edge_Id); + -- Set the Activates_Task flag of the Edge to True - ------------ - -- Create -- - ------------ + procedure Set_Component_Attributes + (G : Library_Graph; + Comp : Component_Id; + Val : Component_Attributes); + pragma Inline (Set_Component_Attributes); + -- Set the attributes of component Comp of library graph G to value Val - function Create - (Initial_Vertices : Positive; - Initial_Edges : Positive) return Invocation_Graph - is - G : constant Invocation_Graph := new Invocation_Graph_Attributes; + procedure Set_Corresponding_Vertex + (G : Library_Graph; + U_Id : Unit_Id; + Val : Library_Graph_Vertex_Id); + pragma Inline (Set_Corresponding_Vertex); + -- Associate vertex Val of library graph G with unit U_Id - begin - G.Edge_Attributes := IGE_Tables.Create (Initial_Edges); - G.Graph := - DG.Create - (Initial_Vertices => Initial_Vertices, - Initial_Edges => Initial_Edges); - G.Relations := Relation_Sets.Create (Initial_Edges); - G.Roots := IGV_Sets.Create (Initial_Vertices); - G.Signature_To_Vertex := Signature_Tables.Create (Initial_Vertices); - G.Vertex_Attributes := IGV_Tables.Create (Initial_Vertices); + procedure Set_Is_Recorded_Edge + (G : Library_Graph; + Rel : Predecessor_Successor_Relation); + pragma Inline (Set_Is_Recorded_Edge); + -- Mark a predecessor vertex and a successor vertex described by + -- relation Rel as already linked. - return G; - end Create; + procedure Set_LGC_Attributes + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id; + Val : Library_Graph_Cycle_Attributes); + pragma Inline (Set_LGC_Attributes); + -- Set the attributes of cycle Cycle of library graph G to value Val - ------------- - -- Destroy -- - ------------- + procedure Set_LGE_Attributes + (G : Library_Graph; + Edge : Library_Graph_Edge_Id; + Val : Library_Graph_Edge_Attributes); + pragma Inline (Set_LGE_Attributes); + -- Set the attributes of edge Edge of library graph G to value Val - procedure Destroy (G : in out Invocation_Graph) is - begin - pragma Assert (Present (G)); + procedure Set_LGV_Attributes + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id; + Val : Library_Graph_Vertex_Attributes); + pragma Inline (Set_LGV_Attributes); + -- Set the attributes of vertex Vertex of library graph G to value Val - IGE_Tables.Destroy (G.Edge_Attributes); - DG.Destroy (G.Graph); - Relation_Sets.Destroy (G.Relations); - IGV_Sets.Destroy (G.Roots); - Signature_Tables.Destroy (G.Signature_To_Vertex); - IGV_Tables.Destroy (G.Vertex_Attributes); + procedure Trace_Component + (G : Library_Graph; + Comp : Component_Id; + Indent : Indentation_Level); + pragma Inline (Trace_Component); + -- Write the contents of component Comp of library graph G to standard + -- output. Indent is the desired indentation level for tracing. - Free (G); - end Destroy; + procedure Trace_Cycle + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id; + Indent : Indentation_Level); + pragma Inline (Trace_Cycle); + -- Write the contents of cycle Cycle of library graph G to standard + -- output. Indent is the desired indentation level for tracing. - ----------------------------------- - -- Destroy_Invocation_Graph_Edge -- - ----------------------------------- + procedure Trace_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id; + Indent : Indentation_Level); + pragma Inline (Trace_Edge); + -- Write the contents of edge Edge of library graph G to standard + -- output. Indent is the desired indentation level for tracing. - procedure Destroy_Invocation_Graph_Edge - (Edge : in out Invocation_Graph_Edge_Id) - is - pragma Unreferenced (Edge); - begin - null; - end Destroy_Invocation_Graph_Edge; + procedure Trace_Vertex + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id; + Indent : Indentation_Level); + pragma Inline (Trace_Vertex); + -- Write the contents of vertex Vertex of library graph G to standard + -- output. Indent is the desired indentation level for tracing. - ---------------------------------------------- - -- Destroy_Invocation_Graph_Edge_Attributes -- - ---------------------------------------------- + procedure Unvisit + (Vertex : Library_Graph_Vertex_Id; + Visited_Set : LGV_Sets.Membership_Set; + Visited_Stack : LGV_Lists.Doubly_Linked_List); + pragma Inline (Unvisit); + -- Part of Tarjan's enumeration of the elementary circuits of a directed + -- graph algorithm. Unwind the Visited_Stack by removing the top vertex + -- from set Visited_Set until vertex Vertex is reached, inclusive. - procedure Destroy_Invocation_Graph_Edge_Attributes - (Attrs : in out Invocation_Graph_Edge_Attributes) - is - pragma Unreferenced (Attrs); - begin - null; - end Destroy_Invocation_Graph_Edge_Attributes; + procedure Update_Pending_Predecessors + (Strong_Predecessors : in out Natural; + Weak_Predecessors : in out Natural; + Update_Weak : Boolean; + Value : Integer); + pragma Inline (Update_Pending_Predecessors); + -- Update the number of pending strong or weak predecessors denoted by + -- Strong_Predecessors and Weak_Predecessors respectively depending on + -- flag Update_Weak by adding value Value. - ------------------------------------- - -- Destroy_Invocation_Graph_Vertex -- - ------------------------------------- + procedure Update_Pending_Predecessors_Of_Components (G : Library_Graph); + pragma Inline (Update_Pending_Predecessors_Of_Components); + -- Update the number of pending predecessors all components of library + -- graph G must wait on before they can be elaborated. - procedure Destroy_Invocation_Graph_Vertex - (Vertex : in out Invocation_Graph_Vertex_Id) - is - pragma Unreferenced (Vertex); - begin - null; - end Destroy_Invocation_Graph_Vertex; + procedure Update_Pending_Predecessors_Of_Components + (G : Library_Graph; + Edge : Library_Graph_Edge_Id); + pragma Inline (Update_Pending_Predecessors_Of_Components); + -- Update the number of pending predecessors the component of edge + -- LGE_Is's successor vertex of library graph G must wait on before + -- it can be elaborated. - ------------------------------------------------ - -- Destroy_Invocation_Graph_Vertex_Attributes -- - ------------------------------------------------ + function Vertex_Precedence + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id; + Compared_To : Library_Graph_Vertex_Id) return Precedence_Kind; + pragma Inline (Vertex_Precedence); + -- Determine the precedence of vertex Vertex of library graph G compared + -- to vertex Compared_To. - procedure Destroy_Invocation_Graph_Vertex_Attributes - (Attrs : in out Invocation_Graph_Vertex_Attributes) - is - pragma Unreferenced (Attrs); - begin - null; - end Destroy_Invocation_Graph_Vertex_Attributes; + procedure Visit + (Vertex : Library_Graph_Vertex_Id; + Visited_Set : LGV_Sets.Membership_Set; + Visited_Stack : LGV_Lists.Doubly_Linked_List); + pragma Inline (Visit); + -- Part of Tarjan's enumeration of the elementary circuits of a directed + -- graph algorithm. Push vertex Vertex on the Visited_Stack and add it + -- to set Visited_Set. - ----------- - -- Extra -- - ----------- + -------------------- + -- Activates_Task -- + -------------------- - function Extra - (G : Invocation_Graph; - Edge : Invocation_Graph_Edge_Id) return Name_Id + function Activates_Task + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean is begin - pragma Assert (Present (G)); - pragma Assert (Present (Edge)); - - return Extra (Relation (G, Edge)); - end Extra; + return Get_LGE_Attributes (G, Edge).Activates_Task; + end Activates_Task; - ------------------------ - -- Get_IGE_Attributes -- - ------------------------ + ------------------------------- + -- Add_Body_Before_Spec_Edge -- + ------------------------------- - function Get_IGE_Attributes - (G : Invocation_Graph; - Edge : Invocation_Graph_Edge_Id) - return Invocation_Graph_Edge_Attributes + procedure Add_Body_Before_Spec_Edge + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id; + Edges : LGE_Lists.Doubly_Linked_List) is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Edge)); - - return IGE_Tables.Get (G.Edge_Attributes, Edge); - end Get_IGE_Attributes; - - ------------------------ - -- Get_IGV_Attributes -- - ------------------------ + Edge : Library_Graph_Edge_Id; - function Get_IGV_Attributes - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) - return Invocation_Graph_Vertex_Attributes - is begin pragma Assert (Present (G)); pragma Assert (Present (Vertex)); + pragma Assert (LGE_Lists.Present (Edges)); - return IGV_Tables.Get (G.Vertex_Attributes, Vertex); - end Get_IGV_Attributes; - - -------------- - -- Has_Next -- - -------------- + -- A vertex requires a special Body_Before_Spec edge to its + -- Corresponding_Item when it either denotes a + -- + -- * Body that completes a previous spec + -- + -- * Spec with a completing body + -- + -- The edge creates an intentional circularity between the spec and + -- body in order to emulate a library unit, and guarantees that both + -- will appear in the same component. + -- + -- Due to the structure of the library graph, either the spec or + -- the body may be visited first, yet Corresponding_Item will still + -- attempt to create the Body_Before_Spec edge. This is OK because + -- successor and predecessor are kept consistent in both cases, and + -- Add_Edge will prevent the creation of the second edge. - function Has_Next (Iter : All_Edge_Iterator) return Boolean is - begin - return DG.Has_Next (DG.All_Edge_Iterator (Iter)); - end Has_Next; + -- Assume that no Body_Before_Spec is necessary - -------------- - -- Has_Next -- - -------------- + Edge := No_Library_Graph_Edge; - function Has_Next (Iter : All_Vertex_Iterator) return Boolean is - begin - return DG.Has_Next (DG.All_Vertex_Iterator (Iter)); - end Has_Next; + -- A body that completes a previous spec - -------------- - -- Has_Next -- - -------------- + if Is_Body_With_Spec (G, Vertex) then + Edge := + Add_Edge + (G => G, + Pred => Vertex, + Succ => Corresponding_Item (G, Vertex), + Kind => Body_Before_Spec_Edge, + Activates_Task => False); - function Has_Next (Iter : Edges_To_Targets_Iterator) return Boolean is - begin - return DG.Has_Next (DG.Outgoing_Edge_Iterator (Iter)); - end Has_Next; + -- A spec with a completing body - -------------- - -- Has_Next -- - -------------- + elsif Is_Spec_With_Body (G, Vertex) then + Edge := + Add_Edge + (G => G, + Pred => Corresponding_Item (G, Vertex), + Succ => Vertex, + Kind => Body_Before_Spec_Edge, + Activates_Task => False); + end if; - function Has_Next (Iter : Elaboration_Root_Iterator) return Boolean is - begin - return IGV_Sets.Has_Next (IGV_Sets.Iterator (Iter)); - end Has_Next; + if Present (Edge) then + LGE_Lists.Append (Edges, Edge); + end if; + end Add_Body_Before_Spec_Edge; - ------------------------------- - -- Hash_Invocation_Signature -- - ------------------------------- + -------------------------------- + -- Add_Body_Before_Spec_Edges -- + -------------------------------- - function Hash_Invocation_Signature - (IS_Id : Invocation_Signature_Id) return Bucket_Range_Type + procedure Add_Body_Before_Spec_Edges + (G : Library_Graph; + Edges : LGE_Lists.Doubly_Linked_List) is - begin - pragma Assert (Present (IS_Id)); - - return Bucket_Range_Type (IS_Id); - end Hash_Invocation_Signature; - - --------------------------------- - -- Hash_Source_Target_Relation -- - --------------------------------- + Iter : Elaborable_Units_Iterator; + U_Id : Unit_Id; - function Hash_Source_Target_Relation - (Rel : Source_Target_Relation) return Bucket_Range_Type - is begin - pragma Assert (Present (Rel.Source)); - pragma Assert (Present (Rel.Target)); - - return - Hash_Two_Keys - (Bucket_Range_Type (Rel.Source), - Bucket_Range_Type (Rel.Target)); - end Hash_Source_Target_Relation; - - ------------------------------------------- - -- Increment_Invocation_Graph_Edge_Count -- - ------------------------------------------- - - procedure Increment_Invocation_Graph_Edge_Count - (G : Invocation_Graph; - Kind : Invocation_Kind) - is pragma Assert (Present (G)); + pragma Assert (LGE_Lists.Present (Edges)); - Count : Natural renames G.Counts (Kind); + Iter := Iterate_Elaborable_Units; + while Has_Next (Iter) loop + Next (Iter, U_Id); - begin - Count := Count + 1; - end Increment_Invocation_Graph_Edge_Count; + Add_Body_Before_Spec_Edge + (G => G, + Vertex => Corresponding_Vertex (G, U_Id), + Edges => Edges); + end loop; + end Add_Body_Before_Spec_Edges; - --------------------------------- - -- Invocation_Graph_Edge_Count -- - --------------------------------- + -------------- + -- Add_Edge -- + -------------- - function Invocation_Graph_Edge_Count - (G : Invocation_Graph; - Kind : Invocation_Kind) return Natural + procedure Add_Edge + (G : Library_Graph; + Pred : Library_Graph_Vertex_Id; + Succ : Library_Graph_Vertex_Id; + Kind : Library_Graph_Edge_Kind; + Activates_Task : Boolean) is + Ignore : constant Library_Graph_Edge_Id := + Add_Edge + (G => G, + Pred => Pred, + Succ => Succ, + Kind => Kind, + Activates_Task => Activates_Task); begin - pragma Assert (Present (G)); - - return G.Counts (Kind); - end Invocation_Graph_Edge_Count; + null; + end Add_Edge; ------------------------- - -- Is_Elaboration_Root -- + -- Add_Edge_Kind_Check -- ------------------------- - function Is_Elaboration_Root - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Boolean + procedure Add_Edge_Kind_Check + (G : Library_Graph; + Pred : Library_Graph_Vertex_Id; + Succ : Library_Graph_Vertex_Id; + New_Kind : Library_Graph_Edge_Kind) is - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); - - Vertex_Kind : constant Invocation_Construct_Kind := - Kind (Construct (G, Vertex)); - + Old_Edge : constant Library_Graph_Edge_Id := + Find_Edge (G, Pred, Succ); + Old_Kind : constant Library_Graph_Edge_Kind := + Get_LGE_Attributes (G, Old_Edge).Kind; + OK : Boolean; begin - return - Vertex_Kind = Elaborate_Body_Procedure - or else - Vertex_Kind = Elaborate_Spec_Procedure; - end Is_Elaboration_Root; - - ---------------------------------------- - -- Is_Existing_Source_Target_Relation -- - ---------------------------------------- + case New_Kind is + when Spec_Before_Body_Edge => + OK := False; + -- Spec_Before_Body_Edge comes first, and there is never more + -- than one Spec_Before_Body_Edge for a given unit, so we can't + -- have a preexisting edge in the Spec_Before_Body_Edge case. - function Is_Existing_Source_Target_Relation - (G : Invocation_Graph; - Rel : Source_Target_Relation) return Boolean - is - begin - pragma Assert (Present (G)); + when With_Edge | Elaborate_Edge | Elaborate_All_Edge + | Forced_Edge | Invocation_Edge => + OK := Old_Kind <= New_Kind; + -- These edges are created in the order of the enumeration + -- type, and there can be duplicates; hence "<=". - return Relation_Sets.Contains (G.Relations, Rel); - end Is_Existing_Source_Target_Relation; + when Body_Before_Spec_Edge => + OK := Old_Kind = Body_Before_Spec_Edge + -- We call Add_Edge with Body_Before_Spec_Edge twice -- once + -- for the spec and once for the body. - ----------------------- - -- Iterate_All_Edges -- - ----------------------- + or else Old_Kind = Forced_Edge + or else Old_Kind = Invocation_Edge; + -- The old one can be Forced_Edge or Invocation_Edge, which + -- necessarily results in an elaboration cycle (in the static + -- model), but this assertion happens before cycle detection, + -- so we need to allow these cases. - function Iterate_All_Edges - (G : Invocation_Graph) return All_Edge_Iterator - is - begin - pragma Assert (Present (G)); + when No_Edge => + OK := False; + end case; - return All_Edge_Iterator (DG.Iterate_All_Edges (G.Graph)); - end Iterate_All_Edges; + if not OK then + raise Program_Error with Old_Kind'Img & "-->" & New_Kind'Img; + end if; + end Add_Edge_Kind_Check; - -------------------------- - -- Iterate_All_Vertices -- - -------------------------- + -------------- + -- Add_Edge -- + -------------- - function Iterate_All_Vertices - (G : Invocation_Graph) return All_Vertex_Iterator + function Add_Edge + (G : Library_Graph; + Pred : Library_Graph_Vertex_Id; + Succ : Library_Graph_Vertex_Id; + Kind : Library_Graph_Edge_Kind; + Activates_Task : Boolean) return Library_Graph_Edge_Id is - begin pragma Assert (Present (G)); + pragma Assert (Present (Pred)); + pragma Assert (Present (Succ)); + pragma Assert (Kind = Invocation_Edge or else not Activates_Task); + -- Only invocation edges can activate tasks - return All_Vertex_Iterator (DG.Iterate_All_Vertices (G.Graph)); - end Iterate_All_Vertices; + Rel : constant Predecessor_Successor_Relation := + (Predecessor => Pred, Successor => Succ); - ------------------------------ - -- Iterate_Edges_To_Targets -- - ------------------------------ + Edge : Library_Graph_Edge_Id; - function Iterate_Edges_To_Targets - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Edges_To_Targets_Iterator - is begin - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); + -- If we already have a Pred-->Succ edge, we don't add another + -- one. But we need to update Activates_Task, in order to avoid + -- depending on the order of processing of edges. If we have + -- Pred-->Succ with Activates_Task=True, and another Pred-->Succ with + -- Activates_Task=False, we want Activates_Task to be True no matter + -- which order we processed those two Add_Edge calls. - return - Edges_To_Targets_Iterator - (DG.Iterate_Outgoing_Edges (G.Graph, Vertex)); - end Iterate_Edges_To_Targets; + if Is_Recorded_Edge (G, Rel) then + pragma Debug (Add_Edge_Kind_Check (G, Pred, Succ, Kind)); - ------------------------------- - -- Iterate_Elaboration_Roots -- - ------------------------------- + if Activates_Task then + Set_Activates_Task (G, Find_Edge (G, Pred, Succ)); + end if; - function Iterate_Elaboration_Roots - (G : Invocation_Graph) return Elaboration_Root_Iterator - is - begin - pragma Assert (Present (G)); + return No_Library_Graph_Edge; + end if; - return Elaboration_Root_Iterator (IGV_Sets.Iterate (G.Roots)); - end Iterate_Elaboration_Roots; + Edge := Sequence_Next_Edge; - ---------- - -- Kind -- - ---------- + -- Add the edge to the underlying graph. Note that the predecessor + -- is the source of the edge because it will later need to notify + -- all its successors that it has been elaborated. - function Kind - (G : Invocation_Graph; - Edge : Invocation_Graph_Edge_Id) return Invocation_Kind - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Edge)); + DG.Add_Edge + (G => G.Graph, + E => Edge, + Source => Pred, + Destination => Succ); - return Kind (Relation (G, Edge)); - end Kind; + -- Construct and save the attributes of the edge - ---------- - -- Line -- - ---------- + Set_LGE_Attributes + (G => G, + Edge => Edge, + Val => + (Activates_Task => Activates_Task, + Kind => Kind)); - function Line - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Nat - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); + -- Mark the predecessor and successor as related by the new edge. + -- This prevents all further attempts to link the same predecessor + -- and successor. - return Line (Signature (Construct (G, Vertex))); - end Line; + Set_Is_Recorded_Edge (G, Rel); - ---------- - -- Name -- - ---------- + -- Update the number of pending predecessors the successor must wait + -- on before it is elaborated. - function Name - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Name_Id - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); + Increment_Pending_Predecessors + (G => G, + Vertex => Succ, + Edge => Edge); - return Name (Signature (Construct (G, Vertex))); - end Name; + -- Update the edge statistics - ---------- - -- Next -- - ---------- + Increment_Library_Graph_Edge_Count (G, Kind); - procedure Next - (Iter : in out All_Edge_Iterator; - Edge : out Invocation_Graph_Edge_Id) - is - begin - DG.Next (DG.All_Edge_Iterator (Iter), Edge); - end Next; + return Edge; + end Add_Edge; - ---------- - -- Next -- - ---------- + ---------------- + -- Add_Vertex -- + ---------------- - procedure Next - (Iter : in out All_Vertex_Iterator; - Vertex : out Invocation_Graph_Vertex_Id) + procedure Add_Vertex + (G : Library_Graph; + U_Id : Unit_Id) is - begin - DG.Next (DG.All_Vertex_Iterator (Iter), Vertex); - end Next; - - ---------- - -- Next -- - ---------- + Vertex : Library_Graph_Vertex_Id; - procedure Next - (Iter : in out Edges_To_Targets_Iterator; - Edge : out Invocation_Graph_Edge_Id) - is begin - DG.Next (DG.Outgoing_Edge_Iterator (Iter), Edge); - end Next; + pragma Assert (Present (G)); + pragma Assert (Present (U_Id)); - ---------- - -- Next -- - ---------- + -- Nothing to do when the unit already has a vertex - procedure Next - (Iter : in out Elaboration_Root_Iterator; - Root : out Invocation_Graph_Vertex_Id) - is - begin - IGV_Sets.Next (IGV_Sets.Iterator (Iter), Root); - end Next; + if Present (Corresponding_Vertex (G, U_Id)) then + return; + end if; - --------------------- - -- Number_Of_Edges -- - --------------------- + Vertex := Sequence_Next_Vertex; - function Number_Of_Edges (G : Invocation_Graph) return Natural is - begin - pragma Assert (Present (G)); + -- Add the vertex to the underlying graph - return DG.Number_Of_Edges (G.Graph); - end Number_Of_Edges; + DG.Add_Vertex (G.Graph, Vertex); - -------------------------------- - -- Number_Of_Edges_To_Targets -- - -------------------------------- + -- Construct and save the attributes of the vertex - function Number_Of_Edges_To_Targets - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Natural - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); + Set_LGV_Attributes + (G => G, + Vertex => Vertex, + Val => + (Corresponding_Item => No_Library_Graph_Vertex, + In_Elaboration_Order => False, + Pending_Strong_Predecessors => 0, + Pending_Weak_Predecessors => 0, + Unit => U_Id)); - return DG.Number_Of_Outgoing_Edges (G.Graph, Vertex); - end Number_Of_Edges_To_Targets; + -- Associate the unit with its corresponding vertex + + Set_Corresponding_Vertex (G, U_Id, Vertex); + end Add_Vertex; --------------------------------- - -- Number_Of_Elaboration_Roots -- + -- At_Least_One_Edge_Satisfies -- --------------------------------- - function Number_Of_Elaboration_Roots - (G : Invocation_Graph) return Natural + function At_Least_One_Edge_Satisfies + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id; + Predicate : LGE_Predicate_Ptr) return Boolean is + Edge : Library_Graph_Edge_Id; + Iter : Edges_Of_Cycle_Iterator; + Satisfied : Boolean; + begin pragma Assert (Present (G)); + pragma Assert (Present (Cycle)); + pragma Assert (Predicate /= null); - return IGV_Sets.Size (G.Roots); - end Number_Of_Elaboration_Roots; + -- Assume that the predicate cannot be satisfied - ------------------------ - -- Number_Of_Vertices -- - ------------------------ + Satisfied := False; + + -- IMPORTANT: + -- + -- * The iteration must run to completion in order to unlock the + -- edges of the cycle. + + Iter := Iterate_Edges_Of_Cycle (G, Cycle); + while Has_Next (Iter) loop + Next (Iter, Edge); + + Satisfied := Satisfied or else Predicate.all (G, Edge); + end loop; + + return Satisfied; + end At_Least_One_Edge_Satisfies; + + -------------------------- + -- Complementary_Vertex -- + -------------------------- + + function Complementary_Vertex + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id; + Force_Complement : Boolean) return Library_Graph_Vertex_Id + is + Complement : Library_Graph_Vertex_Id; - function Number_Of_Vertices (G : Invocation_Graph) return Natural is begin pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); - return DG.Number_Of_Vertices (G.Graph); - end Number_Of_Vertices; + -- Assume that there is no complementary vertex - ------------- - -- Present -- - ------------- + Complement := No_Library_Graph_Vertex; - function Present (G : Invocation_Graph) return Boolean is - begin - return G /= Nil; - end Present; + -- The caller requests the complement explicitly - -------------- - -- Relation -- - -------------- + if Force_Complement then + Complement := Corresponding_Item (G, Vertex); - function Relation - (G : Invocation_Graph; - Edge : Invocation_Graph_Edge_Id) return Invocation_Relation_Id + -- The vertex is a completing body of a spec subject to pragma + -- Elaborate_Body. The complementary vertex is the spec. + + elsif Is_Body_Of_Spec_With_Elaborate_Body (G, Vertex) then + Complement := Proper_Spec (G, Vertex); + + -- The vertex is a spec subject to pragma Elaborate_Body. The + -- complementary vertex is the body. + + elsif Is_Spec_With_Elaborate_Body (G, Vertex) then + Complement := Proper_Body (G, Vertex); + end if; + + return Complement; + end Complementary_Vertex; + + --------------- + -- Component -- + --------------- + + function Component + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Component_Id is begin pragma Assert (Present (G)); - pragma Assert (Present (Edge)); + pragma Assert (Present (Vertex)); - return Get_IGE_Attributes (G, Edge).Relation; - end Relation; + return DG.Component (G.Graph, Vertex); + end Component; - --------------------------- - -- Save_Elaboration_Root -- - --------------------------- + --------------------------------- + -- Contains_Elaborate_All_Edge -- + --------------------------------- - procedure Save_Elaboration_Root - (G : Invocation_Graph; - Root : Invocation_Graph_Vertex_Id) + function Contains_Elaborate_All_Edge + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) return Boolean is begin pragma Assert (Present (G)); - pragma Assert (Present (Root)); + pragma Assert (Present (Cycle)); - IGV_Sets.Insert (G.Roots, Root); - end Save_Elaboration_Root; + return + At_Least_One_Edge_Satisfies + (G => G, + Cycle => Cycle, + Predicate => Is_Elaborate_All_Edge'Access); + end Contains_Elaborate_All_Edge; - ------------------------------ - -- Set_Corresponding_Vertex -- - ------------------------------ + ------------------------------------ + -- Contains_Static_Successor_Edge -- + ------------------------------------ - procedure Set_Corresponding_Vertex - (G : Invocation_Graph; - IS_Id : Invocation_Signature_Id; - Vertex : Invocation_Graph_Vertex_Id) + function Contains_Static_Successor_Edge + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) return Boolean is begin pragma Assert (Present (G)); - pragma Assert (Present (IS_Id)); - pragma Assert (Present (Vertex)); + pragma Assert (Present (Cycle)); - Signature_Tables.Put (G.Signature_To_Vertex, IS_Id, Vertex); - end Set_Corresponding_Vertex; + return + At_Least_One_Edge_Satisfies + (G => G, + Cycle => Cycle, + Predicate => Is_Static_Successor_Edge'Access); + end Contains_Static_Successor_Edge; - -------------------------------------------- - -- Set_Is_Existing_Source_Target_Relation -- - -------------------------------------------- + ------------------------------ + -- Contains_Task_Activation -- + ------------------------------ - procedure Set_Is_Existing_Source_Target_Relation - (G : Invocation_Graph; - Rel : Source_Target_Relation; - Val : Boolean := True) + function Contains_Task_Activation + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) return Boolean is begin pragma Assert (Present (G)); - pragma Assert (Present (Rel.Source)); - pragma Assert (Present (Rel.Target)); + pragma Assert (Present (Cycle)); - if Val then - Relation_Sets.Insert (G.Relations, Rel); - else - Relation_Sets.Delete (G.Relations, Rel); - end if; - end Set_Is_Existing_Source_Target_Relation; + return + At_Least_One_Edge_Satisfies + (G => G, + Cycle => Cycle, + Predicate => Activates_Task'Access); + end Contains_Task_Activation; - ------------------------ - -- Set_IGE_Attributes -- - ------------------------ + --------------------- + -- Copy_Cycle_Path -- + --------------------- - procedure Set_IGE_Attributes - (G : Invocation_Graph; - Edge : Invocation_Graph_Edge_Id; - Val : Invocation_Graph_Edge_Attributes) + function Copy_Cycle_Path + (Cycle_Path : LGE_Lists.Doubly_Linked_List) + return LGE_Lists.Doubly_Linked_List is + Edge : Library_Graph_Edge_Id; + Iter : LGE_Lists.Iterator; + Path : LGE_Lists.Doubly_Linked_List; + begin - pragma Assert (Present (G)); - pragma Assert (Present (Edge)); + pragma Assert (LGE_Lists.Present (Cycle_Path)); - IGE_Tables.Put (G.Edge_Attributes, Edge, Val); - end Set_IGE_Attributes; + Path := LGE_Lists.Create; + Iter := LGE_Lists.Iterate (Cycle_Path); + while LGE_Lists.Has_Next (Iter) loop + LGE_Lists.Next (Iter, Edge); + + LGE_Lists.Append (Path, Edge); + end loop; + + return Path; + end Copy_Cycle_Path; ------------------------ - -- Set_IGV_Attributes -- + -- Corresponding_Item -- ------------------------ - procedure Set_IGV_Attributes - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id; - Val : Invocation_Graph_Vertex_Attributes) + function Corresponding_Item + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id is begin pragma Assert (Present (G)); pragma Assert (Present (Vertex)); - IGV_Tables.Put (G.Vertex_Attributes, Vertex, Val); - end Set_IGV_Attributes; + return Get_LGV_Attributes (G, Vertex).Corresponding_Item; + end Corresponding_Item; - ----------------- - -- Spec_Vertex -- - ----------------- + -------------------------- + -- Corresponding_Vertex -- + -------------------------- - function Spec_Vertex - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id + function Corresponding_Vertex + (G : Library_Graph; + U_Id : Unit_Id) return Library_Graph_Vertex_Id is begin pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); - - return Get_IGV_Attributes (G, Vertex).Spec_Vertex; - end Spec_Vertex; + pragma Assert (Present (U_Id)); + + return Unit_Tables.Get (G.Unit_To_Vertex, U_Id); + end Corresponding_Vertex; ------------ - -- Target -- + -- Create -- ------------ - function Target - (G : Invocation_Graph; - Edge : Invocation_Graph_Edge_Id) return Invocation_Graph_Vertex_Id + function Create + (Initial_Vertices : Positive; + Initial_Edges : Positive) return Library_Graph is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Edge)); - - return DG.Destination_Vertex (G.Graph, Edge); - end Target; - end Invocation_Graphs; - - -------------------- - -- Library_Graphs -- - -------------------- - - package body Library_Graphs is - - ----------------------- - -- Local subprograms -- - ----------------------- - - procedure Add_Body_Before_Spec_Edge - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id; - Edges : LGE_Lists.Doubly_Linked_List); - pragma Inline (Add_Body_Before_Spec_Edge); - -- Create a new edge in library graph G between vertex Vertex and its - -- corresponding spec or body, where the body is a predecessor and the - -- spec a successor. Add the edge to list Edges. - - procedure Add_Body_Before_Spec_Edges - (G : Library_Graph; - Edges : LGE_Lists.Doubly_Linked_List); - pragma Inline (Add_Body_Before_Spec_Edges); - -- Create new edges in library graph G for all vertices and their - -- corresponding specs or bodies, where the body is a predecessor - -- and the spec is a successor. Add all edges to list Edges. - - procedure Add_Edge_Kind_Check - (G : Library_Graph; - Pred : Library_Graph_Vertex_Id; - Succ : Library_Graph_Vertex_Id; - New_Kind : Library_Graph_Edge_Kind); - -- This is called by Add_Edge in the case where there is already a - -- Pred-->Succ edge, to assert that the New_Kind is appropriate. Raises - -- Program_Error if a bug is detected. The purpose is to prevent bugs - -- where calling Add_Edge in different orders produces different output. - - function Add_Edge - (G : Library_Graph; - Pred : Library_Graph_Vertex_Id; - Succ : Library_Graph_Vertex_Id; - Kind : Library_Graph_Edge_Kind; - Activates_Task : Boolean) return Library_Graph_Edge_Id; - pragma Inline (Add_Edge); - -- Create a new edge in library graph G with source vertex Pred and - -- destination vertex Succ, and return its handle. Kind denotes the - -- nature of the edge. Activates_Task should be set when the edge - -- involves a task activation. If Pred and Succ are already related, - -- no edge is created and No_Library_Graph_Edge is returned, but if - -- Activates_Task is True, then the flag of the existing edge is - -- updated. - - function At_Least_One_Edge_Satisfies - (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id; - Predicate : LGE_Predicate_Ptr) return Boolean; - pragma Inline (At_Least_One_Edge_Satisfies); - -- Determine whether at least one edge of cycle Cycle of library graph G - -- satisfies predicate Predicate. - - function Copy_Cycle_Path - (Cycle_Path : LGE_Lists.Doubly_Linked_List) - return LGE_Lists.Doubly_Linked_List; - pragma Inline (Copy_Cycle_Path); - -- Create a deep copy of list Cycle_Path - - function Cycle_End_Vertices - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id; - Elaborate_All_Active : Boolean) return LGV_Sets.Membership_Set; - pragma Inline (Cycle_End_Vertices); - -- Part of Tarjan's enumeration of the elementary circuits of a directed - -- graph algorithm. Collect the vertices that terminate a cycle starting - -- from vertex Vertex of library graph G in a set. This is usually the - -- vertex itself, unless the vertex is part of an Elaborate_Body pair, - -- or flag Elaborate_All_Active is set. In that case the complementary - -- vertex is also added to the set. - - function Cycle_Kind_Of - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Library_Graph_Cycle_Kind; - pragma Inline (Cycle_Kind_Of); - -- Determine the cycle kind of edge Edge of library graph G if the edge - -- participated in a circuit. - - function Cycle_Kind_Precedence - (Kind : Library_Graph_Cycle_Kind; - Compared_To : Library_Graph_Cycle_Kind) return Precedence_Kind; - pragma Inline (Cycle_Kind_Precedence); - -- Determine the precedence of cycle kind Kind compared to cycle kind - -- Compared_To. - - function Cycle_Path_Precedence - (G : Library_Graph; - Path : LGE_Lists.Doubly_Linked_List; - Compared_To : LGE_Lists.Doubly_Linked_List) return Precedence_Kind; - pragma Inline (Cycle_Path_Precedence); - -- Determine the precedence of cycle path Path of library graph G - -- compared to path Compared_To. - - function Cycle_Precedence - (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id; - Compared_To : Library_Graph_Cycle_Id) return Precedence_Kind; - pragma Inline (Cycle_Precedence); - -- Determine the precedence of cycle Cycle of library graph G compared - -- to cycle Compared_To. - - procedure Decrement_Library_Graph_Edge_Count - (G : Library_Graph; - Kind : Library_Graph_Edge_Kind); - pragma Inline (Decrement_Library_Graph_Edge_Count); - -- Decrement the number of edges of kind King in library graph G by one - - procedure Delete_Body_Before_Spec_Edges - (G : Library_Graph; - Edges : LGE_Lists.Doubly_Linked_List); - pragma Inline (Delete_Body_Before_Spec_Edges); - -- Delete all edges in list Edges from library graph G, that link spec - -- and bodies, where the body acts as the predecessor and the spec as a - -- successor. - - procedure Delete_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id); - pragma Inline (Delete_Edge); - -- Delete edge Edge from library graph G - - function Edge_Precedence - (G : Library_Graph; - Edge : Library_Graph_Edge_Id; - Compared_To : Library_Graph_Edge_Id) return Precedence_Kind; - pragma Inline (Edge_Precedence); - -- Determine the precedence of edge Edge of library graph G compared to - -- edge Compared_To. + G : constant Library_Graph := new Library_Graph_Attributes; - procedure Find_Cycles_From_Successor - (G : Library_Graph; - Edge : Library_Graph_Edge_Id; - End_Vertices : LGV_Sets.Membership_Set; - Deleted_Vertices : LGV_Sets.Membership_Set; - Most_Significant_Edge : Library_Graph_Edge_Id; - Invocation_Edge_Count : Natural; - Cycle_Path_Stack : LGE_Lists.Doubly_Linked_List; - Visited_Set : LGV_Sets.Membership_Set; - Visited_Stack : LGV_Lists.Doubly_Linked_List; - Cycle_Count : in out Natural; - Cycle_Limit : Natural; - Elaborate_All_Active : Boolean; - Has_Cycle : out Boolean; - Indent : Indentation_Level); - pragma Inline (Find_Cycles_From_Successor); - -- Part of Tarjan's enumeration of the elementary circuits of a directed - -- graph algorithm. Find all cycles from the successor indicated by edge - -- Edge of library graph G. If at least one cycle exists, set Has_Cycle - -- to True. The remaining parameters are as follows: - -- - -- * End vertices is the set of vertices that terminate a potential - -- cycle. - -- - -- * Deleted vertices is the set of vertices that have been expanded - -- during previous depth-first searches and should not be visited - -- for the rest of the algorithm. - -- - -- * Most_Significant_Edge is the current highest-precedence edge on - -- the path of the potential cycle. - -- - -- * Invocation_Edge_Count is the number of invocation edges on the - -- path of the potential cycle. - -- - -- * Cycle_Path_Stack is the path of the potential cycle. - -- - -- * Visited_Set is the set of vertices that have been visited during - -- the current depth-first search. - -- - -- * Visited_Stack maintains the vertices of Visited_Set in a stack - -- for later unvisiting. - -- - -- * Cycle_Count is the number of cycles discovered so far. - -- - -- * Cycle_Limit is the upper bound of the number of cycles to be - -- discovered. - -- - -- * Elaborate_All_Active should be set when the component currently - -- being examined for cycles contains an Elaborate_All edge. - -- - -- * Indent in the desired indentation level for tracing. + begin + G.Component_Attributes := Component_Tables.Create (Initial_Vertices); + G.Cycle_Attributes := LGC_Tables.Create (Initial_Vertices); + G.Cycles := LGC_Lists.Create; + G.Edge_Attributes := LGE_Tables.Create (Initial_Edges); + G.Graph := + DG.Create + (Initial_Vertices => Initial_Vertices, + Initial_Edges => Initial_Edges); + G.Recorded_Edges := RE_Sets.Create (Initial_Edges); + G.Unit_To_Vertex := Unit_Tables.Create (Initial_Vertices); + G.Vertex_Attributes := LGV_Tables.Create (Initial_Vertices); - procedure Find_Cycles_From_Vertex - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id; - End_Vertices : LGV_Sets.Membership_Set; - Deleted_Vertices : LGV_Sets.Membership_Set; - Most_Significant_Edge : Library_Graph_Edge_Id; - Invocation_Edge_Count : Natural; - Cycle_Path_Stack : LGE_Lists.Doubly_Linked_List; - Visited_Set : LGV_Sets.Membership_Set; - Visited_Stack : LGV_Lists.Doubly_Linked_List; - Cycle_Count : in out Natural; - Cycle_Limit : Natural; - Elaborate_All_Active : Boolean; - Is_Start_Vertex : Boolean; - Has_Cycle : out Boolean; - Indent : Indentation_Level); - pragma Inline (Find_Cycles_From_Vertex); - -- Part of Tarjan's enumeration of the elementary circuits of a directed - -- graph algorithm. Find all cycles from vertex Vertex of library graph - -- G. If at least one cycle exists, set Has_Cycle to True. The remaining - -- parameters are as follows: - -- - -- * End_Vertices is the set of vertices that terminate a potential - -- cycle. - -- - -- * Deleted_Vertices is the set of vertices that have been expanded - -- during previous depth-first searches and should not be visited - -- for the rest of the algorithm. - -- - -- * Most_Significant_Edge is the current highest-precedence edge on - -- the path of the potential cycle. - -- - -- * Invocation_Edge_Count is the number of invocation edges on the - -- path of the potential cycle. - -- - -- * Cycle_Path_Stack is the path of the potential cycle. - -- - -- * Visited_Set is the set of vertices that have been visited during - -- the current depth-first search. - -- - -- * Visited_Stack maintains the vertices of Visited_Set in a stack - -- for later unvisiting. - -- - -- * Cycle_Count is the number of cycles discovered so far. - -- - -- * Cycle_Limit is the upper bound of the number of cycles to be - -- discovered. - -- - -- * Elaborate_All_Active should be set when the component currently - -- being examined for cycles contains an Elaborate_All edge. - -- - -- * Indent in the desired indentation level for tracing. + return G; + end Create; - procedure Find_Cycles_In_Component - (G : Library_Graph; - Comp : Component_Id; - Cycle_Count : in out Natural; - Cycle_Limit : Natural); - pragma Inline (Find_Cycles_In_Component); - -- Part of Tarjan's enumeration of the elementary circuits of a directed - -- graph algorithm. Find all cycles in component Comp of library graph - -- G. The remaining parameters are as follows: - -- - -- * Cycle_Count is the number of cycles discovered so far. - -- - -- * Cycle_Limit is the upper bound of the number of cycles to be - -- discovered. + ------------------------ + -- Cycle_End_Vertices -- + ------------------------ - function Find_Edge - (G : Library_Graph; - Pred : Library_Graph_Vertex_Id; - Succ : Library_Graph_Vertex_Id) return Library_Graph_Edge_Id; - -- There must be an edge Pred-->Succ; this returns it + function Cycle_End_Vertices + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id; + Elaborate_All_Active : Boolean) return LGV_Sets.Membership_Set + is + Complement : Library_Graph_Vertex_Id; + End_Vertices : LGV_Sets.Membership_Set := LGV_Sets.Nil; - function Find_First_Lower_Precedence_Cycle - (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Id; - pragma Inline (Find_First_Lower_Precedence_Cycle); - -- Inspect the list of cycles of library graph G and return the first - -- cycle whose precedence is lower than that of cycle Cycle. If there - -- is no such cycle, return No_Library_Graph_Cycle. + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); - procedure Free is - new Ada.Unchecked_Deallocation - (Library_Graph_Attributes, Library_Graph); + End_Vertices := LGV_Sets.Create (2); - function Get_Component_Attributes - (G : Library_Graph; - Comp : Component_Id) return Component_Attributes; - pragma Inline (Get_Component_Attributes); - -- Obtain the attributes of component Comp of library graph G + -- The input vertex always terminates a cycle path - function Get_LGC_Attributes - (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Attributes; - pragma Inline (Get_LGC_Attributes); - -- Obtain the attributes of cycle Cycle of library graph G + LGV_Sets.Insert (End_Vertices, Vertex); - function Get_LGE_Attributes - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) - return Library_Graph_Edge_Attributes; - pragma Inline (Get_LGE_Attributes); - -- Obtain the attributes of edge Edge of library graph G + -- Add the complementary vertex to the set of cycle terminating + -- vertices when either Elaborate_All is in effect, or the input + -- vertex is part of an Elaborat_Body pair. - function Get_LGV_Attributes - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) - return Library_Graph_Vertex_Attributes; - pragma Inline (Get_LGV_Attributes); - -- Obtain the attributes of vertex Edge of library graph G + if Elaborate_All_Active + or else Is_Vertex_With_Elaborate_Body (G, Vertex) + then + Complement := + Complementary_Vertex + (G => G, + Vertex => Vertex, + Force_Complement => Elaborate_All_Active); - function Has_Elaborate_Body - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean; - pragma Inline (Has_Elaborate_Body); - -- Determine whether vertex Vertex of library graph G is subject to - -- pragma Elaborate_Body. + if Present (Complement) then + LGV_Sets.Insert (End_Vertices, Complement); + end if; + end if; - function Has_Elaborate_All_Edge + return End_Vertices; + end Cycle_End_Vertices; + + ------------------- + -- Cycle_Kind_Of -- + ------------------- + + function Cycle_Kind_Of (G : Library_Graph; - Comp : Component_Id) return Boolean; - pragma Inline (Has_Elaborate_All_Edge); - -- Determine whether component Comp of library graph G contains an - -- Elaborate_All edge that links two vertices in the same component. + Edge : Library_Graph_Edge_Id) return Library_Graph_Cycle_Kind + is + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); - function Has_Elaborate_All_Edge - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean; - pragma Inline (Has_Elaborate_All_Edge); - -- Determine whether vertex Vertex of library graph G contains an - -- Elaborate_All edge to a successor where both the vertex and the - -- successor reside in the same component. + begin + if Is_Cyclic_Elaborate_All_Edge (G, Edge) then + return Elaborate_All_Cycle; - function Highest_Precedence_Edge - (G : Library_Graph; - Left : Library_Graph_Edge_Id; - Right : Library_Graph_Edge_Id) return Library_Graph_Edge_Id; - pragma Inline (Highest_Precedence_Edge); - -- Return the edge with highest precedence among edges Left and Right of - -- library graph G. + elsif Is_Cyclic_Elaborate_Body_Edge (G, Edge) then + return Elaborate_Body_Cycle; - procedure Increment_Library_Graph_Edge_Count - (G : Library_Graph; - Kind : Library_Graph_Edge_Kind); - pragma Inline (Increment_Library_Graph_Edge_Count); - -- Increment the number of edges of king Kind in library graph G by one + elsif Is_Cyclic_Elaborate_Edge (G, Edge) then + return Elaborate_Cycle; - procedure Increment_Pending_Predecessors - (G : Library_Graph; - Comp : Component_Id; - Edge : Library_Graph_Edge_Id); - pragma Inline (Increment_Pending_Predecessors); - -- Increment the number of pending predecessors component Comp which was - -- reached via edge Edge of library graph G must wait on before it can - -- be elaborated by one. + elsif Is_Cyclic_Forced_Edge (G, Edge) then + return Forced_Cycle; - procedure Increment_Pending_Predecessors - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id; - Edge : Library_Graph_Edge_Id); - pragma Inline (Increment_Pending_Predecessors); - -- Increment the number of pending predecessors vertex Vertex which was - -- reached via edge Edge of library graph G must wait on before it can - -- be elaborated by one. + elsif Is_Cyclic_Invocation_Edge (G, Edge) then + return Invocation_Cycle; - procedure Initialize_Components (G : Library_Graph); - pragma Inline (Initialize_Components); - -- Initialize on the initial call or re-initialize on subsequent calls - -- all components of library graph G. + else + return No_Cycle_Kind; + end if; + end Cycle_Kind_Of; - function Is_Cycle_Initiating_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean; - pragma Inline (Is_Cycle_Initiating_Edge); - -- Determine whether edge Edge of library graph G starts a cycle + --------------------------- + -- Cycle_Kind_Precedence -- + --------------------------- - function Is_Cyclic_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean; - pragma Inline (Is_Cyclic_Edge); - -- Determine whether edge Edge of library graph G participates in a - -- cycle. + function Cycle_Kind_Precedence + (Kind : Library_Graph_Cycle_Kind; + Compared_To : Library_Graph_Cycle_Kind) return Precedence_Kind + is + Comp_Pos : constant Integer := + Library_Graph_Cycle_Kind'Pos (Compared_To); + Kind_Pos : constant Integer := Library_Graph_Cycle_Kind'Pos (Kind); - function Is_Cyclic_Elaborate_All_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean; - pragma Inline (Is_Cyclic_Elaborate_All_Edge); - -- Determine whether edge Edge of library graph G participates in a - -- cycle and has a predecessor that is subject to pragma Elaborate_All. + begin + -- A lower ordinal indicates a higher precedence - function Is_Cyclic_Elaborate_Body_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean; - pragma Inline (Is_Cyclic_Elaborate_Body_Edge); - -- Determine whether edge Edge of library graph G participates in a - -- cycle and has a successor that is either a spec subject to pragma - -- Elaborate_Body, or a body that completes such a spec. + if Kind_Pos < Comp_Pos then + return Higher_Precedence; - function Is_Cyclic_Elaborate_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean; - pragma Inline (Is_Cyclic_Elaborate_Edge); - -- Determine whether edge Edge of library graph G participates in a - -- cycle and has a predecessor that is subject to pragma Elaborate. + elsif Kind_Pos > Comp_Pos then + return Lower_Precedence; - function Is_Cyclic_Forced_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean; - pragma Inline (Is_Cyclic_Forced_Edge); - -- Determine whether edge Edge of library graph G participates in a - -- cycle and came from the forced-elaboration-order file. + else + return Equal_Precedence; + end if; + end Cycle_Kind_Precedence; - function Is_Cyclic_Invocation_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean; - pragma Inline (Is_Cyclic_Invocation_Edge); - -- Determine whether edge Edge of library graph G participates in a - -- cycle and came from the traversal of the invocation graph. + --------------------------- + -- Cycle_Path_Precedence -- + --------------------------- - function Is_Cyclic_With_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean; - pragma Inline (Is_Cyclic_With_Edge); - -- Determine whether edge Edge of library graph G participates in a - -- cycle and is the result of a with dependency between its successor - -- and predecessor. + function Cycle_Path_Precedence + (G : Library_Graph; + Path : LGE_Lists.Doubly_Linked_List; + Compared_To : LGE_Lists.Doubly_Linked_List) return Precedence_Kind + is + procedure Next_Available + (Iter : in out LGE_Lists.Iterator; + Edge : out Library_Graph_Edge_Id); + pragma Inline (Next_Available); + -- Obtain the next edge available through iterator Iter, or return + -- No_Library_Graph_Edge if the iterator has been exhausted. + + -------------------- + -- Next_Available -- + -------------------- + + procedure Next_Available + (Iter : in out LGE_Lists.Iterator; + Edge : out Library_Graph_Edge_Id) + is + begin + -- Assume that the iterator has been exhausted + + Edge := No_Library_Graph_Edge; - function Is_Recorded_Edge - (G : Library_Graph; - Rel : Predecessor_Successor_Relation) return Boolean; - pragma Inline (Is_Recorded_Edge); - -- Determine whether a predecessor vertex and a successor vertex - -- described by relation Rel are already linked in library graph G. + if LGE_Lists.Has_Next (Iter) then + LGE_Lists.Next (Iter, Edge); + end if; + end Next_Available; - function Is_Static_Successor_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean; - pragma Inline (Is_Static_Successor_Edge); - -- Determine whether the successor of invocation edge Edge represents a - -- unit that was compiled with the static model. + -- Local variables - function Is_Vertex_With_Elaborate_Body - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean; - pragma Inline (Is_Vertex_With_Elaborate_Body); - -- Determine whether vertex Vertex of library graph G denotes a spec - -- subject to pragma Elaborate_Body or the completing body of such a - -- spec. + Comp_Edge : Library_Graph_Edge_Id; + Comp_Iter : LGE_Lists.Iterator; + Path_Edge : Library_Graph_Edge_Id; + Path_Iter : LGE_Lists.Iterator; + Prec : Precedence_Kind; - function Links_Vertices_In_Same_Component - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean; - pragma Inline (Links_Vertices_In_Same_Component); - -- Determine whether edge Edge of library graph G links a predecessor - -- and successor that reside in the same component. + -- Start of processing for Cycle_Path_Precedence - function Maximum_Invocation_Edge_Count - (G : Library_Graph; - Edge : Library_Graph_Edge_Id; - Count : Natural) return Natural; - pragma Inline (Maximum_Invocation_Edge_Count); - -- Determine whether edge Edge of library graph G is an invocation edge, - -- and if it is return Count + 1, otherwise return Count. + begin + pragma Assert (Present (G)); + pragma Assert (LGE_Lists.Present (Path)); + pragma Assert (LGE_Lists.Present (Compared_To)); - procedure Normalize_Cycle_Path - (Cycle_Path : LGE_Lists.Doubly_Linked_List; - Most_Significant_Edge : Library_Graph_Edge_Id); - pragma Inline (Normalize_Cycle_Path); - -- Normalize cycle path Path by rotating it until its starting edge is - -- Sig_Edge. + -- Assume that the paths have equal precedence - procedure Order_Cycle - (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id); - pragma Inline (Order_Cycle); - -- Insert cycle Cycle in library graph G and sort it based on its - -- precedence relative to all recorded cycles. + Prec := Equal_Precedence; - function Path - (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id) return LGE_Lists.Doubly_Linked_List; - pragma Inline (Path); - -- Obtain the path of edges which comprises cycle Cycle of library - -- graph G. + Comp_Iter := LGE_Lists.Iterate (Compared_To); + Path_Iter := LGE_Lists.Iterate (Path); - procedure Record_Cycle - (G : Library_Graph; - Most_Significant_Edge : Library_Graph_Edge_Id; - Invocation_Edge_Count : Natural; - Cycle_Path : LGE_Lists.Doubly_Linked_List; - Indent : Indentation_Level); - pragma Inline (Record_Cycle); - -- Normalize a cycle described by its path Cycle_Path and add it to - -- library graph G. Most_Significant_Edge denotes the edge with the - -- highest significance along the cycle path. Invocation_Edge_Count - -- is the number of invocation edges along the cycle path. Indent is - -- the desired indentation level for tracing. + Next_Available (Comp_Iter, Comp_Edge); + Next_Available (Path_Iter, Path_Edge); - procedure Set_Activates_Task - (G : Library_Graph; - Edge : Library_Graph_Edge_Id); - -- Set the Activates_Task flag of the Edge to True + -- IMPORTANT: + -- + -- * The iteration must run to completion in order to unlock the + -- edges of both paths. - procedure Set_Component_Attributes - (G : Library_Graph; - Comp : Component_Id; - Val : Component_Attributes); - pragma Inline (Set_Component_Attributes); - -- Set the attributes of component Comp of library graph G to value Val + while Present (Comp_Edge) or else Present (Path_Edge) loop + if Prec = Equal_Precedence + and then Present (Comp_Edge) + and then Present (Path_Edge) + then + Prec := + Edge_Precedence + (G => G, + Edge => Path_Edge, + Compared_To => Comp_Edge); + end if; - procedure Set_Corresponding_Vertex - (G : Library_Graph; - U_Id : Unit_Id; - Val : Library_Graph_Vertex_Id); - pragma Inline (Set_Corresponding_Vertex); - -- Associate vertex Val of library graph G with unit U_Id + Next_Available (Comp_Iter, Comp_Edge); + Next_Available (Path_Iter, Path_Edge); + end loop; - procedure Set_Is_Recorded_Edge - (G : Library_Graph; - Rel : Predecessor_Successor_Relation); - pragma Inline (Set_Is_Recorded_Edge); - -- Mark a predecessor vertex and a successor vertex described by - -- relation Rel as already linked. + return Prec; + end Cycle_Path_Precedence; - procedure Set_LGC_Attributes - (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id; - Val : Library_Graph_Cycle_Attributes); - pragma Inline (Set_LGC_Attributes); - -- Set the attributes of cycle Cycle of library graph G to value Val + ---------------------- + -- Cycle_Precedence -- + ---------------------- - procedure Set_LGE_Attributes - (G : Library_Graph; - Edge : Library_Graph_Edge_Id; - Val : Library_Graph_Edge_Attributes); - pragma Inline (Set_LGE_Attributes); - -- Set the attributes of edge Edge of library graph G to value Val + function Cycle_Precedence + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id; + Compared_To : Library_Graph_Cycle_Id) return Precedence_Kind + is + pragma Assert (Present (G)); + pragma Assert (Present (Cycle)); + pragma Assert (Present (Compared_To)); - procedure Set_LGV_Attributes - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id; - Val : Library_Graph_Vertex_Attributes); - pragma Inline (Set_LGV_Attributes); - -- Set the attributes of vertex Vertex of library graph G to value Val + Comp_Invs : constant Natural := + Invocation_Edge_Count (G, Compared_To); + Comp_Len : constant Natural := Length (G, Compared_To); + Cycle_Invs : constant Natural := Invocation_Edge_Count (G, Cycle); + Cycle_Len : constant Natural := Length (G, Cycle); + Kind_Prec : constant Precedence_Kind := + Cycle_Kind_Precedence + (Kind => Kind (G, Cycle), + Compared_To => Kind (G, Compared_To)); - procedure Trace_Component - (G : Library_Graph; - Comp : Component_Id; - Indent : Indentation_Level); - pragma Inline (Trace_Component); - -- Write the contents of component Comp of library graph G to standard - -- output. Indent is the desired indentation level for tracing. + begin + -- Prefer a cycle with higher precedence based on its kind - procedure Trace_Cycle - (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id; - Indent : Indentation_Level); - pragma Inline (Trace_Cycle); - -- Write the contents of cycle Cycle of library graph G to standard - -- output. Indent is the desired indentation level for tracing. + if Kind_Prec = Higher_Precedence + or else + Kind_Prec = Lower_Precedence + then + return Kind_Prec; - procedure Trace_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id; - Indent : Indentation_Level); - pragma Inline (Trace_Edge); - -- Write the contents of edge Edge of library graph G to standard - -- output. Indent is the desired indentation level for tracing. + -- Prefer a shorter cycle - procedure Trace_Vertex - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id; - Indent : Indentation_Level); - pragma Inline (Trace_Vertex); - -- Write the contents of vertex Vertex of library graph G to standard - -- output. Indent is the desired indentation level for tracing. + elsif Cycle_Len < Comp_Len then + return Higher_Precedence; - procedure Unvisit - (Vertex : Library_Graph_Vertex_Id; - Visited_Set : LGV_Sets.Membership_Set; - Visited_Stack : LGV_Lists.Doubly_Linked_List); - pragma Inline (Unvisit); - -- Part of Tarjan's enumeration of the elementary circuits of a directed - -- graph algorithm. Unwind the Visited_Stack by removing the top vertex - -- from set Visited_Set until vertex Vertex is reached, inclusive. + elsif Cycle_Len > Comp_Len then + return Lower_Precedence; - procedure Update_Pending_Predecessors - (Strong_Predecessors : in out Natural; - Weak_Predecessors : in out Natural; - Update_Weak : Boolean; - Value : Integer); - pragma Inline (Update_Pending_Predecessors); - -- Update the number of pending strong or weak predecessors denoted by - -- Strong_Predecessors and Weak_Predecessors respectively depending on - -- flag Update_Weak by adding value Value. + -- Prefer a cycle wih fewer invocation edges - procedure Update_Pending_Predecessors_Of_Components (G : Library_Graph); - pragma Inline (Update_Pending_Predecessors_Of_Components); - -- Update the number of pending predecessors all components of library - -- graph G must wait on before they can be elaborated. + elsif Cycle_Invs < Comp_Invs then + return Higher_Precedence; - procedure Update_Pending_Predecessors_Of_Components - (G : Library_Graph; - Edge : Library_Graph_Edge_Id); - pragma Inline (Update_Pending_Predecessors_Of_Components); - -- Update the number of pending predecessors the component of edge - -- LGE_Is's successor vertex of library graph G must wait on before - -- it can be elaborated. + elsif Cycle_Invs > Comp_Invs then + return Lower_Precedence; - function Vertex_Precedence - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id; - Compared_To : Library_Graph_Vertex_Id) return Precedence_Kind; - pragma Inline (Vertex_Precedence); - -- Determine the precedence of vertex Vertex of library graph G compared - -- to vertex Compared_To. + -- Prefer a cycle with a higher path precedence - procedure Visit - (Vertex : Library_Graph_Vertex_Id; - Visited_Set : LGV_Sets.Membership_Set; - Visited_Stack : LGV_Lists.Doubly_Linked_List); - pragma Inline (Visit); - -- Part of Tarjan's enumeration of the elementary circuits of a directed - -- graph algorithm. Push vertex Vertex on the Visited_Stack and add it - -- to set Visited_Set. + else + return + Cycle_Path_Precedence + (G => G, + Path => Path (G, Cycle), + Compared_To => Path (G, Compared_To)); + end if; + end Cycle_Precedence; - -------------------- - -- Activates_Task -- - -------------------- + ---------------------------------------- + -- Decrement_Library_Graph_Edge_Count -- + ---------------------------------------- - function Activates_Task + procedure Decrement_Library_Graph_Edge_Count (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean + Kind : Library_Graph_Edge_Kind) is + pragma Assert (Present (G)); + + Count : Natural renames G.Counts (Kind); + begin - return Get_LGE_Attributes (G, Edge).Activates_Task; - end Activates_Task; + Count := Count - 1; + end Decrement_Library_Graph_Edge_Count; - ------------------------------- - -- Add_Body_Before_Spec_Edge -- - ------------------------------- + ------------------------------------ + -- Decrement_Pending_Predecessors -- + ------------------------------------ - procedure Add_Body_Before_Spec_Edge - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id; - Edges : LGE_Lists.Doubly_Linked_List) + procedure Decrement_Pending_Predecessors + (G : Library_Graph; + Comp : Component_Id; + Edge : Library_Graph_Edge_Id) is - Edge : Library_Graph_Edge_Id; + Attrs : Component_Attributes; begin pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); - pragma Assert (LGE_Lists.Present (Edges)); + pragma Assert (Present (Comp)); - -- A vertex requires a special Body_Before_Spec edge to its - -- Corresponding_Item when it either denotes a - -- - -- * Body that completes a previous spec - -- - -- * Spec with a completing body - -- - -- The edge creates an intentional circularity between the spec and - -- body in order to emulate a library unit, and guarantees that both - -- will appear in the same component. - -- - -- Due to the structure of the library graph, either the spec or - -- the body may be visited first, yet Corresponding_Item will still - -- attempt to create the Body_Before_Spec edge. This is OK because - -- successor and predecessor are kept consistent in both cases, and - -- Add_Edge will prevent the creation of the second edge. + Attrs := Get_Component_Attributes (G, Comp); - -- Assume that no Body_Before_Spec is necessary + Update_Pending_Predecessors + (Strong_Predecessors => Attrs.Pending_Strong_Predecessors, + Weak_Predecessors => Attrs.Pending_Weak_Predecessors, + Update_Weak => Is_Invocation_Edge (G, Edge), + Value => -1); - Edge := No_Library_Graph_Edge; + Set_Component_Attributes (G, Comp, Attrs); + end Decrement_Pending_Predecessors; - -- A body that completes a previous spec + ------------------------------------ + -- Decrement_Pending_Predecessors -- + ------------------------------------ - if Is_Body_With_Spec (G, Vertex) then - Edge := - Add_Edge - (G => G, - Pred => Vertex, - Succ => Corresponding_Item (G, Vertex), - Kind => Body_Before_Spec_Edge, - Activates_Task => False); + procedure Decrement_Pending_Predecessors + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id; + Edge : Library_Graph_Edge_Id) + is + Attrs : Library_Graph_Vertex_Attributes; - -- A spec with a completing body + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); - elsif Is_Spec_With_Body (G, Vertex) then - Edge := - Add_Edge - (G => G, - Pred => Corresponding_Item (G, Vertex), - Succ => Vertex, - Kind => Body_Before_Spec_Edge, - Activates_Task => False); - end if; + Attrs := Get_LGV_Attributes (G, Vertex); - if Present (Edge) then - LGE_Lists.Append (Edges, Edge); - end if; - end Add_Body_Before_Spec_Edge; + Update_Pending_Predecessors + (Strong_Predecessors => Attrs.Pending_Strong_Predecessors, + Weak_Predecessors => Attrs.Pending_Weak_Predecessors, + Update_Weak => Is_Invocation_Edge (G, Edge), + Value => -1); - -------------------------------- - -- Add_Body_Before_Spec_Edges -- - -------------------------------- + Set_LGV_Attributes (G, Vertex, Attrs); + end Decrement_Pending_Predecessors; - procedure Add_Body_Before_Spec_Edges + ----------------------------------- + -- Delete_Body_Before_Spec_Edges -- + ----------------------------------- + + procedure Delete_Body_Before_Spec_Edges (G : Library_Graph; Edges : LGE_Lists.Doubly_Linked_List) is - Iter : Elaborable_Units_Iterator; - U_Id : Unit_Id; + Edge : Library_Graph_Edge_Id; + Iter : LGE_Lists.Iterator; begin pragma Assert (Present (G)); pragma Assert (LGE_Lists.Present (Edges)); - Iter := Iterate_Elaborable_Units; - while Has_Next (Iter) loop - Next (Iter, U_Id); + Iter := LGE_Lists.Iterate (Edges); + while LGE_Lists.Has_Next (Iter) loop + LGE_Lists.Next (Iter, Edge); + pragma Assert (Kind (G, Edge) = Body_Before_Spec_Edge); - Add_Body_Before_Spec_Edge - (G => G, - Vertex => Corresponding_Vertex (G, U_Id), - Edges => Edges); + Delete_Edge (G, Edge); end loop; - end Add_Body_Before_Spec_Edges; + end Delete_Body_Before_Spec_Edges; - -------------- - -- Add_Edge -- - -------------- + ----------------- + -- Delete_Edge -- + ----------------- - procedure Add_Edge - (G : Library_Graph; - Pred : Library_Graph_Vertex_Id; - Succ : Library_Graph_Vertex_Id; - Kind : Library_Graph_Edge_Kind; - Activates_Task : Boolean) + procedure Delete_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) is - Ignore : constant Library_Graph_Edge_Id := - Add_Edge - (G => G, - Pred => Pred, - Succ => Succ, - Kind => Kind, - Activates_Task => Activates_Task); - begin - null; - end Add_Edge; + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); - ------------------------- - -- Add_Edge_Kind_Check -- - ------------------------- + Pred : constant Library_Graph_Vertex_Id := Predecessor (G, Edge); + Succ : constant Library_Graph_Vertex_Id := Successor (G, Edge); + Rel : constant Predecessor_Successor_Relation := + (Predecessor => Pred, + Successor => Succ); - procedure Add_Edge_Kind_Check - (G : Library_Graph; - Pred : Library_Graph_Vertex_Id; - Succ : Library_Graph_Vertex_Id; - New_Kind : Library_Graph_Edge_Kind) - is - Old_Edge : constant Library_Graph_Edge_Id := - Find_Edge (G, Pred, Succ); - Old_Kind : constant Library_Graph_Edge_Kind := - Get_LGE_Attributes (G, Old_Edge).Kind; - OK : Boolean; begin - case New_Kind is - when Spec_Before_Body_Edge => - OK := False; - -- Spec_Before_Body_Edge comes first, and there is never more - -- than one Spec_Before_Body_Edge for a given unit, so we can't - -- have a preexisting edge in the Spec_Before_Body_Edge case. + -- Update the edge statistics - when With_Edge | Elaborate_Edge | Elaborate_All_Edge - | Forced_Edge | Invocation_Edge => - OK := Old_Kind <= New_Kind; - -- These edges are created in the order of the enumeration - -- type, and there can be duplicates; hence "<=". + Decrement_Library_Graph_Edge_Count (G, Kind (G, Edge)); - when Body_Before_Spec_Edge => - OK := Old_Kind = Body_Before_Spec_Edge - -- We call Add_Edge with Body_Before_Spec_Edge twice -- once - -- for the spec and once for the body. + -- Update the number of pending predecessors the successor must wait + -- on before it is elaborated. - or else Old_Kind = Forced_Edge - or else Old_Kind = Invocation_Edge; - -- The old one can be Forced_Edge or Invocation_Edge, which - -- necessarily results in an elaboration cycle (in the static - -- model), but this assertion happens before cycle detection, - -- so we need to allow these cases. + Decrement_Pending_Predecessors + (G => G, + Vertex => Succ, + Edge => Edge); - when No_Edge => - OK := False; - end case; + -- Delete the link between the predecessor and successor. This allows + -- for further attempts to link the same predecessor and successor. - if not OK then - raise Program_Error with Old_Kind'Img & "-->" & New_Kind'Img; - end if; - end Add_Edge_Kind_Check; + RE_Sets.Delete (G.Recorded_Edges, Rel); - -------------- - -- Add_Edge -- - -------------- + -- Delete the attributes of the edge - function Add_Edge - (G : Library_Graph; - Pred : Library_Graph_Vertex_Id; - Succ : Library_Graph_Vertex_Id; - Kind : Library_Graph_Edge_Kind; - Activates_Task : Boolean) return Library_Graph_Edge_Id - is + LGE_Tables.Delete (G.Edge_Attributes, Edge); + + -- Delete the edge from the underlying graph + + DG.Delete_Edge (G.Graph, Edge); + end Delete_Edge; + + ------------- + -- Destroy -- + ------------- + + procedure Destroy (G : in out Library_Graph) is + begin pragma Assert (Present (G)); - pragma Assert (Present (Pred)); - pragma Assert (Present (Succ)); - pragma Assert (Kind = Invocation_Edge or else not Activates_Task); - -- Only invocation edges can activate tasks - Rel : constant Predecessor_Successor_Relation := - (Predecessor => Pred, Successor => Succ); + Component_Tables.Destroy (G.Component_Attributes); + LGC_Tables.Destroy (G.Cycle_Attributes); + LGC_Lists.Destroy (G.Cycles); + LGE_Tables.Destroy (G.Edge_Attributes); + DG.Destroy (G.Graph); + RE_Sets.Destroy (G.Recorded_Edges); + Unit_Tables.Destroy (G.Unit_To_Vertex); + LGV_Tables.Destroy (G.Vertex_Attributes); + + Free (G); + end Destroy; - Edge : Library_Graph_Edge_Id; + ---------------------------------- + -- Destroy_Component_Attributes -- + ---------------------------------- + procedure Destroy_Component_Attributes + (Attrs : in out Component_Attributes) + is + pragma Unreferenced (Attrs); begin - -- If we already have a Pred-->Succ edge, we don't add another - -- one. But we need to update Activates_Task, in order to avoid - -- depending on the order of processing of edges. If we have - -- Pred-->Succ with Activates_Task=True, and another Pred-->Succ with - -- Activates_Task=False, we want Activates_Task to be True no matter - -- which order we processed those two Add_Edge calls. + null; + end Destroy_Component_Attributes; - if Is_Recorded_Edge (G, Rel) then - pragma Debug (Add_Edge_Kind_Check (G, Pred, Succ, Kind)); + -------------------------------------------- + -- Destroy_Library_Graph_Cycle_Attributes -- + -------------------------------------------- - if Activates_Task then - Set_Activates_Task (G, Find_Edge (G, Pred, Succ)); - end if; + procedure Destroy_Library_Graph_Cycle_Attributes + (Attrs : in out Library_Graph_Cycle_Attributes) + is + begin + LGE_Lists.Destroy (Attrs.Path); + end Destroy_Library_Graph_Cycle_Attributes; - return No_Library_Graph_Edge; - end if; + ------------------------------------------- + -- Destroy_Library_Graph_Edge_Attributes -- + ------------------------------------------- - Edge := Sequence_Next_Edge; + procedure Destroy_Library_Graph_Edge_Attributes + (Attrs : in out Library_Graph_Edge_Attributes) + is + pragma Unreferenced (Attrs); + begin + null; + end Destroy_Library_Graph_Edge_Attributes; - -- Add the edge to the underlying graph. Note that the predecessor - -- is the source of the edge because it will later need to notify - -- all its successors that it has been elaborated. + --------------------------------------------- + -- Destroy_Library_Graph_Vertex_Attributes -- + --------------------------------------------- - DG.Add_Edge - (G => G.Graph, - E => Edge, - Source => Pred, - Destination => Succ); + procedure Destroy_Library_Graph_Vertex_Attributes + (Attrs : in out Library_Graph_Vertex_Attributes) + is + pragma Unreferenced (Attrs); + begin + null; + end Destroy_Library_Graph_Vertex_Attributes; - -- Construct and save the attributes of the edge + --------------------- + -- Edge_Precedence -- + --------------------- - Set_LGE_Attributes - (G => G, - Edge => Edge, - Val => - (Activates_Task => Activates_Task, - Kind => Kind)); + function Edge_Precedence + (G : Library_Graph; + Edge : Library_Graph_Edge_Id; + Compared_To : Library_Graph_Edge_Id) return Precedence_Kind + is + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); + pragma Assert (Present (Compared_To)); - -- Mark the predecessor and successor as related by the new edge. - -- This prevents all further attempts to link the same predecessor - -- and successor. + Comp_Succ : constant Library_Graph_Vertex_Id := + Successor (G, Compared_To); + Edge_Succ : constant Library_Graph_Vertex_Id := + Successor (G, Edge); + Kind_Prec : constant Precedence_Kind := + Cycle_Kind_Precedence + (Kind => Cycle_Kind_Of (G, Edge), + Compared_To => Cycle_Kind_Of (G, Compared_To)); + Succ_Prec : constant Precedence_Kind := + Vertex_Precedence + (G => G, + Vertex => Edge_Succ, + Compared_To => Comp_Succ); - Set_Is_Recorded_Edge (G, Rel); + begin + -- Prefer an edge with a higher cycle kind precedence - -- Update the number of pending predecessors the successor must wait - -- on before it is elaborated. + if Kind_Prec = Higher_Precedence + or else + Kind_Prec = Lower_Precedence + then + return Kind_Prec; - Increment_Pending_Predecessors - (G => G, - Vertex => Succ, - Edge => Edge); + -- Prefer an edge whose successor has a higher precedence - -- Update the edge statistics + elsif Comp_Succ /= Edge_Succ + and then (Succ_Prec = Higher_Precedence + or else + Succ_Prec = Lower_Precedence) + then + return Succ_Prec; - Increment_Library_Graph_Edge_Count (G, Kind); + -- Prefer an edge whose predecessor has a higher precedence - return Edge; - end Add_Edge; + else + return + Vertex_Precedence + (G => G, + Vertex => Predecessor (G, Edge), + Compared_To => Predecessor (G, Compared_To)); + end if; + end Edge_Precedence; - ---------------- - -- Add_Vertex -- - ---------------- + --------------- + -- File_Name -- + --------------- - procedure Add_Vertex - (G : Library_Graph; - U_Id : Unit_Id) + function File_Name + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return File_Name_Type is - Vertex : Library_Graph_Vertex_Id; + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + return File_Name (Unit (G, Vertex)); + end File_Name; + + --------------------- + -- Find_Components -- + --------------------- + + procedure Find_Components (G : Library_Graph) is + Edges : LGE_Lists.Doubly_Linked_List; begin pragma Assert (Present (G)); - pragma Assert (Present (U_Id)); - -- Nothing to do when the unit already has a vertex + Start_Phase (Component_Discovery); - if Present (Corresponding_Vertex (G, U_Id)) then - return; - end if; + -- Initialize or reinitialize the components of the graph - Vertex := Sequence_Next_Vertex; + Initialize_Components (G); - -- Add the vertex to the underlying graph + -- Create a set of special edges that link a predecessor body with a + -- successor spec. This is an illegal dependency, however using such + -- edges eliminates the need to create yet another graph, where both + -- spec and body are collapsed into a single vertex. - DG.Add_Vertex (G.Graph, Vertex); + Edges := LGE_Lists.Create; + Add_Body_Before_Spec_Edges (G, Edges); - -- Construct and save the attributes of the vertex + DG.Find_Components (G.Graph); - Set_LGV_Attributes - (G => G, - Vertex => Vertex, - Val => - (Corresponding_Item => No_Library_Graph_Vertex, - In_Elaboration_Order => False, - Pending_Strong_Predecessors => 0, - Pending_Weak_Predecessors => 0, - Unit => U_Id)); + -- Remove the special edges that link a predecessor body with a + -- successor spec because they cause unresolvable circularities. - -- Associate the unit with its corresponding vertex + Delete_Body_Before_Spec_Edges (G, Edges); + LGE_Lists.Destroy (Edges); - Set_Corresponding_Vertex (G, U_Id, Vertex); - end Add_Vertex; + -- Update the number of predecessors various components must wait on + -- before they can be elaborated. - --------------------------------- - -- At_Least_One_Edge_Satisfies -- - --------------------------------- + Update_Pending_Predecessors_Of_Components (G); + End_Phase (Component_Discovery); + end Find_Components; - function At_Least_One_Edge_Satisfies - (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id; - Predicate : LGE_Predicate_Ptr) return Boolean - is - Edge : Library_Graph_Edge_Id; - Iter : Edges_Of_Cycle_Iterator; - Satisfied : Boolean; + ----------------- + -- Find_Cycles -- + ----------------- + + procedure Find_Cycles (G : Library_Graph) is + All_Cycle_Limit : constant Natural := 64; + -- The performance of Tarjan's algorithm may degrate to exponential + -- when pragma Elaborate_All is in effect, or some vertex is part of + -- an Elaborate_Body pair. In this case the algorithm discovers all + -- combinations of edges that close a circuit starting and ending on + -- some start vertex while going through different vertices. Use a + -- limit on the total number of cycles within a component to guard + -- against such degradation. + + Comp : Component_Id; + Cycle_Count : Natural; + Iter : Component_Iterator; begin pragma Assert (Present (G)); - pragma Assert (Present (Cycle)); - pragma Assert (Predicate /= null); - -- Assume that the predicate cannot be satisfied + Start_Phase (Cycle_Discovery); + + -- The cycles of graph G are discovered using Tarjan's enumeration + -- of the elementary circuits of a directed-graph algorithm. Do not + -- modify this code unless you intimately understand the algorithm. + -- + -- The logic of the algorithm is split among the following routines: + -- + -- Cycle_End_Vertices + -- Find_Cycles_From_Successor + -- Find_Cycles_From_Vertex + -- Find_Cycles_In_Component + -- Unvisit + -- Visit + -- + -- The original algorithm has been significantly modified in order to + -- + -- * Accommodate the semantics of Elaborate_All and Elaborate_Body. + -- + -- * Capture cycle paths as edges rather than vertices. + -- + -- * Take advantage of graph components. + + -- Assume that the graph does not contain a cycle - Satisfied := False; + Cycle_Count := 0; - -- IMPORTANT: - -- - -- * The iteration must run to completion in order to unlock the - -- edges of the cycle. + -- Run the modified version of the algorithm on each component of the + -- graph. - Iter := Iterate_Edges_Of_Cycle (G, Cycle); + Iter := Iterate_Components (G); while Has_Next (Iter) loop - Next (Iter, Edge); + Next (Iter, Comp); - Satisfied := Satisfied or else Predicate.all (G, Edge); + Find_Cycles_In_Component + (G => G, + Comp => Comp, + Cycle_Count => Cycle_Count, + Cycle_Limit => All_Cycle_Limit); end loop; - return Satisfied; - end At_Least_One_Edge_Satisfies; + End_Phase (Cycle_Discovery); + end Find_Cycles; - -------------------------- - -- Complementary_Vertex -- - -------------------------- + -------------------------------- + -- Find_Cycles_From_Successor -- + -------------------------------- - function Complementary_Vertex - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id; - Force_Complement : Boolean) return Library_Graph_Vertex_Id + procedure Find_Cycles_From_Successor + (G : Library_Graph; + Edge : Library_Graph_Edge_Id; + End_Vertices : LGV_Sets.Membership_Set; + Deleted_Vertices : LGV_Sets.Membership_Set; + Most_Significant_Edge : Library_Graph_Edge_Id; + Invocation_Edge_Count : Natural; + Cycle_Path_Stack : LGE_Lists.Doubly_Linked_List; + Visited_Set : LGV_Sets.Membership_Set; + Visited_Stack : LGV_Lists.Doubly_Linked_List; + Cycle_Count : in out Natural; + Cycle_Limit : Natural; + Elaborate_All_Active : Boolean; + Has_Cycle : out Boolean; + Indent : Indentation_Level) is - Complement : Library_Graph_Vertex_Id; - - begin pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); - - -- Assume that there is no complementary vertex - - Complement := No_Library_Graph_Vertex; - - -- The caller requests the complement explicitly + pragma Assert (Present (Edge)); + pragma Assert (LGV_Sets.Present (End_Vertices)); + pragma Assert (LGV_Sets.Present (Deleted_Vertices)); + pragma Assert (LGE_Lists.Present (Cycle_Path_Stack)); + pragma Assert (LGV_Sets.Present (Visited_Set)); + pragma Assert (LGV_Lists.Present (Visited_Stack)); - if Force_Complement then - Complement := Corresponding_Item (G, Vertex); + Succ : constant Library_Graph_Vertex_Id := Successor (G, Edge); + Succ_Indent : constant Indentation_Level := + Indent + Nested_Indentation; - -- The vertex is a completing body of a spec subject to pragma - -- Elaborate_Body. The complementary vertex is the spec. + begin + -- Assume that the successor reached via the edge does not result in + -- a cycle. - elsif Is_Body_Of_Spec_With_Elaborate_Body (G, Vertex) then - Complement := Proper_Spec (G, Vertex); + Has_Cycle := False; - -- The vertex is a spec subject to pragma Elaborate_Body. The - -- complementary vertex is the body. + -- Nothing to do when the edge connects two vertices residing in two + -- different components. - elsif Is_Spec_With_Elaborate_Body (G, Vertex) then - Complement := Proper_Body (G, Vertex); + if not Is_Cyclic_Edge (G, Edge) then + return; end if; - return Complement; - end Complementary_Vertex; - - --------------- - -- Component -- - --------------- + Trace_Edge (G, Edge, Indent); - function Component - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Component_Id - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); + -- The modified version does not place vertices on the "point stack", + -- but instead collects the edges comprising the cycle. Prepare the + -- edge for backtracking. - return DG.Component (G.Graph, Vertex); - end Component; + LGE_Lists.Prepend (Cycle_Path_Stack, Edge); - --------------------------------- - -- Contains_Elaborate_All_Edge -- - --------------------------------- + Find_Cycles_From_Vertex + (G => G, + Vertex => Succ, + End_Vertices => End_Vertices, + Deleted_Vertices => Deleted_Vertices, + Most_Significant_Edge => Most_Significant_Edge, + Invocation_Edge_Count => Invocation_Edge_Count, + Cycle_Path_Stack => Cycle_Path_Stack, + Visited_Set => Visited_Set, + Visited_Stack => Visited_Stack, + Cycle_Count => Cycle_Count, + Cycle_Limit => Cycle_Limit, + Elaborate_All_Active => Elaborate_All_Active, + Is_Start_Vertex => False, + Has_Cycle => Has_Cycle, + Indent => Succ_Indent); - function Contains_Elaborate_All_Edge - (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id) return Boolean - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Cycle)); + -- The modified version does not place vertices on the "point stack", + -- but instead collects the edges comprising the cycle. Backtrack the + -- edge. - return - At_Least_One_Edge_Satisfies - (G => G, - Cycle => Cycle, - Predicate => Is_Elaborate_All_Edge'Access); - end Contains_Elaborate_All_Edge; + LGE_Lists.Delete_First (Cycle_Path_Stack); + end Find_Cycles_From_Successor; - ------------------------------------ - -- Contains_Static_Successor_Edge -- - ------------------------------------ + ----------------------------- + -- Find_Cycles_From_Vertex -- + ----------------------------- - function Contains_Static_Successor_Edge - (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id) return Boolean + procedure Find_Cycles_From_Vertex + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id; + End_Vertices : LGV_Sets.Membership_Set; + Deleted_Vertices : LGV_Sets.Membership_Set; + Most_Significant_Edge : Library_Graph_Edge_Id; + Invocation_Edge_Count : Natural; + Cycle_Path_Stack : LGE_Lists.Doubly_Linked_List; + Visited_Set : LGV_Sets.Membership_Set; + Visited_Stack : LGV_Lists.Doubly_Linked_List; + Cycle_Count : in out Natural; + Cycle_Limit : Natural; + Elaborate_All_Active : Boolean; + Is_Start_Vertex : Boolean; + Has_Cycle : out Boolean; + Indent : Indentation_Level) is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Cycle)); + Edge_Indent : constant Indentation_Level := + Indent + Nested_Indentation; - return - At_Least_One_Edge_Satisfies - (G => G, - Cycle => Cycle, - Predicate => Is_Static_Successor_Edge'Access); - end Contains_Static_Successor_Edge; + Complement : Library_Graph_Vertex_Id; + Edge : Library_Graph_Edge_Id; + Iter : Edges_To_Successors_Iterator; - ------------------------------ - -- Contains_Task_Activation -- - ------------------------------ + Complement_Has_Cycle : Boolean; + -- This flag is set when either Elaborate_All is in effect or the + -- current vertex is part of an Elaborate_Body pair, and visiting + -- the "complementary" vertex resulted in a cycle. + + Successor_Has_Cycle : Boolean; + -- This flag is set when visiting at least one successor of the + -- current vertex resulted in a cycle. - function Contains_Task_Activation - (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id) return Boolean - is begin pragma Assert (Present (G)); - pragma Assert (Present (Cycle)); + pragma Assert (Present (Vertex)); + pragma Assert (LGV_Sets.Present (End_Vertices)); + pragma Assert (LGV_Sets.Present (Deleted_Vertices)); + pragma Assert (LGE_Lists.Present (Cycle_Path_Stack)); + pragma Assert (LGV_Sets.Present (Visited_Set)); + pragma Assert (LGV_Lists.Present (Visited_Stack)); - return - At_Least_One_Edge_Satisfies - (G => G, - Cycle => Cycle, - Predicate => Activates_Task'Access); - end Contains_Task_Activation; + -- Assume that the vertex does not close a circuit - --------------------- - -- Copy_Cycle_Path -- - --------------------- + Has_Cycle := False; - function Copy_Cycle_Path - (Cycle_Path : LGE_Lists.Doubly_Linked_List) - return LGE_Lists.Doubly_Linked_List - is - Edge : Library_Graph_Edge_Id; - Iter : LGE_Lists.Iterator; - Path : LGE_Lists.Doubly_Linked_List; + -- Nothing to do when the limit on the number of saved cycles has + -- been reached. This protects against a combinatorial explosion + -- in components with Elaborate_All cycles. - begin - pragma Assert (LGE_Lists.Present (Cycle_Path)); + if Cycle_Count >= Cycle_Limit then + return; - Path := LGE_Lists.Create; - Iter := LGE_Lists.Iterate (Cycle_Path); - while LGE_Lists.Has_Next (Iter) loop - LGE_Lists.Next (Iter, Edge); + -- The vertex closes the circuit, thus resulting in a cycle. Save + -- the cycle for later diagnostics. The initial invocation of the + -- routine always ignores the starting vertex, to prevent a spurious + -- self-cycle. - LGE_Lists.Append (Path, Edge); - end loop; + elsif not Is_Start_Vertex + and then LGV_Sets.Contains (End_Vertices, Vertex) + then + Trace_Vertex (G, Vertex, Indent); - return Path; - end Copy_Cycle_Path; + Record_Cycle + (G => G, + Most_Significant_Edge => Most_Significant_Edge, + Invocation_Edge_Count => Invocation_Edge_Count, + Cycle_Path => Cycle_Path_Stack, + Indent => Indent); - ------------------------ - -- Corresponding_Item -- - ------------------------ + Has_Cycle := True; + Cycle_Count := Cycle_Count + 1; + return; - function Corresponding_Item - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); + -- Nothing to do when the vertex has already been deleted. This + -- indicates that all available cycles involving the vertex have + -- been discovered, and the vertex cannot contribute further to + -- the depth-first search. - return Get_LGV_Attributes (G, Vertex).Corresponding_Item; - end Corresponding_Item; + elsif LGV_Sets.Contains (Deleted_Vertices, Vertex) then + return; - -------------------------- - -- Corresponding_Vertex -- - -------------------------- + -- Nothing to do when the vertex has already been visited. This + -- indicates that the depth-first search initiated from some start + -- vertex already encountered this vertex, and the visited stack has + -- not been unrolled yet. - function Corresponding_Vertex - (G : Library_Graph; - U_Id : Unit_Id) return Library_Graph_Vertex_Id - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (U_Id)); + elsif LGV_Sets.Contains (Visited_Set, Vertex) then + return; + end if; - return Unit_Tables.Get (G.Unit_To_Vertex, U_Id); - end Corresponding_Vertex; + Trace_Vertex (G, Vertex, Indent); - ------------ - -- Create -- - ------------ + -- Mark the vertex as visited - function Create - (Initial_Vertices : Positive; - Initial_Edges : Positive) return Library_Graph - is - G : constant Library_Graph := new Library_Graph_Attributes; + Visit + (Vertex => Vertex, + Visited_Set => Visited_Set, + Visited_Stack => Visited_Stack); - begin - G.Component_Attributes := Component_Tables.Create (Initial_Vertices); - G.Cycle_Attributes := LGC_Tables.Create (Initial_Vertices); - G.Cycles := LGC_Lists.Create; - G.Edge_Attributes := LGE_Tables.Create (Initial_Edges); - G.Graph := - DG.Create - (Initial_Vertices => Initial_Vertices, - Initial_Edges => Initial_Edges); - G.Recorded_Edges := RE_Sets.Create (Initial_Edges); - G.Unit_To_Vertex := Unit_Tables.Create (Initial_Vertices); - G.Vertex_Attributes := LGV_Tables.Create (Initial_Vertices); + -- Extend the depth-first search via all the edges to successors - return G; - end Create; + Iter := Iterate_Edges_To_Successors (G, Vertex); + while Has_Next (Iter) loop + Next (Iter, Edge); - ------------------------ - -- Cycle_End_Vertices -- - ------------------------ + Find_Cycles_From_Successor + (G => G, + Edge => Edge, + End_Vertices => End_Vertices, + Deleted_Vertices => Deleted_Vertices, - function Cycle_End_Vertices - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id; - Elaborate_All_Active : Boolean) return LGV_Sets.Membership_Set - is - Complement : Library_Graph_Vertex_Id; - End_Vertices : LGV_Sets.Membership_Set := LGV_Sets.Nil; + -- The edge may be more important than the most important edge + -- up to this point, thus "upgrading" the nature of the cycle, + -- and shifting its point of normalization. - begin - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); + Most_Significant_Edge => + Highest_Precedence_Edge + (G => G, + Left => Edge, + Right => Most_Significant_Edge), - End_Vertices := LGV_Sets.Create (2); + -- The edge may be an invocation edge, in which case the count + -- of invocation edges increases by one. - -- The input vertex always terminates a cycle path + Invocation_Edge_Count => + Maximum_Invocation_Edge_Count + (G => G, + Edge => Edge, + Count => Invocation_Edge_Count), - LGV_Sets.Insert (End_Vertices, Vertex); + Cycle_Path_Stack => Cycle_Path_Stack, + Visited_Set => Visited_Set, + Visited_Stack => Visited_Stack, + Cycle_Count => Cycle_Count, + Cycle_Limit => Cycle_Limit, + Elaborate_All_Active => Elaborate_All_Active, + Has_Cycle => Successor_Has_Cycle, + Indent => Edge_Indent); - -- Add the complementary vertex to the set of cycle terminating - -- vertices when either Elaborate_All is in effect, or the input - -- vertex is part of an Elaborat_Body pair. + Has_Cycle := Has_Cycle or Successor_Has_Cycle; + end loop; + + -- Visit the complementary vertex of the current vertex when pragma + -- Elaborate_All is in effect, or the current vertex is part of an + -- Elaborate_Body pair. if Elaborate_All_Active or else Is_Vertex_With_Elaborate_Body (G, Vertex) @@ -2215,1254 +2177,1211 @@ package body Bindo.Graphs is Force_Complement => Elaborate_All_Active); if Present (Complement) then - LGV_Sets.Insert (End_Vertices, Complement); + Find_Cycles_From_Vertex + (G => G, + Vertex => Complement, + End_Vertices => End_Vertices, + Deleted_Vertices => Deleted_Vertices, + Most_Significant_Edge => Most_Significant_Edge, + Invocation_Edge_Count => Invocation_Edge_Count, + Cycle_Path_Stack => Cycle_Path_Stack, + Visited_Set => Visited_Set, + Visited_Stack => Visited_Stack, + Cycle_Count => Cycle_Count, + Cycle_Limit => Cycle_Limit, + Elaborate_All_Active => Elaborate_All_Active, + Is_Start_Vertex => Is_Start_Vertex, + Has_Cycle => Complement_Has_Cycle, + Indent => Indent); + + Has_Cycle := Has_Cycle or Complement_Has_Cycle; end if; end if; - return End_Vertices; - end Cycle_End_Vertices; + -- The original algorithm clears the "marked stack" in two places: + -- + -- * When the depth-first search starting from the current vertex + -- discovers at least one cycle, and + -- + -- * When the depth-first search initiated from a start vertex + -- completes. + -- + -- The modified version handles both cases in one place. - ------------------- - -- Cycle_Kind_Of -- - ------------------- + if Has_Cycle or else Is_Start_Vertex then + Unvisit + (Vertex => Vertex, + Visited_Set => Visited_Set, + Visited_Stack => Visited_Stack); + end if; - function Cycle_Kind_Of - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Library_Graph_Cycle_Kind + -- Delete a start vertex from the graph once its depth-first search + -- completes. This action preserves the invariant where a cycle is + -- not rediscovered "later" in some permuted form. + + if Is_Start_Vertex then + LGV_Sets.Insert (Deleted_Vertices, Vertex); + end if; + end Find_Cycles_From_Vertex; + + ------------------------------ + -- Find_Cycles_In_Component -- + ------------------------------ + + procedure Find_Cycles_In_Component + (G : Library_Graph; + Comp : Component_Id; + Cycle_Count : in out Natural; + Cycle_Limit : Natural) is pragma Assert (Present (G)); - pragma Assert (Present (Edge)); + pragma Assert (Present (Comp)); + + Num_Of_Vertices : constant Natural := + Number_Of_Component_Vertices (G, Comp); + + Elaborate_All_Active : constant Boolean := + Has_Elaborate_All_Edge (G, Comp); + -- The presence of an Elaborate_All edge within a component causes + -- all spec-body pairs to be treated as one vertex. + + Has_Cycle : Boolean; + Iter : Component_Vertex_Iterator; + Vertex : Library_Graph_Vertex_Id; + + Cycle_Path_Stack : LGE_Lists.Doubly_Linked_List := LGE_Lists.Nil; + -- The "point stack" of Tarjan's algorithm. The original maintains + -- a stack of vertices, however for diagnostic purposes using edges + -- is preferable. + + Deleted_Vertices : LGV_Sets.Membership_Set := LGV_Sets.Nil; + -- The original algorithm alters the graph by deleting vertices with + -- lower ordinals compared to some starting vertex. Since the graph + -- must remain intact for diagnostic purposes, vertices are instead + -- inserted in this set and treated as "deleted". + + End_Vertices : LGV_Sets.Membership_Set := LGV_Sets.Nil; + -- The original algorithm uses a single vertex to indicate the start + -- and end vertex of a cycle. The semantics of pragmas Elaborate_All + -- and Elaborate_Body increase this number by one. The end vertices + -- are added to this set and treated as "cycle-terminating". + + Visited_Set : LGV_Sets.Membership_Set := LGV_Sets.Nil; + -- The "mark" array of Tarjan's algorithm. Since the original visits + -- all vertices in increasing ordinal number 1 .. N, the array offers + -- a one-to-one mapping between a vertex and its "marked" state. The + -- modified version however visits vertices within components, where + -- their ordinals are not contiguous. Vertices are added to this set + -- and treated as "marked". + + Visited_Stack : LGV_Lists.Doubly_Linked_List := LGV_Lists.Nil; + -- The "marked stack" of Tarjan's algorithm begin - if Is_Cyclic_Elaborate_All_Edge (G, Edge) then - return Elaborate_All_Cycle; + Trace_Component (G, Comp, No_Indentation); - elsif Is_Cyclic_Elaborate_Body_Edge (G, Edge) then - return Elaborate_Body_Cycle; + -- Initialize all component-level data structures - elsif Is_Cyclic_Elaborate_Edge (G, Edge) then - return Elaborate_Cycle; + Cycle_Path_Stack := LGE_Lists.Create; + Deleted_Vertices := LGV_Sets.Create (Num_Of_Vertices); + Visited_Set := LGV_Sets.Create (Num_Of_Vertices); + Visited_Stack := LGV_Lists.Create; - elsif Is_Cyclic_Forced_Edge (G, Edge) then - return Forced_Cycle; + -- The modified version does not use ordinals to visit vertices in + -- 1 .. N fashion. To preserve the invariant of the original, this + -- version deletes a vertex after its depth-first search completes. + -- The timing of the deletion is sound because all cycles through + -- that vertex have already been discovered, thus the vertex cannot + -- contribute to any cycles discovered "later" in the algorithm. - elsif Is_Cyclic_Invocation_Edge (G, Edge) then - return Invocation_Cycle; + Iter := Iterate_Component_Vertices (G, Comp); + while Has_Next (Iter) loop + Next (Iter, Vertex); - else - return No_Cycle_Kind; - end if; - end Cycle_Kind_Of; + -- Construct the set of vertices (at most 2) that terminates a + -- potential cycle that starts from the current vertex. + + End_Vertices := + Cycle_End_Vertices + (G => G, + Vertex => Vertex, + Elaborate_All_Active => Elaborate_All_Active); - --------------------------- - -- Cycle_Kind_Precedence -- - --------------------------- + -- The modified version maintains two additional attributes while + -- performing the depth-first search: + -- + -- * The most significant edge of the current potential cycle. + -- + -- * The number of invocation edges encountered along the path + -- of the current potential cycle. + -- + -- Both attributes are used in the heuristic that determines the + -- importance of cycles. - function Cycle_Kind_Precedence - (Kind : Library_Graph_Cycle_Kind; - Compared_To : Library_Graph_Cycle_Kind) return Precedence_Kind - is - Comp_Pos : constant Integer := - Library_Graph_Cycle_Kind'Pos (Compared_To); - Kind_Pos : constant Integer := Library_Graph_Cycle_Kind'Pos (Kind); + Find_Cycles_From_Vertex + (G => G, + Vertex => Vertex, + End_Vertices => End_Vertices, + Deleted_Vertices => Deleted_Vertices, + Most_Significant_Edge => No_Library_Graph_Edge, + Invocation_Edge_Count => 0, + Cycle_Path_Stack => Cycle_Path_Stack, + Visited_Set => Visited_Set, + Visited_Stack => Visited_Stack, + Cycle_Count => Cycle_Count, + Cycle_Limit => Cycle_Limit, + Elaborate_All_Active => Elaborate_All_Active, + Is_Start_Vertex => True, + Has_Cycle => Has_Cycle, + Indent => Nested_Indentation); - begin - -- A lower ordinal indicates a higher precedence + -- Destroy the cycle-terminating vertices because a new set must + -- be constructed for the next vertex. - if Kind_Pos < Comp_Pos then - return Higher_Precedence; + LGV_Sets.Destroy (End_Vertices); + end loop; - elsif Kind_Pos > Comp_Pos then - return Lower_Precedence; + -- Destroy all component-level data structures - else - return Equal_Precedence; - end if; - end Cycle_Kind_Precedence; + LGE_Lists.Destroy (Cycle_Path_Stack); + LGV_Sets.Destroy (Deleted_Vertices); + LGV_Sets.Destroy (Visited_Set); + LGV_Lists.Destroy (Visited_Stack); + end Find_Cycles_In_Component; - --------------------------- - -- Cycle_Path_Precedence -- - --------------------------- + --------------- + -- Find_Edge -- + --------------- - function Cycle_Path_Precedence - (G : Library_Graph; - Path : LGE_Lists.Doubly_Linked_List; - Compared_To : LGE_Lists.Doubly_Linked_List) return Precedence_Kind + function Find_Edge + (G : Library_Graph; + Pred : Library_Graph_Vertex_Id; + Succ : Library_Graph_Vertex_Id) return Library_Graph_Edge_Id is - procedure Next_Available - (Iter : in out LGE_Lists.Iterator; - Edge : out Library_Graph_Edge_Id); - pragma Inline (Next_Available); - -- Obtain the next edge available through iterator Iter, or return - -- No_Library_Graph_Edge if the iterator has been exhausted. + Result : Library_Graph_Edge_Id := No_Library_Graph_Edge; + Edge : Library_Graph_Edge_Id; + Iter : Edges_To_Successors_Iterator := + Iterate_Edges_To_Successors (G, Pred); - -------------------- - -- Next_Available -- - -------------------- + begin + -- IMPORTANT: + -- + -- * The iteration must run to completion in order to unlock the + -- edges to successors. - procedure Next_Available - (Iter : in out LGE_Lists.Iterator; - Edge : out Library_Graph_Edge_Id) - is - begin - -- Assume that the iterator has been exhausted + -- This does a linear search through the successors of Pred. + -- Efficiency is not a problem, because this is called only when + -- Activates_Task is True, which is rare, and anyway, there aren't + -- usually large numbers of successors. - Edge := No_Library_Graph_Edge; + while Has_Next (Iter) loop + Next (Iter, Edge); - if LGE_Lists.Has_Next (Iter) then - LGE_Lists.Next (Iter, Edge); + if Succ = Successor (G, Edge) then + pragma Assert (not Present (Result)); + Result := Edge; end if; - end Next_Available; + end loop; - -- Local variables + pragma Assert (Present (Result)); + return Result; + end Find_Edge; - Comp_Edge : Library_Graph_Edge_Id; - Comp_Iter : LGE_Lists.Iterator; - Path_Edge : Library_Graph_Edge_Id; - Path_Iter : LGE_Lists.Iterator; - Prec : Precedence_Kind; + --------------------------------------- + -- Find_First_Lower_Precedence_Cycle -- + --------------------------------------- - -- Start of processing for Cycle_Path_Precedence + function Find_First_Lower_Precedence_Cycle + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Id + is + Current_Cycle : Library_Graph_Cycle_Id; + Iter : All_Cycle_Iterator; + Lesser_Cycle : Library_Graph_Cycle_Id; begin pragma Assert (Present (G)); - pragma Assert (LGE_Lists.Present (Path)); - pragma Assert (LGE_Lists.Present (Compared_To)); - - -- Assume that the paths have equal precedence - - Prec := Equal_Precedence; + pragma Assert (Present (Cycle)); - Comp_Iter := LGE_Lists.Iterate (Compared_To); - Path_Iter := LGE_Lists.Iterate (Path); + -- Assume that there is no lesser cycle - Next_Available (Comp_Iter, Comp_Edge); - Next_Available (Path_Iter, Path_Edge); + Lesser_Cycle := No_Library_Graph_Cycle; + -- Find a cycle with a slightly lower precedence than the input + -- cycle. + -- -- IMPORTANT: -- - -- * The iteration must run to completion in order to unlock the - -- edges of both paths. + -- * The iterator must run to completion in order to unlock the + -- list of all cycles. - while Present (Comp_Edge) or else Present (Path_Edge) loop - if Prec = Equal_Precedence - and then Present (Comp_Edge) - and then Present (Path_Edge) + Iter := Iterate_All_Cycles (G); + while Has_Next (Iter) loop + Next (Iter, Current_Cycle); + + if not Present (Lesser_Cycle) + and then Cycle_Precedence + (G => G, + Cycle => Cycle, + Compared_To => Current_Cycle) = Higher_Precedence then - Prec := - Edge_Precedence - (G => G, - Edge => Path_Edge, - Compared_To => Comp_Edge); + Lesser_Cycle := Current_Cycle; end if; - - Next_Available (Comp_Iter, Comp_Edge); - Next_Available (Path_Iter, Path_Edge); end loop; - return Prec; - end Cycle_Path_Precedence; + return Lesser_Cycle; + end Find_First_Lower_Precedence_Cycle; - ---------------------- - -- Cycle_Precedence -- - ---------------------- + ------------------------------ + -- Get_Component_Attributes -- + ------------------------------ - function Cycle_Precedence - (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id; - Compared_To : Library_Graph_Cycle_Id) return Precedence_Kind + function Get_Component_Attributes + (G : Library_Graph; + Comp : Component_Id) return Component_Attributes + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Comp)); + + return Component_Tables.Get (G.Component_Attributes, Comp); + end Get_Component_Attributes; + + ------------------------ + -- Get_LGC_Attributes -- + ------------------------ + + function Get_LGC_Attributes + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Attributes is + begin pragma Assert (Present (G)); pragma Assert (Present (Cycle)); - pragma Assert (Present (Compared_To)); - Comp_Invs : constant Natural := - Invocation_Edge_Count (G, Compared_To); - Comp_Len : constant Natural := Length (G, Compared_To); - Cycle_Invs : constant Natural := Invocation_Edge_Count (G, Cycle); - Cycle_Len : constant Natural := Length (G, Cycle); - Kind_Prec : constant Precedence_Kind := - Cycle_Kind_Precedence - (Kind => Kind (G, Cycle), - Compared_To => Kind (G, Compared_To)); + return LGC_Tables.Get (G.Cycle_Attributes, Cycle); + end Get_LGC_Attributes; + + ------------------------ + -- Get_LGE_Attributes -- + ------------------------ + function Get_LGE_Attributes + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Library_Graph_Edge_Attributes + is begin - -- Prefer a cycle with higher precedence based on its kind + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); - if Kind_Prec = Higher_Precedence - or else - Kind_Prec = Lower_Precedence - then - return Kind_Prec; + return LGE_Tables.Get (G.Edge_Attributes, Edge); + end Get_LGE_Attributes; - -- Prefer a shorter cycle + ------------------------ + -- Get_LGV_Attributes -- + ------------------------ - elsif Cycle_Len < Comp_Len then - return Higher_Precedence; + function Get_LGV_Attributes + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) + return Library_Graph_Vertex_Attributes + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); - elsif Cycle_Len > Comp_Len then - return Lower_Precedence; + return LGV_Tables.Get (G.Vertex_Attributes, Vertex); + end Get_LGV_Attributes; - -- Prefer a cycle wih fewer invocation edges + ----------------------------- + -- Has_Elaborate_All_Cycle -- + ----------------------------- - elsif Cycle_Invs < Comp_Invs then - return Higher_Precedence; + function Has_Elaborate_All_Cycle (G : Library_Graph) return Boolean is + Edge : Library_Graph_Edge_Id; + Iter : All_Edge_Iterator; + Seen : Boolean; - elsif Cycle_Invs > Comp_Invs then - return Lower_Precedence; + begin + pragma Assert (Present (G)); - -- Prefer a cycle with a higher path precedence + -- Assume that no cyclic Elaborate_All edge has been seen - else - return - Cycle_Path_Precedence - (G => G, - Path => Path (G, Cycle), - Compared_To => Path (G, Compared_To)); - end if; - end Cycle_Precedence; + Seen := False; - ---------------------------------------- - -- Decrement_Library_Graph_Edge_Count -- - ---------------------------------------- + -- IMPORTANT: + -- + -- * The iteration must run to completion in order to unlock the + -- graph. - procedure Decrement_Library_Graph_Edge_Count - (G : Library_Graph; - Kind : Library_Graph_Edge_Kind) - is - pragma Assert (Present (G)); + Iter := Iterate_All_Edges (G); + while Has_Next (Iter) loop + Next (Iter, Edge); - Count : Natural renames G.Counts (Kind); + if not Seen and then Is_Cyclic_Elaborate_All_Edge (G, Edge) then + Seen := True; + end if; + end loop; - begin - Count := Count - 1; - end Decrement_Library_Graph_Edge_Count; + return Seen; + end Has_Elaborate_All_Cycle; - ------------------------------------ - -- Decrement_Pending_Predecessors -- - ------------------------------------ + ---------------------------- + -- Has_Elaborate_All_Edge -- + ---------------------------- - procedure Decrement_Pending_Predecessors + function Has_Elaborate_All_Edge (G : Library_Graph; - Comp : Component_Id; - Edge : Library_Graph_Edge_Id) + Comp : Component_Id) return Boolean is - Attrs : Component_Attributes; + Has_Edge : Boolean; + Iter : Component_Vertex_Iterator; + Vertex : Library_Graph_Vertex_Id; begin pragma Assert (Present (G)); pragma Assert (Present (Comp)); - Attrs := Get_Component_Attributes (G, Comp); + -- Assume that there is no Elaborate_All edge - Update_Pending_Predecessors - (Strong_Predecessors => Attrs.Pending_Strong_Predecessors, - Weak_Predecessors => Attrs.Pending_Weak_Predecessors, - Update_Weak => Is_Invocation_Edge (G, Edge), - Value => -1); + Has_Edge := False; - Set_Component_Attributes (G, Comp, Attrs); - end Decrement_Pending_Predecessors; + -- IMPORTANT: + -- + -- * The iteration must run to completion in order to unlock the + -- component vertices. - ------------------------------------ - -- Decrement_Pending_Predecessors -- - ------------------------------------ + Iter := Iterate_Component_Vertices (G, Comp); + while Has_Next (Iter) loop + Next (Iter, Vertex); - procedure Decrement_Pending_Predecessors + Has_Edge := Has_Edge or else Has_Elaborate_All_Edge (G, Vertex); + end loop; + + return Has_Edge; + end Has_Elaborate_All_Edge; + + ---------------------------- + -- Has_Elaborate_All_Edge -- + ---------------------------- + + function Has_Elaborate_All_Edge (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id; - Edge : Library_Graph_Edge_Id) + Vertex : Library_Graph_Vertex_Id) return Boolean is - Attrs : Library_Graph_Vertex_Attributes; + Edge : Library_Graph_Edge_Id; + Has_Edge : Boolean; + Iter : Edges_To_Successors_Iterator; begin pragma Assert (Present (G)); pragma Assert (Present (Vertex)); - Attrs := Get_LGV_Attributes (G, Vertex); - - Update_Pending_Predecessors - (Strong_Predecessors => Attrs.Pending_Strong_Predecessors, - Weak_Predecessors => Attrs.Pending_Weak_Predecessors, - Update_Weak => Is_Invocation_Edge (G, Edge), - Value => -1); - - Set_LGV_Attributes (G, Vertex, Attrs); - end Decrement_Pending_Predecessors; - - ----------------------------------- - -- Delete_Body_Before_Spec_Edges -- - ----------------------------------- + -- Assume that there is no Elaborate_All edge - procedure Delete_Body_Before_Spec_Edges - (G : Library_Graph; - Edges : LGE_Lists.Doubly_Linked_List) - is - Edge : Library_Graph_Edge_Id; - Iter : LGE_Lists.Iterator; + Has_Edge := False; - begin - pragma Assert (Present (G)); - pragma Assert (LGE_Lists.Present (Edges)); + -- IMPORTANT: + -- + -- * The iteration must run to completion in order to unlock the + -- edges to successors. - Iter := LGE_Lists.Iterate (Edges); - while LGE_Lists.Has_Next (Iter) loop - LGE_Lists.Next (Iter, Edge); - pragma Assert (Kind (G, Edge) = Body_Before_Spec_Edge); + Iter := Iterate_Edges_To_Successors (G, Vertex); + while Has_Next (Iter) loop + Next (Iter, Edge); - Delete_Edge (G, Edge); + Has_Edge := + Has_Edge or else Is_Cyclic_Elaborate_All_Edge (G, Edge); end loop; - end Delete_Body_Before_Spec_Edges; - ----------------- - -- Delete_Edge -- - ----------------- + return Has_Edge; + end Has_Elaborate_All_Edge; - procedure Delete_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) + ------------------------ + -- Has_Elaborate_Body -- + ------------------------ + + function Has_Elaborate_Body + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean is pragma Assert (Present (G)); - pragma Assert (Present (Edge)); + pragma Assert (Present (Vertex)); - Pred : constant Library_Graph_Vertex_Id := Predecessor (G, Edge); - Succ : constant Library_Graph_Vertex_Id := Successor (G, Edge); - Rel : constant Predecessor_Successor_Relation := - (Predecessor => Pred, - Successor => Succ); + U_Id : constant Unit_Id := Unit (G, Vertex); + U_Rec : Unit_Record renames ALI.Units.Table (U_Id); begin - -- Update the edge statistics - - Decrement_Library_Graph_Edge_Count (G, Kind (G, Edge)); - - -- Update the number of pending predecessors the successor must wait - -- on before it is elaborated. - - Decrement_Pending_Predecessors - (G => G, - Vertex => Succ, - Edge => Edge); - - -- Delete the link between the predecessor and successor. This allows - -- for further attempts to link the same predecessor and successor. + -- Treat the spec and body as decoupled when switch -d_b (ignore the + -- effects of pragma Elaborate_Body) is in effect. - RE_Sets.Delete (G.Recorded_Edges, Rel); + return U_Rec.Elaborate_Body and not Debug_Flag_Underscore_B; + end Has_Elaborate_Body; - -- Delete the attributes of the edge + -------------- + -- Has_Next -- + -------------- - LGE_Tables.Delete (G.Edge_Attributes, Edge); + function Has_Next (Iter : All_Cycle_Iterator) return Boolean is + begin + return LGC_Lists.Has_Next (LGC_Lists.Iterator (Iter)); + end Has_Next; - -- Delete the edge from the underlying graph + -------------- + -- Has_Next -- + -------------- - DG.Delete_Edge (G.Graph, Edge); - end Delete_Edge; + function Has_Next (Iter : All_Edge_Iterator) return Boolean is + begin + return DG.Has_Next (DG.All_Edge_Iterator (Iter)); + end Has_Next; - ------------- - -- Destroy -- - ------------- + -------------- + -- Has_Next -- + -------------- - procedure Destroy (G : in out Library_Graph) is + function Has_Next (Iter : All_Vertex_Iterator) return Boolean is begin - pragma Assert (Present (G)); + return DG.Has_Next (DG.All_Vertex_Iterator (Iter)); + end Has_Next; - Component_Tables.Destroy (G.Component_Attributes); - LGC_Tables.Destroy (G.Cycle_Attributes); - LGC_Lists.Destroy (G.Cycles); - LGE_Tables.Destroy (G.Edge_Attributes); - DG.Destroy (G.Graph); - RE_Sets.Destroy (G.Recorded_Edges); - Unit_Tables.Destroy (G.Unit_To_Vertex); - LGV_Tables.Destroy (G.Vertex_Attributes); + -------------- + -- Has_Next -- + -------------- - Free (G); - end Destroy; + function Has_Next (Iter : Component_Iterator) return Boolean is + begin + return DG.Has_Next (DG.Component_Iterator (Iter)); + end Has_Next; - ---------------------------------- - -- Destroy_Component_Attributes -- - ---------------------------------- + -------------- + -- Has_Next -- + -------------- - procedure Destroy_Component_Attributes - (Attrs : in out Component_Attributes) - is - pragma Unreferenced (Attrs); + function Has_Next (Iter : Component_Vertex_Iterator) return Boolean is begin - null; - end Destroy_Component_Attributes; + return DG.Has_Next (DG.Component_Vertex_Iterator (Iter)); + end Has_Next; - -------------------------------------------- - -- Destroy_Library_Graph_Cycle_Attributes -- - -------------------------------------------- + -------------- + -- Has_Next -- + -------------- - procedure Destroy_Library_Graph_Cycle_Attributes - (Attrs : in out Library_Graph_Cycle_Attributes) - is + function Has_Next (Iter : Edges_Of_Cycle_Iterator) return Boolean is begin - LGE_Lists.Destroy (Attrs.Path); - end Destroy_Library_Graph_Cycle_Attributes; + return LGE_Lists.Has_Next (LGE_Lists.Iterator (Iter)); + end Has_Next; - ------------------------------------------- - -- Destroy_Library_Graph_Edge_Attributes -- - ------------------------------------------- + -------------- + -- Has_Next -- + -------------- - procedure Destroy_Library_Graph_Edge_Attributes - (Attrs : in out Library_Graph_Edge_Attributes) - is - pragma Unreferenced (Attrs); + function Has_Next (Iter : Edges_To_Successors_Iterator) return Boolean is begin - null; - end Destroy_Library_Graph_Edge_Attributes; + return DG.Has_Next (DG.Outgoing_Edge_Iterator (Iter)); + end Has_Next; - --------------------------------------------- - -- Destroy_Library_Graph_Vertex_Attributes -- - --------------------------------------------- + ----------------------------- + -- Has_No_Elaboration_Code -- + ----------------------------- - procedure Destroy_Library_Graph_Vertex_Attributes - (Attrs : in out Library_Graph_Vertex_Attributes) + function Has_No_Elaboration_Code + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean is - pragma Unreferenced (Attrs); begin - null; - end Destroy_Library_Graph_Vertex_Attributes; + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); - --------------------- - -- Edge_Precedence -- - --------------------- + return Has_No_Elaboration_Code (Unit (G, Vertex)); + end Has_No_Elaboration_Code; - function Edge_Precedence - (G : Library_Graph; - Edge : Library_Graph_Edge_Id; - Compared_To : Library_Graph_Edge_Id) return Precedence_Kind - is - pragma Assert (Present (G)); - pragma Assert (Present (Edge)); - pragma Assert (Present (Compared_To)); + ----------------------------------------- + -- Hash_Library_Graph_Cycle_Attributes -- + ----------------------------------------- - Comp_Succ : constant Library_Graph_Vertex_Id := - Successor (G, Compared_To); - Edge_Succ : constant Library_Graph_Vertex_Id := - Successor (G, Edge); - Kind_Prec : constant Precedence_Kind := - Cycle_Kind_Precedence - (Kind => Cycle_Kind_Of (G, Edge), - Compared_To => Cycle_Kind_Of (G, Compared_To)); - Succ_Prec : constant Precedence_Kind := - Vertex_Precedence - (G => G, - Vertex => Edge_Succ, - Compared_To => Comp_Succ); + function Hash_Library_Graph_Cycle_Attributes + (Attrs : Library_Graph_Cycle_Attributes) return Bucket_Range_Type + is + Edge : Library_Graph_Edge_Id; + Hash : Bucket_Range_Type; + Iter : LGE_Lists.Iterator; begin - -- Prefer an edge with a higher cycle kind precedence - - if Kind_Prec = Higher_Precedence - or else - Kind_Prec = Lower_Precedence - then - return Kind_Prec; + pragma Assert (LGE_Lists.Present (Attrs.Path)); - -- Prefer an edge whose successor has a higher precedence + -- The hash is obtained in the following manner: + -- + -- (((edge1 * 31) + edge2) * 31) + edgeN - elsif Comp_Succ /= Edge_Succ - and then (Succ_Prec = Higher_Precedence - or else - Succ_Prec = Lower_Precedence) - then - return Succ_Prec; + Hash := 0; + Iter := LGE_Lists.Iterate (Attrs.Path); + while LGE_Lists.Has_Next (Iter) loop + LGE_Lists.Next (Iter, Edge); - -- Prefer an edge whose predecessor has a higher precedence + Hash := (Hash * 31) + Bucket_Range_Type (Edge); + end loop; - else - return - Vertex_Precedence - (G => G, - Vertex => Predecessor (G, Edge), - Compared_To => Predecessor (G, Compared_To)); - end if; - end Edge_Precedence; + return Hash; + end Hash_Library_Graph_Cycle_Attributes; - --------------- - -- File_Name -- - --------------- + ----------------------------------------- + -- Hash_Predecessor_Successor_Relation -- + ----------------------------------------- - function File_Name - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return File_Name_Type + function Hash_Predecessor_Successor_Relation + (Rel : Predecessor_Successor_Relation) return Bucket_Range_Type is begin - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); - - return File_Name (Unit (G, Vertex)); - end File_Name; + pragma Assert (Present (Rel.Predecessor)); + pragma Assert (Present (Rel.Successor)); - --------------------- - -- Find_Components -- - --------------------- + return + Hash_Two_Keys + (Bucket_Range_Type (Rel.Predecessor), + Bucket_Range_Type (Rel.Successor)); + end Hash_Predecessor_Successor_Relation; - procedure Find_Components (G : Library_Graph) is - Edges : LGE_Lists.Doubly_Linked_List; + ------------------------------ + -- Highest_Precedence_Cycle -- + ------------------------------ + function Highest_Precedence_Cycle + (G : Library_Graph) return Library_Graph_Cycle_Id + is begin pragma Assert (Present (G)); + pragma Assert (LGC_Lists.Present (G.Cycles)); - Start_Phase (Component_Discovery); - - -- Initialize or reinitialize the components of the graph + if LGC_Lists.Is_Empty (G.Cycles) then + return No_Library_Graph_Cycle; - Initialize_Components (G); + -- The highest precedence cycle is always the first in the list of + -- all cycles. - -- Create a set of special edges that link a predecessor body with a - -- successor spec. This is an illegal dependency, however using such - -- edges eliminates the need to create yet another graph, where both - -- spec and body are collapsed into a single vertex. + else + return LGC_Lists.First (G.Cycles); + end if; + end Highest_Precedence_Cycle; - Edges := LGE_Lists.Create; - Add_Body_Before_Spec_Edges (G, Edges); + ----------------------------- + -- Highest_Precedence_Edge -- + ----------------------------- - DG.Find_Components (G.Graph); + function Highest_Precedence_Edge + (G : Library_Graph; + Left : Library_Graph_Edge_Id; + Right : Library_Graph_Edge_Id) return Library_Graph_Edge_Id + is + Edge_Prec : Precedence_Kind; - -- Remove the special edges that link a predecessor body with a - -- successor spec because they cause unresolvable circularities. + begin + pragma Assert (Present (G)); - Delete_Body_Before_Spec_Edges (G, Edges); - LGE_Lists.Destroy (Edges); + -- Both edges are available, pick the one with highest precedence - -- Update the number of predecessors various components must wait on - -- before they can be elaborated. + if Present (Left) and then Present (Right) then + Edge_Prec := + Edge_Precedence + (G => G, + Edge => Left, + Compared_To => Right); - Update_Pending_Predecessors_Of_Components (G); - End_Phase (Component_Discovery); - end Find_Components; + if Edge_Prec = Higher_Precedence then + return Left; - ----------------- - -- Find_Cycles -- - ----------------- + -- The precedence rules for edges are such that no two edges can + -- ever have the same precedence. - procedure Find_Cycles (G : Library_Graph) is - All_Cycle_Limit : constant Natural := 64; - -- The performance of Tarjan's algorithm may degrate to exponential - -- when pragma Elaborate_All is in effect, or some vertex is part of - -- an Elaborate_Body pair. In this case the algorithm discovers all - -- combinations of edges that close a circuit starting and ending on - -- some start vertex while going through different vertices. Use a - -- limit on the total number of cycles within a component to guard - -- against such degradation. + else + pragma Assert (Edge_Prec = Lower_Precedence); + return Right; + end if; - Comp : Component_Id; - Cycle_Count : Natural; - Iter : Component_Iterator; + -- Otherwise at least one edge must be present - begin - pragma Assert (Present (G)); + elsif Present (Left) then + return Left; - Start_Phase (Cycle_Discovery); + else + pragma Assert (Present (Right)); - -- The cycles of graph G are discovered using Tarjan's enumeration - -- of the elementary circuits of a directed-graph algorithm. Do not - -- modify this code unless you intimately understand the algorithm. - -- - -- The logic of the algorithm is split among the following routines: - -- - -- Cycle_End_Vertices - -- Find_Cycles_From_Successor - -- Find_Cycles_From_Vertex - -- Find_Cycles_In_Component - -- Unvisit - -- Visit - -- - -- The original algorithm has been significantly modified in order to - -- - -- * Accommodate the semantics of Elaborate_All and Elaborate_Body. - -- - -- * Capture cycle paths as edges rather than vertices. - -- - -- * Take advantage of graph components. + return Right; + end if; + end Highest_Precedence_Edge; - -- Assume that the graph does not contain a cycle + -------------------------- + -- In_Elaboration_Order -- + -------------------------- - Cycle_Count := 0; + function In_Elaboration_Order + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); - -- Run the modified version of the algorithm on each component of the - -- graph. + return Get_LGV_Attributes (G, Vertex).In_Elaboration_Order; + end In_Elaboration_Order; - Iter := Iterate_Components (G); - while Has_Next (Iter) loop - Next (Iter, Comp); + ----------------------- + -- In_Same_Component -- + ----------------------- - Find_Cycles_In_Component - (G => G, - Comp => Comp, - Cycle_Count => Cycle_Count, - Cycle_Limit => All_Cycle_Limit); - end loop; + function In_Same_Component + (G : Library_Graph; + Left : Library_Graph_Vertex_Id; + Right : Library_Graph_Vertex_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Left)); + pragma Assert (Present (Right)); - End_Phase (Cycle_Discovery); - end Find_Cycles; + return Component (G, Left) = Component (G, Right); + end In_Same_Component; - -------------------------------- - -- Find_Cycles_From_Successor -- - -------------------------------- + ---------------------------------------- + -- Increment_Library_Graph_Edge_Count -- + ---------------------------------------- - procedure Find_Cycles_From_Successor - (G : Library_Graph; - Edge : Library_Graph_Edge_Id; - End_Vertices : LGV_Sets.Membership_Set; - Deleted_Vertices : LGV_Sets.Membership_Set; - Most_Significant_Edge : Library_Graph_Edge_Id; - Invocation_Edge_Count : Natural; - Cycle_Path_Stack : LGE_Lists.Doubly_Linked_List; - Visited_Set : LGV_Sets.Membership_Set; - Visited_Stack : LGV_Lists.Doubly_Linked_List; - Cycle_Count : in out Natural; - Cycle_Limit : Natural; - Elaborate_All_Active : Boolean; - Has_Cycle : out Boolean; - Indent : Indentation_Level) + procedure Increment_Library_Graph_Edge_Count + (G : Library_Graph; + Kind : Library_Graph_Edge_Kind) is pragma Assert (Present (G)); - pragma Assert (Present (Edge)); - pragma Assert (LGV_Sets.Present (End_Vertices)); - pragma Assert (LGV_Sets.Present (Deleted_Vertices)); - pragma Assert (LGE_Lists.Present (Cycle_Path_Stack)); - pragma Assert (LGV_Sets.Present (Visited_Set)); - pragma Assert (LGV_Lists.Present (Visited_Stack)); - Succ : constant Library_Graph_Vertex_Id := Successor (G, Edge); - Succ_Indent : constant Indentation_Level := - Indent + Nested_Indentation; + Count : Natural renames G.Counts (Kind); begin - -- Assume that the successor reached via the edge does not result in - -- a cycle. - - Has_Cycle := False; + Count := Count + 1; + end Increment_Library_Graph_Edge_Count; - -- Nothing to do when the edge connects two vertices residing in two - -- different components. + ------------------------------------ + -- Increment_Pending_Predecessors -- + ------------------------------------ - if not Is_Cyclic_Edge (G, Edge) then - return; - end if; + procedure Increment_Pending_Predecessors + (G : Library_Graph; + Comp : Component_Id; + Edge : Library_Graph_Edge_Id) + is + Attrs : Component_Attributes; - Trace_Edge (G, Edge, Indent); + begin + pragma Assert (Present (G)); + pragma Assert (Present (Comp)); - -- The modified version does not place vertices on the "point stack", - -- but instead collects the edges comprising the cycle. Prepare the - -- edge for backtracking. + Attrs := Get_Component_Attributes (G, Comp); - LGE_Lists.Prepend (Cycle_Path_Stack, Edge); + Update_Pending_Predecessors + (Strong_Predecessors => Attrs.Pending_Strong_Predecessors, + Weak_Predecessors => Attrs.Pending_Weak_Predecessors, + Update_Weak => Is_Invocation_Edge (G, Edge), + Value => 1); - Find_Cycles_From_Vertex - (G => G, - Vertex => Succ, - End_Vertices => End_Vertices, - Deleted_Vertices => Deleted_Vertices, - Most_Significant_Edge => Most_Significant_Edge, - Invocation_Edge_Count => Invocation_Edge_Count, - Cycle_Path_Stack => Cycle_Path_Stack, - Visited_Set => Visited_Set, - Visited_Stack => Visited_Stack, - Cycle_Count => Cycle_Count, - Cycle_Limit => Cycle_Limit, - Elaborate_All_Active => Elaborate_All_Active, - Is_Start_Vertex => False, - Has_Cycle => Has_Cycle, - Indent => Succ_Indent); + Set_Component_Attributes (G, Comp, Attrs); + end Increment_Pending_Predecessors; - -- The modified version does not place vertices on the "point stack", - -- but instead collects the edges comprising the cycle. Backtrack the - -- edge. + ------------------------------------ + -- Increment_Pending_Predecessors -- + ------------------------------------ - LGE_Lists.Delete_First (Cycle_Path_Stack); - end Find_Cycles_From_Successor; + procedure Increment_Pending_Predecessors + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id; + Edge : Library_Graph_Edge_Id) + is + Attrs : Library_Graph_Vertex_Attributes; - ----------------------------- - -- Find_Cycles_From_Vertex -- - ----------------------------- + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); - procedure Find_Cycles_From_Vertex - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id; - End_Vertices : LGV_Sets.Membership_Set; - Deleted_Vertices : LGV_Sets.Membership_Set; - Most_Significant_Edge : Library_Graph_Edge_Id; - Invocation_Edge_Count : Natural; - Cycle_Path_Stack : LGE_Lists.Doubly_Linked_List; - Visited_Set : LGV_Sets.Membership_Set; - Visited_Stack : LGV_Lists.Doubly_Linked_List; - Cycle_Count : in out Natural; - Cycle_Limit : Natural; - Elaborate_All_Active : Boolean; - Is_Start_Vertex : Boolean; - Has_Cycle : out Boolean; - Indent : Indentation_Level) - is - Edge_Indent : constant Indentation_Level := - Indent + Nested_Indentation; + Attrs := Get_LGV_Attributes (G, Vertex); - Complement : Library_Graph_Vertex_Id; - Edge : Library_Graph_Edge_Id; - Iter : Edges_To_Successors_Iterator; + Update_Pending_Predecessors + (Strong_Predecessors => Attrs.Pending_Strong_Predecessors, + Weak_Predecessors => Attrs.Pending_Weak_Predecessors, + Update_Weak => Is_Invocation_Edge (G, Edge), + Value => 1); - Complement_Has_Cycle : Boolean; - -- This flag is set when either Elaborate_All is in effect or the - -- current vertex is part of an Elaborate_Body pair, and visiting - -- the "complementary" vertex resulted in a cycle. + Set_LGV_Attributes (G, Vertex, Attrs); + end Increment_Pending_Predecessors; - Successor_Has_Cycle : Boolean; - -- This flag is set when visiting at least one successor of the - -- current vertex resulted in a cycle. + --------------------------- + -- Initialize_Components -- + --------------------------- + procedure Initialize_Components (G : Library_Graph) is begin pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); - pragma Assert (LGV_Sets.Present (End_Vertices)); - pragma Assert (LGV_Sets.Present (Deleted_Vertices)); - pragma Assert (LGE_Lists.Present (Cycle_Path_Stack)); - pragma Assert (LGV_Sets.Present (Visited_Set)); - pragma Assert (LGV_Lists.Present (Visited_Stack)); - -- Assume that the vertex does not close a circuit + -- The graph already contains a set of components. Reinitialize + -- them in order to accommodate the new set of components about to + -- be computed. - Has_Cycle := False; + if Number_Of_Components (G) > 0 then + Component_Tables.Destroy (G.Component_Attributes); - -- Nothing to do when the limit on the number of saved cycles has - -- been reached. This protects against a combinatorial explosion - -- in components with Elaborate_All cycles. + G.Component_Attributes := + Component_Tables.Create (Number_Of_Vertices (G)); + end if; + end Initialize_Components; - if Cycle_Count >= Cycle_Limit then - return; + --------------------------- + -- Invocation_Edge_Count -- + --------------------------- - -- The vertex closes the circuit, thus resulting in a cycle. Save - -- the cycle for later diagnostics. The initial invocation of the - -- routine always ignores the starting vertex, to prevent a spurious - -- self-cycle. + function Invocation_Edge_Count + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) return Natural + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Cycle)); - elsif not Is_Start_Vertex - and then LGV_Sets.Contains (End_Vertices, Vertex) - then - Trace_Vertex (G, Vertex, Indent); + return Get_LGC_Attributes (G, Cycle).Invocation_Edge_Count; + end Invocation_Edge_Count; - Record_Cycle - (G => G, - Most_Significant_Edge => Most_Significant_Edge, - Invocation_Edge_Count => Invocation_Edge_Count, - Cycle_Path => Cycle_Path_Stack, - Indent => Indent); + ------------------------------- + -- Invocation_Graph_Encoding -- + ------------------------------- - Has_Cycle := True; - Cycle_Count := Cycle_Count + 1; - return; + function Invocation_Graph_Encoding + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) + return Invocation_Graph_Encoding_Kind + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); - -- Nothing to do when the vertex has already been deleted. This - -- indicates that all available cycles involving the vertex have - -- been discovered, and the vertex cannot contribute further to - -- the depth-first search. + return Invocation_Graph_Encoding (Unit (G, Vertex)); + end Invocation_Graph_Encoding; - elsif LGV_Sets.Contains (Deleted_Vertices, Vertex) then - return; + ------------- + -- Is_Body -- + ------------- - -- Nothing to do when the vertex has already been visited. This - -- indicates that the depth-first search initiated from some start - -- vertex already encountered this vertex, and the visited stack has - -- not been unrolled yet. + function Is_Body + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean + is + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + U_Id : constant Unit_Id := Unit (G, Vertex); + U_Rec : Unit_Record renames ALI.Units.Table (U_Id); - elsif LGV_Sets.Contains (Visited_Set, Vertex) then - return; - end if; + begin + return U_Rec.Utype = Is_Body or else U_Rec.Utype = Is_Body_Only; + end Is_Body; - Trace_Vertex (G, Vertex, Indent); + ----------------------------------------- + -- Is_Body_Of_Spec_With_Elaborate_Body -- + ----------------------------------------- - -- Mark the vertex as visited + function Is_Body_Of_Spec_With_Elaborate_Body + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); - Visit - (Vertex => Vertex, - Visited_Set => Visited_Set, - Visited_Stack => Visited_Stack); + if Is_Body_With_Spec (G, Vertex) then + return + Is_Spec_With_Elaborate_Body + (G => G, + Vertex => Proper_Spec (G, Vertex)); + end if; - -- Extend the depth-first search via all the edges to successors + return False; + end Is_Body_Of_Spec_With_Elaborate_Body; - Iter := Iterate_Edges_To_Successors (G, Vertex); - while Has_Next (Iter) loop - Next (Iter, Edge); + ----------------------- + -- Is_Body_With_Spec -- + ----------------------- - Find_Cycles_From_Successor - (G => G, - Edge => Edge, - End_Vertices => End_Vertices, - Deleted_Vertices => Deleted_Vertices, + function Is_Body_With_Spec + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean + is + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); - -- The edge may be more important than the most important edge - -- up to this point, thus "upgrading" the nature of the cycle, - -- and shifting its point of normalization. + U_Id : constant Unit_Id := Unit (G, Vertex); + U_Rec : Unit_Record renames ALI.Units.Table (U_Id); - Most_Significant_Edge => - Highest_Precedence_Edge - (G => G, - Left => Edge, - Right => Most_Significant_Edge), + begin + return U_Rec.Utype = Is_Body; + end Is_Body_With_Spec; - -- The edge may be an invocation edge, in which case the count - -- of invocation edges increases by one. + ------------------------------ + -- Is_Cycle_Initiating_Edge -- + ------------------------------ - Invocation_Edge_Count => - Maximum_Invocation_Edge_Count - (G => G, - Edge => Edge, - Count => Invocation_Edge_Count), + function Is_Cycle_Initiating_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); - Cycle_Path_Stack => Cycle_Path_Stack, - Visited_Set => Visited_Set, - Visited_Stack => Visited_Stack, - Cycle_Count => Cycle_Count, - Cycle_Limit => Cycle_Limit, - Elaborate_All_Active => Elaborate_All_Active, - Has_Cycle => Successor_Has_Cycle, - Indent => Edge_Indent); + return + Is_Cyclic_Elaborate_All_Edge (G, Edge) + or else Is_Cyclic_Elaborate_Body_Edge (G, Edge) + or else Is_Cyclic_Elaborate_Edge (G, Edge) + or else Is_Cyclic_Forced_Edge (G, Edge) + or else Is_Cyclic_Invocation_Edge (G, Edge); + end Is_Cycle_Initiating_Edge; - Has_Cycle := Has_Cycle or Successor_Has_Cycle; - end loop; + -------------------- + -- Is_Cyclic_Edge -- + -------------------- - -- Visit the complementary vertex of the current vertex when pragma - -- Elaborate_All is in effect, or the current vertex is part of an - -- Elaborate_Body pair. + function Is_Cyclic_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); - if Elaborate_All_Active - or else Is_Vertex_With_Elaborate_Body (G, Vertex) - then - Complement := - Complementary_Vertex - (G => G, - Vertex => Vertex, - Force_Complement => Elaborate_All_Active); + return + Is_Cycle_Initiating_Edge (G, Edge) + or else Is_Cyclic_With_Edge (G, Edge); + end Is_Cyclic_Edge; - if Present (Complement) then - Find_Cycles_From_Vertex - (G => G, - Vertex => Complement, - End_Vertices => End_Vertices, - Deleted_Vertices => Deleted_Vertices, - Most_Significant_Edge => Most_Significant_Edge, - Invocation_Edge_Count => Invocation_Edge_Count, - Cycle_Path_Stack => Cycle_Path_Stack, - Visited_Set => Visited_Set, - Visited_Stack => Visited_Stack, - Cycle_Count => Cycle_Count, - Cycle_Limit => Cycle_Limit, - Elaborate_All_Active => Elaborate_All_Active, - Is_Start_Vertex => Is_Start_Vertex, - Has_Cycle => Complement_Has_Cycle, - Indent => Indent); + ---------------------------------- + -- Is_Cyclic_Elaborate_All_Edge -- + ---------------------------------- - Has_Cycle := Has_Cycle or Complement_Has_Cycle; - end if; - end if; + function Is_Cyclic_Elaborate_All_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); - -- The original algorithm clears the "marked stack" in two places: - -- - -- * When the depth-first search starting from the current vertex - -- discovers at least one cycle, and - -- - -- * When the depth-first search initiated from a start vertex - -- completes. - -- - -- The modified version handles both cases in one place. + return + Is_Elaborate_All_Edge (G, Edge) + and then Links_Vertices_In_Same_Component (G, Edge); + end Is_Cyclic_Elaborate_All_Edge; - if Has_Cycle or else Is_Start_Vertex then - Unvisit - (Vertex => Vertex, - Visited_Set => Visited_Set, - Visited_Stack => Visited_Stack); - end if; + ----------------------------------- + -- Is_Cyclic_Elaborate_Body_Edge -- + ----------------------------------- - -- Delete a start vertex from the graph once its depth-first search - -- completes. This action preserves the invariant where a cycle is - -- not rediscovered "later" in some permuted form. + function Is_Cyclic_Elaborate_Body_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); - if Is_Start_Vertex then - LGV_Sets.Insert (Deleted_Vertices, Vertex); - end if; - end Find_Cycles_From_Vertex; + return + Is_Elaborate_Body_Edge (G, Edge) + and then Links_Vertices_In_Same_Component (G, Edge); + end Is_Cyclic_Elaborate_Body_Edge; ------------------------------ - -- Find_Cycles_In_Component -- + -- Is_Cyclic_Elaborate_Edge -- ------------------------------ - procedure Find_Cycles_In_Component - (G : Library_Graph; - Comp : Component_Id; - Cycle_Count : in out Natural; - Cycle_Limit : Natural) + function Is_Cyclic_Elaborate_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean is + begin pragma Assert (Present (G)); - pragma Assert (Present (Comp)); - - Num_Of_Vertices : constant Natural := - Number_Of_Component_Vertices (G, Comp); - - Elaborate_All_Active : constant Boolean := - Has_Elaborate_All_Edge (G, Comp); - -- The presence of an Elaborate_All edge within a component causes - -- all spec-body pairs to be treated as one vertex. - - Has_Cycle : Boolean; - Iter : Component_Vertex_Iterator; - Vertex : Library_Graph_Vertex_Id; + pragma Assert (Present (Edge)); - Cycle_Path_Stack : LGE_Lists.Doubly_Linked_List := LGE_Lists.Nil; - -- The "point stack" of Tarjan's algorithm. The original maintains - -- a stack of vertices, however for diagnostic purposes using edges - -- is preferable. + return + Is_Elaborate_Edge (G, Edge) + and then Links_Vertices_In_Same_Component (G, Edge); + end Is_Cyclic_Elaborate_Edge; - Deleted_Vertices : LGV_Sets.Membership_Set := LGV_Sets.Nil; - -- The original algorithm alters the graph by deleting vertices with - -- lower ordinals compared to some starting vertex. Since the graph - -- must remain intact for diagnostic purposes, vertices are instead - -- inserted in this set and treated as "deleted". + --------------------------- + -- Is_Cyclic_Forced_Edge -- + --------------------------- - End_Vertices : LGV_Sets.Membership_Set := LGV_Sets.Nil; - -- The original algorithm uses a single vertex to indicate the start - -- and end vertex of a cycle. The semantics of pragmas Elaborate_All - -- and Elaborate_Body increase this number by one. The end vertices - -- are added to this set and treated as "cycle-terminating". + function Is_Cyclic_Forced_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); - Visited_Set : LGV_Sets.Membership_Set := LGV_Sets.Nil; - -- The "mark" array of Tarjan's algorithm. Since the original visits - -- all vertices in increasing ordinal number 1 .. N, the array offers - -- a one-to-one mapping between a vertex and its "marked" state. The - -- modified version however visits vertices within components, where - -- their ordinals are not contiguous. Vertices are added to this set - -- and treated as "marked". + return + Is_Forced_Edge (G, Edge) + and then Links_Vertices_In_Same_Component (G, Edge); + end Is_Cyclic_Forced_Edge; - Visited_Stack : LGV_Lists.Doubly_Linked_List := LGV_Lists.Nil; - -- The "marked stack" of Tarjan's algorithm + ------------------------------- + -- Is_Cyclic_Invocation_Edge -- + ------------------------------- + function Is_Cyclic_Invocation_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean + is begin - Trace_Component (G, Comp, No_Indentation); + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); - -- Initialize all component-level data structures + return + Is_Invocation_Edge (G, Edge) + and then Links_Vertices_In_Same_Component (G, Edge); + end Is_Cyclic_Invocation_Edge; - Cycle_Path_Stack := LGE_Lists.Create; - Deleted_Vertices := LGV_Sets.Create (Num_Of_Vertices); - Visited_Set := LGV_Sets.Create (Num_Of_Vertices); - Visited_Stack := LGV_Lists.Create; + ------------------------- + -- Is_Cyclic_With_Edge -- + ------------------------- - -- The modified version does not use ordinals to visit vertices in - -- 1 .. N fashion. To preserve the invariant of the original, this - -- version deletes a vertex after its depth-first search completes. - -- The timing of the deletion is sound because all cycles through - -- that vertex have already been discovered, thus the vertex cannot - -- contribute to any cycles discovered "later" in the algorithm. + function Is_Cyclic_With_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); - Iter := Iterate_Component_Vertices (G, Comp); - while Has_Next (Iter) loop - Next (Iter, Vertex); + -- Ignore Elaborate_Body edges because they also appear as with + -- edges, but have special successors. - -- Construct the set of vertices (at most 2) that terminates a - -- potential cycle that starts from the current vertex. + return + Is_With_Edge (G, Edge) + and then Links_Vertices_In_Same_Component (G, Edge) + and then not Is_Elaborate_Body_Edge (G, Edge); + end Is_Cyclic_With_Edge; - End_Vertices := - Cycle_End_Vertices - (G => G, - Vertex => Vertex, - Elaborate_All_Active => Elaborate_All_Active); + ------------------------------- + -- Is_Dynamically_Elaborated -- + ------------------------------- - -- The modified version maintains two additional attributes while - -- performing the depth-first search: - -- - -- * The most significant edge of the current potential cycle. - -- - -- * The number of invocation edges encountered along the path - -- of the current potential cycle. - -- - -- Both attributes are used in the heuristic that determines the - -- importance of cycles. + function Is_Dynamically_Elaborated + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); - Find_Cycles_From_Vertex - (G => G, - Vertex => Vertex, - End_Vertices => End_Vertices, - Deleted_Vertices => Deleted_Vertices, - Most_Significant_Edge => No_Library_Graph_Edge, - Invocation_Edge_Count => 0, - Cycle_Path_Stack => Cycle_Path_Stack, - Visited_Set => Visited_Set, - Visited_Stack => Visited_Stack, - Cycle_Count => Cycle_Count, - Cycle_Limit => Cycle_Limit, - Elaborate_All_Active => Elaborate_All_Active, - Is_Start_Vertex => True, - Has_Cycle => Has_Cycle, - Indent => Nested_Indentation); + return Is_Dynamically_Elaborated (Unit (G, Vertex)); + end Is_Dynamically_Elaborated; - -- Destroy the cycle-terminating vertices because a new set must - -- be constructed for the next vertex. + ----------------------------- + -- Is_Elaborable_Component -- + ----------------------------- - LGV_Sets.Destroy (End_Vertices); - end loop; + function Is_Elaborable_Component + (G : Library_Graph; + Comp : Component_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Comp)); - -- Destroy all component-level data structures + -- A component is elaborable when: + -- + -- * It is not waiting on strong predecessors, and + -- * It is not waiting on weak predecessors - LGE_Lists.Destroy (Cycle_Path_Stack); - LGV_Sets.Destroy (Deleted_Vertices); - LGV_Sets.Destroy (Visited_Set); - LGV_Lists.Destroy (Visited_Stack); - end Find_Cycles_In_Component; + return + Pending_Strong_Predecessors (G, Comp) = 0 + and then Pending_Weak_Predecessors (G, Comp) = 0; + end Is_Elaborable_Component; - --------------- - -- Find_Edge -- - --------------- + -------------------------- + -- Is_Elaborable_Vertex -- + -------------------------- - function Find_Edge - (G : Library_Graph; - Pred : Library_Graph_Vertex_Id; - Succ : Library_Graph_Vertex_Id) return Library_Graph_Edge_Id + function Is_Elaborable_Vertex + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean is - Result : Library_Graph_Edge_Id := No_Library_Graph_Edge; - Edge : Library_Graph_Edge_Id; - Iter : Edges_To_Successors_Iterator := - Iterate_Edges_To_Successors (G, Pred); + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + Complement : constant Library_Graph_Vertex_Id := + Complementary_Vertex + (G => G, + Vertex => Vertex, + Force_Complement => False); + + Strong_Preds : Natural; + Weak_Preds : Natural; begin - -- IMPORTANT: + -- A vertex is elaborable when: -- - -- * The iteration must run to completion in order to unlock the - -- edges to successors. + -- * It has not been elaborated yet, and + -- * The complement vertex of an Elaborate_Body pair has not been + -- elaborated yet, and + -- * It resides within an elaborable component, and + -- * It is not waiting on strong predecessors, and + -- * It is not waiting on weak predecessors - -- This does a linear search through the successors of Pred. - -- Efficiency is not a problem, because this is called only when - -- Activates_Task is True, which is rare, and anyway, there aren't - -- usually large numbers of successors. + if In_Elaboration_Order (G, Vertex) then + return False; - while Has_Next (Iter) loop - Next (Iter, Edge); + elsif Present (Complement) + and then In_Elaboration_Order (G, Complement) + then + return False; - if Succ = Successor (G, Edge) then - pragma Assert (not Present (Result)); - Result := Edge; - end if; - end loop; + elsif not Is_Elaborable_Component (G, Component (G, Vertex)) then + return False; + end if; - pragma Assert (Present (Result)); - return Result; - end Find_Edge; + Pending_Predecessors_For_Elaboration + (G => G, + Vertex => Vertex, + Strong_Preds => Strong_Preds, + Weak_Preds => Weak_Preds); - --------------------------------------- - -- Find_First_Lower_Precedence_Cycle -- - --------------------------------------- + return Strong_Preds = 0 and then Weak_Preds = 0; + end Is_Elaborable_Vertex; - function Find_First_Lower_Precedence_Cycle - (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Id - is - Current_Cycle : Library_Graph_Cycle_Id; - Iter : All_Cycle_Iterator; - Lesser_Cycle : Library_Graph_Cycle_Id; + --------------------------- + -- Is_Elaborate_All_Edge -- + --------------------------- + function Is_Elaborate_All_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean + is begin pragma Assert (Present (G)); - pragma Assert (Present (Cycle)); - - -- Assume that there is no lesser cycle - - Lesser_Cycle := No_Library_Graph_Cycle; + pragma Assert (Present (Edge)); - -- Find a cycle with a slightly lower precedence than the input - -- cycle. - -- - -- IMPORTANT: - -- - -- * The iterator must run to completion in order to unlock the - -- list of all cycles. + return Kind (G, Edge) = Elaborate_All_Edge; + end Is_Elaborate_All_Edge; - Iter := Iterate_All_Cycles (G); - while Has_Next (Iter) loop - Next (Iter, Current_Cycle); + ---------------------------- + -- Is_Elaborate_Body_Edge -- + ---------------------------- - if not Present (Lesser_Cycle) - and then Cycle_Precedence - (G => G, - Cycle => Cycle, - Compared_To => Current_Cycle) = Higher_Precedence - then - Lesser_Cycle := Current_Cycle; - end if; - end loop; + function Is_Elaborate_Body_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); - return Lesser_Cycle; - end Find_First_Lower_Precedence_Cycle; + return + Kind (G, Edge) = With_Edge + and then Is_Vertex_With_Elaborate_Body (G, Successor (G, Edge)); + end Is_Elaborate_Body_Edge; - ------------------------------ - -- Get_Component_Attributes -- - ------------------------------ + ----------------------- + -- Is_Elaborate_Edge -- + ----------------------- - function Get_Component_Attributes + function Is_Elaborate_Edge (G : Library_Graph; - Comp : Component_Id) return Component_Attributes + Edge : Library_Graph_Edge_Id) return Boolean is begin pragma Assert (Present (G)); - pragma Assert (Present (Comp)); + pragma Assert (Present (Edge)); - return Component_Tables.Get (G.Component_Attributes, Comp); - end Get_Component_Attributes; + return Kind (G, Edge) = Elaborate_Edge; + end Is_Elaborate_Edge; - ------------------------ - -- Get_LGC_Attributes -- - ------------------------ + ---------------------------- + -- Is_Elaborate_Body_Pair -- + ---------------------------- - function Get_LGC_Attributes - (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Attributes + function Is_Elaborate_Body_Pair + (G : Library_Graph; + Spec_Vertex : Library_Graph_Vertex_Id; + Body_Vertex : Library_Graph_Vertex_Id) return Boolean is begin pragma Assert (Present (G)); - pragma Assert (Present (Cycle)); + pragma Assert (Present (Spec_Vertex)); + pragma Assert (Present (Body_Vertex)); - return LGC_Tables.Get (G.Cycle_Attributes, Cycle); - end Get_LGC_Attributes; + return + Is_Spec_With_Elaborate_Body (G, Spec_Vertex) + and then Is_Body_Of_Spec_With_Elaborate_Body (G, Body_Vertex) + and then Proper_Body (G, Spec_Vertex) = Body_Vertex; + end Is_Elaborate_Body_Pair; - ------------------------ - -- Get_LGE_Attributes -- - ------------------------ + -------------------- + -- Is_Forced_Edge -- + -------------------- - function Get_LGE_Attributes + function Is_Forced_Edge (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Library_Graph_Edge_Attributes + Edge : Library_Graph_Edge_Id) return Boolean is begin pragma Assert (Present (G)); pragma Assert (Present (Edge)); - return LGE_Tables.Get (G.Edge_Attributes, Edge); - end Get_LGE_Attributes; + return Kind (G, Edge) = Forced_Edge; + end Is_Forced_Edge; - ------------------------ - -- Get_LGV_Attributes -- - ------------------------ + ---------------------- + -- Is_Internal_Unit -- + ---------------------- - function Get_LGV_Attributes + function Is_Internal_Unit (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) - return Library_Graph_Vertex_Attributes + Vertex : Library_Graph_Vertex_Id) return Boolean is begin pragma Assert (Present (G)); pragma Assert (Present (Vertex)); - return LGV_Tables.Get (G.Vertex_Attributes, Vertex); - end Get_LGV_Attributes; - - ----------------------------- - -- Has_Elaborate_All_Cycle -- - ----------------------------- - - function Has_Elaborate_All_Cycle (G : Library_Graph) return Boolean is - Edge : Library_Graph_Edge_Id; - Iter : All_Edge_Iterator; - Seen : Boolean; - - begin - pragma Assert (Present (G)); - - -- Assume that no cyclic Elaborate_All edge has been seen - - Seen := False; - - -- IMPORTANT: - -- - -- * The iteration must run to completion in order to unlock the - -- graph. - - Iter := Iterate_All_Edges (G); - while Has_Next (Iter) loop - Next (Iter, Edge); - - if not Seen and then Is_Cyclic_Elaborate_All_Edge (G, Edge) then - Seen := True; - end if; - end loop; - - return Seen; - end Has_Elaborate_All_Cycle; + return Is_Internal_Unit (Unit (G, Vertex)); + end Is_Internal_Unit; - ---------------------------- - -- Has_Elaborate_All_Edge -- - ---------------------------- + ------------------------ + -- Is_Invocation_Edge -- + ------------------------ - function Has_Elaborate_All_Edge + function Is_Invocation_Edge (G : Library_Graph; - Comp : Component_Id) return Boolean + Edge : Library_Graph_Edge_Id) return Boolean is - Has_Edge : Boolean; - Iter : Component_Vertex_Iterator; - Vertex : Library_Graph_Vertex_Id; - begin pragma Assert (Present (G)); - pragma Assert (Present (Comp)); - - -- Assume that there is no Elaborate_All edge - - Has_Edge := False; - - -- IMPORTANT: - -- - -- * The iteration must run to completion in order to unlock the - -- component vertices. - - Iter := Iterate_Component_Vertices (G, Comp); - while Has_Next (Iter) loop - Next (Iter, Vertex); - - Has_Edge := Has_Edge or else Has_Elaborate_All_Edge (G, Vertex); - end loop; + pragma Assert (Present (Edge)); - return Has_Edge; - end Has_Elaborate_All_Edge; + return Kind (G, Edge) = Invocation_Edge; + end Is_Invocation_Edge; - ---------------------------- - -- Has_Elaborate_All_Edge -- - ---------------------------- + ------------------------ + -- Is_Predefined_Unit -- + ------------------------ - function Has_Elaborate_All_Edge + function Is_Predefined_Unit (G : Library_Graph; Vertex : Library_Graph_Vertex_Id) return Boolean is - Edge : Library_Graph_Edge_Id; - Has_Edge : Boolean; - Iter : Edges_To_Successors_Iterator; - begin pragma Assert (Present (G)); pragma Assert (Present (Vertex)); - -- Assume that there is no Elaborate_All edge - - Has_Edge := False; - - -- IMPORTANT: - -- - -- * The iteration must run to completion in order to unlock the - -- edges to successors. - - Iter := Iterate_Edges_To_Successors (G, Vertex); - while Has_Next (Iter) loop - Next (Iter, Edge); - - Has_Edge := - Has_Edge or else Is_Cyclic_Elaborate_All_Edge (G, Edge); - end loop; - - return Has_Edge; - end Has_Elaborate_All_Edge; + return Is_Predefined_Unit (Unit (G, Vertex)); + end Is_Predefined_Unit; - ------------------------ - -- Has_Elaborate_Body -- - ------------------------ + --------------------------- + -- Is_Preelaborated_Unit -- + --------------------------- - function Has_Elaborate_Body + function Is_Preelaborated_Unit (G : Library_Graph; Vertex : Library_Graph_Vertex_Id) return Boolean is @@ -3473,418 +3392,356 @@ package body Bindo.Graphs is U_Rec : Unit_Record renames ALI.Units.Table (U_Id); begin - -- Treat the spec and body as decoupled when switch -d_b (ignore the - -- effects of pragma Elaborate_Body) is in effect. - - return U_Rec.Elaborate_Body and not Debug_Flag_Underscore_B; - end Has_Elaborate_Body; - - -------------- - -- Has_Next -- - -------------- - - function Has_Next (Iter : All_Cycle_Iterator) return Boolean is - begin - return LGC_Lists.Has_Next (LGC_Lists.Iterator (Iter)); - end Has_Next; - - -------------- - -- Has_Next -- - -------------- - - function Has_Next (Iter : All_Edge_Iterator) return Boolean is - begin - return DG.Has_Next (DG.All_Edge_Iterator (Iter)); - end Has_Next; + return U_Rec.Preelab or else U_Rec.Pure; + end Is_Preelaborated_Unit; - -------------- - -- Has_Next -- - -------------- + ---------------------- + -- Is_Recorded_Edge -- + ---------------------- - function Has_Next (Iter : All_Vertex_Iterator) return Boolean is + function Is_Recorded_Edge + (G : Library_Graph; + Rel : Predecessor_Successor_Relation) return Boolean + is begin - return DG.Has_Next (DG.All_Vertex_Iterator (Iter)); - end Has_Next; - - -------------- - -- Has_Next -- - -------------- + pragma Assert (Present (G)); + pragma Assert (Present (Rel.Predecessor)); + pragma Assert (Present (Rel.Successor)); - function Has_Next (Iter : Component_Iterator) return Boolean is - begin - return DG.Has_Next (DG.Component_Iterator (Iter)); - end Has_Next; + return RE_Sets.Contains (G.Recorded_Edges, Rel); + end Is_Recorded_Edge; - -------------- - -- Has_Next -- - -------------- + ------------- + -- Is_Spec -- + ------------- - function Has_Next (Iter : Component_Vertex_Iterator) return Boolean is - begin - return DG.Has_Next (DG.Component_Vertex_Iterator (Iter)); - end Has_Next; + function Is_Spec + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean + is + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); - -------------- - -- Has_Next -- - -------------- + U_Id : constant Unit_Id := Unit (G, Vertex); + U_Rec : Unit_Record renames ALI.Units.Table (U_Id); - function Has_Next (Iter : Edges_Of_Cycle_Iterator) return Boolean is begin - return LGE_Lists.Has_Next (LGE_Lists.Iterator (Iter)); - end Has_Next; + return U_Rec.Utype = Is_Spec or else U_Rec.Utype = Is_Spec_Only; + end Is_Spec; - -------------- - -- Has_Next -- - -------------- + ------------------------------ + -- Is_Spec_Before_Body_Edge -- + ------------------------------ - function Has_Next (Iter : Edges_To_Successors_Iterator) return Boolean is + function Is_Spec_Before_Body_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean + is begin - return DG.Has_Next (DG.Outgoing_Edge_Iterator (Iter)); - end Has_Next; + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); - ----------------------------- - -- Has_No_Elaboration_Code -- - ----------------------------- + return Kind (G, Edge) = Spec_Before_Body_Edge; + end Is_Spec_Before_Body_Edge; - function Has_No_Elaboration_Code + ----------------------- + -- Is_Spec_With_Body -- + ----------------------- + + function Is_Spec_With_Body (G : Library_Graph; Vertex : Library_Graph_Vertex_Id) return Boolean is - begin pragma Assert (Present (G)); pragma Assert (Present (Vertex)); - return Has_No_Elaboration_Code (Unit (G, Vertex)); - end Has_No_Elaboration_Code; - - ----------------------------------------- - -- Hash_Library_Graph_Cycle_Attributes -- - ----------------------------------------- - - function Hash_Library_Graph_Cycle_Attributes - (Attrs : Library_Graph_Cycle_Attributes) return Bucket_Range_Type - is - Edge : Library_Graph_Edge_Id; - Hash : Bucket_Range_Type; - Iter : LGE_Lists.Iterator; + U_Id : constant Unit_Id := Unit (G, Vertex); + U_Rec : Unit_Record renames ALI.Units.Table (U_Id); begin - pragma Assert (LGE_Lists.Present (Attrs.Path)); - - -- The hash is obtained in the following manner: - -- - -- (((edge1 * 31) + edge2) * 31) + edgeN - - Hash := 0; - Iter := LGE_Lists.Iterate (Attrs.Path); - while LGE_Lists.Has_Next (Iter) loop - LGE_Lists.Next (Iter, Edge); - - Hash := (Hash * 31) + Bucket_Range_Type (Edge); - end loop; - - return Hash; - end Hash_Library_Graph_Cycle_Attributes; + return U_Rec.Utype = Is_Spec; + end Is_Spec_With_Body; - ----------------------------------------- - -- Hash_Predecessor_Successor_Relation -- - ----------------------------------------- + --------------------------------- + -- Is_Spec_With_Elaborate_Body -- + --------------------------------- - function Hash_Predecessor_Successor_Relation - (Rel : Predecessor_Successor_Relation) return Bucket_Range_Type + function Is_Spec_With_Elaborate_Body + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean is begin - pragma Assert (Present (Rel.Predecessor)); - pragma Assert (Present (Rel.Successor)); + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); return - Hash_Two_Keys - (Bucket_Range_Type (Rel.Predecessor), - Bucket_Range_Type (Rel.Successor)); - end Hash_Predecessor_Successor_Relation; + Is_Spec_With_Body (G, Vertex) + and then Has_Elaborate_Body (G, Vertex); + end Is_Spec_With_Elaborate_Body; ------------------------------ - -- Highest_Precedence_Cycle -- + -- Is_Static_Successor_Edge -- ------------------------------ - function Highest_Precedence_Cycle - (G : Library_Graph) return Library_Graph_Cycle_Id + function Is_Static_Successor_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean is begin pragma Assert (Present (G)); - pragma Assert (LGC_Lists.Present (G.Cycles)); - - if LGC_Lists.Is_Empty (G.Cycles) then - return No_Library_Graph_Cycle; - - -- The highest precedence cycle is always the first in the list of - -- all cycles. + pragma Assert (Present (Edge)); - else - return LGC_Lists.First (G.Cycles); - end if; - end Highest_Precedence_Cycle; + return + Is_Invocation_Edge (G, Edge) + and then not Is_Dynamically_Elaborated (G, Successor (G, Edge)); + end Is_Static_Successor_Edge; - ----------------------------- - -- Highest_Precedence_Edge -- - ----------------------------- + ----------------------------------- + -- Is_Vertex_With_Elaborate_Body -- + ----------------------------------- - function Highest_Precedence_Edge - (G : Library_Graph; - Left : Library_Graph_Edge_Id; - Right : Library_Graph_Edge_Id) return Library_Graph_Edge_Id + function Is_Vertex_With_Elaborate_Body + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean is - Edge_Prec : Precedence_Kind; - begin pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); - -- Both edges are available, pick the one with highest precedence - - if Present (Left) and then Present (Right) then - Edge_Prec := - Edge_Precedence - (G => G, - Edge => Left, - Compared_To => Right); - - if Edge_Prec = Higher_Precedence then - return Left; - - -- The precedence rules for edges are such that no two edges can - -- ever have the same precedence. - - else - pragma Assert (Edge_Prec = Lower_Precedence); - return Right; - end if; - - -- Otherwise at least one edge must be present - - elsif Present (Left) then - return Left; - - else - pragma Assert (Present (Right)); - - return Right; - end if; - end Highest_Precedence_Edge; + return + Is_Spec_With_Elaborate_Body (G, Vertex) + or else + Is_Body_Of_Spec_With_Elaborate_Body (G, Vertex); + end Is_Vertex_With_Elaborate_Body; - -------------------------- - -- In_Elaboration_Order -- - -------------------------- + --------------------------------- + -- Is_Weakly_Elaborable_Vertex -- + ---------------------------------- - function In_Elaboration_Order + function Is_Weakly_Elaborable_Vertex (G : Library_Graph; Vertex : Library_Graph_Vertex_Id) return Boolean is - begin pragma Assert (Present (G)); pragma Assert (Present (Vertex)); - return Get_LGV_Attributes (G, Vertex).In_Elaboration_Order; - end In_Elaboration_Order; + Complement : constant Library_Graph_Vertex_Id := + Complementary_Vertex + (G => G, + Vertex => Vertex, + Force_Complement => False); - ----------------------- - -- In_Same_Component -- - ----------------------- + Strong_Preds : Natural; + Weak_Preds : Natural; - function In_Same_Component - (G : Library_Graph; - Left : Library_Graph_Vertex_Id; - Right : Library_Graph_Vertex_Id) return Boolean - is begin - pragma Assert (Present (G)); - pragma Assert (Present (Left)); - pragma Assert (Present (Right)); + -- A vertex is weakly elaborable when: + -- + -- * It has not been elaborated yet, and + -- * The complement vertex of an Elaborate_Body pair has not been + -- elaborated yet, and + -- * It resides within an elaborable component, and + -- * It is not waiting on strong predecessors, and + -- * It is waiting on at least one weak predecessor - return Component (G, Left) = Component (G, Right); - end In_Same_Component; + if In_Elaboration_Order (G, Vertex) then + return False; - ---------------------------------------- - -- Increment_Library_Graph_Edge_Count -- - ---------------------------------------- + elsif Present (Complement) + and then In_Elaboration_Order (G, Complement) + then + return False; - procedure Increment_Library_Graph_Edge_Count - (G : Library_Graph; - Kind : Library_Graph_Edge_Kind) - is - pragma Assert (Present (G)); + elsif not Is_Elaborable_Component (G, Component (G, Vertex)) then + return False; + end if; - Count : Natural renames G.Counts (Kind); + Pending_Predecessors_For_Elaboration + (G => G, + Vertex => Vertex, + Strong_Preds => Strong_Preds, + Weak_Preds => Weak_Preds); - begin - Count := Count + 1; - end Increment_Library_Graph_Edge_Count; + return Strong_Preds = 0 and then Weak_Preds >= 1; + end Is_Weakly_Elaborable_Vertex; - ------------------------------------ - -- Increment_Pending_Predecessors -- - ------------------------------------ + ------------------ + -- Is_With_Edge -- + ------------------ - procedure Increment_Pending_Predecessors + function Is_With_Edge (G : Library_Graph; - Comp : Component_Id; - Edge : Library_Graph_Edge_Id) + Edge : Library_Graph_Edge_Id) return Boolean is - Attrs : Component_Attributes; - begin pragma Assert (Present (G)); - pragma Assert (Present (Comp)); + pragma Assert (Present (Edge)); - Attrs := Get_Component_Attributes (G, Comp); + return Kind (G, Edge) = With_Edge; + end Is_With_Edge; - Update_Pending_Predecessors - (Strong_Predecessors => Attrs.Pending_Strong_Predecessors, - Weak_Predecessors => Attrs.Pending_Weak_Predecessors, - Update_Weak => Is_Invocation_Edge (G, Edge), - Value => 1); + ------------------------ + -- Iterate_All_Cycles -- + ------------------------ - Set_Component_Attributes (G, Comp, Attrs); - end Increment_Pending_Predecessors; + function Iterate_All_Cycles + (G : Library_Graph) return All_Cycle_Iterator + is + begin + pragma Assert (Present (G)); - ------------------------------------ - -- Increment_Pending_Predecessors -- - ------------------------------------ + return All_Cycle_Iterator (LGC_Lists.Iterate (G.Cycles)); + end Iterate_All_Cycles; + + ----------------------- + -- Iterate_All_Edges -- + ----------------------- - procedure Increment_Pending_Predecessors - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id; - Edge : Library_Graph_Edge_Id) + function Iterate_All_Edges + (G : Library_Graph) return All_Edge_Iterator is - Attrs : Library_Graph_Vertex_Attributes; - begin pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); - Attrs := Get_LGV_Attributes (G, Vertex); + return All_Edge_Iterator (DG.Iterate_All_Edges (G.Graph)); + end Iterate_All_Edges; - Update_Pending_Predecessors - (Strong_Predecessors => Attrs.Pending_Strong_Predecessors, - Weak_Predecessors => Attrs.Pending_Weak_Predecessors, - Update_Weak => Is_Invocation_Edge (G, Edge), - Value => 1); + -------------------------- + -- Iterate_All_Vertices -- + -------------------------- - Set_LGV_Attributes (G, Vertex, Attrs); - end Increment_Pending_Predecessors; + function Iterate_All_Vertices + (G : Library_Graph) return All_Vertex_Iterator + is + begin + pragma Assert (Present (G)); - --------------------------- - -- Initialize_Components -- - --------------------------- + return All_Vertex_Iterator (DG.Iterate_All_Vertices (G.Graph)); + end Iterate_All_Vertices; - procedure Initialize_Components (G : Library_Graph) is + ------------------------ + -- Iterate_Components -- + ------------------------ + + function Iterate_Components + (G : Library_Graph) return Component_Iterator + is begin pragma Assert (Present (G)); - -- The graph already contains a set of components. Reinitialize - -- them in order to accommodate the new set of components about to - -- be computed. + return Component_Iterator (DG.Iterate_Components (G.Graph)); + end Iterate_Components; - if Number_Of_Components (G) > 0 then - Component_Tables.Destroy (G.Component_Attributes); + -------------------------------- + -- Iterate_Component_Vertices -- + -------------------------------- - G.Component_Attributes := - Component_Tables.Create (Number_Of_Vertices (G)); - end if; - end Initialize_Components; + function Iterate_Component_Vertices + (G : Library_Graph; + Comp : Component_Id) return Component_Vertex_Iterator + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Comp)); - --------------------------- - -- Invocation_Edge_Count -- - --------------------------- + return + Component_Vertex_Iterator + (DG.Iterate_Component_Vertices (G.Graph, Comp)); + end Iterate_Component_Vertices; - function Invocation_Edge_Count + ---------------------------- + -- Iterate_Edges_Of_Cycle -- + ---------------------------- + + function Iterate_Edges_Of_Cycle (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id) return Natural + Cycle : Library_Graph_Cycle_Id) return Edges_Of_Cycle_Iterator is begin pragma Assert (Present (G)); pragma Assert (Present (Cycle)); - return Get_LGC_Attributes (G, Cycle).Invocation_Edge_Count; - end Invocation_Edge_Count; + return Edges_Of_Cycle_Iterator (LGE_Lists.Iterate (Path (G, Cycle))); + end Iterate_Edges_Of_Cycle; - ------------------------------- - -- Invocation_Graph_Encoding -- - ------------------------------- + --------------------------------- + -- Iterate_Edges_To_Successors -- + --------------------------------- - function Invocation_Graph_Encoding + function Iterate_Edges_To_Successors (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) - return Invocation_Graph_Encoding_Kind + Vertex : Library_Graph_Vertex_Id) return Edges_To_Successors_Iterator is begin pragma Assert (Present (G)); pragma Assert (Present (Vertex)); - return Invocation_Graph_Encoding (Unit (G, Vertex)); - end Invocation_Graph_Encoding; + return + Edges_To_Successors_Iterator + (DG.Iterate_Outgoing_Edges (G.Graph, Vertex)); + end Iterate_Edges_To_Successors; - ------------- - -- Is_Body -- - ------------- + ---------- + -- Kind -- + ---------- - function Is_Body + function Kind (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean + Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Kind is + begin pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); + pragma Assert (Present (Cycle)); - U_Id : constant Unit_Id := Unit (G, Vertex); - U_Rec : Unit_Record renames ALI.Units.Table (U_Id); + return Get_LGC_Attributes (G, Cycle).Kind; + end Kind; + + ---------- + -- Kind -- + ---------- + function Kind + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Library_Graph_Edge_Kind + is begin - return U_Rec.Utype = Is_Body or else U_Rec.Utype = Is_Body_Only; - end Is_Body; + return Get_LGE_Attributes (G, Edge).Kind; + end Kind; - ----------------------------------------- - -- Is_Body_Of_Spec_With_Elaborate_Body -- - ----------------------------------------- + ------------ + -- Length -- + ------------ - function Is_Body_Of_Spec_With_Elaborate_Body - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean + function Length + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) return Natural is begin pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); - - if Is_Body_With_Spec (G, Vertex) then - return - Is_Spec_With_Elaborate_Body - (G => G, - Vertex => Proper_Spec (G, Vertex)); - end if; + pragma Assert (Present (Cycle)); - return False; - end Is_Body_Of_Spec_With_Elaborate_Body; + return LGE_Lists.Size (Path (G, Cycle)); + end Length; - ----------------------- - -- Is_Body_With_Spec -- - ----------------------- + ------------------------------ + -- Library_Graph_Edge_Count -- + ------------------------------ - function Is_Body_With_Spec - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean + function Library_Graph_Edge_Count + (G : Library_Graph; + Kind : Library_Graph_Edge_Kind) return Natural is + begin pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); - - U_Id : constant Unit_Id := Unit (G, Vertex); - U_Rec : Unit_Record renames ALI.Units.Table (U_Id); - begin - return U_Rec.Utype = Is_Body; - end Is_Body_With_Spec; + return G.Counts (Kind); + end Library_Graph_Edge_Count; - ------------------------------ - -- Is_Cycle_Initiating_Edge -- - ------------------------------ + -------------------------------------- + -- Links_Vertices_In_Same_Component -- + -------------------------------------- - function Is_Cycle_Initiating_Edge + function Links_Vertices_In_Same_Component (G : Library_Graph; Edge : Library_Graph_Edge_Id) return Boolean is @@ -3892,1813 +3749,1970 @@ package body Bindo.Graphs is pragma Assert (Present (G)); pragma Assert (Present (Edge)); + -- An edge is part of a cycle when both the successor and predecessor + -- reside in the same component. + return - Is_Cyclic_Elaborate_All_Edge (G, Edge) - or else Is_Cyclic_Elaborate_Body_Edge (G, Edge) - or else Is_Cyclic_Elaborate_Edge (G, Edge) - or else Is_Cyclic_Forced_Edge (G, Edge) - or else Is_Cyclic_Invocation_Edge (G, Edge); - end Is_Cycle_Initiating_Edge; + In_Same_Component + (G => G, + Left => Predecessor (G, Edge), + Right => Successor (G, Edge)); + end Links_Vertices_In_Same_Component; - -------------------- - -- Is_Cyclic_Edge -- - -------------------- + ----------------------------------- + -- Maximum_Invocation_Edge_Count -- + ----------------------------------- - function Is_Cyclic_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean + function Maximum_Invocation_Edge_Count + (G : Library_Graph; + Edge : Library_Graph_Edge_Id; + Count : Natural) return Natural is + New_Count : Natural; + begin pragma Assert (Present (G)); - pragma Assert (Present (Edge)); - return - Is_Cycle_Initiating_Edge (G, Edge) - or else Is_Cyclic_With_Edge (G, Edge); - end Is_Cyclic_Edge; + New_Count := Count; - ---------------------------------- - -- Is_Cyclic_Elaborate_All_Edge -- - ---------------------------------- + if Present (Edge) and then Is_Invocation_Edge (G, Edge) then + New_Count := New_Count + 1; + end if; - function Is_Cyclic_Elaborate_All_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean + return New_Count; + end Maximum_Invocation_Edge_Count; + + ---------- + -- Name -- + ---------- + + function Name + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Unit_Name_Type is begin pragma Assert (Present (G)); - pragma Assert (Present (Edge)); + pragma Assert (Present (Vertex)); - return - Is_Elaborate_All_Edge (G, Edge) - and then Links_Vertices_In_Same_Component (G, Edge); - end Is_Cyclic_Elaborate_All_Edge; + return Name (Unit (G, Vertex)); + end Name; - ----------------------------------- - -- Is_Cyclic_Elaborate_Body_Edge -- - ----------------------------------- + ----------------------- + -- Needs_Elaboration -- + ----------------------- - function Is_Cyclic_Elaborate_Body_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean + function Needs_Elaboration + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean is begin pragma Assert (Present (G)); - pragma Assert (Present (Edge)); + pragma Assert (Present (Vertex)); - return - Is_Elaborate_Body_Edge (G, Edge) - and then Links_Vertices_In_Same_Component (G, Edge); - end Is_Cyclic_Elaborate_Body_Edge; + return Needs_Elaboration (Unit (G, Vertex)); + end Needs_Elaboration; - ------------------------------ - -- Is_Cyclic_Elaborate_Edge -- - ------------------------------ + ---------- + -- Next -- + ---------- - function Is_Cyclic_Elaborate_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean + procedure Next + (Iter : in out All_Cycle_Iterator; + Cycle : out Library_Graph_Cycle_Id) is begin - pragma Assert (Present (G)); - pragma Assert (Present (Edge)); - - return - Is_Elaborate_Edge (G, Edge) - and then Links_Vertices_In_Same_Component (G, Edge); - end Is_Cyclic_Elaborate_Edge; + LGC_Lists.Next (LGC_Lists.Iterator (Iter), Cycle); + end Next; - --------------------------- - -- Is_Cyclic_Forced_Edge -- - --------------------------- + ---------- + -- Next -- + ---------- - function Is_Cyclic_Forced_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean + procedure Next + (Iter : in out All_Edge_Iterator; + Edge : out Library_Graph_Edge_Id) is begin - pragma Assert (Present (G)); - pragma Assert (Present (Edge)); + DG.Next (DG.All_Edge_Iterator (Iter), Edge); + end Next; - return - Is_Forced_Edge (G, Edge) - and then Links_Vertices_In_Same_Component (G, Edge); - end Is_Cyclic_Forced_Edge; + ---------- + -- Next -- + ---------- - ------------------------------- - -- Is_Cyclic_Invocation_Edge -- - ------------------------------- + procedure Next + (Iter : in out All_Vertex_Iterator; + Vertex : out Library_Graph_Vertex_Id) + is + begin + DG.Next (DG.All_Vertex_Iterator (Iter), Vertex); + end Next; - function Is_Cyclic_Invocation_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean + ---------- + -- Next -- + ---------- + + procedure Next + (Iter : in out Edges_Of_Cycle_Iterator; + Edge : out Library_Graph_Edge_Id) is begin - pragma Assert (Present (G)); - pragma Assert (Present (Edge)); + LGE_Lists.Next (LGE_Lists.Iterator (Iter), Edge); + end Next; - return - Is_Invocation_Edge (G, Edge) - and then Links_Vertices_In_Same_Component (G, Edge); - end Is_Cyclic_Invocation_Edge; + ---------- + -- Next -- + ---------- - ------------------------- - -- Is_Cyclic_With_Edge -- - ------------------------- + procedure Next + (Iter : in out Component_Iterator; + Comp : out Component_Id) + is + begin + DG.Next (DG.Component_Iterator (Iter), Comp); + end Next; - function Is_Cyclic_With_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean + ---------- + -- Next -- + ---------- + + procedure Next + (Iter : in out Edges_To_Successors_Iterator; + Edge : out Library_Graph_Edge_Id) is begin - pragma Assert (Present (G)); - pragma Assert (Present (Edge)); + DG.Next (DG.Outgoing_Edge_Iterator (Iter), Edge); + end Next; - -- Ignore Elaborate_Body edges because they also appear as with - -- edges, but have special successors. + ---------- + -- Next -- + ---------- - return - Is_With_Edge (G, Edge) - and then Links_Vertices_In_Same_Component (G, Edge) - and then not Is_Elaborate_Body_Edge (G, Edge); - end Is_Cyclic_With_Edge; + procedure Next + (Iter : in out Component_Vertex_Iterator; + Vertex : out Library_Graph_Vertex_Id) + is + begin + DG.Next (DG.Component_Vertex_Iterator (Iter), Vertex); + end Next; - ------------------------------- - -- Is_Dynamically_Elaborated -- - ------------------------------- + -------------------------- + -- Normalize_Cycle_Path -- + -------------------------- - function Is_Dynamically_Elaborated - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean + procedure Normalize_Cycle_Path + (Cycle_Path : LGE_Lists.Doubly_Linked_List; + Most_Significant_Edge : Library_Graph_Edge_Id) is + Edge : Library_Graph_Edge_Id; + begin - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); + pragma Assert (LGE_Lists.Present (Cycle_Path)); + pragma Assert (Present (Most_Significant_Edge)); - return Is_Dynamically_Elaborated (Unit (G, Vertex)); - end Is_Dynamically_Elaborated; + -- Perform at most |Cycle_Path| rotations in case the cycle is + -- malformed and the significant edge does not appear within. - ----------------------------- - -- Is_Elaborable_Component -- - ----------------------------- + for Rotation in 1 .. LGE_Lists.Size (Cycle_Path) loop + Edge := LGE_Lists.First (Cycle_Path); - function Is_Elaborable_Component + -- The cycle is already rotated such that the most significant + -- edge is first. + + if Edge = Most_Significant_Edge then + return; + + -- Otherwise rotate the cycle by relocating the current edge from + -- the start to the end of the path. This preserves the order of + -- the path. + + else + LGE_Lists.Delete_First (Cycle_Path); + LGE_Lists.Append (Cycle_Path, Edge); + end if; + end loop; + + pragma Assert (False); + end Normalize_Cycle_Path; + + ---------------------------------- + -- Number_Of_Component_Vertices -- + ---------------------------------- + + function Number_Of_Component_Vertices (G : Library_Graph; - Comp : Component_Id) return Boolean + Comp : Component_Id) return Natural is begin pragma Assert (Present (G)); pragma Assert (Present (Comp)); - -- A component is elaborable when: - -- - -- * It is not waiting on strong predecessors, and - -- * It is not waiting on weak predecessors - - return - Pending_Strong_Predecessors (G, Comp) = 0 - and then Pending_Weak_Predecessors (G, Comp) = 0; - end Is_Elaborable_Component; + return DG.Number_Of_Component_Vertices (G.Graph, Comp); + end Number_Of_Component_Vertices; -------------------------- - -- Is_Elaborable_Vertex -- + -- Number_Of_Components -- -------------------------- - function Is_Elaborable_Vertex - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean - is + function Number_Of_Components (G : Library_Graph) return Natural is + begin pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); - Complement : constant Library_Graph_Vertex_Id := - Complementary_Vertex - (G => G, - Vertex => Vertex, - Force_Complement => False); + return DG.Number_Of_Components (G.Graph); + end Number_Of_Components; - Strong_Preds : Natural; - Weak_Preds : Natural; + ---------------------- + -- Number_Of_Cycles -- + ---------------------- + function Number_Of_Cycles (G : Library_Graph) return Natural is begin - -- A vertex is elaborable when: - -- - -- * It has not been elaborated yet, and - -- * The complement vertex of an Elaborate_Body pair has not been - -- elaborated yet, and - -- * It resides within an elaborable component, and - -- * It is not waiting on strong predecessors, and - -- * It is not waiting on weak predecessors - - if In_Elaboration_Order (G, Vertex) then - return False; + pragma Assert (Present (G)); - elsif Present (Complement) - and then In_Elaboration_Order (G, Complement) - then - return False; + return LGC_Lists.Size (G.Cycles); + end Number_Of_Cycles; - elsif not Is_Elaborable_Component (G, Component (G, Vertex)) then - return False; - end if; + --------------------- + -- Number_Of_Edges -- + --------------------- - Pending_Predecessors_For_Elaboration - (G => G, - Vertex => Vertex, - Strong_Preds => Strong_Preds, - Weak_Preds => Weak_Preds); + function Number_Of_Edges (G : Library_Graph) return Natural is + begin + pragma Assert (Present (G)); - return Strong_Preds = 0 and then Weak_Preds = 0; - end Is_Elaborable_Vertex; + return DG.Number_Of_Edges (G.Graph); + end Number_Of_Edges; - --------------------------- - -- Is_Elaborate_All_Edge -- - --------------------------- + ----------------------------------- + -- Number_Of_Edges_To_Successors -- + ----------------------------------- - function Is_Elaborate_All_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean + function Number_Of_Edges_To_Successors + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Natural is begin pragma Assert (Present (G)); - pragma Assert (Present (Edge)); - return Kind (G, Edge) = Elaborate_All_Edge; - end Is_Elaborate_All_Edge; + return DG.Number_Of_Outgoing_Edges (G.Graph, Vertex); + end Number_Of_Edges_To_Successors; - ---------------------------- - -- Is_Elaborate_Body_Edge -- - ---------------------------- + ------------------------ + -- Number_Of_Vertices -- + ------------------------ - function Is_Elaborate_Body_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean - is + function Number_Of_Vertices (G : Library_Graph) return Natural is begin pragma Assert (Present (G)); - pragma Assert (Present (Edge)); - return - Kind (G, Edge) = With_Edge - and then Is_Vertex_With_Elaborate_Body (G, Successor (G, Edge)); - end Is_Elaborate_Body_Edge; + return DG.Number_Of_Vertices (G.Graph); + end Number_Of_Vertices; - ----------------------- - -- Is_Elaborate_Edge -- - ----------------------- + ----------------- + -- Order_Cycle -- + ----------------- - function Is_Elaborate_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean + procedure Order_Cycle + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) is + Lesser_Cycle : Library_Graph_Cycle_Id; + begin pragma Assert (Present (G)); - pragma Assert (Present (Edge)); + pragma Assert (Present (Cycle)); + pragma Assert (LGC_Lists.Present (G.Cycles)); - return Kind (G, Edge) = Elaborate_Edge; - end Is_Elaborate_Edge; + -- The input cycle is the first to be inserted - ---------------------------- - -- Is_Elaborate_Body_Pair -- - ---------------------------- + if LGC_Lists.Is_Empty (G.Cycles) then + LGC_Lists.Prepend (G.Cycles, Cycle); - function Is_Elaborate_Body_Pair - (G : Library_Graph; - Spec_Vertex : Library_Graph_Vertex_Id; - Body_Vertex : Library_Graph_Vertex_Id) return Boolean - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Spec_Vertex)); - pragma Assert (Present (Body_Vertex)); + -- Otherwise the list of all cycles contains at least one cycle. + -- Insert the input cycle based on its precedence. - return - Is_Spec_With_Elaborate_Body (G, Spec_Vertex) - and then Is_Body_Of_Spec_With_Elaborate_Body (G, Body_Vertex) - and then Proper_Body (G, Spec_Vertex) = Body_Vertex; - end Is_Elaborate_Body_Pair; + else + Lesser_Cycle := Find_First_Lower_Precedence_Cycle (G, Cycle); - -------------------- - -- Is_Forced_Edge -- - -------------------- + -- The list contains at least one cycle, and the input cycle has a + -- higher precedence compared to some cycle in the list. - function Is_Forced_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean + if Present (Lesser_Cycle) then + LGC_Lists.Insert_Before + (L => G.Cycles, + Before => Lesser_Cycle, + Elem => Cycle); + + -- Otherwise the input cycle has the lowest precedence among all + -- cycles. + + else + LGC_Lists.Append (G.Cycles, Cycle); + end if; + end if; + end Order_Cycle; + + ---------- + -- Path -- + ---------- + + function Path + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) return LGE_Lists.Doubly_Linked_List is begin pragma Assert (Present (G)); - pragma Assert (Present (Edge)); + pragma Assert (Present (Cycle)); - return Kind (G, Edge) = Forced_Edge; - end Is_Forced_Edge; + return Get_LGC_Attributes (G, Cycle).Path; + end Path; - ---------------------- - -- Is_Internal_Unit -- - ---------------------- + ------------------------------------------ + -- Pending_Predecessors_For_Elaboration -- + ------------------------------------------ - function Is_Internal_Unit - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean + procedure Pending_Predecessors_For_Elaboration + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id; + Strong_Preds : out Natural; + Weak_Preds : out Natural) is + Complement : Library_Graph_Vertex_Id; + Spec_Vertex : Library_Graph_Vertex_Id; + Total_Strong_Preds : Natural; + Total_Weak_Preds : Natural; + begin pragma Assert (Present (G)); pragma Assert (Present (Vertex)); - return Is_Internal_Unit (Unit (G, Vertex)); - end Is_Internal_Unit; + Total_Strong_Preds := Pending_Strong_Predecessors (G, Vertex); + Total_Weak_Preds := Pending_Weak_Predecessors (G, Vertex); - ------------------------ - -- Is_Invocation_Edge -- - ------------------------ + -- Assume that there is no complementary vertex that needs to be + -- examined. - function Is_Invocation_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Edge)); + Complement := No_Library_Graph_Vertex; + Spec_Vertex := No_Library_Graph_Vertex; - return Kind (G, Edge) = Invocation_Edge; - end Is_Invocation_Edge; + if Is_Body_Of_Spec_With_Elaborate_Body (G, Vertex) then + Complement := Proper_Spec (G, Vertex); + Spec_Vertex := Complement; - ------------------------ - -- Is_Predefined_Unit -- - ------------------------ + elsif Is_Spec_With_Elaborate_Body (G, Vertex) then + Complement := Proper_Body (G, Vertex); + Spec_Vertex := Vertex; + end if; - function Is_Predefined_Unit - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean + -- The vertex is part of an Elaborate_Body pair. Take into account + -- the strong and weak predecessors of the complementary vertex. + + if Present (Complement) then + Total_Strong_Preds := + Pending_Strong_Predecessors (G, Complement) + Total_Strong_Preds; + Total_Weak_Preds := + Pending_Weak_Predecessors (G, Complement) + Total_Weak_Preds; + + -- The body of an Elaborate_Body pair is the successor of a strong + -- edge where the predecessor is the spec. This edge must not be + -- considered for elaboration purposes because the pair is treated + -- as one vertex. Account for the edge only when the spec has not + -- been elaborated yet. + + if not In_Elaboration_Order (G, Spec_Vertex) then + Total_Strong_Preds := Total_Strong_Preds - 1; + end if; + end if; + + Strong_Preds := Total_Strong_Preds; + Weak_Preds := Total_Weak_Preds; + end Pending_Predecessors_For_Elaboration; + + --------------------------------- + -- Pending_Strong_Predecessors -- + --------------------------------- + + function Pending_Strong_Predecessors + (G : Library_Graph; + Comp : Component_Id) return Natural is begin pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); + pragma Assert (Present (Comp)); - return Is_Predefined_Unit (Unit (G, Vertex)); - end Is_Predefined_Unit; + return Get_Component_Attributes (G, Comp).Pending_Strong_Predecessors; + end Pending_Strong_Predecessors; - --------------------------- - -- Is_Preelaborated_Unit -- - --------------------------- + --------------------------------- + -- Pending_Strong_Predecessors -- + --------------------------------- - function Is_Preelaborated_Unit + function Pending_Strong_Predecessors (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean + Vertex : Library_Graph_Vertex_Id) return Natural is + begin pragma Assert (Present (G)); pragma Assert (Present (Vertex)); - U_Id : constant Unit_Id := Unit (G, Vertex); - U_Rec : Unit_Record renames ALI.Units.Table (U_Id); - - begin - return U_Rec.Preelab or else U_Rec.Pure; - end Is_Preelaborated_Unit; + return Get_LGV_Attributes (G, Vertex).Pending_Strong_Predecessors; + end Pending_Strong_Predecessors; - ---------------------- - -- Is_Recorded_Edge -- - ---------------------- + ------------------------------- + -- Pending_Weak_Predecessors -- + ------------------------------- - function Is_Recorded_Edge - (G : Library_Graph; - Rel : Predecessor_Successor_Relation) return Boolean + function Pending_Weak_Predecessors + (G : Library_Graph; + Comp : Component_Id) return Natural is begin pragma Assert (Present (G)); - pragma Assert (Present (Rel.Predecessor)); - pragma Assert (Present (Rel.Successor)); + pragma Assert (Present (Comp)); - return RE_Sets.Contains (G.Recorded_Edges, Rel); - end Is_Recorded_Edge; + return Get_Component_Attributes (G, Comp).Pending_Weak_Predecessors; + end Pending_Weak_Predecessors; - ------------- - -- Is_Spec -- - ------------- + ------------------------------- + -- Pending_Weak_Predecessors -- + ------------------------------- - function Is_Spec + function Pending_Weak_Predecessors (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean + Vertex : Library_Graph_Vertex_Id) return Natural is + begin pragma Assert (Present (G)); pragma Assert (Present (Vertex)); - U_Id : constant Unit_Id := Unit (G, Vertex); - U_Rec : Unit_Record renames ALI.Units.Table (U_Id); - - begin - return U_Rec.Utype = Is_Spec or else U_Rec.Utype = Is_Spec_Only; - end Is_Spec; + return Get_LGV_Attributes (G, Vertex).Pending_Weak_Predecessors; + end Pending_Weak_Predecessors; - ------------------------------ - -- Is_Spec_Before_Body_Edge -- - ------------------------------ + ----------------- + -- Predecessor -- + ----------------- - function Is_Spec_Before_Body_Edge + function Predecessor (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean + Edge : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id is begin pragma Assert (Present (G)); pragma Assert (Present (Edge)); - return Kind (G, Edge) = Spec_Before_Body_Edge; - end Is_Spec_Before_Body_Edge; + return DG.Source_Vertex (G.Graph, Edge); + end Predecessor; - ----------------------- - -- Is_Spec_With_Body -- - ----------------------- + ------------- + -- Present -- + ------------- - function Is_Spec_With_Body + function Present (G : Library_Graph) return Boolean is + begin + return G /= Nil; + end Present; + + ----------------- + -- Proper_Body -- + ----------------- + + function Proper_Body (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean + Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id is + begin pragma Assert (Present (G)); pragma Assert (Present (Vertex)); - U_Id : constant Unit_Id := Unit (G, Vertex); - U_Rec : Unit_Record renames ALI.Units.Table (U_Id); + -- When the vertex denotes a spec with a completing body, return the + -- body. - begin - return U_Rec.Utype = Is_Spec; - end Is_Spec_With_Body; + if Is_Spec_With_Body (G, Vertex) then + return Corresponding_Item (G, Vertex); - --------------------------------- - -- Is_Spec_With_Elaborate_Body -- - --------------------------------- + -- Otherwise the vertex must be a body - function Is_Spec_With_Elaborate_Body + else + pragma Assert (Is_Body (G, Vertex)); + return Vertex; + end if; + end Proper_Body; + + ----------------- + -- Proper_Spec -- + ----------------- + + function Proper_Spec (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean + Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id is begin pragma Assert (Present (G)); pragma Assert (Present (Vertex)); - return - Is_Spec_With_Body (G, Vertex) - and then Has_Elaborate_Body (G, Vertex); - end Is_Spec_With_Elaborate_Body; + -- When the vertex denotes a body that completes a spec, return the + -- spec. - ------------------------------ - -- Is_Static_Successor_Edge -- - ------------------------------ + if Is_Body_With_Spec (G, Vertex) then + return Corresponding_Item (G, Vertex); - function Is_Static_Successor_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Edge)); + -- Otherwise the vertex must denote a spec - return - Is_Invocation_Edge (G, Edge) - and then not Is_Dynamically_Elaborated (G, Successor (G, Edge)); - end Is_Static_Successor_Edge; + else + pragma Assert (Is_Spec (G, Vertex)); + return Vertex; + end if; + end Proper_Spec; - ----------------------------------- - -- Is_Vertex_With_Elaborate_Body -- - ----------------------------------- + ------------------ + -- Record_Cycle -- + ------------------ - function Is_Vertex_With_Elaborate_Body - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean + procedure Record_Cycle + (G : Library_Graph; + Most_Significant_Edge : Library_Graph_Edge_Id; + Invocation_Edge_Count : Natural; + Cycle_Path : LGE_Lists.Doubly_Linked_List; + Indent : Indentation_Level) is + Cycle : Library_Graph_Cycle_Id; + Path : LGE_Lists.Doubly_Linked_List; + begin pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); + pragma Assert (Present (Most_Significant_Edge)); + pragma Assert (LGE_Lists.Present (Cycle_Path)); - return - Is_Spec_With_Elaborate_Body (G, Vertex) - or else - Is_Body_Of_Spec_With_Elaborate_Body (G, Vertex); - end Is_Vertex_With_Elaborate_Body; + -- Replicate the path of the cycle in order to avoid sharing lists - --------------------------------- - -- Is_Weakly_Elaborable_Vertex -- - ---------------------------------- + Path := Copy_Cycle_Path (Cycle_Path); - function Is_Weakly_Elaborable_Vertex - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean - is - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); + -- Normalize the path of the cycle such that its most significant + -- edge is the first in the list of edges. - Complement : constant Library_Graph_Vertex_Id := - Complementary_Vertex - (G => G, - Vertex => Vertex, - Force_Complement => False); + Normalize_Cycle_Path + (Cycle_Path => Path, + Most_Significant_Edge => Most_Significant_Edge); - Strong_Preds : Natural; - Weak_Preds : Natural; + -- Save the cycle for diagnostic purposes. Its kind is determined by + -- its most significant edge. + + Cycle := Sequence_Next_Cycle; + + Set_LGC_Attributes + (G => G, + Cycle => Cycle, + Val => + (Invocation_Edge_Count => Invocation_Edge_Count, + Kind => + Cycle_Kind_Of + (G => G, + Edge => Most_Significant_Edge), + Path => Path)); + + Trace_Cycle (G, Cycle, Indent); + + -- Order the cycle based on its precedence relative to previously + -- discovered cycles. + + Order_Cycle (G, Cycle); + end Record_Cycle; + + ----------------------------------------- + -- Same_Library_Graph_Cycle_Attributes -- + ----------------------------------------- + function Same_Library_Graph_Cycle_Attributes + (Left : Library_Graph_Cycle_Attributes; + Right : Library_Graph_Cycle_Attributes) return Boolean + is begin - -- A vertex is weakly elaborable when: + -- Two cycles are the same when -- - -- * It has not been elaborated yet, and - -- * The complement vertex of an Elaborate_Body pair has not been - -- elaborated yet, and - -- * It resides within an elaborable component, and - -- * It is not waiting on strong predecessors, and - -- * It is waiting on at least one weak predecessor + -- * They are of the same kind + -- * They have the same number of invocation edges in their paths + -- * Their paths are the same length + -- * The edges comprising their paths are the same - if In_Elaboration_Order (G, Vertex) then - return False; + return + Left.Invocation_Edge_Count = Right.Invocation_Edge_Count + and then Left.Kind = Right.Kind + and then LGE_Lists.Equal (Left.Path, Right.Path); + end Same_Library_Graph_Cycle_Attributes; - elsif Present (Complement) - and then In_Elaboration_Order (G, Complement) - then - return False; + ------------------------ + -- Set_Activates_Task -- + ------------------------ - elsif not Is_Elaborable_Component (G, Component (G, Vertex)) then - return False; - end if; + procedure Set_Activates_Task + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) + is + Attributes : Library_Graph_Edge_Attributes := + Get_LGE_Attributes (G, Edge); + begin + Attributes.Activates_Task := True; + Set_LGE_Attributes (G, Edge, Attributes); + end Set_Activates_Task; - Pending_Predecessors_For_Elaboration - (G => G, - Vertex => Vertex, - Strong_Preds => Strong_Preds, - Weak_Preds => Weak_Preds); + ------------------------------ + -- Set_Component_Attributes -- + ------------------------------ - return Strong_Preds = 0 and then Weak_Preds >= 1; - end Is_Weakly_Elaborable_Vertex; + procedure Set_Component_Attributes + (G : Library_Graph; + Comp : Component_Id; + Val : Component_Attributes) + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Comp)); - ------------------ - -- Is_With_Edge -- - ------------------ + Component_Tables.Put (G.Component_Attributes, Comp, Val); + end Set_Component_Attributes; - function Is_With_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean + ---------------------------- + -- Set_Corresponding_Item -- + ---------------------------- + + procedure Set_Corresponding_Item + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id; + Val : Library_Graph_Vertex_Id) is + Attrs : Library_Graph_Vertex_Attributes; + begin pragma Assert (Present (G)); - pragma Assert (Present (Edge)); + pragma Assert (Present (Vertex)); - return Kind (G, Edge) = With_Edge; - end Is_With_Edge; + Attrs := Get_LGV_Attributes (G, Vertex); + Attrs.Corresponding_Item := Val; + Set_LGV_Attributes (G, Vertex, Attrs); + end Set_Corresponding_Item; - ------------------------ - -- Iterate_All_Cycles -- - ------------------------ + ------------------------------ + -- Set_Corresponding_Vertex -- + ------------------------------ - function Iterate_All_Cycles - (G : Library_Graph) return All_Cycle_Iterator + procedure Set_Corresponding_Vertex + (G : Library_Graph; + U_Id : Unit_Id; + Val : Library_Graph_Vertex_Id) is begin pragma Assert (Present (G)); + pragma Assert (Present (U_Id)); - return All_Cycle_Iterator (LGC_Lists.Iterate (G.Cycles)); - end Iterate_All_Cycles; + Unit_Tables.Put (G.Unit_To_Vertex, U_Id, Val); + end Set_Corresponding_Vertex; - ----------------------- - -- Iterate_All_Edges -- - ----------------------- + ------------------------------ + -- Set_In_Elaboration_Order -- + ------------------------------ - function Iterate_All_Edges - (G : Library_Graph) return All_Edge_Iterator + procedure Set_In_Elaboration_Order + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id; + Val : Boolean := True) is + Attrs : Library_Graph_Vertex_Attributes; + begin pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); - return All_Edge_Iterator (DG.Iterate_All_Edges (G.Graph)); - end Iterate_All_Edges; + Attrs := Get_LGV_Attributes (G, Vertex); + Attrs.In_Elaboration_Order := Val; + Set_LGV_Attributes (G, Vertex, Attrs); + end Set_In_Elaboration_Order; -------------------------- - -- Iterate_All_Vertices -- + -- Set_Is_Recorded_Edge -- -------------------------- - function Iterate_All_Vertices - (G : Library_Graph) return All_Vertex_Iterator + procedure Set_Is_Recorded_Edge + (G : Library_Graph; + Rel : Predecessor_Successor_Relation) is begin pragma Assert (Present (G)); + pragma Assert (Present (Rel.Predecessor)); + pragma Assert (Present (Rel.Successor)); - return All_Vertex_Iterator (DG.Iterate_All_Vertices (G.Graph)); - end Iterate_All_Vertices; + RE_Sets.Insert (G.Recorded_Edges, Rel); + end Set_Is_Recorded_Edge; ------------------------ - -- Iterate_Components -- + -- Set_LGC_Attributes -- ------------------------ - function Iterate_Components - (G : Library_Graph) return Component_Iterator + procedure Set_LGC_Attributes + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id; + Val : Library_Graph_Cycle_Attributes) is begin pragma Assert (Present (G)); + pragma Assert (Present (Cycle)); - return Component_Iterator (DG.Iterate_Components (G.Graph)); - end Iterate_Components; + LGC_Tables.Put (G.Cycle_Attributes, Cycle, Val); + end Set_LGC_Attributes; - -------------------------------- - -- Iterate_Component_Vertices -- - -------------------------------- + ------------------------ + -- Set_LGE_Attributes -- + ------------------------ - function Iterate_Component_Vertices + procedure Set_LGE_Attributes (G : Library_Graph; - Comp : Component_Id) return Component_Vertex_Iterator + Edge : Library_Graph_Edge_Id; + Val : Library_Graph_Edge_Attributes) is begin pragma Assert (Present (G)); - pragma Assert (Present (Comp)); + pragma Assert (Present (Edge)); - return - Component_Vertex_Iterator - (DG.Iterate_Component_Vertices (G.Graph, Comp)); - end Iterate_Component_Vertices; + LGE_Tables.Put (G.Edge_Attributes, Edge, Val); + end Set_LGE_Attributes; - ---------------------------- - -- Iterate_Edges_Of_Cycle -- - ---------------------------- + ------------------------ + -- Set_LGV_Attributes -- + ------------------------ - function Iterate_Edges_Of_Cycle - (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id) return Edges_Of_Cycle_Iterator + procedure Set_LGV_Attributes + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id; + Val : Library_Graph_Vertex_Attributes) is begin pragma Assert (Present (G)); - pragma Assert (Present (Cycle)); + pragma Assert (Present (Vertex)); - return Edges_Of_Cycle_Iterator (LGE_Lists.Iterate (Path (G, Cycle))); - end Iterate_Edges_Of_Cycle; + LGV_Tables.Put (G.Vertex_Attributes, Vertex, Val); + end Set_LGV_Attributes; - --------------------------------- - -- Iterate_Edges_To_Successors -- - --------------------------------- + --------------- + -- Successor -- + --------------- - function Iterate_Edges_To_Successors - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Edges_To_Successors_Iterator + function Successor + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id is begin pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); + pragma Assert (Present (Edge)); - return - Edges_To_Successors_Iterator - (DG.Iterate_Outgoing_Edges (G.Graph, Vertex)); - end Iterate_Edges_To_Successors; + return DG.Destination_Vertex (G.Graph, Edge); + end Successor; - ---------- - -- Kind -- - ---------- + --------------------- + -- Trace_Component -- + --------------------- - function Kind + procedure Trace_Component (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Kind + Comp : Component_Id; + Indent : Indentation_Level) is begin pragma Assert (Present (G)); - pragma Assert (Present (Cycle)); + pragma Assert (Present (Comp)); - return Get_LGC_Attributes (G, Cycle).Kind; - end Kind; + -- Nothing to do when switch -d_t (output cycle-detection trace + -- information) is not in effect. - ---------- - -- Kind -- - ---------- + if not Debug_Flag_Underscore_T then + return; + end if; - function Kind - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Library_Graph_Edge_Kind - is - begin - return Get_LGE_Attributes (G, Edge).Kind; - end Kind; + Write_Eol; + Indent_By (Indent); + Write_Str ("component (Comp_"); + Write_Int (Int (Comp)); + Write_Str (")"); + Write_Eol; + end Trace_Component; - ------------ - -- Length -- - ------------ + ----------------- + -- Trace_Cycle -- + ----------------- - function Length - (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id) return Natural + procedure Trace_Cycle + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id; + Indent : Indentation_Level) is + Attr_Indent : constant Indentation_Level := + Indent + Nested_Indentation; + Edge_Indent : constant Indentation_Level := + Attr_Indent + Nested_Indentation; + + Edge : Library_Graph_Edge_Id; + Iter : Edges_Of_Cycle_Iterator; + begin pragma Assert (Present (G)); pragma Assert (Present (Cycle)); - return LGE_Lists.Size (Path (G, Cycle)); - end Length; + -- Nothing to do when switch -d_t (output cycle-detection trace + -- information) is not in effect. - ------------------------------ - -- Library_Graph_Edge_Count -- - ------------------------------ + if not Debug_Flag_Underscore_T then + return; + end if; - function Library_Graph_Edge_Count - (G : Library_Graph; - Kind : Library_Graph_Edge_Kind) return Natural - is - begin - pragma Assert (Present (G)); + Indent_By (Indent); + Write_Str ("cycle (LGC_Id_"); + Write_Int (Int (Cycle)); + Write_Str (")"); + Write_Eol; - return G.Counts (Kind); - end Library_Graph_Edge_Count; + Indent_By (Attr_Indent); + Write_Str ("kind = "); + Write_Str (Kind (G, Cycle)'Img); + Write_Eol; - -------------------------------------- - -- Links_Vertices_In_Same_Component -- - -------------------------------------- + Indent_By (Attr_Indent); + Write_Str ("invocation edges = "); + Write_Int (Int (Invocation_Edge_Count (G, Cycle))); + Write_Eol; - function Links_Vertices_In_Same_Component - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Edge)); + Indent_By (Attr_Indent); + Write_Str ("length: "); + Write_Int (Int (Length (G, Cycle))); + Write_Eol; - -- An edge is part of a cycle when both the successor and predecessor - -- reside in the same component. + Iter := Iterate_Edges_Of_Cycle (G, Cycle); + while Has_Next (Iter) loop + Next (Iter, Edge); - return - In_Same_Component - (G => G, - Left => Predecessor (G, Edge), - Right => Successor (G, Edge)); - end Links_Vertices_In_Same_Component; + Indent_By (Edge_Indent); + Write_Str ("library graph edge (LGE_Id_"); + Write_Int (Int (Edge)); + Write_Str (")"); + Write_Eol; + end loop; + end Trace_Cycle; - ----------------------------------- - -- Maximum_Invocation_Edge_Count -- - ----------------------------------- + ---------------- + -- Trace_Edge -- + ---------------- - function Maximum_Invocation_Edge_Count - (G : Library_Graph; - Edge : Library_Graph_Edge_Id; - Count : Natural) return Natural + procedure Trace_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id; + Indent : Indentation_Level) is - New_Count : Natural; + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); + + Attr_Indent : constant Indentation_Level := + Indent + Nested_Indentation; + + Pred : constant Library_Graph_Vertex_Id := Predecessor (G, Edge); + Succ : constant Library_Graph_Vertex_Id := Successor (G, Edge); begin - pragma Assert (Present (G)); - - New_Count := Count; + -- Nothing to do when switch -d_t (output cycle-detection trace + -- information) is not in effect. - if Present (Edge) and then Is_Invocation_Edge (G, Edge) then - New_Count := New_Count + 1; + if not Debug_Flag_Underscore_T then + return; end if; - return New_Count; - end Maximum_Invocation_Edge_Count; + Indent_By (Indent); + Write_Str ("library graph edge (LGE_Id_"); + Write_Int (Int (Edge)); + Write_Str (")"); + Write_Eol; - ---------- - -- Name -- - ---------- + Indent_By (Attr_Indent); + Write_Str ("kind = "); + Write_Str (Kind (G, Edge)'Img); + Write_Eol; - function Name - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Unit_Name_Type - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); + Indent_By (Attr_Indent); + Write_Str ("Predecessor (LGV_Id_"); + Write_Int (Int (Pred)); + Write_Str (") name = "); + Write_Name (Name (G, Pred)); + Write_Eol; - return Name (Unit (G, Vertex)); - end Name; + Indent_By (Attr_Indent); + Write_Str ("Successor (LGV_Id_"); + Write_Int (Int (Succ)); + Write_Str (") name = "); + Write_Name (Name (G, Succ)); + Write_Eol; + end Trace_Edge; - ----------------------- - -- Needs_Elaboration -- - ----------------------- + ------------------ + -- Trace_Vertex -- + ------------------ - function Needs_Elaboration + procedure Trace_Vertex (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean + Vertex : Library_Graph_Vertex_Id; + Indent : Indentation_Level) is + Attr_Indent : constant Indentation_Level := + Indent + Nested_Indentation; + begin pragma Assert (Present (G)); pragma Assert (Present (Vertex)); - return Needs_Elaboration (Unit (G, Vertex)); - end Needs_Elaboration; - - ---------- - -- Next -- - ---------- + -- Nothing to do when switch -d_t (output cycle-detection trace + -- information) is not in effect. - procedure Next - (Iter : in out All_Cycle_Iterator; - Cycle : out Library_Graph_Cycle_Id) - is - begin - LGC_Lists.Next (LGC_Lists.Iterator (Iter), Cycle); - end Next; + if not Debug_Flag_Underscore_T then + return; + end if; - ---------- - -- Next -- - ---------- + Indent_By (Indent); + Write_Str ("library graph vertex (LGV_Id_"); + Write_Int (Int (Vertex)); + Write_Str (")"); + Write_Eol; - procedure Next - (Iter : in out All_Edge_Iterator; - Edge : out Library_Graph_Edge_Id) - is - begin - DG.Next (DG.All_Edge_Iterator (Iter), Edge); - end Next; + Indent_By (Attr_Indent); + Write_Str ("Unit (U_Id_"); + Write_Int (Int (Unit (G, Vertex))); + Write_Str (") name = "); + Write_Name (Name (G, Vertex)); + Write_Eol; + end Trace_Vertex; ---------- - -- Next -- + -- Unit -- ---------- - procedure Next - (Iter : in out All_Vertex_Iterator; - Vertex : out Library_Graph_Vertex_Id) + function Unit + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Unit_Id is begin - DG.Next (DG.All_Vertex_Iterator (Iter), Vertex); - end Next; - - ---------- - -- Next -- - ---------- + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); - procedure Next - (Iter : in out Edges_Of_Cycle_Iterator; - Edge : out Library_Graph_Edge_Id) - is - begin - LGE_Lists.Next (LGE_Lists.Iterator (Iter), Edge); - end Next; + return Get_LGV_Attributes (G, Vertex).Unit; + end Unit; - ---------- - -- Next -- - ---------- + ------------- + -- Unvisit -- + ------------- - procedure Next - (Iter : in out Component_Iterator; - Comp : out Component_Id) + procedure Unvisit + (Vertex : Library_Graph_Vertex_Id; + Visited_Set : LGV_Sets.Membership_Set; + Visited_Stack : LGV_Lists.Doubly_Linked_List) is + Current_Vertex : Library_Graph_Vertex_Id; + begin - DG.Next (DG.Component_Iterator (Iter), Comp); - end Next; + pragma Assert (Present (Vertex)); + pragma Assert (LGV_Sets.Present (Visited_Set)); + pragma Assert (LGV_Lists.Present (Visited_Stack)); - ---------- - -- Next -- - ---------- + while not LGV_Lists.Is_Empty (Visited_Stack) loop + Current_Vertex := LGV_Lists.First (Visited_Stack); - procedure Next - (Iter : in out Edges_To_Successors_Iterator; - Edge : out Library_Graph_Edge_Id) - is - begin - DG.Next (DG.Outgoing_Edge_Iterator (Iter), Edge); - end Next; + LGV_Lists.Delete_First (Visited_Stack); + LGV_Sets.Delete (Visited_Set, Current_Vertex); - ---------- - -- Next -- - ---------- + exit when Current_Vertex = Vertex; + end loop; + end Unvisit; - procedure Next - (Iter : in out Component_Vertex_Iterator; - Vertex : out Library_Graph_Vertex_Id) + --------------------------------- + -- Update_Pending_Predecessors -- + --------------------------------- + + procedure Update_Pending_Predecessors + (Strong_Predecessors : in out Natural; + Weak_Predecessors : in out Natural; + Update_Weak : Boolean; + Value : Integer) is begin - DG.Next (DG.Component_Vertex_Iterator (Iter), Vertex); - end Next; + if Update_Weak then + Weak_Predecessors := Weak_Predecessors + Value; + else + Strong_Predecessors := Strong_Predecessors + Value; + end if; + end Update_Pending_Predecessors; - -------------------------- - -- Normalize_Cycle_Path -- - -------------------------- + ----------------------------------------------- + -- Update_Pending_Predecessors_Of_Components -- + ----------------------------------------------- - procedure Normalize_Cycle_Path - (Cycle_Path : LGE_Lists.Doubly_Linked_List; - Most_Significant_Edge : Library_Graph_Edge_Id) + procedure Update_Pending_Predecessors_Of_Components + (G : Library_Graph) is Edge : Library_Graph_Edge_Id; + Iter : All_Edge_Iterator; begin - pragma Assert (LGE_Lists.Present (Cycle_Path)); - pragma Assert (Present (Most_Significant_Edge)); + pragma Assert (Present (G)); - -- Perform at most |Cycle_Path| rotations in case the cycle is - -- malformed and the significant edge does not appear within. + Iter := Iterate_All_Edges (G); + while Has_Next (Iter) loop + Next (Iter, Edge); - for Rotation in 1 .. LGE_Lists.Size (Cycle_Path) loop - Edge := LGE_Lists.First (Cycle_Path); + Update_Pending_Predecessors_Of_Components (G, Edge); + end loop; + end Update_Pending_Predecessors_Of_Components; - -- The cycle is already rotated such that the most significant - -- edge is first. + ----------------------------------------------- + -- Update_Pending_Predecessors_Of_Components -- + ----------------------------------------------- - if Edge = Most_Significant_Edge then - return; + procedure Update_Pending_Predecessors_Of_Components + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) + is + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); - -- Otherwise rotate the cycle by relocating the current edge from - -- the start to the end of the path. This preserves the order of - -- the path. + Pred_Comp : constant Component_Id := + Component (G, Predecessor (G, Edge)); + Succ_Comp : constant Component_Id := + Component (G, Successor (G, Edge)); - else - LGE_Lists.Delete_First (Cycle_Path); - LGE_Lists.Append (Cycle_Path, Edge); - end if; - end loop; + pragma Assert (Present (Pred_Comp)); + pragma Assert (Present (Succ_Comp)); - pragma Assert (False); - end Normalize_Cycle_Path; + begin + -- The edge links a successor and a predecessor coming from two + -- different SCCs. This indicates that the SCC of the successor + -- must wait on another predecessor until it can be elaborated. - ---------------------------------- - -- Number_Of_Component_Vertices -- - ---------------------------------- + if Pred_Comp /= Succ_Comp then + Increment_Pending_Predecessors + (G => G, + Comp => Succ_Comp, + Edge => Edge); + end if; + end Update_Pending_Predecessors_Of_Components; + + ----------------------- + -- Vertex_Precedence -- + ----------------------- - function Number_Of_Component_Vertices - (G : Library_Graph; - Comp : Component_Id) return Natural + function Vertex_Precedence + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id; + Compared_To : Library_Graph_Vertex_Id) return Precedence_Kind is begin pragma Assert (Present (G)); - pragma Assert (Present (Comp)); + pragma Assert (Present (Vertex)); + pragma Assert (Present (Compared_To)); - return DG.Number_Of_Component_Vertices (G.Graph, Comp); - end Number_Of_Component_Vertices; + -- Use lexicographical order to determine precedence and ensure + -- deterministic behavior. - -------------------------- - -- Number_Of_Components -- - -------------------------- + if Uname_Less (Name (G, Vertex), Name (G, Compared_To)) then + return Higher_Precedence; + else + return Lower_Precedence; + end if; + end Vertex_Precedence; - function Number_Of_Components (G : Library_Graph) return Natural is + ----------- + -- Visit -- + ----------- + + procedure Visit + (Vertex : Library_Graph_Vertex_Id; + Visited_Set : LGV_Sets.Membership_Set; + Visited_Stack : LGV_Lists.Doubly_Linked_List) + is begin - pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + pragma Assert (LGV_Sets.Present (Visited_Set)); + pragma Assert (LGV_Lists.Present (Visited_Stack)); - return DG.Number_Of_Components (G.Graph); - end Number_Of_Components; + LGV_Sets.Insert (Visited_Set, Vertex); + LGV_Lists.Prepend (Visited_Stack, Vertex); + end Visit; + end Library_Graphs; - ---------------------- - -- Number_Of_Cycles -- - ---------------------- + ----------------------- + -- Invocation_Graphs -- + ----------------------- - function Number_Of_Cycles (G : Library_Graph) return Natural is - begin - pragma Assert (Present (G)); + package body Invocation_Graphs is - return LGC_Lists.Size (G.Cycles); - end Number_Of_Cycles; + ----------------------- + -- Local subprograms -- + ----------------------- - --------------------- - -- Number_Of_Edges -- - --------------------- + procedure Free is + new Ada.Unchecked_Deallocation + (Invocation_Graph_Attributes, Invocation_Graph); - function Number_Of_Edges (G : Library_Graph) return Natural is - begin - pragma Assert (Present (G)); + function Get_IGE_Attributes + (G : Invocation_Graph; + Edge : Invocation_Graph_Edge_Id) + return Invocation_Graph_Edge_Attributes; + pragma Inline (Get_IGE_Attributes); + -- Obtain the attributes of edge Edge of invocation graph G - return DG.Number_Of_Edges (G.Graph); - end Number_Of_Edges; + function Get_IGV_Attributes + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) + return Invocation_Graph_Vertex_Attributes; + pragma Inline (Get_IGV_Attributes); + -- Obtain the attributes of vertex Vertex of invocation graph G - ----------------------------------- - -- Number_Of_Edges_To_Successors -- - ----------------------------------- + procedure Increment_Invocation_Graph_Edge_Count + (G : Invocation_Graph; + Kind : Invocation_Kind); + pragma Inline (Increment_Invocation_Graph_Edge_Count); + -- Increment the number of edges of king Kind in invocation graph G by + -- one. - function Number_Of_Edges_To_Successors - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Natural - is - begin - pragma Assert (Present (G)); + function Is_Elaboration_Root + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Boolean; + pragma Inline (Is_Elaboration_Root); + -- Determine whether vertex Vertex of invocation graph denotes the + -- elaboration procedure of a spec or a body. - return DG.Number_Of_Outgoing_Edges (G.Graph, Vertex); - end Number_Of_Edges_To_Successors; + function Is_Existing_Source_Target_Relation + (G : Invocation_Graph; + Rel : Source_Target_Relation) return Boolean; + pragma Inline (Is_Existing_Source_Target_Relation); + -- Determine whether a source vertex and a target vertex described by + -- relation Rel are already related in invocation graph G. - ------------------------ - -- Number_Of_Vertices -- - ------------------------ + procedure Save_Elaboration_Root + (G : Invocation_Graph; + Root : Invocation_Graph_Vertex_Id); + pragma Inline (Save_Elaboration_Root); + -- Save elaboration root Root of invocation graph G - function Number_Of_Vertices (G : Library_Graph) return Natural is - begin - pragma Assert (Present (G)); + procedure Set_Corresponding_Vertex + (G : Invocation_Graph; + IS_Id : Invocation_Signature_Id; + Vertex : Invocation_Graph_Vertex_Id); + pragma Inline (Set_Corresponding_Vertex); + -- Associate vertex Vertex of invocation graph G with signature IS_Id - return DG.Number_Of_Vertices (G.Graph); - end Number_Of_Vertices; + procedure Set_Is_Existing_Source_Target_Relation + (G : Invocation_Graph; + Rel : Source_Target_Relation; + Val : Boolean := True); + pragma Inline (Set_Is_Existing_Source_Target_Relation); + -- Mark a source vertex and a target vertex described by relation Rel as + -- already related in invocation graph G depending on value Val. - ----------------- - -- Order_Cycle -- - ----------------- + procedure Set_IGE_Attributes + (G : Invocation_Graph; + Edge : Invocation_Graph_Edge_Id; + Val : Invocation_Graph_Edge_Attributes); + pragma Inline (Set_IGE_Attributes); + -- Set the attributes of edge Edge of invocation graph G to value Val - procedure Order_Cycle - (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id) - is - Lesser_Cycle : Library_Graph_Cycle_Id; + procedure Set_IGV_Attributes + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id; + Val : Invocation_Graph_Vertex_Attributes); + pragma Inline (Set_IGV_Attributes); + -- Set the attributes of vertex Vertex of invocation graph G to value + -- Val. - begin + -------------- + -- Add_Edge -- + -------------- + + procedure Add_Edge + (G : Invocation_Graph; + Source : Invocation_Graph_Vertex_Id; + Target : Invocation_Graph_Vertex_Id; + IR_Id : Invocation_Relation_Id) + is pragma Assert (Present (G)); - pragma Assert (Present (Cycle)); - pragma Assert (LGC_Lists.Present (G.Cycles)); + pragma Assert (Present (Source)); + pragma Assert (Present (Target)); + pragma Assert (Present (IR_Id)); - -- The input cycle is the first to be inserted + Rel : constant Source_Target_Relation := + (Source => Source, + Target => Target); - if LGC_Lists.Is_Empty (G.Cycles) then - LGC_Lists.Prepend (G.Cycles, Cycle); + Edge : Invocation_Graph_Edge_Id; - -- Otherwise the list of all cycles contains at least one cycle. - -- Insert the input cycle based on its precedence. + begin + -- Nothing to do when the source and target are already related by an + -- edge. - else - Lesser_Cycle := Find_First_Lower_Precedence_Cycle (G, Cycle); + if Is_Existing_Source_Target_Relation (G, Rel) then + return; + end if; - -- The list contains at least one cycle, and the input cycle has a - -- higher precedence compared to some cycle in the list. + Edge := Sequence_Next_Edge; - if Present (Lesser_Cycle) then - LGC_Lists.Insert_Before - (L => G.Cycles, - Before => Lesser_Cycle, - Elem => Cycle); + -- Add the edge to the underlying graph - -- Otherwise the input cycle has the lowest precedence among all - -- cycles. + DG.Add_Edge + (G => G.Graph, + E => Edge, + Source => Source, + Destination => Target); - else - LGC_Lists.Append (G.Cycles, Cycle); - end if; - end if; - end Order_Cycle; + -- Build and save the attributes of the edge - ---------- - -- Path -- - ---------- + Set_IGE_Attributes + (G => G, + Edge => Edge, + Val => (Relation => IR_Id)); - function Path - (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id) return LGE_Lists.Doubly_Linked_List - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Cycle)); + -- Mark the source and target as related by the new edge. This + -- prevents all further attempts to link the same source and target. - return Get_LGC_Attributes (G, Cycle).Path; - end Path; + Set_Is_Existing_Source_Target_Relation (G, Rel); - ------------------------------------------ - -- Pending_Predecessors_For_Elaboration -- - ------------------------------------------ + -- Update the edge statistics - procedure Pending_Predecessors_For_Elaboration - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id; - Strong_Preds : out Natural; - Weak_Preds : out Natural) - is - Complement : Library_Graph_Vertex_Id; - Spec_Vertex : Library_Graph_Vertex_Id; - Total_Strong_Preds : Natural; - Total_Weak_Preds : Natural; + Increment_Invocation_Graph_Edge_Count (G, Kind (IR_Id)); + end Add_Edge; + + ---------------- + -- Add_Vertex -- + ---------------- + + procedure Add_Vertex + (G : Invocation_Graph; + IC_Id : Invocation_Construct_Id; + Body_Vertex : Library_Graph_Vertex_Id; + Spec_Vertex : Library_Graph_Vertex_Id) + is + pragma Assert (Present (G)); + pragma Assert (Present (IC_Id)); + pragma Assert (Present (Body_Vertex)); + pragma Assert (Present (Spec_Vertex)); + + Construct_Signature : constant Invocation_Signature_Id := + Signature (IC_Id); + Vertex : Invocation_Graph_Vertex_Id; begin - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); + -- Nothing to do when the construct already has a vertex - Total_Strong_Preds := Pending_Strong_Predecessors (G, Vertex); - Total_Weak_Preds := Pending_Weak_Predecessors (G, Vertex); + if Present (Corresponding_Vertex (G, Construct_Signature)) then + return; + end if; - -- Assume that there is no complementary vertex that needs to be - -- examined. + Vertex := Sequence_Next_Vertex; - Complement := No_Library_Graph_Vertex; - Spec_Vertex := No_Library_Graph_Vertex; + -- Add the vertex to the underlying graph - if Is_Body_Of_Spec_With_Elaborate_Body (G, Vertex) then - Complement := Proper_Spec (G, Vertex); - Spec_Vertex := Complement; + DG.Add_Vertex (G.Graph, Vertex); - elsif Is_Spec_With_Elaborate_Body (G, Vertex) then - Complement := Proper_Body (G, Vertex); - Spec_Vertex := Vertex; - end if; + -- Build and save the attributes of the vertex - -- The vertex is part of an Elaborate_Body pair. Take into account - -- the strong and weak predecessors of the complementary vertex. + Set_IGV_Attributes + (G => G, + Vertex => Vertex, + Val => (Body_Vertex => Body_Vertex, + Construct => IC_Id, + Spec_Vertex => Spec_Vertex)); - if Present (Complement) then - Total_Strong_Preds := - Pending_Strong_Predecessors (G, Complement) + Total_Strong_Preds; - Total_Weak_Preds := - Pending_Weak_Predecessors (G, Complement) + Total_Weak_Preds; + -- Associate the construct with its corresponding vertex - -- The body of an Elaborate_Body pair is the successor of a strong - -- edge where the predecessor is the spec. This edge must not be - -- considered for elaboration purposes because the pair is treated - -- as one vertex. Account for the edge only when the spec has not - -- been elaborated yet. + Set_Corresponding_Vertex (G, Construct_Signature, Vertex); - if not In_Elaboration_Order (G, Spec_Vertex) then - Total_Strong_Preds := Total_Strong_Preds - 1; - end if; - end if; + -- Save the vertex for later processing when it denotes a spec or + -- body elaboration procedure. - Strong_Preds := Total_Strong_Preds; - Weak_Preds := Total_Weak_Preds; - end Pending_Predecessors_For_Elaboration; + if Is_Elaboration_Root (G, Vertex) then + Save_Elaboration_Root (G, Vertex); + end if; + end Add_Vertex; - --------------------------------- - -- Pending_Strong_Predecessors -- - --------------------------------- + ----------------- + -- Body_Vertex -- + ----------------- - function Pending_Strong_Predecessors - (G : Library_Graph; - Comp : Component_Id) return Natural + function Body_Vertex + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id is begin pragma Assert (Present (G)); - pragma Assert (Present (Comp)); + pragma Assert (Present (Vertex)); - return Get_Component_Attributes (G, Comp).Pending_Strong_Predecessors; - end Pending_Strong_Predecessors; + return Get_IGV_Attributes (G, Vertex).Body_Vertex; + end Body_Vertex; - --------------------------------- - -- Pending_Strong_Predecessors -- - --------------------------------- + ------------ + -- Column -- + ------------ - function Pending_Strong_Predecessors - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Natural + function Column + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Nat is begin pragma Assert (Present (G)); pragma Assert (Present (Vertex)); - return Get_LGV_Attributes (G, Vertex).Pending_Strong_Predecessors; - end Pending_Strong_Predecessors; + return Column (Signature (Construct (G, Vertex))); + end Column; - ------------------------------- - -- Pending_Weak_Predecessors -- - ------------------------------- + --------------- + -- Construct -- + --------------- - function Pending_Weak_Predecessors - (G : Library_Graph; - Comp : Component_Id) return Natural + function Construct + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Invocation_Construct_Id is begin pragma Assert (Present (G)); - pragma Assert (Present (Comp)); + pragma Assert (Present (Vertex)); - return Get_Component_Attributes (G, Comp).Pending_Weak_Predecessors; - end Pending_Weak_Predecessors; + return Get_IGV_Attributes (G, Vertex).Construct; + end Construct; - ------------------------------- - -- Pending_Weak_Predecessors -- - ------------------------------- + -------------------------- + -- Corresponding_Vertex -- + -------------------------- - function Pending_Weak_Predecessors - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Natural + function Corresponding_Vertex + (G : Invocation_Graph; + IS_Id : Invocation_Signature_Id) return Invocation_Graph_Vertex_Id is begin pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); + pragma Assert (Present (IS_Id)); - return Get_LGV_Attributes (G, Vertex).Pending_Weak_Predecessors; - end Pending_Weak_Predecessors; + return Signature_Tables.Get (G.Signature_To_Vertex, IS_Id); + end Corresponding_Vertex; - ----------------- - -- Predecessor -- - ----------------- + ------------ + -- Create -- + ------------ - function Predecessor - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id - is + function Create + (Initial_Vertices : Positive; + Initial_Edges : Positive; + Lib_Graph : Library_Graphs.Library_Graph) + return Invocation_Graph + is + G : constant Invocation_Graph := new Invocation_Graph_Attributes' + (Counts => <>, + Edge_Attributes => IGE_Tables.Create (Initial_Edges), + Graph => + DG.Create + (Initial_Vertices => Initial_Vertices, + Initial_Edges => Initial_Edges), + Relations => Relation_Sets.Create (Initial_Edges), + Roots => IGV_Sets.Create (Initial_Vertices), + Signature_To_Vertex => Signature_Tables.Create (Initial_Vertices), + Vertex_Attributes => IGV_Tables.Create (Initial_Vertices), + Lib_Graph => Lib_Graph); begin - pragma Assert (Present (G)); - pragma Assert (Present (Edge)); - - return DG.Source_Vertex (G.Graph, Edge); - end Predecessor; + return G; + end Create; ------------- - -- Present -- + -- Destroy -- ------------- - function Present (G : Library_Graph) return Boolean is + procedure Destroy (G : in out Invocation_Graph) is begin - return G /= Nil; - end Present; + pragma Assert (Present (G)); - ----------------- - -- Proper_Body -- - ----------------- + IGE_Tables.Destroy (G.Edge_Attributes); + DG.Destroy (G.Graph); + Relation_Sets.Destroy (G.Relations); + IGV_Sets.Destroy (G.Roots); + Signature_Tables.Destroy (G.Signature_To_Vertex); + IGV_Tables.Destroy (G.Vertex_Attributes); - function Proper_Body - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id - is - begin - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); + Free (G); + end Destroy; - -- When the vertex denotes a spec with a completing body, return the - -- body. + ----------------------------------- + -- Destroy_Invocation_Graph_Edge -- + ----------------------------------- - if Is_Spec_With_Body (G, Vertex) then - return Corresponding_Item (G, Vertex); + procedure Destroy_Invocation_Graph_Edge + (Edge : in out Invocation_Graph_Edge_Id) + is + pragma Unreferenced (Edge); + begin + null; + end Destroy_Invocation_Graph_Edge; - -- Otherwise the vertex must be a body + ---------------------------------------------- + -- Destroy_Invocation_Graph_Edge_Attributes -- + ---------------------------------------------- - else - pragma Assert (Is_Body (G, Vertex)); - return Vertex; - end if; - end Proper_Body; + procedure Destroy_Invocation_Graph_Edge_Attributes + (Attrs : in out Invocation_Graph_Edge_Attributes) + is + pragma Unreferenced (Attrs); + begin + null; + end Destroy_Invocation_Graph_Edge_Attributes; - ----------------- - -- Proper_Spec -- - ----------------- + ------------------------------------- + -- Destroy_Invocation_Graph_Vertex -- + ------------------------------------- - function Proper_Spec - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id + procedure Destroy_Invocation_Graph_Vertex + (Vertex : in out Invocation_Graph_Vertex_Id) is + pragma Unreferenced (Vertex); begin - pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); + null; + end Destroy_Invocation_Graph_Vertex; - -- When the vertex denotes a body that completes a spec, return the - -- spec. + ------------------------------------------------ + -- Destroy_Invocation_Graph_Vertex_Attributes -- + ------------------------------------------------ - if Is_Body_With_Spec (G, Vertex) then - return Corresponding_Item (G, Vertex); + procedure Destroy_Invocation_Graph_Vertex_Attributes + (Attrs : in out Invocation_Graph_Vertex_Attributes) + is + pragma Unreferenced (Attrs); + begin + null; + end Destroy_Invocation_Graph_Vertex_Attributes; - -- Otherwise the vertex must denote a spec + ----------- + -- Extra -- + ----------- - else - pragma Assert (Is_Spec (G, Vertex)); - return Vertex; - end if; - end Proper_Spec; + function Extra + (G : Invocation_Graph; + Edge : Invocation_Graph_Edge_Id) return Name_Id + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); - ------------------ - -- Record_Cycle -- - ------------------ + return Extra (Relation (G, Edge)); + end Extra; - procedure Record_Cycle - (G : Library_Graph; - Most_Significant_Edge : Library_Graph_Edge_Id; - Invocation_Edge_Count : Natural; - Cycle_Path : LGE_Lists.Doubly_Linked_List; - Indent : Indentation_Level) - is - Cycle : Library_Graph_Cycle_Id; - Path : LGE_Lists.Doubly_Linked_List; + ------------------------ + -- Get_IGE_Attributes -- + ------------------------ + function Get_IGE_Attributes + (G : Invocation_Graph; + Edge : Invocation_Graph_Edge_Id) + return Invocation_Graph_Edge_Attributes + is begin pragma Assert (Present (G)); - pragma Assert (Present (Most_Significant_Edge)); - pragma Assert (LGE_Lists.Present (Cycle_Path)); + pragma Assert (Present (Edge)); - -- Replicate the path of the cycle in order to avoid sharing lists + return IGE_Tables.Get (G.Edge_Attributes, Edge); + end Get_IGE_Attributes; - Path := Copy_Cycle_Path (Cycle_Path); + ------------------------ + -- Get_IGV_Attributes -- + ------------------------ - -- Normalize the path of the cycle such that its most significant - -- edge is the first in the list of edges. + function Get_IGV_Attributes + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) + return Invocation_Graph_Vertex_Attributes + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); - Normalize_Cycle_Path - (Cycle_Path => Path, - Most_Significant_Edge => Most_Significant_Edge); + return IGV_Tables.Get (G.Vertex_Attributes, Vertex); + end Get_IGV_Attributes; - -- Save the cycle for diagnostic purposes. Its kind is determined by - -- its most significant edge. + -------------- + -- Has_Next -- + -------------- - Cycle := Sequence_Next_Cycle; + function Has_Next (Iter : All_Edge_Iterator) return Boolean is + begin + return DG.Has_Next (DG.All_Edge_Iterator (Iter)); + end Has_Next; - Set_LGC_Attributes - (G => G, - Cycle => Cycle, - Val => - (Invocation_Edge_Count => Invocation_Edge_Count, - Kind => - Cycle_Kind_Of - (G => G, - Edge => Most_Significant_Edge), - Path => Path)); + -------------- + -- Has_Next -- + -------------- - Trace_Cycle (G, Cycle, Indent); + function Has_Next (Iter : All_Vertex_Iterator) return Boolean is + begin + return DG.Has_Next (DG.All_Vertex_Iterator (Iter)); + end Has_Next; - -- Order the cycle based on its precedence relative to previously - -- discovered cycles. + -------------- + -- Has_Next -- + -------------- - Order_Cycle (G, Cycle); - end Record_Cycle; + function Has_Next (Iter : Edges_To_Targets_Iterator) return Boolean is + begin + return DG.Has_Next (DG.Outgoing_Edge_Iterator (Iter)); + end Has_Next; - ----------------------------------------- - -- Same_Library_Graph_Cycle_Attributes -- - ----------------------------------------- + -------------- + -- Has_Next -- + -------------- - function Same_Library_Graph_Cycle_Attributes - (Left : Library_Graph_Cycle_Attributes; - Right : Library_Graph_Cycle_Attributes) return Boolean - is + function Has_Next (Iter : Elaboration_Root_Iterator) return Boolean is begin - -- Two cycles are the same when - -- - -- * They are of the same kind - -- * They have the same number of invocation edges in their paths - -- * Their paths are the same length - -- * The edges comprising their paths are the same - - return - Left.Invocation_Edge_Count = Right.Invocation_Edge_Count - and then Left.Kind = Right.Kind - and then LGE_Lists.Equal (Left.Path, Right.Path); - end Same_Library_Graph_Cycle_Attributes; + return IGV_Sets.Has_Next (IGV_Sets.Iterator (Iter)); + end Has_Next; - ------------------------ - -- Set_Activates_Task -- - ------------------------ + ------------------------------- + -- Hash_Invocation_Signature -- + ------------------------------- - procedure Set_Activates_Task - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) + function Hash_Invocation_Signature + (IS_Id : Invocation_Signature_Id) return Bucket_Range_Type is - Attributes : Library_Graph_Edge_Attributes := - Get_LGE_Attributes (G, Edge); begin - Attributes.Activates_Task := True; - Set_LGE_Attributes (G, Edge, Attributes); - end Set_Activates_Task; + pragma Assert (Present (IS_Id)); - ------------------------------ - -- Set_Component_Attributes -- - ------------------------------ + return Bucket_Range_Type (IS_Id); + end Hash_Invocation_Signature; - procedure Set_Component_Attributes - (G : Library_Graph; - Comp : Component_Id; - Val : Component_Attributes) + --------------------------------- + -- Hash_Source_Target_Relation -- + --------------------------------- + + function Hash_Source_Target_Relation + (Rel : Source_Target_Relation) return Bucket_Range_Type is begin - pragma Assert (Present (G)); - pragma Assert (Present (Comp)); + pragma Assert (Present (Rel.Source)); + pragma Assert (Present (Rel.Target)); - Component_Tables.Put (G.Component_Attributes, Comp, Val); - end Set_Component_Attributes; + return + Hash_Two_Keys + (Bucket_Range_Type (Rel.Source), + Bucket_Range_Type (Rel.Target)); + end Hash_Source_Target_Relation; - ---------------------------- - -- Set_Corresponding_Item -- - ---------------------------- + ------------------------------------------- + -- Increment_Invocation_Graph_Edge_Count -- + ------------------------------------------- - procedure Set_Corresponding_Item - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id; - Val : Library_Graph_Vertex_Id) + procedure Increment_Invocation_Graph_Edge_Count + (G : Invocation_Graph; + Kind : Invocation_Kind) is - Attrs : Library_Graph_Vertex_Attributes; - - begin pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); - Attrs := Get_LGV_Attributes (G, Vertex); - Attrs.Corresponding_Item := Val; - Set_LGV_Attributes (G, Vertex, Attrs); - end Set_Corresponding_Item; + Count : Natural renames G.Counts (Kind); - ------------------------------ - -- Set_Corresponding_Vertex -- - ------------------------------ + begin + Count := Count + 1; + end Increment_Invocation_Graph_Edge_Count; - procedure Set_Corresponding_Vertex - (G : Library_Graph; - U_Id : Unit_Id; - Val : Library_Graph_Vertex_Id) + --------------------------------- + -- Invocation_Graph_Edge_Count -- + --------------------------------- + + function Invocation_Graph_Edge_Count + (G : Invocation_Graph; + Kind : Invocation_Kind) return Natural is begin pragma Assert (Present (G)); - pragma Assert (Present (U_Id)); - Unit_Tables.Put (G.Unit_To_Vertex, U_Id, Val); - end Set_Corresponding_Vertex; + return G.Counts (Kind); + end Invocation_Graph_Edge_Count; - ------------------------------ - -- Set_In_Elaboration_Order -- - ------------------------------ + ------------------------- + -- Is_Elaboration_Root -- + ------------------------- - procedure Set_In_Elaboration_Order - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id; - Val : Boolean := True) + function Is_Elaboration_Root + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Boolean is - Attrs : Library_Graph_Vertex_Attributes; - - begin pragma Assert (Present (G)); pragma Assert (Present (Vertex)); - Attrs := Get_LGV_Attributes (G, Vertex); - Attrs.In_Elaboration_Order := Val; - Set_LGV_Attributes (G, Vertex, Attrs); - end Set_In_Elaboration_Order; + Vertex_Kind : constant Invocation_Construct_Kind := + Kind (Construct (G, Vertex)); - -------------------------- - -- Set_Is_Recorded_Edge -- - -------------------------- + begin + return + Vertex_Kind = Elaborate_Body_Procedure + or else + Vertex_Kind = Elaborate_Spec_Procedure; + end Is_Elaboration_Root; - procedure Set_Is_Recorded_Edge - (G : Library_Graph; - Rel : Predecessor_Successor_Relation) + ---------------------------------------- + -- Is_Existing_Source_Target_Relation -- + ---------------------------------------- + + function Is_Existing_Source_Target_Relation + (G : Invocation_Graph; + Rel : Source_Target_Relation) return Boolean is begin pragma Assert (Present (G)); - pragma Assert (Present (Rel.Predecessor)); - pragma Assert (Present (Rel.Successor)); - - RE_Sets.Insert (G.Recorded_Edges, Rel); - end Set_Is_Recorded_Edge; - ------------------------ - -- Set_LGC_Attributes -- - ------------------------ + return Relation_Sets.Contains (G.Relations, Rel); + end Is_Existing_Source_Target_Relation; - procedure Set_LGC_Attributes - (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id; - Val : Library_Graph_Cycle_Attributes) + ----------------------- + -- Iterate_All_Edges -- + ----------------------- + + function Iterate_All_Edges + (G : Invocation_Graph) return All_Edge_Iterator is begin pragma Assert (Present (G)); - pragma Assert (Present (Cycle)); - LGC_Tables.Put (G.Cycle_Attributes, Cycle, Val); - end Set_LGC_Attributes; + return All_Edge_Iterator (DG.Iterate_All_Edges (G.Graph)); + end Iterate_All_Edges; - ------------------------ - -- Set_LGE_Attributes -- - ------------------------ + -------------------------- + -- Iterate_All_Vertices -- + -------------------------- - procedure Set_LGE_Attributes - (G : Library_Graph; - Edge : Library_Graph_Edge_Id; - Val : Library_Graph_Edge_Attributes) + function Iterate_All_Vertices + (G : Invocation_Graph) return All_Vertex_Iterator is begin pragma Assert (Present (G)); - pragma Assert (Present (Edge)); - LGE_Tables.Put (G.Edge_Attributes, Edge, Val); - end Set_LGE_Attributes; + return All_Vertex_Iterator (DG.Iterate_All_Vertices (G.Graph)); + end Iterate_All_Vertices; - ------------------------ - -- Set_LGV_Attributes -- - ------------------------ + ------------------------------ + -- Iterate_Edges_To_Targets -- + ------------------------------ - procedure Set_LGV_Attributes - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id; - Val : Library_Graph_Vertex_Attributes) + function Iterate_Edges_To_Targets + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Edges_To_Targets_Iterator is begin pragma Assert (Present (G)); pragma Assert (Present (Vertex)); - LGV_Tables.Put (G.Vertex_Attributes, Vertex, Val); - end Set_LGV_Attributes; + return + Edges_To_Targets_Iterator + (DG.Iterate_Outgoing_Edges (G.Graph, Vertex)); + end Iterate_Edges_To_Targets; - --------------- - -- Successor -- - --------------- + ------------------------------- + -- Iterate_Elaboration_Roots -- + ------------------------------- - function Successor - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id + function Iterate_Elaboration_Roots + (G : Invocation_Graph) return Elaboration_Root_Iterator is begin pragma Assert (Present (G)); - pragma Assert (Present (Edge)); - return DG.Destination_Vertex (G.Graph, Edge); - end Successor; + return Elaboration_Root_Iterator (IGV_Sets.Iterate (G.Roots)); + end Iterate_Elaboration_Roots; - --------------------- - -- Trace_Component -- - --------------------- + ---------- + -- Kind -- + ---------- - procedure Trace_Component - (G : Library_Graph; - Comp : Component_Id; - Indent : Indentation_Level) + function Kind + (G : Invocation_Graph; + Edge : Invocation_Graph_Edge_Id) return Invocation_Kind is begin pragma Assert (Present (G)); - pragma Assert (Present (Comp)); - - -- Nothing to do when switch -d_t (output cycle-detection trace - -- information) is not in effect. - - if not Debug_Flag_Underscore_T then - return; - end if; + pragma Assert (Present (Edge)); - Write_Eol; - Indent_By (Indent); - Write_Str ("component (Comp_"); - Write_Int (Int (Comp)); - Write_Str (")"); - Write_Eol; - end Trace_Component; + return Kind (Relation (G, Edge)); + end Kind; - ----------------- - -- Trace_Cycle -- - ----------------- + ------------------- + -- Get_Lib_Graph -- + ------------------- - procedure Trace_Cycle - (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id; - Indent : Indentation_Level) + function Get_Lib_Graph + (G : Invocation_Graph) return Library_Graphs.Library_Graph is - Attr_Indent : constant Indentation_Level := - Indent + Nested_Indentation; - Edge_Indent : constant Indentation_Level := - Attr_Indent + Nested_Indentation; + pragma Assert (Present (G)); + begin + return G.Lib_Graph; + end Get_Lib_Graph; - Edge : Library_Graph_Edge_Id; - Iter : Edges_Of_Cycle_Iterator; + ---------- + -- Line -- + ---------- + function Line + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Nat + is begin pragma Assert (Present (G)); - pragma Assert (Present (Cycle)); - - -- Nothing to do when switch -d_t (output cycle-detection trace - -- information) is not in effect. - - if not Debug_Flag_Underscore_T then - return; - end if; + pragma Assert (Present (Vertex)); - Indent_By (Indent); - Write_Str ("cycle (LGC_Id_"); - Write_Int (Int (Cycle)); - Write_Str (")"); - Write_Eol; + return Line (Signature (Construct (G, Vertex))); + end Line; - Indent_By (Attr_Indent); - Write_Str ("kind = "); - Write_Str (Kind (G, Cycle)'Img); - Write_Eol; + ---------- + -- Name -- + ---------- - Indent_By (Attr_Indent); - Write_Str ("invocation edges = "); - Write_Int (Int (Invocation_Edge_Count (G, Cycle))); - Write_Eol; + function Name + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Name_Id + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); - Indent_By (Attr_Indent); - Write_Str ("length: "); - Write_Int (Int (Length (G, Cycle))); - Write_Eol; + return Name (Signature (Construct (G, Vertex))); + end Name; - Iter := Iterate_Edges_Of_Cycle (G, Cycle); - while Has_Next (Iter) loop - Next (Iter, Edge); + ---------- + -- Next -- + ---------- - Indent_By (Edge_Indent); - Write_Str ("library graph edge (LGE_Id_"); - Write_Int (Int (Edge)); - Write_Str (")"); - Write_Eol; - end loop; - end Trace_Cycle; + procedure Next + (Iter : in out All_Edge_Iterator; + Edge : out Invocation_Graph_Edge_Id) + is + begin + DG.Next (DG.All_Edge_Iterator (Iter), Edge); + end Next; - ---------------- - -- Trace_Edge -- - ---------------- + ---------- + -- Next -- + ---------- - procedure Trace_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id; - Indent : Indentation_Level) + procedure Next + (Iter : in out All_Vertex_Iterator; + Vertex : out Invocation_Graph_Vertex_Id) is - pragma Assert (Present (G)); - pragma Assert (Present (Edge)); - - Attr_Indent : constant Indentation_Level := - Indent + Nested_Indentation; + begin + DG.Next (DG.All_Vertex_Iterator (Iter), Vertex); + end Next; - Pred : constant Library_Graph_Vertex_Id := Predecessor (G, Edge); - Succ : constant Library_Graph_Vertex_Id := Successor (G, Edge); + ---------- + -- Next -- + ---------- + procedure Next + (Iter : in out Edges_To_Targets_Iterator; + Edge : out Invocation_Graph_Edge_Id) + is begin - -- Nothing to do when switch -d_t (output cycle-detection trace - -- information) is not in effect. + DG.Next (DG.Outgoing_Edge_Iterator (Iter), Edge); + end Next; - if not Debug_Flag_Underscore_T then - return; - end if; + ---------- + -- Next -- + ---------- - Indent_By (Indent); - Write_Str ("library graph edge (LGE_Id_"); - Write_Int (Int (Edge)); - Write_Str (")"); - Write_Eol; + procedure Next + (Iter : in out Elaboration_Root_Iterator; + Root : out Invocation_Graph_Vertex_Id) + is + begin + IGV_Sets.Next (IGV_Sets.Iterator (Iter), Root); + end Next; - Indent_By (Attr_Indent); - Write_Str ("kind = "); - Write_Str (Kind (G, Edge)'Img); - Write_Eol; + --------------------- + -- Number_Of_Edges -- + --------------------- - Indent_By (Attr_Indent); - Write_Str ("Predecessor (LGV_Id_"); - Write_Int (Int (Pred)); - Write_Str (") name = "); - Write_Name (Name (G, Pred)); - Write_Eol; + function Number_Of_Edges (G : Invocation_Graph) return Natural is + begin + pragma Assert (Present (G)); - Indent_By (Attr_Indent); - Write_Str ("Successor (LGV_Id_"); - Write_Int (Int (Succ)); - Write_Str (") name = "); - Write_Name (Name (G, Succ)); - Write_Eol; - end Trace_Edge; + return DG.Number_Of_Edges (G.Graph); + end Number_Of_Edges; - ------------------ - -- Trace_Vertex -- - ------------------ + -------------------------------- + -- Number_Of_Edges_To_Targets -- + -------------------------------- - procedure Trace_Vertex - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id; - Indent : Indentation_Level) + function Number_Of_Edges_To_Targets + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Natural is - Attr_Indent : constant Indentation_Level := - Indent + Nested_Indentation; - begin pragma Assert (Present (G)); pragma Assert (Present (Vertex)); - -- Nothing to do when switch -d_t (output cycle-detection trace - -- information) is not in effect. + return DG.Number_Of_Outgoing_Edges (G.Graph, Vertex); + end Number_Of_Edges_To_Targets; - if not Debug_Flag_Underscore_T then - return; - end if; + --------------------------------- + -- Number_Of_Elaboration_Roots -- + --------------------------------- - Indent_By (Indent); - Write_Str ("library graph vertex (LGV_Id_"); - Write_Int (Int (Vertex)); - Write_Str (")"); - Write_Eol; + function Number_Of_Elaboration_Roots + (G : Invocation_Graph) return Natural + is + begin + pragma Assert (Present (G)); - Indent_By (Attr_Indent); - Write_Str ("Unit (U_Id_"); - Write_Int (Int (Unit (G, Vertex))); - Write_Str (") name = "); - Write_Name (Name (G, Vertex)); - Write_Eol; - end Trace_Vertex; + return IGV_Sets.Size (G.Roots); + end Number_Of_Elaboration_Roots; - ---------- - -- Unit -- - ---------- + ------------------------ + -- Number_Of_Vertices -- + ------------------------ - function Unit - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Unit_Id - is + function Number_Of_Vertices (G : Invocation_Graph) return Natural is begin pragma Assert (Present (G)); - pragma Assert (Present (Vertex)); - return Get_LGV_Attributes (G, Vertex).Unit; - end Unit; + return DG.Number_Of_Vertices (G.Graph); + end Number_Of_Vertices; ------------- - -- Unvisit -- + -- Present -- ------------- - procedure Unvisit - (Vertex : Library_Graph_Vertex_Id; - Visited_Set : LGV_Sets.Membership_Set; - Visited_Stack : LGV_Lists.Doubly_Linked_List) - is - Current_Vertex : Library_Graph_Vertex_Id; - + function Present (G : Invocation_Graph) return Boolean is begin - pragma Assert (Present (Vertex)); - pragma Assert (LGV_Sets.Present (Visited_Set)); - pragma Assert (LGV_Lists.Present (Visited_Stack)); + return G /= Nil; + end Present; - while not LGV_Lists.Is_Empty (Visited_Stack) loop - Current_Vertex := LGV_Lists.First (Visited_Stack); + -------------- + -- Relation -- + -------------- - LGV_Lists.Delete_First (Visited_Stack); - LGV_Sets.Delete (Visited_Set, Current_Vertex); + function Relation + (G : Invocation_Graph; + Edge : Invocation_Graph_Edge_Id) return Invocation_Relation_Id + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); - exit when Current_Vertex = Vertex; - end loop; - end Unvisit; + return Get_IGE_Attributes (G, Edge).Relation; + end Relation; - --------------------------------- - -- Update_Pending_Predecessors -- - --------------------------------- + --------------------------- + -- Save_Elaboration_Root -- + --------------------------- - procedure Update_Pending_Predecessors - (Strong_Predecessors : in out Natural; - Weak_Predecessors : in out Natural; - Update_Weak : Boolean; - Value : Integer) + procedure Save_Elaboration_Root + (G : Invocation_Graph; + Root : Invocation_Graph_Vertex_Id) is begin - if Update_Weak then - Weak_Predecessors := Weak_Predecessors + Value; - else - Strong_Predecessors := Strong_Predecessors + Value; - end if; - end Update_Pending_Predecessors; + pragma Assert (Present (G)); + pragma Assert (Present (Root)); - ----------------------------------------------- - -- Update_Pending_Predecessors_Of_Components -- - ----------------------------------------------- + IGV_Sets.Insert (G.Roots, Root); + end Save_Elaboration_Root; - procedure Update_Pending_Predecessors_Of_Components - (G : Library_Graph) - is - Edge : Library_Graph_Edge_Id; - Iter : All_Edge_Iterator; + ------------------------------ + -- Set_Corresponding_Vertex -- + ------------------------------ + procedure Set_Corresponding_Vertex + (G : Invocation_Graph; + IS_Id : Invocation_Signature_Id; + Vertex : Invocation_Graph_Vertex_Id) + is begin pragma Assert (Present (G)); + pragma Assert (Present (IS_Id)); + pragma Assert (Present (Vertex)); - Iter := Iterate_All_Edges (G); - while Has_Next (Iter) loop - Next (Iter, Edge); + Signature_Tables.Put (G.Signature_To_Vertex, IS_Id, Vertex); + end Set_Corresponding_Vertex; - Update_Pending_Predecessors_Of_Components (G, Edge); - end loop; - end Update_Pending_Predecessors_Of_Components; + -------------------------------------------- + -- Set_Is_Existing_Source_Target_Relation -- + -------------------------------------------- - ----------------------------------------------- - -- Update_Pending_Predecessors_Of_Components -- - ----------------------------------------------- + procedure Set_Is_Existing_Source_Target_Relation + (G : Invocation_Graph; + Rel : Source_Target_Relation; + Val : Boolean := True) + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Rel.Source)); + pragma Assert (Present (Rel.Target)); - procedure Update_Pending_Predecessors_Of_Components - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) + if Val then + Relation_Sets.Insert (G.Relations, Rel); + else + Relation_Sets.Delete (G.Relations, Rel); + end if; + end Set_Is_Existing_Source_Target_Relation; + + ------------------------ + -- Set_IGE_Attributes -- + ------------------------ + + procedure Set_IGE_Attributes + (G : Invocation_Graph; + Edge : Invocation_Graph_Edge_Id; + Val : Invocation_Graph_Edge_Attributes) is + begin pragma Assert (Present (G)); pragma Assert (Present (Edge)); - Pred_Comp : constant Component_Id := - Component (G, Predecessor (G, Edge)); - Succ_Comp : constant Component_Id := - Component (G, Successor (G, Edge)); + IGE_Tables.Put (G.Edge_Attributes, Edge, Val); + end Set_IGE_Attributes; - pragma Assert (Present (Pred_Comp)); - pragma Assert (Present (Succ_Comp)); + ------------------------ + -- Set_IGV_Attributes -- + ------------------------ + procedure Set_IGV_Attributes + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id; + Val : Invocation_Graph_Vertex_Attributes) + is begin - -- The edge links a successor and a predecessor coming from two - -- different SCCs. This indicates that the SCC of the successor - -- must wait on another predecessor until it can be elaborated. + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); - if Pred_Comp /= Succ_Comp then - Increment_Pending_Predecessors - (G => G, - Comp => Succ_Comp, - Edge => Edge); - end if; - end Update_Pending_Predecessors_Of_Components; + IGV_Tables.Put (G.Vertex_Attributes, Vertex, Val); + end Set_IGV_Attributes; - ----------------------- - -- Vertex_Precedence -- - ----------------------- + ----------------- + -- Spec_Vertex -- + ----------------- - function Vertex_Precedence - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id; - Compared_To : Library_Graph_Vertex_Id) return Precedence_Kind + function Spec_Vertex + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id is begin pragma Assert (Present (G)); pragma Assert (Present (Vertex)); - pragma Assert (Present (Compared_To)); - -- Use lexicographical order to determine precedence and ensure - -- deterministic behavior. - - if Uname_Less (Name (G, Vertex), Name (G, Compared_To)) then - return Higher_Precedence; - else - return Lower_Precedence; - end if; - end Vertex_Precedence; + return Get_IGV_Attributes (G, Vertex).Spec_Vertex; + end Spec_Vertex; - ----------- - -- Visit -- - ----------- + ------------ + -- Target -- + ------------ - procedure Visit - (Vertex : Library_Graph_Vertex_Id; - Visited_Set : LGV_Sets.Membership_Set; - Visited_Stack : LGV_Lists.Doubly_Linked_List) + function Target + (G : Invocation_Graph; + Edge : Invocation_Graph_Edge_Id) return Invocation_Graph_Vertex_Id is begin - pragma Assert (Present (Vertex)); - pragma Assert (LGV_Sets.Present (Visited_Set)); - pragma Assert (LGV_Lists.Present (Visited_Stack)); + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); - LGV_Sets.Insert (Visited_Set, Vertex); - LGV_Lists.Prepend (Visited_Stack, Vertex); - end Visit; - end Library_Graphs; + return DG.Destination_Vertex (G.Graph, Edge); + end Target; + end Invocation_Graphs; ------------- -- Present -- diff --git a/gcc/ada/bindo-graphs.ads b/gcc/ada/bindo-graphs.ads index 73846bd5ffb..e2843698b2d 100644 --- a/gcc/ada/bindo-graphs.ads +++ b/gcc/ada/bindo-graphs.ads @@ -198,1103 +198,1252 @@ package Bindo.Graphs is "=" => "=", Hash => Hash_Library_Graph_Vertex); - ----------------------- - -- Invocation_Graphs -- - ----------------------- + -------------------- + -- Library_Graphs -- + -------------------- - package Invocation_Graphs is + package Library_Graphs is + + -- The following type represents the various kinds of library graph + -- cycles. The ordering of kinds is significant, where a literal with + -- lower ordinal has a higher precedence than one with higher ordinal. + + type Library_Graph_Cycle_Kind is + (Elaborate_Body_Cycle, + -- A cycle that involves at least one spec-body pair, where the + -- spec is subject to pragma Elaborate_Body. This is the highest + -- precedence cycle. + + Elaborate_Cycle, + -- A cycle that involves at least one Elaborate edge + + Elaborate_All_Cycle, + -- A cycle that involves at least one Elaborate_All edge + + Forced_Cycle, + -- A cycle that involves at least one edge which is a byproduct of + -- the forced-elaboration-order file. + + Invocation_Cycle, + -- A cycle that involves at least one invocation edge. This is the + -- lowest precedence cycle. + + No_Cycle_Kind); + + -- The following type represents the various kinds of library edges. The + -- order is important here, and corresponds to the order in which edges + -- are added to the graph. See Add_Edge_Kind_Check for details. If + -- changes are made such that new edge kinds are added or similar, we + -- need to make sure this type matches the code in Add_Edge_Kind_Check, + -- and Add_Edge_Kind_Check matches the order of edge adding. Likewise, + -- if the edge-adding order changes, we need consistency between this + -- enumeration type, the edge-adding order, and Add_Edge_Kind_Check. + + type Library_Graph_Edge_Kind is + (Spec_Before_Body_Edge, + -- Successor denotes a body, Predecessor denotes a spec + + Elaborate_Edge, + -- Successor withs Predecessor, and has pragma Elaborate for it + + Elaborate_All_Edge, + -- Successor withs Predecessor, and has pragma Elaborate_All for it + + With_Edge, + -- Successor withs Predecessor + + Forced_Edge, + -- Successor is forced to with Predecessor by virtue of an existing + -- elaboration order provided in a file. + + Invocation_Edge, + -- An invocation construct in unit Successor invokes a target in unit + -- Predecessor. + + Body_Before_Spec_Edge, + -- Successor denotes spec, Predecessor denotes a body. This is a + -- special edge kind used only during the discovery of components. + -- Note that a body can never be elaborated before its spec. + + No_Edge); ----------- -- Graph -- ----------- - -- The following type denotes an invocation graph handle. Each instance - -- must be created using routine Create. + -- The following type denotes a library graph handle. Each instance must + -- be created using routine Create. - type Invocation_Graph is private; - Nil : constant Invocation_Graph; + type Library_Graph is private; + Nil : constant Library_Graph; + + type LGE_Predicate_Ptr is access function + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean; + + type LGV_Comparator_Ptr is access function + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id; + Compared_To : Library_Graph_Vertex_Id) return Precedence_Kind; + + type LGV_Predicate_Ptr is access function + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean; ---------------------- -- Graph operations -- ---------------------- procedure Add_Edge - (G : Invocation_Graph; - Source : Invocation_Graph_Vertex_Id; - Target : Invocation_Graph_Vertex_Id; - IR_Id : Invocation_Relation_Id); + (G : Library_Graph; + Pred : Library_Graph_Vertex_Id; + Succ : Library_Graph_Vertex_Id; + Kind : Library_Graph_Edge_Kind; + Activates_Task : Boolean); pragma Inline (Add_Edge); - -- Create a new edge in invocation graph G with source vertex Source and - -- destination vertex Target. IR_Id is the invocation relation the edge - -- describes. + -- Create a new edge in library graph G with source vertex Pred and + -- destination vertex Succ. Kind denotes the nature of the edge. Flag + -- Activates_Task should be set when the edge involves task activation. procedure Add_Vertex - (G : Invocation_Graph; - IC_Id : Invocation_Construct_Id; - Body_Vertex : Library_Graph_Vertex_Id; - Spec_Vertex : Library_Graph_Vertex_Id); + (G : Library_Graph; + U_Id : Unit_Id); pragma Inline (Add_Vertex); - -- Create a new vertex in invocation graph G. IC_Id is the invocation - -- construct the vertex describes. Body_Vertex denotes the library graph - -- vertex where the invocation construct's body is declared. Spec_Vertex - -- is the library graph vertex where the invocation construct's spec is - -- declared. + -- Create a new vertex in library graph G. U_Id is the unit the vertex + -- describes. function Create (Initial_Vertices : Positive; - Initial_Edges : Positive) return Invocation_Graph; + Initial_Edges : Positive) return Library_Graph; pragma Inline (Create); -- Create a new empty graph with vertex capacity Initial_Vertices and -- edge capacity Initial_Edges. - procedure Destroy (G : in out Invocation_Graph); + procedure Destroy (G : in out Library_Graph); pragma Inline (Destroy); - -- Destroy the contents of invocation graph G, rendering it unusable + -- Destroy the contents of library graph G, rendering it unusable - function Present (G : Invocation_Graph) return Boolean; + procedure Find_Components (G : Library_Graph); + pragma Inline (Find_Components); + -- Find all components in library graph G + + procedure Find_Cycles (G : Library_Graph); + pragma Inline (Find_Cycles); + -- Find all cycles in library graph G + + function Highest_Precedence_Cycle + (G : Library_Graph) return Library_Graph_Cycle_Id; + pragma Inline (Highest_Precedence_Cycle); + -- Obtain the cycle with highest precedence among all other cycles of + -- library graph G. + + function Present (G : Library_Graph) return Boolean; pragma Inline (Present); - -- Determine whether invocation graph G exists + -- Determine whether library graph G exists ----------------------- -- Vertex attributes -- ----------------------- - function Body_Vertex - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id; - pragma Inline (Body_Vertex); - -- Obtain the library graph vertex where the body of the invocation - -- construct represented by vertex Vertex of invocation graph G is - -- declared. - - function Column - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Nat; - pragma Inline (Column); - -- Obtain the column number where the invocation construct vertex Vertex - -- of invocation graph G describes. + function Component + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Component_Id; + pragma Inline (Component); + -- Obtain the component where vertex Vertex of library graph G resides - function Construct - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Invocation_Construct_Id; - pragma Inline (Construct); - -- Obtain the invocation construct vertex Vertex of invocation graph G - -- describes. + function Corresponding_Item + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id; + pragma Inline (Corresponding_Item); + -- Obtain the complementary vertex which represents the corresponding + -- spec or body of vertex Vertex of library graph G. function Corresponding_Vertex - (G : Invocation_Graph; - IS_Id : Invocation_Signature_Id) return Invocation_Graph_Vertex_Id; + (G : Library_Graph; + U_Id : Unit_Id) return Library_Graph_Vertex_Id; pragma Inline (Corresponding_Vertex); - -- Obtain the vertex of invocation graph G that corresponds to signature - -- IS_Id. + -- Obtain the corresponding vertex of library graph G which represents + -- unit U_Id. - function Line - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Nat; - pragma Inline (Line); - -- Obtain the line number where the invocation construct vertex Vertex - -- of invocation graph G describes. + procedure Decrement_Pending_Predecessors + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id; + Edge : Library_Graph_Edge_Id); + pragma Inline (Decrement_Pending_Predecessors); + -- Decrease the number of pending predecessors vertex Vertex which was + -- reached via edge Edge of library graph G must wait until it can be + -- elaborated. + + function File_Name + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return File_Name_Type; + pragma Inline (File_Name); + -- Obtain the name of the file where vertex Vertex of library graph G + -- resides. + + function In_Elaboration_Order + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean; + pragma Inline (In_Elaboration_Order); + -- Determine whether vertex Vertex of library graph G is already in some + -- elaboration order. + + function Invocation_Graph_Encoding + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) + return Invocation_Graph_Encoding_Kind; + pragma Inline (Invocation_Graph_Encoding); + -- Obtain the encoding format used to capture information related to + -- invocation vertices and edges that reside within vertex Vertex of + -- library graph G. function Name - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Name_Id; + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Unit_Name_Type; pragma Inline (Name); - -- Obtain the name of the construct vertex Vertex of invocation graph G - -- describes. + -- Obtain the name of the unit which vertex Vertex of library graph G + -- represents. - function Spec_Vertex - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id; - pragma Inline (Spec_Vertex); - -- Obtain the library graph vertex where the spec of the invocation - -- construct represented by vertex Vertex of invocation graph G is - -- declared. + procedure Pending_Predecessors_For_Elaboration + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id; + Strong_Preds : out Natural; + Weak_Preds : out Natural); + pragma Inline (Pending_Predecessors_For_Elaboration); + -- Obtain the number of pending strong and weak predecessors of vertex + -- Vertex of library graph G, taking into account Elaborate_Body pairs. + -- Strong predecessors are returned in Strong_Preds. Weak predecessors + -- are returned in Weak_Preds. - --------------------- - -- Edge attributes -- - --------------------- + function Pending_Strong_Predecessors + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Natural; + pragma Inline (Pending_Strong_Predecessors); + -- Obtain the number of pending strong predecessors vertex Vertex of + -- library graph G must wait on until it can be elaborated. - function Extra - (G : Invocation_Graph; - Edge : Invocation_Graph_Edge_Id) return Name_Id; - pragma Inline (Extra); - -- Obtain the extra name used in error diagnostics of edge Edge of - -- invocation graph G. - - function Kind - (G : Invocation_Graph; - Edge : Invocation_Graph_Edge_Id) return Invocation_Kind; - pragma Inline (Kind); - -- Obtain the nature of edge Edge of invocation graph G - - function Relation - (G : Invocation_Graph; - Edge : Invocation_Graph_Edge_Id) return Invocation_Relation_Id; - pragma Inline (Relation); - -- Obtain the relation edge Edge of invocation graph G describes + function Pending_Weak_Predecessors + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Natural; + pragma Inline (Pending_Weak_Predecessors); + -- Obtain the number of pending weak predecessors vertex Vertex of + -- library graph G must wait on until it can be elaborated. - function Target - (G : Invocation_Graph; - Edge : Invocation_Graph_Edge_Id) return Invocation_Graph_Vertex_Id; - pragma Inline (Target); - -- Obtain the target vertex edge Edge of invocation graph G designates + procedure Set_Corresponding_Item + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id; + Val : Library_Graph_Vertex_Id); + pragma Inline (Set_Corresponding_Item); + -- Set the complementary vertex which represents the corresponding + -- spec or body of vertex Vertex of library graph G to value Val. - ---------------- - -- Statistics -- - ---------------- + procedure Set_In_Elaboration_Order + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id; + Val : Boolean := True); + pragma Inline (Set_In_Elaboration_Order); + -- Mark vertex Vertex of library graph G as included in some elaboration + -- order depending on value Val. - function Invocation_Graph_Edge_Count - (G : Invocation_Graph; - Kind : Invocation_Kind) return Natural; - pragma Inline (Invocation_Graph_Edge_Count); - -- Obtain the total number of edges of kind Kind in invocation graph G + function Unit + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Unit_Id; + pragma Inline (Unit); + -- Obtain the unit vertex Vertex of library graph G represents - function Number_Of_Edges (G : Invocation_Graph) return Natural; - pragma Inline (Number_Of_Edges); - -- Obtain the total number of edges in invocation graph G + --------------------- + -- Edge attributes -- + --------------------- - function Number_Of_Edges_To_Targets - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Natural; - pragma Inline (Number_Of_Edges_To_Targets); - -- Obtain the total number of edges to targets vertex Vertex of - -- invocation graph G has. + function Activates_Task + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean; + pragma Inline (Activates_Task); + -- Determine whether edge Edge of library graph G activates a task - function Number_Of_Elaboration_Roots - (G : Invocation_Graph) return Natural; - pragma Inline (Number_Of_Elaboration_Roots); - -- Obtain the total number of elaboration roots in invocation graph G + function Kind + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Library_Graph_Edge_Kind; + pragma Inline (Kind); + -- Obtain the nature of edge Edge of library graph G - function Number_Of_Vertices (G : Invocation_Graph) return Natural; - pragma Inline (Number_Of_Vertices); - -- Obtain the total number of vertices in invocation graph G + function Predecessor + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id; + pragma Inline (Predecessor); + -- Obtain the predecessor vertex of edge Edge of library graph G - --------------- - -- Iterators -- - --------------- + function Successor + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id; + pragma Inline (Successor); + -- Obtain the successor vertex of edge Edge of library graph G - -- The following type represents an iterator over all edges of an - -- invocation graph. + -------------------------- + -- Component attributes -- + -------------------------- - type All_Edge_Iterator is private; + procedure Decrement_Pending_Predecessors + (G : Library_Graph; + Comp : Component_Id; + Edge : Library_Graph_Edge_Id); + pragma Inline (Decrement_Pending_Predecessors); + -- Decrease the number of pending predecessors component Comp which was + -- reached via edge Edge of library graph G must wait on until it can be + -- elaborated. - function Has_Next (Iter : All_Edge_Iterator) return Boolean; - pragma Inline (Has_Next); - -- Determine whether iterator Iter has more edges to examine + function Pending_Strong_Predecessors + (G : Library_Graph; + Comp : Component_Id) return Natural; + pragma Inline (Pending_Strong_Predecessors); + -- Obtain the number of pending strong predecessors component Comp of + -- library graph G must wait on until it can be elaborated. - function Iterate_All_Edges - (G : Invocation_Graph) return All_Edge_Iterator; - pragma Inline (Iterate_All_Edges); - -- Obtain an iterator over all edges of invocation graph G + function Pending_Weak_Predecessors + (G : Library_Graph; + Comp : Component_Id) return Natural; + pragma Inline (Pending_Weak_Predecessors); + -- Obtain the number of pending weak predecessors component Comp of + -- library graph G must wait on until it can be elaborated. - procedure Next - (Iter : in out All_Edge_Iterator; - Edge : out Invocation_Graph_Edge_Id); - pragma Inline (Next); - -- Return the current edge referenced by iterator Iter and advance to - -- the next available edge. + ---------------------- + -- Cycle attributes -- + ---------------------- - -- The following type represents an iterator over all vertices of an - -- invocation graph. + function Invocation_Edge_Count + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) return Natural; + pragma Inline (Invocation_Edge_Count); + -- Obtain the number of invocation edges in cycle Cycle of library + -- graph G. - type All_Vertex_Iterator is private; + function Kind + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Kind; + pragma Inline (Kind); + -- Obtain the nature of cycle Cycle of library graph G - function Has_Next (Iter : All_Vertex_Iterator) return Boolean; - pragma Inline (Has_Next); - -- Determine whether iterator Iter has more vertices to examine + function Length + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) return Natural; + pragma Inline (Length); + -- Obtain the length of cycle Cycle of library graph G - function Iterate_All_Vertices - (G : Invocation_Graph) return All_Vertex_Iterator; - pragma Inline (Iterate_All_Vertices); - -- Obtain an iterator over all vertices of invocation graph G + --------------- + -- Semantics -- + --------------- - procedure Next - (Iter : in out All_Vertex_Iterator; - Vertex : out Invocation_Graph_Vertex_Id); - pragma Inline (Next); - -- Return the current vertex referenced by iterator Iter and advance - -- to the next available vertex. + function Complementary_Vertex + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id; + Force_Complement : Boolean) return Library_Graph_Vertex_Id; + pragma Inline (Complementary_Vertex); + -- Obtain the complementary vertex of vertex Vertex of library graph G + -- as follows: + -- + -- * If Vertex is the spec of an Elaborate_Body pair, return the body + -- * If Vertex is the body of an Elaborate_Body pair, return the spec + -- + -- This behavior can be forced by setting flag Force_Complement to True. - -- The following type represents an iterator over all edges that reach - -- targets starting from a particular source vertex. + function Contains_Elaborate_All_Edge + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) return Boolean; + pragma Inline (Contains_Elaborate_All_Edge); + -- Determine whether cycle Cycle of library graph G contains an + -- Elaborate_All edge. - type Edges_To_Targets_Iterator is private; + function Contains_Static_Successor_Edge + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) return Boolean; + pragma Inline (Contains_Static_Successor_Edge); + -- Determine whether cycle Cycle of library graph G contains an edge + -- where the successor was compiled using the static model. - function Has_Next (Iter : Edges_To_Targets_Iterator) return Boolean; - pragma Inline (Has_Next); - -- Determine whether iterator Iter has more edges to examine + function Contains_Task_Activation + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) return Boolean; + pragma Inline (Contains_Task_Activation); + -- Determine whether cycle Cycle of library graph G contains an + -- invocation edge where the path it represents involves a task + -- activation. - function Iterate_Edges_To_Targets - (G : Invocation_Graph; - Vertex : Invocation_Graph_Vertex_Id) return Edges_To_Targets_Iterator; - pragma Inline (Iterate_Edges_To_Targets); - -- Obtain an iterator over all edges to targets with source vertex - -- Vertex of invocation graph G. + function Has_Elaborate_All_Cycle (G : Library_Graph) return Boolean; + pragma Inline (Has_Elaborate_All_Cycle); + -- Determine whether library graph G contains a cycle involving pragma + -- Elaborate_All. - procedure Next - (Iter : in out Edges_To_Targets_Iterator; - Edge : out Invocation_Graph_Edge_Id); - pragma Inline (Next); - -- Return the current edge referenced by iterator Iter and advance to - -- the next available edge. + function Has_No_Elaboration_Code + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean; + pragma Inline (Has_No_Elaboration_Code); + -- Determine whether vertex Vertex of library graph G represents a unit + -- that lacks elaboration code. - -- The following type represents an iterator over all vertices of an - -- invocation graph that denote the elaboration procedure or a spec or - -- a body, referred to as elaboration root. + function In_Same_Component + (G : Library_Graph; + Left : Library_Graph_Vertex_Id; + Right : Library_Graph_Vertex_Id) return Boolean; + pragma Inline (In_Same_Component); + -- Determine whether vertices Left and Right of library graph G reside + -- in the same component. - type Elaboration_Root_Iterator is private; + function Is_Body + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean; + pragma Inline (Is_Body); + -- Determine whether vertex Vertex of library graph G denotes a body - function Has_Next (Iter : Elaboration_Root_Iterator) return Boolean; - pragma Inline (Has_Next); - -- Determine whether iterator Iter has more elaboration roots to examine + function Is_Body_Of_Spec_With_Elaborate_Body + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean; + pragma Inline (Is_Body_Of_Spec_With_Elaborate_Body); + -- Determine whether vertex Vertex of library graph G denotes a body + -- with a corresponding spec, and the spec has pragma Elaborate_Body. - function Iterate_Elaboration_Roots - (G : Invocation_Graph) return Elaboration_Root_Iterator; - pragma Inline (Iterate_Elaboration_Roots); - -- Obtain an iterator over all elaboration roots of invocation graph G - - procedure Next - (Iter : in out Elaboration_Root_Iterator; - Root : out Invocation_Graph_Vertex_Id); - pragma Inline (Next); - -- Return the current elaboration root referenced by iterator Iter and - -- advance to the next available elaboration root. - - private - - -------------- - -- Vertices -- - -------------- - - procedure Destroy_Invocation_Graph_Vertex - (Vertex : in out Invocation_Graph_Vertex_Id); - pragma Inline (Destroy_Invocation_Graph_Vertex); - -- Destroy invocation graph vertex Vertex + function Is_Body_With_Spec + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean; + pragma Inline (Is_Body_With_Spec); + -- Determine whether vertex Vertex of library graph G denotes a body + -- with a corresponding spec. - -- The following type represents the attributes of an invocation graph - -- vertex. + function Is_Dynamically_Elaborated + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean; + pragma Inline (Is_Dynamically_Elaborated); + -- Determine whether vertex Vertex of library graph G was compiled + -- using the dynamic model. - type Invocation_Graph_Vertex_Attributes is record - Body_Vertex : Library_Graph_Vertex_Id := No_Library_Graph_Vertex; - -- Reference to the library graph vertex where the body of this - -- vertex resides. + function Is_Elaborable_Component + (G : Library_Graph; + Comp : Component_Id) return Boolean; + pragma Inline (Is_Elaborable_Component); + -- Determine whether component Comp of library graph G is not waiting on + -- any predecessors, and can thus be elaborated. - Construct : Invocation_Construct_Id := No_Invocation_Construct; - -- Reference to the invocation construct this vertex represents + function Is_Elaborable_Vertex + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean; + pragma Inline (Is_Elaborable_Vertex); + -- Determine whether vertex Vertex of library graph G is not waiting on + -- any predecessors, and can thus be elaborated. - Spec_Vertex : Library_Graph_Vertex_Id := No_Library_Graph_Vertex; - -- Reference to the library graph vertex where the spec of this - -- vertex resides. - end record; + function Is_Elaborate_All_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean; + pragma Inline (Is_Elaborate_All_Edge); + -- Determine whether edge Edge of library graph G is an edge whose + -- predecessor is subject to pragma Elaborate_All. - No_Invocation_Graph_Vertex_Attributes : - constant Invocation_Graph_Vertex_Attributes := - (Body_Vertex => No_Library_Graph_Vertex, - Construct => No_Invocation_Construct, - Spec_Vertex => No_Library_Graph_Vertex); + function Is_Elaborate_Body_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean; + pragma Inline (Is_Elaborate_Body_Edge); + -- Determine whether edge Edge of library graph G has a successor + -- that is either a spec subject to pragma Elaborate_Body, or a body + -- that completes such a spec. - procedure Destroy_Invocation_Graph_Vertex_Attributes - (Attrs : in out Invocation_Graph_Vertex_Attributes); - pragma Inline (Destroy_Invocation_Graph_Vertex_Attributes); - -- Destroy the contents of attributes Attrs + function Is_Elaborate_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean; + pragma Inline (Is_Elaborate_Edge); + -- Determine whether edge Edge of library graph G is an edge whose + -- predecessor is subject to pragma Elaborate. - package IGV_Tables is new Dynamic_Hash_Tables - (Key_Type => Invocation_Graph_Vertex_Id, - Value_Type => Invocation_Graph_Vertex_Attributes, - No_Value => No_Invocation_Graph_Vertex_Attributes, - Expansion_Threshold => 1.5, - Expansion_Factor => 2, - Compression_Threshold => 0.3, - Compression_Factor => 2, - "=" => "=", - Destroy_Value => Destroy_Invocation_Graph_Vertex_Attributes, - Hash => Hash_Invocation_Graph_Vertex); + function Is_Elaborate_Body_Pair + (G : Library_Graph; + Spec_Vertex : Library_Graph_Vertex_Id; + Body_Vertex : Library_Graph_Vertex_Id) return Boolean; + pragma Inline (Is_Elaborate_Body_Pair); + -- Determine whether vertices Spec_Vertex and Body_Vertex of library + -- graph G denote a spec subject to Elaborate_Body and its completing + -- body. - ----------- - -- Edges -- - ----------- + function Is_Forced_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean; + pragma Inline (Is_Forced_Edge); + -- Determine whether edge Edge of library graph G is a byproduct of the + -- forced-elaboration-order file. - procedure Destroy_Invocation_Graph_Edge - (Edge : in out Invocation_Graph_Edge_Id); - pragma Inline (Destroy_Invocation_Graph_Edge); - -- Destroy invocation graph edge Edge + function Is_Internal_Unit + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean; + pragma Inline (Is_Internal_Unit); + -- Determine whether vertex Vertex of library graph G denotes an + -- internal unit. - -- The following type represents the attributes of an invocation graph - -- edge. + function Is_Invocation_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean; + pragma Inline (Is_Invocation_Edge); + -- Determine whether edge Edge of library graph G came from the + -- traversal of the invocation graph. - type Invocation_Graph_Edge_Attributes is record - Relation : Invocation_Relation_Id := No_Invocation_Relation; - -- Reference to the invocation relation this edge represents - end record; + function Is_Predefined_Unit + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean; + pragma Inline (Is_Predefined_Unit); + -- Determine whether vertex Vertex of library graph G denotes a + -- predefined unit. - No_Invocation_Graph_Edge_Attributes : - constant Invocation_Graph_Edge_Attributes := - (Relation => No_Invocation_Relation); + function Is_Preelaborated_Unit + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean; + pragma Inline (Is_Preelaborated_Unit); + -- Determine whether vertex Vertex of library graph G denotes a unit + -- subject to pragma Pure or Preelaborable. - procedure Destroy_Invocation_Graph_Edge_Attributes - (Attrs : in out Invocation_Graph_Edge_Attributes); - pragma Inline (Destroy_Invocation_Graph_Edge_Attributes); - -- Destroy the contents of attributes Attrs + function Is_Spec + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean; + pragma Inline (Is_Spec); + -- Determine whether vertex Vertex of library graph G denotes a spec - package IGE_Tables is new Dynamic_Hash_Tables - (Key_Type => Invocation_Graph_Edge_Id, - Value_Type => Invocation_Graph_Edge_Attributes, - No_Value => No_Invocation_Graph_Edge_Attributes, - Expansion_Threshold => 1.5, - Expansion_Factor => 2, - Compression_Threshold => 0.3, - Compression_Factor => 2, - "=" => "=", - Destroy_Value => Destroy_Invocation_Graph_Edge_Attributes, - Hash => Hash_Invocation_Graph_Edge); + function Is_Spec_Before_Body_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean; + pragma Inline (Is_Spec_Before_Body_Edge); + -- Determine whether edge Edge of library graph G links a predecessor + -- spec and a successor body belonging to the same unit. - --------------- - -- Relations -- - --------------- + function Is_Spec_With_Body + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean; + pragma Inline (Is_Spec_With_Body); + -- Determine whether vertex Vertex of library graph G denotes a spec + -- with a corresponding body. - -- The following type represents a relation between a source and target - -- vertices. + function Is_Spec_With_Elaborate_Body + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean; + pragma Inline (Is_Spec_With_Elaborate_Body); + -- Determine whether vertex Vertex of library graph G denotes a spec + -- with a corresponding body, and is subject to pragma Elaborate_Body. - type Source_Target_Relation is record - Source : Invocation_Graph_Vertex_Id := No_Invocation_Graph_Vertex; - -- The source vertex + function Is_Weakly_Elaborable_Vertex + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean; + pragma Inline (Is_Weakly_Elaborable_Vertex); + -- Determine whether vertex Vertex of library graph G is waiting on + -- weak predecessors only, in which case it can be elaborated assuming + -- that the weak edges will not be exercised at elaboration time. - Target : Invocation_Graph_Vertex_Id := No_Invocation_Graph_Vertex; - -- The destination vertex - end record; + function Is_With_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean; + pragma Inline (Is_With_Edge); + -- Determine whether edge Edge of library graph G is the result of a + -- with dependency between its successor and predecessor. - No_Source_Target_Relation : - constant Source_Target_Relation := - (Source => No_Invocation_Graph_Vertex, - Target => No_Invocation_Graph_Vertex); + function Needs_Elaboration + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean; + pragma Inline (Needs_Elaboration); + -- Determine whether vertex Vertex of library graph G represents a unit + -- that needs to be elaborated. - function Hash_Source_Target_Relation - (Rel : Source_Target_Relation) return Bucket_Range_Type; - pragma Inline (Hash_Source_Target_Relation); - -- Obtain the hash value of key Rel + function Proper_Body + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id; + pragma Inline (Proper_Body); + -- Obtain the body of vertex Vertex of library graph G - package Relation_Sets is new Membership_Sets - (Element_Type => Source_Target_Relation, - "=" => "=", - Hash => Hash_Source_Target_Relation); + function Proper_Spec + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id; + pragma Inline (Proper_Spec); + -- Obtain the spec of vertex Vertex of library graph G ---------------- -- Statistics -- ---------------- - type Invocation_Graph_Edge_Counts is array (Invocation_Kind) of Natural; + function Library_Graph_Edge_Count + (G : Library_Graph; + Kind : Library_Graph_Edge_Kind) return Natural; + pragma Inline (Library_Graph_Edge_Count); + -- Obtain the total number of edges of kind Kind in library graph G - ---------------- - -- Signatures -- - ---------------- + function Number_Of_Component_Vertices + (G : Library_Graph; + Comp : Component_Id) return Natural; + pragma Inline (Number_Of_Component_Vertices); + -- Obtain the total number of vertices component Comp of library graph + -- contains. - function Hash_Invocation_Signature - (IS_Id : Invocation_Signature_Id) return Bucket_Range_Type; - pragma Inline (Hash_Invocation_Signature); - -- Obtain the hash value of key IS_Id + function Number_Of_Components (G : Library_Graph) return Natural; + pragma Inline (Number_Of_Components); + -- Obtain the total number of components in library graph G - package Signature_Tables is new Dynamic_Hash_Tables - (Key_Type => Invocation_Signature_Id, - Value_Type => Invocation_Graph_Vertex_Id, - No_Value => No_Invocation_Graph_Vertex, - Expansion_Threshold => 1.5, - Expansion_Factor => 2, - Compression_Threshold => 0.3, - Compression_Factor => 2, - "=" => "=", - Destroy_Value => Destroy_Invocation_Graph_Vertex, - Hash => Hash_Invocation_Signature); + function Number_Of_Cycles (G : Library_Graph) return Natural; + pragma Inline (Number_Of_Cycles); + -- Obtain the total number of cycles in library graph G - ----------------------- - -- Elaboration roots -- - ----------------------- + function Number_Of_Edges (G : Library_Graph) return Natural; + pragma Inline (Number_Of_Edges); + -- Obtain the total number of edges in library graph G - package IGV_Sets is new Membership_Sets - (Element_Type => Invocation_Graph_Vertex_Id, - "=" => "=", - Hash => Hash_Invocation_Graph_Vertex); + function Number_Of_Edges_To_Successors + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Natural; + pragma Inline (Number_Of_Edges_To_Successors); + -- Obtain the total number of edges to successors vertex Vertex of + -- library graph G has. - ----------- - -- Graph -- - ----------- + function Number_Of_Vertices (G : Library_Graph) return Natural; + pragma Inline (Number_Of_Vertices); + -- Obtain the total number of vertices in library graph G - package DG is new Directed_Graphs - (Vertex_Id => Invocation_Graph_Vertex_Id, - No_Vertex => No_Invocation_Graph_Vertex, - Hash_Vertex => Hash_Invocation_Graph_Vertex, - Same_Vertex => "=", - Edge_id => Invocation_Graph_Edge_Id, - No_Edge => No_Invocation_Graph_Edge, - Hash_Edge => Hash_Invocation_Graph_Edge, - Same_Edge => "="); + --------------- + -- Iterators -- + --------------- - -- The following type represents the attributes of an invocation graph + -- The following type represents an iterator over all cycles of a + -- library graph. - type Invocation_Graph_Attributes is record - Counts : Invocation_Graph_Edge_Counts := (others => 0); - -- Edge statistics + type All_Cycle_Iterator is private; - Edge_Attributes : IGE_Tables.Dynamic_Hash_Table := IGE_Tables.Nil; - -- The map of edge -> edge attributes for all edges in the graph + function Has_Next (Iter : All_Cycle_Iterator) return Boolean; + pragma Inline (Has_Next); + -- Determine whether iterator Iter has more cycles to examine - Graph : DG.Directed_Graph := DG.Nil; - -- The underlying graph describing the relations between edges and - -- vertices. + function Iterate_All_Cycles + (G : Library_Graph) return All_Cycle_Iterator; + pragma Inline (Iterate_All_Cycles); + -- Obtain an iterator over all cycles of library graph G - Relations : Relation_Sets.Membership_Set := Relation_Sets.Nil; - -- The set of relations between source and targets, used to prevent - -- duplicate edges in the graph. + procedure Next + (Iter : in out All_Cycle_Iterator; + Cycle : out Library_Graph_Cycle_Id); + pragma Inline (Next); + -- Return the current cycle referenced by iterator Iter and advance to + -- the next available cycle. - Roots : IGV_Sets.Membership_Set := IGV_Sets.Nil; - -- The set of elaboration root vertices + -- The following type represents an iterator over all edges of a library + -- graph. - Signature_To_Vertex : Signature_Tables.Dynamic_Hash_Table := - Signature_Tables.Nil; - -- The map of signature -> vertex + type All_Edge_Iterator is private; - Vertex_Attributes : IGV_Tables.Dynamic_Hash_Table := IGV_Tables.Nil; - -- The map of vertex -> vertex attributes for all vertices in the - -- graph. - end record; + function Has_Next (Iter : All_Edge_Iterator) return Boolean; + pragma Inline (Has_Next); + -- Determine whether iterator Iter has more edges to examine - type Invocation_Graph is access Invocation_Graph_Attributes; - Nil : constant Invocation_Graph := null; + function Iterate_All_Edges (G : Library_Graph) return All_Edge_Iterator; + pragma Inline (Iterate_All_Edges); + -- Obtain an iterator over all edges of library graph G - --------------- - -- Iterators -- - --------------- + procedure Next + (Iter : in out All_Edge_Iterator; + Edge : out Library_Graph_Edge_Id); + pragma Inline (Next); + -- Return the current edge referenced by iterator Iter and advance to + -- the next available edge. - type All_Edge_Iterator is new DG.All_Edge_Iterator; - type All_Vertex_Iterator is new DG.All_Vertex_Iterator; - type Edges_To_Targets_Iterator is new DG.Outgoing_Edge_Iterator; - type Elaboration_Root_Iterator is new IGV_Sets.Iterator; - end Invocation_Graphs; + -- The following type represents an iterator over all vertices of a + -- library graph. - -------------------- - -- Library_Graphs -- - -------------------- + type All_Vertex_Iterator is private; - package Library_Graphs is + function Has_Next (Iter : All_Vertex_Iterator) return Boolean; + pragma Inline (Has_Next); + -- Determine whether iterator Iter has more vertices to examine - -- The following type represents the various kinds of library graph - -- cycles. The ordering of kinds is significant, where a literal with - -- lower ordinal has a higher precedence than one with higher ordinal. + function Iterate_All_Vertices + (G : Library_Graph) return All_Vertex_Iterator; + pragma Inline (Iterate_All_Vertices); + -- Obtain an iterator over all vertices of library graph G - type Library_Graph_Cycle_Kind is - (Elaborate_Body_Cycle, - -- A cycle that involves at least one spec-body pair, where the - -- spec is subject to pragma Elaborate_Body. This is the highest - -- precedence cycle. + procedure Next + (Iter : in out All_Vertex_Iterator; + Vertex : out Library_Graph_Vertex_Id); + pragma Inline (Next); + -- Return the current vertex referenced by iterator Iter and advance + -- to the next available vertex. - Elaborate_Cycle, - -- A cycle that involves at least one Elaborate edge + -- The following type represents an iterator over all components of a + -- library graph. - Elaborate_All_Cycle, - -- A cycle that involves at least one Elaborate_All edge + type Component_Iterator is private; - Forced_Cycle, - -- A cycle that involves at least one edge which is a byproduct of - -- the forced-elaboration-order file. + function Has_Next (Iter : Component_Iterator) return Boolean; + pragma Inline (Has_Next); + -- Determine whether iterator Iter has more components to examine - Invocation_Cycle, - -- A cycle that involves at least one invocation edge. This is the - -- lowest precedence cycle. + function Iterate_Components + (G : Library_Graph) return Component_Iterator; + pragma Inline (Iterate_Components); + -- Obtain an iterator over all components of library graph G - No_Cycle_Kind); + procedure Next + (Iter : in out Component_Iterator; + Comp : out Component_Id); + pragma Inline (Next); + -- Return the current component referenced by iterator Iter and advance + -- to the next available component. - -- The following type represents the various kinds of library edges. The - -- order is important here, and corresponds to the order in which edges - -- are added to the graph. See Add_Edge_Kind_Check for details. If - -- changes are made such that new edge kinds are added or similar, we - -- need to make sure this type matches the code in Add_Edge_Kind_Check, - -- and Add_Edge_Kind_Check matches the order of edge adding. Likewise, - -- if the edge-adding order changes, we need consistency between this - -- enumeration type, the edge-adding order, and Add_Edge_Kind_Check. + -- The following type represents an iterator over all vertices of a + -- component. - type Library_Graph_Edge_Kind is - (Spec_Before_Body_Edge, - -- Successor denotes a body, Predecessor denotes a spec + type Component_Vertex_Iterator is private; - Elaborate_Edge, - -- Successor withs Predecessor, and has pragma Elaborate for it + function Has_Next (Iter : Component_Vertex_Iterator) return Boolean; + pragma Inline (Has_Next); + -- Determine whether iterator Iter has more vertices to examine - Elaborate_All_Edge, - -- Successor withs Predecessor, and has pragma Elaborate_All for it + function Iterate_Component_Vertices + (G : Library_Graph; + Comp : Component_Id) return Component_Vertex_Iterator; + pragma Inline (Iterate_Component_Vertices); + -- Obtain an iterator over all vertices of component Comp of library + -- graph G. - With_Edge, - -- Successor withs Predecessor + procedure Next + (Iter : in out Component_Vertex_Iterator; + Vertex : out Library_Graph_Vertex_Id); + pragma Inline (Next); + -- Return the current vertex referenced by iterator Iter and advance + -- to the next available vertex. - Forced_Edge, - -- Successor is forced to with Predecessor by virtue of an existing - -- elaboration order provided in a file. + -- The following type represents an iterator over all edges that form a + -- cycle. - Invocation_Edge, - -- An invocation construct in unit Successor invokes a target in unit - -- Predecessor. + type Edges_Of_Cycle_Iterator is private; - Body_Before_Spec_Edge, - -- Successor denotes spec, Predecessor denotes a body. This is a - -- special edge kind used only during the discovery of components. - -- Note that a body can never be elaborated before its spec. + function Has_Next (Iter : Edges_Of_Cycle_Iterator) return Boolean; + pragma Inline (Has_Next); + -- Determine whether iterator Iter has more edges to examine - No_Edge); + function Iterate_Edges_Of_Cycle + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) return Edges_Of_Cycle_Iterator; + pragma Inline (Iterate_Edges_Of_Cycle); + -- Obtain an iterator over all edges that form cycle Cycle of library + -- graph G. - ----------- - -- Graph -- - ----------- + procedure Next + (Iter : in out Edges_Of_Cycle_Iterator; + Edge : out Library_Graph_Edge_Id); + pragma Inline (Next); + -- Return the current edge referenced by iterator Iter and advance to + -- the next available edge. - -- The following type denotes a library graph handle. Each instance must - -- be created using routine Create. + -- The following type represents an iterator over all edges that reach + -- successors starting from a particular predecessor vertex. - type Library_Graph is private; - Nil : constant Library_Graph; + type Edges_To_Successors_Iterator is private; - type LGE_Predicate_Ptr is access function - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean; + function Has_Next (Iter : Edges_To_Successors_Iterator) return Boolean; + pragma Inline (Has_Next); + -- Determine whether iterator Iter has more edges to examine - type LGV_Comparator_Ptr is access function - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id; - Compared_To : Library_Graph_Vertex_Id) return Precedence_Kind; - - type LGV_Predicate_Ptr is access function + function Iterate_Edges_To_Successors (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean; + Vertex : Library_Graph_Vertex_Id) return Edges_To_Successors_Iterator; + pragma Inline (Iterate_Edges_To_Successors); + -- Obtain an iterator over all edges to successors with predecessor + -- vertex Vertex of library graph G. - ---------------------- - -- Graph operations -- - ---------------------- + procedure Next + (Iter : in out Edges_To_Successors_Iterator; + Edge : out Library_Graph_Edge_Id); + pragma Inline (Next); + -- Return the current edge referenced by iterator Iter and advance to + -- the next available edge. - procedure Add_Edge - (G : Library_Graph; - Pred : Library_Graph_Vertex_Id; - Succ : Library_Graph_Vertex_Id; - Kind : Library_Graph_Edge_Kind; - Activates_Task : Boolean); - pragma Inline (Add_Edge); - -- Create a new edge in library graph G with source vertex Pred and - -- destination vertex Succ. Kind denotes the nature of the edge. Flag - -- Activates_Task should be set when the edge involves task activation. + private - procedure Add_Vertex - (G : Library_Graph; - U_Id : Unit_Id); - pragma Inline (Add_Vertex); - -- Create a new vertex in library graph G. U_Id is the unit the vertex - -- describes. + -------------- + -- Vertices -- + -------------- - function Create - (Initial_Vertices : Positive; - Initial_Edges : Positive) return Library_Graph; - pragma Inline (Create); - -- Create a new empty graph with vertex capacity Initial_Vertices and - -- edge capacity Initial_Edges. + -- The following type represents the attributes of a library graph + -- vertex. - procedure Destroy (G : in out Library_Graph); - pragma Inline (Destroy); - -- Destroy the contents of library graph G, rendering it unusable + type Library_Graph_Vertex_Attributes is record + Corresponding_Item : Library_Graph_Vertex_Id := + No_Library_Graph_Vertex; + -- The reference to the corresponding spec or body. This attribute is + -- set as follows: + -- + -- * If predicate Is_Body_With_Spec is True, the reference denotes + -- the corresponding spec. + -- + -- * If predicate Is_Spec_With_Body is True, the reference denotes + -- the corresponding body. + -- + -- * Otherwise the attribute remains empty. - procedure Find_Components (G : Library_Graph); - pragma Inline (Find_Components); - -- Find all components in library graph G + In_Elaboration_Order : Boolean := False; + -- Set when this vertex is elaborated - procedure Find_Cycles (G : Library_Graph); - pragma Inline (Find_Cycles); - -- Find all cycles in library graph G + Pending_Strong_Predecessors : Natural := 0; + -- The number of pending strong predecessor vertices this vertex must + -- wait on before it can be elaborated. - function Highest_Precedence_Cycle - (G : Library_Graph) return Library_Graph_Cycle_Id; - pragma Inline (Highest_Precedence_Cycle); - -- Obtain the cycle with highest precedence among all other cycles of - -- library graph G. + Pending_Weak_Predecessors : Natural := 0; + -- The number of weak predecessor vertices this vertex must wait on + -- before it can be elaborated. - function Present (G : Library_Graph) return Boolean; - pragma Inline (Present); - -- Determine whether library graph G exists + Unit : Unit_Id := No_Unit_Id; + -- The reference to unit this vertex represents + end record; - ----------------------- - -- Vertex attributes -- - ----------------------- + No_Library_Graph_Vertex_Attributes : + constant Library_Graph_Vertex_Attributes := + (Corresponding_Item => No_Library_Graph_Vertex, + In_Elaboration_Order => False, + Pending_Strong_Predecessors => 0, + Pending_Weak_Predecessors => 0, + Unit => No_Unit_Id); - function Component - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Component_Id; - pragma Inline (Component); - -- Obtain the component where vertex Vertex of library graph G resides + procedure Destroy_Library_Graph_Vertex_Attributes + (Attrs : in out Library_Graph_Vertex_Attributes); + pragma Inline (Destroy_Library_Graph_Vertex_Attributes); + -- Destroy the contents of attributes Attrs - function Corresponding_Item - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id; - pragma Inline (Corresponding_Item); - -- Obtain the complementary vertex which represents the corresponding - -- spec or body of vertex Vertex of library graph G. + package LGV_Tables is new Dynamic_Hash_Tables + (Key_Type => Library_Graph_Vertex_Id, + Value_Type => Library_Graph_Vertex_Attributes, + No_Value => No_Library_Graph_Vertex_Attributes, + Expansion_Threshold => 1.5, + Expansion_Factor => 2, + Compression_Threshold => 0.3, + Compression_Factor => 2, + "=" => "=", + Destroy_Value => Destroy_Library_Graph_Vertex_Attributes, + Hash => Hash_Library_Graph_Vertex); - function Corresponding_Vertex - (G : Library_Graph; - U_Id : Unit_Id) return Library_Graph_Vertex_Id; - pragma Inline (Corresponding_Vertex); - -- Obtain the corresponding vertex of library graph G which represents - -- unit U_Id. + ----------- + -- Edges -- + ----------- - procedure Decrement_Pending_Predecessors - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id; - Edge : Library_Graph_Edge_Id); - pragma Inline (Decrement_Pending_Predecessors); - -- Decrease the number of pending predecessors vertex Vertex which was - -- reached via edge Edge of library graph G must wait until it can be - -- elaborated. + -- The following type represents the attributes of a library graph edge - function File_Name - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return File_Name_Type; - pragma Inline (File_Name); - -- Obtain the name of the file where vertex Vertex of library graph G - -- resides. + type Library_Graph_Edge_Attributes is record + Activates_Task : Boolean := False; + -- Set for an invocation edge, where at least one of the paths the + -- edge represents activates a task. - function In_Elaboration_Order - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean; - pragma Inline (In_Elaboration_Order); - -- Determine whether vertex Vertex of library graph G is already in some - -- elaboration order. + Kind : Library_Graph_Edge_Kind := No_Edge; + -- The nature of the library graph edge + end record; - function Invocation_Graph_Encoding - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) - return Invocation_Graph_Encoding_Kind; - pragma Inline (Invocation_Graph_Encoding); - -- Obtain the encoding format used to capture information related to - -- invocation vertices and edges that reside within vertex Vertex of - -- library graph G. + No_Library_Graph_Edge_Attributes : + constant Library_Graph_Edge_Attributes := + (Activates_Task => False, + Kind => No_Edge); - function Name - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Unit_Name_Type; - pragma Inline (Name); - -- Obtain the name of the unit which vertex Vertex of library graph G - -- represents. + procedure Destroy_Library_Graph_Edge_Attributes + (Attrs : in out Library_Graph_Edge_Attributes); + pragma Inline (Destroy_Library_Graph_Edge_Attributes); + -- Destroy the contents of attributes Attrs - procedure Pending_Predecessors_For_Elaboration - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id; - Strong_Preds : out Natural; - Weak_Preds : out Natural); - pragma Inline (Pending_Predecessors_For_Elaboration); - -- Obtain the number of pending strong and weak predecessors of vertex - -- Vertex of library graph G, taking into account Elaborate_Body pairs. - -- Strong predecessors are returned in Strong_Preds. Weak predecessors - -- are returned in Weak_Preds. + package LGE_Tables is new Dynamic_Hash_Tables + (Key_Type => Library_Graph_Edge_Id, + Value_Type => Library_Graph_Edge_Attributes, + No_Value => No_Library_Graph_Edge_Attributes, + Expansion_Threshold => 1.5, + Expansion_Factor => 2, + Compression_Threshold => 0.3, + Compression_Factor => 2, + "=" => "=", + Destroy_Value => Destroy_Library_Graph_Edge_Attributes, + Hash => Hash_Library_Graph_Edge); - function Pending_Strong_Predecessors - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Natural; - pragma Inline (Pending_Strong_Predecessors); - -- Obtain the number of pending strong predecessors vertex Vertex of - -- library graph G must wait on until it can be elaborated. + ---------------- + -- Components -- + ---------------- - function Pending_Weak_Predecessors - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Natural; - pragma Inline (Pending_Weak_Predecessors); - -- Obtain the number of pending weak predecessors vertex Vertex of - -- library graph G must wait on until it can be elaborated. + -- The following type represents the attributes of a component - procedure Set_Corresponding_Item - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id; - Val : Library_Graph_Vertex_Id); - pragma Inline (Set_Corresponding_Item); - -- Set the complementary vertex which represents the corresponding - -- spec or body of vertex Vertex of library graph G to value Val. + type Component_Attributes is record + Pending_Strong_Predecessors : Natural := 0; + -- The number of pending strong predecessor components this component + -- must wait on before it can be elaborated. - procedure Set_In_Elaboration_Order - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id; - Val : Boolean := True); - pragma Inline (Set_In_Elaboration_Order); - -- Mark vertex Vertex of library graph G as included in some elaboration - -- order depending on value Val. + Pending_Weak_Predecessors : Natural := 0; + -- The number of pending weak predecessor components this component + -- must wait on before it can be elaborated. + end record; - function Unit - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Unit_Id; - pragma Inline (Unit); - -- Obtain the unit vertex Vertex of library graph G represents + No_Component_Attributes : constant Component_Attributes := + (Pending_Strong_Predecessors => 0, + Pending_Weak_Predecessors => 0); - --------------------- - -- Edge attributes -- - --------------------- + procedure Destroy_Component_Attributes + (Attrs : in out Component_Attributes); + pragma Inline (Destroy_Component_Attributes); + -- Destroy the contents of attributes Attrs - function Activates_Task - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean; - pragma Inline (Activates_Task); - -- Determine whether edge Edge of library graph G activates a task + package Component_Tables is new Dynamic_Hash_Tables + (Key_Type => Component_Id, + Value_Type => Component_Attributes, + No_Value => No_Component_Attributes, + Expansion_Threshold => 1.5, + Expansion_Factor => 2, + Compression_Threshold => 0.3, + Compression_Factor => 2, + "=" => "=", + Destroy_Value => Destroy_Component_Attributes, + Hash => Hash_Component); - function Kind - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Library_Graph_Edge_Kind; - pragma Inline (Kind); - -- Obtain the nature of edge Edge of library graph G + ------------ + -- Cycles -- + ------------ - function Predecessor - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id; - pragma Inline (Predecessor); - -- Obtain the predecessor vertex of edge Edge of library graph G + -- The following type represents the attributes of a cycle - function Successor - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id; - pragma Inline (Successor); - -- Obtain the successor vertex of edge Edge of library graph G + type Library_Graph_Cycle_Attributes is record + Invocation_Edge_Count : Natural := 0; + -- The number of invocation edges within the cycle - -------------------------- - -- Component attributes -- - -------------------------- + Kind : Library_Graph_Cycle_Kind := No_Cycle_Kind; + -- The nature of the cycle - procedure Decrement_Pending_Predecessors - (G : Library_Graph; - Comp : Component_Id; - Edge : Library_Graph_Edge_Id); - pragma Inline (Decrement_Pending_Predecessors); - -- Decrease the number of pending predecessors component Comp which was - -- reached via edge Edge of library graph G must wait on until it can be - -- elaborated. + Path : LGE_Lists.Doubly_Linked_List := LGE_Lists.Nil; + -- The path of edges that form the cycle + end record; - function Pending_Strong_Predecessors - (G : Library_Graph; - Comp : Component_Id) return Natural; - pragma Inline (Pending_Strong_Predecessors); - -- Obtain the number of pending strong predecessors component Comp of - -- library graph G must wait on until it can be elaborated. + No_Library_Graph_Cycle_Attributes : + constant Library_Graph_Cycle_Attributes := + (Invocation_Edge_Count => 0, + Kind => No_Cycle_Kind, + Path => LGE_Lists.Nil); - function Pending_Weak_Predecessors - (G : Library_Graph; - Comp : Component_Id) return Natural; - pragma Inline (Pending_Weak_Predecessors); - -- Obtain the number of pending weak predecessors component Comp of - -- library graph G must wait on until it can be elaborated. + procedure Destroy_Library_Graph_Cycle_Attributes + (Attrs : in out Library_Graph_Cycle_Attributes); + pragma Inline (Destroy_Library_Graph_Cycle_Attributes); + -- Destroy the contents of attributes Attrs - ---------------------- - -- Cycle attributes -- - ---------------------- + function Hash_Library_Graph_Cycle_Attributes + (Attrs : Library_Graph_Cycle_Attributes) return Bucket_Range_Type; + pragma Inline (Hash_Library_Graph_Cycle_Attributes); + -- Obtain the hash of key Attrs - function Invocation_Edge_Count - (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id) return Natural; - pragma Inline (Invocation_Edge_Count); - -- Obtain the number of invocation edges in cycle Cycle of library - -- graph G. + function Same_Library_Graph_Cycle_Attributes + (Left : Library_Graph_Cycle_Attributes; + Right : Library_Graph_Cycle_Attributes) return Boolean; + pragma Inline (Same_Library_Graph_Cycle_Attributes); + -- Determine whether cycle attributes Left and Right are the same - function Kind - (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Kind; - pragma Inline (Kind); - -- Obtain the nature of cycle Cycle of library graph G + package LGC_Tables is new Dynamic_Hash_Tables + (Key_Type => Library_Graph_Cycle_Id, + Value_Type => Library_Graph_Cycle_Attributes, + No_Value => No_Library_Graph_Cycle_Attributes, + Expansion_Threshold => 1.5, + Expansion_Factor => 2, + Compression_Threshold => 0.3, + Compression_Factor => 2, + "=" => "=", + Destroy_Value => Destroy_Library_Graph_Cycle_Attributes, + Hash => Hash_Library_Graph_Cycle); - function Length - (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id) return Natural; - pragma Inline (Length); - -- Obtain the length of cycle Cycle of library graph G + -------------------- + -- Recorded edges -- + -------------------- - --------------- - -- Semantics -- - --------------- + -- The following type represents a relation between a predecessor and + -- successor vertices. - function Complementary_Vertex - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id; - Force_Complement : Boolean) return Library_Graph_Vertex_Id; - pragma Inline (Complementary_Vertex); - -- Obtain the complementary vertex of vertex Vertex of library graph G - -- as follows: - -- - -- * If Vertex is the spec of an Elaborate_Body pair, return the body - -- * If Vertex is the body of an Elaborate_Body pair, return the spec - -- - -- This behavior can be forced by setting flag Force_Complement to True. + type Predecessor_Successor_Relation is record + Predecessor : Library_Graph_Vertex_Id := No_Library_Graph_Vertex; + -- The source vertex - function Contains_Elaborate_All_Edge - (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id) return Boolean; - pragma Inline (Contains_Elaborate_All_Edge); - -- Determine whether cycle Cycle of library graph G contains an - -- Elaborate_All edge. + Successor : Library_Graph_Vertex_Id := No_Library_Graph_Vertex; + -- The destination vertex + end record; - function Contains_Static_Successor_Edge - (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id) return Boolean; - pragma Inline (Contains_Static_Successor_Edge); - -- Determine whether cycle Cycle of library graph G contains an edge - -- where the successor was compiled using the static model. + No_Predecessor_Successor_Relation : + constant Predecessor_Successor_Relation := + (Predecessor => No_Library_Graph_Vertex, + Successor => No_Library_Graph_Vertex); - function Contains_Task_Activation - (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id) return Boolean; - pragma Inline (Contains_Task_Activation); - -- Determine whether cycle Cycle of library graph G contains an - -- invocation edge where the path it represents involves a task - -- activation. + function Hash_Predecessor_Successor_Relation + (Rel : Predecessor_Successor_Relation) return Bucket_Range_Type; + pragma Inline (Hash_Predecessor_Successor_Relation); + -- Obtain the hash value of key Rel - function Has_Elaborate_All_Cycle (G : Library_Graph) return Boolean; - pragma Inline (Has_Elaborate_All_Cycle); - -- Determine whether library graph G contains a cycle involving pragma - -- Elaborate_All. + package RE_Sets is new Membership_Sets + (Element_Type => Predecessor_Successor_Relation, + "=" => "=", + Hash => Hash_Predecessor_Successor_Relation); - function Has_No_Elaboration_Code - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean; - pragma Inline (Has_No_Elaboration_Code); - -- Determine whether vertex Vertex of library graph G represents a unit - -- that lacks elaboration code. + ---------------- + -- Statistics -- + ---------------- - function In_Same_Component - (G : Library_Graph; - Left : Library_Graph_Vertex_Id; - Right : Library_Graph_Vertex_Id) return Boolean; - pragma Inline (In_Same_Component); - -- Determine whether vertices Left and Right of library graph G reside - -- in the same component. + type Library_Graph_Edge_Counts is + array (Library_Graph_Edge_Kind) of Natural; - function Is_Body - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean; - pragma Inline (Is_Body); - -- Determine whether vertex Vertex of library graph G denotes a body + ----------- + -- Units -- + ----------- - function Is_Body_Of_Spec_With_Elaborate_Body - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean; - pragma Inline (Is_Body_Of_Spec_With_Elaborate_Body); - -- Determine whether vertex Vertex of library graph G denotes a body - -- with a corresponding spec, and the spec has pragma Elaborate_Body. + package Unit_Tables is new Dynamic_Hash_Tables + (Key_Type => Unit_Id, + Value_Type => Library_Graph_Vertex_Id, + No_Value => No_Library_Graph_Vertex, + Expansion_Threshold => 1.5, + Expansion_Factor => 2, + Compression_Threshold => 0.3, + Compression_Factor => 2, + "=" => "=", + Destroy_Value => Destroy_Library_Graph_Vertex, + Hash => Hash_Unit); - function Is_Body_With_Spec - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean; - pragma Inline (Is_Body_With_Spec); - -- Determine whether vertex Vertex of library graph G denotes a body - -- with a corresponding spec. + ----------- + -- Graph -- + ----------- - function Is_Dynamically_Elaborated - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean; - pragma Inline (Is_Dynamically_Elaborated); - -- Determine whether vertex Vertex of library graph G was compiled - -- using the dynamic model. + package DG is new Directed_Graphs + (Vertex_Id => Library_Graph_Vertex_Id, + No_Vertex => No_Library_Graph_Vertex, + Hash_Vertex => Hash_Library_Graph_Vertex, + Same_Vertex => "=", + Edge_Id => Library_Graph_Edge_Id, + No_Edge => No_Library_Graph_Edge, + Hash_Edge => Hash_Library_Graph_Edge, + Same_Edge => "="); - function Is_Elaborable_Component - (G : Library_Graph; - Comp : Component_Id) return Boolean; - pragma Inline (Is_Elaborable_Component); - -- Determine whether component Comp of library graph G is not waiting on - -- any predecessors, and can thus be elaborated. + -- The following type represents the attributes of a library graph + + type Library_Graph_Attributes is record + Component_Attributes : Component_Tables.Dynamic_Hash_Table := + Component_Tables.Nil; + -- The map of component -> component attributes for all components in + -- the graph. + + Counts : Library_Graph_Edge_Counts := (others => 0); + -- Edge statistics + + Cycle_Attributes : LGC_Tables.Dynamic_Hash_Table := LGC_Tables.Nil; + -- The map of cycle -> cycle attributes for all cycles in the graph + + Cycles : LGC_Lists.Doubly_Linked_List := LGC_Lists.Nil; + -- The list of all cycles in the graph, sorted based on precedence + + Edge_Attributes : LGE_Tables.Dynamic_Hash_Table := LGE_Tables.Nil; + -- The map of edge -> edge attributes for all edges in the graph + + Graph : DG.Directed_Graph := DG.Nil; + -- The underlying graph describing the relations between edges and + -- vertices. + + Recorded_Edges : RE_Sets.Membership_Set := RE_Sets.Nil; + -- The set of recorded edges, used to prevent duplicate edges in the + -- graph. + + Unit_To_Vertex : Unit_Tables.Dynamic_Hash_Table := Unit_Tables.Nil; + -- The map of unit -> vertex + + Vertex_Attributes : LGV_Tables.Dynamic_Hash_Table := LGV_Tables.Nil; + -- The map of vertex -> vertex attributes for all vertices in the + -- graph. + end record; + + type Library_Graph is access Library_Graph_Attributes; + Nil : constant Library_Graph := null; + + --------------- + -- Iterators -- + --------------- + + type All_Cycle_Iterator is new LGC_Lists.Iterator; + type All_Edge_Iterator is new DG.All_Edge_Iterator; + type All_Vertex_Iterator is new DG.All_Vertex_Iterator; + type Component_Iterator is new DG.Component_Iterator; + type Component_Vertex_Iterator is new DG.Component_Vertex_Iterator; + type Edges_Of_Cycle_Iterator is new LGE_Lists.Iterator; + type Edges_To_Successors_Iterator is new DG.Outgoing_Edge_Iterator; + end Library_Graphs; + + ----------------------- + -- Invocation_Graphs -- + ----------------------- + + package Invocation_Graphs is + + ----------- + -- Graph -- + ----------- + + -- The following type denotes an invocation graph handle. Each instance + -- must be created using routine Create. - function Is_Elaborable_Vertex - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean; - pragma Inline (Is_Elaborable_Vertex); - -- Determine whether vertex Vertex of library graph G is not waiting on - -- any predecessors, and can thus be elaborated. + type Invocation_Graph is private; + Nil : constant Invocation_Graph; - function Is_Elaborate_All_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean; - pragma Inline (Is_Elaborate_All_Edge); - -- Determine whether edge Edge of library graph G is an edge whose - -- predecessor is subject to pragma Elaborate_All. + ---------------------- + -- Graph operations -- + ---------------------- - function Is_Elaborate_Body_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean; - pragma Inline (Is_Elaborate_Body_Edge); - -- Determine whether edge Edge of library graph G has a successor - -- that is either a spec subject to pragma Elaborate_Body, or a body - -- that completes such a spec. + procedure Add_Edge + (G : Invocation_Graph; + Source : Invocation_Graph_Vertex_Id; + Target : Invocation_Graph_Vertex_Id; + IR_Id : Invocation_Relation_Id); + pragma Inline (Add_Edge); + -- Create a new edge in invocation graph G with source vertex Source and + -- destination vertex Target. IR_Id is the invocation relation the edge + -- describes. - function Is_Elaborate_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean; - pragma Inline (Is_Elaborate_Edge); - -- Determine whether edge Edge of library graph G is an edge whose - -- predecessor is subject to pragma Elaborate. + procedure Add_Vertex + (G : Invocation_Graph; + IC_Id : Invocation_Construct_Id; + Body_Vertex : Library_Graph_Vertex_Id; + Spec_Vertex : Library_Graph_Vertex_Id); + pragma Inline (Add_Vertex); + -- Create a new vertex in invocation graph G. IC_Id is the invocation + -- construct the vertex describes. Body_Vertex denotes the library graph + -- vertex where the invocation construct's body is declared. Spec_Vertex + -- is the library graph vertex where the invocation construct's spec is + -- declared. - function Is_Elaborate_Body_Pair - (G : Library_Graph; - Spec_Vertex : Library_Graph_Vertex_Id; - Body_Vertex : Library_Graph_Vertex_Id) return Boolean; - pragma Inline (Is_Elaborate_Body_Pair); - -- Determine whether vertices Spec_Vertex and Body_Vertex of library - -- graph G denote a spec subject to Elaborate_Body and its completing - -- body. + function Create + (Initial_Vertices : Positive; + Initial_Edges : Positive; + Lib_Graph : Library_Graphs.Library_Graph) + return Invocation_Graph; + pragma Inline (Create); + -- Create a new empty graph with vertex capacity Initial_Vertices + -- and edge capacity Initial_Edges. Lib_Graph is the library graph + -- corresponding to this invocation graph. - function Is_Forced_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean; - pragma Inline (Is_Forced_Edge); - -- Determine whether edge Edge of library graph G is a byproduct of the - -- forced-elaboration-order file. + function Get_Lib_Graph + (G : Invocation_Graph) return Library_Graphs.Library_Graph; + pragma Inline (Get_Lib_Graph); + -- Return the library graph corresponding to this invocation graph - function Is_Internal_Unit - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean; - pragma Inline (Is_Internal_Unit); - -- Determine whether vertex Vertex of library graph G denotes an - -- internal unit. + procedure Destroy (G : in out Invocation_Graph); + pragma Inline (Destroy); + -- Destroy the contents of invocation graph G, rendering it unusable - function Is_Invocation_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean; - pragma Inline (Is_Invocation_Edge); - -- Determine whether edge Edge of library graph G came from the - -- traversal of the invocation graph. + function Present (G : Invocation_Graph) return Boolean; + pragma Inline (Present); + -- Determine whether invocation graph G exists - function Is_Predefined_Unit - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean; - pragma Inline (Is_Predefined_Unit); - -- Determine whether vertex Vertex of library graph G denotes a - -- predefined unit. + ----------------------- + -- Vertex attributes -- + ----------------------- - function Is_Preelaborated_Unit - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean; - pragma Inline (Is_Preelaborated_Unit); - -- Determine whether vertex Vertex of library graph G denotes a unit - -- subject to pragma Pure or Preelaborable. + function Body_Vertex + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id; + pragma Inline (Body_Vertex); + -- Obtain the library graph vertex where the body of the invocation + -- construct represented by vertex Vertex of invocation graph G is + -- declared. - function Is_Spec - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean; - pragma Inline (Is_Spec); - -- Determine whether vertex Vertex of library graph G denotes a spec + function Column + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Nat; + pragma Inline (Column); + -- Obtain the column number where the invocation construct vertex Vertex + -- of invocation graph G describes. - function Is_Spec_Before_Body_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean; - pragma Inline (Is_Spec_Before_Body_Edge); - -- Determine whether edge Edge of library graph G links a predecessor - -- spec and a successor body belonging to the same unit. + function Construct + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Invocation_Construct_Id; + pragma Inline (Construct); + -- Obtain the invocation construct vertex Vertex of invocation graph G + -- describes. - function Is_Spec_With_Body - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean; - pragma Inline (Is_Spec_With_Body); - -- Determine whether vertex Vertex of library graph G denotes a spec - -- with a corresponding body. + function Corresponding_Vertex + (G : Invocation_Graph; + IS_Id : Invocation_Signature_Id) return Invocation_Graph_Vertex_Id; + pragma Inline (Corresponding_Vertex); + -- Obtain the vertex of invocation graph G that corresponds to signature + -- IS_Id. - function Is_Spec_With_Elaborate_Body - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean; - pragma Inline (Is_Spec_With_Elaborate_Body); - -- Determine whether vertex Vertex of library graph G denotes a spec - -- with a corresponding body, and is subject to pragma Elaborate_Body. + function Line + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Nat; + pragma Inline (Line); + -- Obtain the line number where the invocation construct vertex Vertex + -- of invocation graph G describes. - function Is_Weakly_Elaborable_Vertex - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean; - pragma Inline (Is_Weakly_Elaborable_Vertex); - -- Determine whether vertex Vertex of library graph G is waiting on - -- weak predecessors only, in which case it can be elaborated assuming - -- that the weak edges will not be exercised at elaboration time. + function Name + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Name_Id; + pragma Inline (Name); + -- Obtain the name of the construct vertex Vertex of invocation graph G + -- describes. - function Is_With_Edge - (G : Library_Graph; - Edge : Library_Graph_Edge_Id) return Boolean; - pragma Inline (Is_With_Edge); - -- Determine whether edge Edge of library graph G is the result of a - -- with dependency between its successor and predecessor. + function Spec_Vertex + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id; + pragma Inline (Spec_Vertex); + -- Obtain the library graph vertex where the spec of the invocation + -- construct represented by vertex Vertex of invocation graph G is + -- declared. - function Needs_Elaboration - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean; - pragma Inline (Needs_Elaboration); - -- Determine whether vertex Vertex of library graph G represents a unit - -- that needs to be elaborated. + --------------------- + -- Edge attributes -- + --------------------- - function Proper_Body - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id; - pragma Inline (Proper_Body); - -- Obtain the body of vertex Vertex of library graph G + function Extra + (G : Invocation_Graph; + Edge : Invocation_Graph_Edge_Id) return Name_Id; + pragma Inline (Extra); + -- Obtain the extra name used in error diagnostics of edge Edge of + -- invocation graph G. - function Proper_Spec - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id; - pragma Inline (Proper_Spec); - -- Obtain the spec of vertex Vertex of library graph G + function Kind + (G : Invocation_Graph; + Edge : Invocation_Graph_Edge_Id) return Invocation_Kind; + pragma Inline (Kind); + -- Obtain the nature of edge Edge of invocation graph G + + function Relation + (G : Invocation_Graph; + Edge : Invocation_Graph_Edge_Id) return Invocation_Relation_Id; + pragma Inline (Relation); + -- Obtain the relation edge Edge of invocation graph G describes + + function Target + (G : Invocation_Graph; + Edge : Invocation_Graph_Edge_Id) return Invocation_Graph_Vertex_Id; + pragma Inline (Target); + -- Obtain the target vertex edge Edge of invocation graph G designates ---------------- -- Statistics -- ---------------- - function Library_Graph_Edge_Count - (G : Library_Graph; - Kind : Library_Graph_Edge_Kind) return Natural; - pragma Inline (Library_Graph_Edge_Count); - -- Obtain the total number of edges of kind Kind in library graph G - - function Number_Of_Component_Vertices - (G : Library_Graph; - Comp : Component_Id) return Natural; - pragma Inline (Number_Of_Component_Vertices); - -- Obtain the total number of vertices component Comp of library graph - -- contains. - - function Number_Of_Components (G : Library_Graph) return Natural; - pragma Inline (Number_Of_Components); - -- Obtain the total number of components in library graph G - - function Number_Of_Cycles (G : Library_Graph) return Natural; - pragma Inline (Number_Of_Cycles); - -- Obtain the total number of cycles in library graph G + function Invocation_Graph_Edge_Count + (G : Invocation_Graph; + Kind : Invocation_Kind) return Natural; + pragma Inline (Invocation_Graph_Edge_Count); + -- Obtain the total number of edges of kind Kind in invocation graph G - function Number_Of_Edges (G : Library_Graph) return Natural; + function Number_Of_Edges (G : Invocation_Graph) return Natural; pragma Inline (Number_Of_Edges); - -- Obtain the total number of edges in library graph G + -- Obtain the total number of edges in invocation graph G + + function Number_Of_Edges_To_Targets + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Natural; + pragma Inline (Number_Of_Edges_To_Targets); + -- Obtain the total number of edges to targets vertex Vertex of + -- invocation graph G has. - function Number_Of_Edges_To_Successors - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Natural; - pragma Inline (Number_Of_Edges_To_Successors); - -- Obtain the total number of edges to successors vertex Vertex of - -- library graph G has. + function Number_Of_Elaboration_Roots + (G : Invocation_Graph) return Natural; + pragma Inline (Number_Of_Elaboration_Roots); + -- Obtain the total number of elaboration roots in invocation graph G - function Number_Of_Vertices (G : Library_Graph) return Natural; + function Number_Of_Vertices (G : Invocation_Graph) return Natural; pragma Inline (Number_Of_Vertices); - -- Obtain the total number of vertices in library graph G + -- Obtain the total number of vertices in invocation graph G --------------- -- Iterators -- --------------- - -- The following type represents an iterator over all cycles of a - -- library graph. - - type All_Cycle_Iterator is private; - - function Has_Next (Iter : All_Cycle_Iterator) return Boolean; - pragma Inline (Has_Next); - -- Determine whether iterator Iter has more cycles to examine - - function Iterate_All_Cycles - (G : Library_Graph) return All_Cycle_Iterator; - pragma Inline (Iterate_All_Cycles); - -- Obtain an iterator over all cycles of library graph G - - procedure Next - (Iter : in out All_Cycle_Iterator; - Cycle : out Library_Graph_Cycle_Id); - pragma Inline (Next); - -- Return the current cycle referenced by iterator Iter and advance to - -- the next available cycle. - - -- The following type represents an iterator over all edges of a library - -- graph. + -- The following type represents an iterator over all edges of an + -- invocation graph. type All_Edge_Iterator is private; @@ -1302,19 +1451,20 @@ package Bindo.Graphs is pragma Inline (Has_Next); -- Determine whether iterator Iter has more edges to examine - function Iterate_All_Edges (G : Library_Graph) return All_Edge_Iterator; + function Iterate_All_Edges + (G : Invocation_Graph) return All_Edge_Iterator; pragma Inline (Iterate_All_Edges); - -- Obtain an iterator over all edges of library graph G + -- Obtain an iterator over all edges of invocation graph G procedure Next (Iter : in out All_Edge_Iterator; - Edge : out Library_Graph_Edge_Id); + Edge : out Invocation_Graph_Edge_Id); pragma Inline (Next); -- Return the current edge referenced by iterator Iter and advance to -- the next available edge. - -- The following type represents an iterator over all vertices of a - -- library graph. + -- The following type represents an iterator over all vertices of an + -- invocation graph. type All_Vertex_Iterator is private; @@ -1323,412 +1473,272 @@ package Bindo.Graphs is -- Determine whether iterator Iter has more vertices to examine function Iterate_All_Vertices - (G : Library_Graph) return All_Vertex_Iterator; + (G : Invocation_Graph) return All_Vertex_Iterator; pragma Inline (Iterate_All_Vertices); - -- Obtain an iterator over all vertices of library graph G + -- Obtain an iterator over all vertices of invocation graph G procedure Next (Iter : in out All_Vertex_Iterator; - Vertex : out Library_Graph_Vertex_Id); - pragma Inline (Next); - -- Return the current vertex referenced by iterator Iter and advance - -- to the next available vertex. - - -- The following type represents an iterator over all components of a - -- library graph. - - type Component_Iterator is private; - - function Has_Next (Iter : Component_Iterator) return Boolean; - pragma Inline (Has_Next); - -- Determine whether iterator Iter has more components to examine - - function Iterate_Components - (G : Library_Graph) return Component_Iterator; - pragma Inline (Iterate_Components); - -- Obtain an iterator over all components of library graph G - - procedure Next - (Iter : in out Component_Iterator; - Comp : out Component_Id); - pragma Inline (Next); - -- Return the current component referenced by iterator Iter and advance - -- to the next available component. - - -- The following type represents an iterator over all vertices of a - -- component. - - type Component_Vertex_Iterator is private; - - function Has_Next (Iter : Component_Vertex_Iterator) return Boolean; - pragma Inline (Has_Next); - -- Determine whether iterator Iter has more vertices to examine - - function Iterate_Component_Vertices - (G : Library_Graph; - Comp : Component_Id) return Component_Vertex_Iterator; - pragma Inline (Iterate_Component_Vertices); - -- Obtain an iterator over all vertices of component Comp of library - -- graph G. - - procedure Next - (Iter : in out Component_Vertex_Iterator; - Vertex : out Library_Graph_Vertex_Id); + Vertex : out Invocation_Graph_Vertex_Id); pragma Inline (Next); -- Return the current vertex referenced by iterator Iter and advance -- to the next available vertex. - -- The following type represents an iterator over all edges that form a - -- cycle. + -- The following type represents an iterator over all edges that reach + -- targets starting from a particular source vertex. - type Edges_Of_Cycle_Iterator is private; + type Edges_To_Targets_Iterator is private; - function Has_Next (Iter : Edges_Of_Cycle_Iterator) return Boolean; + function Has_Next (Iter : Edges_To_Targets_Iterator) return Boolean; pragma Inline (Has_Next); -- Determine whether iterator Iter has more edges to examine - function Iterate_Edges_Of_Cycle - (G : Library_Graph; - Cycle : Library_Graph_Cycle_Id) return Edges_Of_Cycle_Iterator; - pragma Inline (Iterate_Edges_Of_Cycle); - -- Obtain an iterator over all edges that form cycle Cycle of library - -- graph G. + function Iterate_Edges_To_Targets + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Edges_To_Targets_Iterator; + pragma Inline (Iterate_Edges_To_Targets); + -- Obtain an iterator over all edges to targets with source vertex + -- Vertex of invocation graph G. procedure Next - (Iter : in out Edges_Of_Cycle_Iterator; - Edge : out Library_Graph_Edge_Id); + (Iter : in out Edges_To_Targets_Iterator; + Edge : out Invocation_Graph_Edge_Id); pragma Inline (Next); -- Return the current edge referenced by iterator Iter and advance to -- the next available edge. - -- The following type represents an iterator over all edges that reach - -- successors starting from a particular predecessor vertex. + -- The following type represents an iterator over all vertices of an + -- invocation graph that denote the elaboration procedure or a spec or + -- a body, referred to as elaboration root. - type Edges_To_Successors_Iterator is private; + type Elaboration_Root_Iterator is private; - function Has_Next (Iter : Edges_To_Successors_Iterator) return Boolean; + function Has_Next (Iter : Elaboration_Root_Iterator) return Boolean; pragma Inline (Has_Next); - -- Determine whether iterator Iter has more edges to examine + -- Determine whether iterator Iter has more elaboration roots to examine - function Iterate_Edges_To_Successors - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Edges_To_Successors_Iterator; - pragma Inline (Iterate_Edges_To_Successors); - -- Obtain an iterator over all edges to successors with predecessor - -- vertex Vertex of library graph G. + function Iterate_Elaboration_Roots + (G : Invocation_Graph) return Elaboration_Root_Iterator; + pragma Inline (Iterate_Elaboration_Roots); + -- Obtain an iterator over all elaboration roots of invocation graph G procedure Next - (Iter : in out Edges_To_Successors_Iterator; - Edge : out Library_Graph_Edge_Id); + (Iter : in out Elaboration_Root_Iterator; + Root : out Invocation_Graph_Vertex_Id); pragma Inline (Next); - -- Return the current edge referenced by iterator Iter and advance to - -- the next available edge. - - private - - -------------- - -- Vertices -- - -------------- - - -- The following type represents the attributes of a library graph - -- vertex. - - type Library_Graph_Vertex_Attributes is record - Corresponding_Item : Library_Graph_Vertex_Id := - No_Library_Graph_Vertex; - -- The reference to the corresponding spec or body. This attribute is - -- set as follows: - -- - -- * If predicate Is_Body_With_Spec is True, the reference denotes - -- the corresponding spec. - -- - -- * If predicate Is_Spec_With_Body is True, the reference denotes - -- the corresponding body. - -- - -- * Otherwise the attribute remains empty. - - In_Elaboration_Order : Boolean := False; - -- Set when this vertex is elaborated - - Pending_Strong_Predecessors : Natural := 0; - -- The number of pending strong predecessor vertices this vertex must - -- wait on before it can be elaborated. - - Pending_Weak_Predecessors : Natural := 0; - -- The number of weak predecessor vertices this vertex must wait on - -- before it can be elaborated. - - Unit : Unit_Id := No_Unit_Id; - -- The reference to unit this vertex represents - end record; - - No_Library_Graph_Vertex_Attributes : - constant Library_Graph_Vertex_Attributes := - (Corresponding_Item => No_Library_Graph_Vertex, - In_Elaboration_Order => False, - Pending_Strong_Predecessors => 0, - Pending_Weak_Predecessors => 0, - Unit => No_Unit_Id); - - procedure Destroy_Library_Graph_Vertex_Attributes - (Attrs : in out Library_Graph_Vertex_Attributes); - pragma Inline (Destroy_Library_Graph_Vertex_Attributes); - -- Destroy the contents of attributes Attrs - - package LGV_Tables is new Dynamic_Hash_Tables - (Key_Type => Library_Graph_Vertex_Id, - Value_Type => Library_Graph_Vertex_Attributes, - No_Value => No_Library_Graph_Vertex_Attributes, - Expansion_Threshold => 1.5, - Expansion_Factor => 2, - Compression_Threshold => 0.3, - Compression_Factor => 2, - "=" => "=", - Destroy_Value => Destroy_Library_Graph_Vertex_Attributes, - Hash => Hash_Library_Graph_Vertex); - - ----------- - -- Edges -- - ----------- - - -- The following type represents the attributes of a library graph edge - - type Library_Graph_Edge_Attributes is record - Activates_Task : Boolean := False; - -- Set for an invocation edge, where at least one of the paths the - -- edge represents activates a task. - - Kind : Library_Graph_Edge_Kind := No_Edge; - -- The nature of the library graph edge - end record; - - No_Library_Graph_Edge_Attributes : - constant Library_Graph_Edge_Attributes := - (Activates_Task => False, - Kind => No_Edge); - - procedure Destroy_Library_Graph_Edge_Attributes - (Attrs : in out Library_Graph_Edge_Attributes); - pragma Inline (Destroy_Library_Graph_Edge_Attributes); - -- Destroy the contents of attributes Attrs - - package LGE_Tables is new Dynamic_Hash_Tables - (Key_Type => Library_Graph_Edge_Id, - Value_Type => Library_Graph_Edge_Attributes, - No_Value => No_Library_Graph_Edge_Attributes, - Expansion_Threshold => 1.5, - Expansion_Factor => 2, - Compression_Threshold => 0.3, - Compression_Factor => 2, - "=" => "=", - Destroy_Value => Destroy_Library_Graph_Edge_Attributes, - Hash => Hash_Library_Graph_Edge); + -- Return the current elaboration root referenced by iterator Iter and + -- advance to the next available elaboration root. - ---------------- - -- Components -- - ---------------- + private - -- The following type represents the attributes of a component + -------------- + -- Vertices -- + -------------- - type Component_Attributes is record - Pending_Strong_Predecessors : Natural := 0; - -- The number of pending strong predecessor components this component - -- must wait on before it can be elaborated. + procedure Destroy_Invocation_Graph_Vertex + (Vertex : in out Invocation_Graph_Vertex_Id); + pragma Inline (Destroy_Invocation_Graph_Vertex); + -- Destroy invocation graph vertex Vertex - Pending_Weak_Predecessors : Natural := 0; - -- The number of pending weak predecessor components this component - -- must wait on before it can be elaborated. + -- The following type represents the attributes of an invocation graph + -- vertex. + + type Invocation_Graph_Vertex_Attributes is record + Body_Vertex : Library_Graph_Vertex_Id := No_Library_Graph_Vertex; + -- Reference to the library graph vertex where the body of this + -- vertex resides. + + Construct : Invocation_Construct_Id := No_Invocation_Construct; + -- Reference to the invocation construct this vertex represents + + Spec_Vertex : Library_Graph_Vertex_Id := No_Library_Graph_Vertex; + -- Reference to the library graph vertex where the spec of this + -- vertex resides. end record; - No_Component_Attributes : constant Component_Attributes := - (Pending_Strong_Predecessors => 0, - Pending_Weak_Predecessors => 0); + No_Invocation_Graph_Vertex_Attributes : + constant Invocation_Graph_Vertex_Attributes := + (Body_Vertex => No_Library_Graph_Vertex, + Construct => No_Invocation_Construct, + Spec_Vertex => No_Library_Graph_Vertex); - procedure Destroy_Component_Attributes - (Attrs : in out Component_Attributes); - pragma Inline (Destroy_Component_Attributes); + procedure Destroy_Invocation_Graph_Vertex_Attributes + (Attrs : in out Invocation_Graph_Vertex_Attributes); + pragma Inline (Destroy_Invocation_Graph_Vertex_Attributes); -- Destroy the contents of attributes Attrs - package Component_Tables is new Dynamic_Hash_Tables - (Key_Type => Component_Id, - Value_Type => Component_Attributes, - No_Value => No_Component_Attributes, + package IGV_Tables is new Dynamic_Hash_Tables + (Key_Type => Invocation_Graph_Vertex_Id, + Value_Type => Invocation_Graph_Vertex_Attributes, + No_Value => No_Invocation_Graph_Vertex_Attributes, Expansion_Threshold => 1.5, Expansion_Factor => 2, Compression_Threshold => 0.3, Compression_Factor => 2, "=" => "=", - Destroy_Value => Destroy_Component_Attributes, - Hash => Hash_Component); - - ------------ - -- Cycles -- - ------------ + Destroy_Value => Destroy_Invocation_Graph_Vertex_Attributes, + Hash => Hash_Invocation_Graph_Vertex); - -- The following type represents the attributes of a cycle + ----------- + -- Edges -- + ----------- - type Library_Graph_Cycle_Attributes is record - Invocation_Edge_Count : Natural := 0; - -- The number of invocation edges within the cycle + procedure Destroy_Invocation_Graph_Edge + (Edge : in out Invocation_Graph_Edge_Id); + pragma Inline (Destroy_Invocation_Graph_Edge); + -- Destroy invocation graph edge Edge - Kind : Library_Graph_Cycle_Kind := No_Cycle_Kind; - -- The nature of the cycle + -- The following type represents the attributes of an invocation graph + -- edge. - Path : LGE_Lists.Doubly_Linked_List := LGE_Lists.Nil; - -- The path of edges that form the cycle + type Invocation_Graph_Edge_Attributes is record + Relation : Invocation_Relation_Id := No_Invocation_Relation; + -- Reference to the invocation relation this edge represents end record; - No_Library_Graph_Cycle_Attributes : - constant Library_Graph_Cycle_Attributes := - (Invocation_Edge_Count => 0, - Kind => No_Cycle_Kind, - Path => LGE_Lists.Nil); + No_Invocation_Graph_Edge_Attributes : + constant Invocation_Graph_Edge_Attributes := + (Relation => No_Invocation_Relation); - procedure Destroy_Library_Graph_Cycle_Attributes - (Attrs : in out Library_Graph_Cycle_Attributes); - pragma Inline (Destroy_Library_Graph_Cycle_Attributes); + procedure Destroy_Invocation_Graph_Edge_Attributes + (Attrs : in out Invocation_Graph_Edge_Attributes); + pragma Inline (Destroy_Invocation_Graph_Edge_Attributes); -- Destroy the contents of attributes Attrs - function Hash_Library_Graph_Cycle_Attributes - (Attrs : Library_Graph_Cycle_Attributes) return Bucket_Range_Type; - pragma Inline (Hash_Library_Graph_Cycle_Attributes); - -- Obtain the hash of key Attrs - - function Same_Library_Graph_Cycle_Attributes - (Left : Library_Graph_Cycle_Attributes; - Right : Library_Graph_Cycle_Attributes) return Boolean; - pragma Inline (Same_Library_Graph_Cycle_Attributes); - -- Determine whether cycle attributes Left and Right are the same - - package LGC_Tables is new Dynamic_Hash_Tables - (Key_Type => Library_Graph_Cycle_Id, - Value_Type => Library_Graph_Cycle_Attributes, - No_Value => No_Library_Graph_Cycle_Attributes, + package IGE_Tables is new Dynamic_Hash_Tables + (Key_Type => Invocation_Graph_Edge_Id, + Value_Type => Invocation_Graph_Edge_Attributes, + No_Value => No_Invocation_Graph_Edge_Attributes, Expansion_Threshold => 1.5, Expansion_Factor => 2, Compression_Threshold => 0.3, Compression_Factor => 2, "=" => "=", - Destroy_Value => Destroy_Library_Graph_Cycle_Attributes, - Hash => Hash_Library_Graph_Cycle); + Destroy_Value => Destroy_Invocation_Graph_Edge_Attributes, + Hash => Hash_Invocation_Graph_Edge); - -------------------- - -- Recorded edges -- - -------------------- + --------------- + -- Relations -- + --------------- - -- The following type represents a relation between a predecessor and - -- successor vertices. + -- The following type represents a relation between a source and target + -- vertices. - type Predecessor_Successor_Relation is record - Predecessor : Library_Graph_Vertex_Id := No_Library_Graph_Vertex; + type Source_Target_Relation is record + Source : Invocation_Graph_Vertex_Id := No_Invocation_Graph_Vertex; -- The source vertex - Successor : Library_Graph_Vertex_Id := No_Library_Graph_Vertex; + Target : Invocation_Graph_Vertex_Id := No_Invocation_Graph_Vertex; -- The destination vertex end record; - No_Predecessor_Successor_Relation : - constant Predecessor_Successor_Relation := - (Predecessor => No_Library_Graph_Vertex, - Successor => No_Library_Graph_Vertex); + No_Source_Target_Relation : + constant Source_Target_Relation := + (Source => No_Invocation_Graph_Vertex, + Target => No_Invocation_Graph_Vertex); - function Hash_Predecessor_Successor_Relation - (Rel : Predecessor_Successor_Relation) return Bucket_Range_Type; - pragma Inline (Hash_Predecessor_Successor_Relation); + function Hash_Source_Target_Relation + (Rel : Source_Target_Relation) return Bucket_Range_Type; + pragma Inline (Hash_Source_Target_Relation); -- Obtain the hash value of key Rel - package RE_Sets is new Membership_Sets - (Element_Type => Predecessor_Successor_Relation, + package Relation_Sets is new Membership_Sets + (Element_Type => Source_Target_Relation, "=" => "=", - Hash => Hash_Predecessor_Successor_Relation); + Hash => Hash_Source_Target_Relation); ---------------- -- Statistics -- ---------------- - type Library_Graph_Edge_Counts is - array (Library_Graph_Edge_Kind) of Natural; + type Invocation_Graph_Edge_Counts is array (Invocation_Kind) of Natural; - ----------- - -- Units -- - ----------- + ---------------- + -- Signatures -- + ---------------- - package Unit_Tables is new Dynamic_Hash_Tables - (Key_Type => Unit_Id, - Value_Type => Library_Graph_Vertex_Id, - No_Value => No_Library_Graph_Vertex, + function Hash_Invocation_Signature + (IS_Id : Invocation_Signature_Id) return Bucket_Range_Type; + pragma Inline (Hash_Invocation_Signature); + -- Obtain the hash value of key IS_Id + + package Signature_Tables is new Dynamic_Hash_Tables + (Key_Type => Invocation_Signature_Id, + Value_Type => Invocation_Graph_Vertex_Id, + No_Value => No_Invocation_Graph_Vertex, Expansion_Threshold => 1.5, Expansion_Factor => 2, Compression_Threshold => 0.3, Compression_Factor => 2, "=" => "=", - Destroy_Value => Destroy_Library_Graph_Vertex, - Hash => Hash_Unit); + Destroy_Value => Destroy_Invocation_Graph_Vertex, + Hash => Hash_Invocation_Signature); + + ----------------------- + -- Elaboration roots -- + ----------------------- + + package IGV_Sets is new Membership_Sets + (Element_Type => Invocation_Graph_Vertex_Id, + "=" => "=", + Hash => Hash_Invocation_Graph_Vertex); ----------- -- Graph -- ----------- package DG is new Directed_Graphs - (Vertex_Id => Library_Graph_Vertex_Id, - No_Vertex => No_Library_Graph_Vertex, - Hash_Vertex => Hash_Library_Graph_Vertex, + (Vertex_Id => Invocation_Graph_Vertex_Id, + No_Vertex => No_Invocation_Graph_Vertex, + Hash_Vertex => Hash_Invocation_Graph_Vertex, Same_Vertex => "=", - Edge_Id => Library_Graph_Edge_Id, - No_Edge => No_Library_Graph_Edge, - Hash_Edge => Hash_Library_Graph_Edge, + Edge_id => Invocation_Graph_Edge_Id, + No_Edge => No_Invocation_Graph_Edge, + Hash_Edge => Hash_Invocation_Graph_Edge, Same_Edge => "="); - -- The following type represents the attributes of a library graph - - type Library_Graph_Attributes is record - Component_Attributes : Component_Tables.Dynamic_Hash_Table := - Component_Tables.Nil; - -- The map of component -> component attributes for all components in - -- the graph. + -- The following type represents the attributes of an invocation graph - Counts : Library_Graph_Edge_Counts := (others => 0); + type Invocation_Graph_Attributes is record + Counts : Invocation_Graph_Edge_Counts := (others => 0); -- Edge statistics - Cycle_Attributes : LGC_Tables.Dynamic_Hash_Table := LGC_Tables.Nil; - -- The map of cycle -> cycle attributes for all cycles in the graph - - Cycles : LGC_Lists.Doubly_Linked_List := LGC_Lists.Nil; - -- The list of all cycles in the graph, sorted based on precedence - - Edge_Attributes : LGE_Tables.Dynamic_Hash_Table := LGE_Tables.Nil; + Edge_Attributes : IGE_Tables.Dynamic_Hash_Table := IGE_Tables.Nil; -- The map of edge -> edge attributes for all edges in the graph Graph : DG.Directed_Graph := DG.Nil; -- The underlying graph describing the relations between edges and -- vertices. - Recorded_Edges : RE_Sets.Membership_Set := RE_Sets.Nil; - -- The set of recorded edges, used to prevent duplicate edges in the - -- graph. + Relations : Relation_Sets.Membership_Set := Relation_Sets.Nil; + -- The set of relations between source and targets, used to prevent + -- duplicate edges in the graph. - Unit_To_Vertex : Unit_Tables.Dynamic_Hash_Table := Unit_Tables.Nil; - -- The map of unit -> vertex + Roots : IGV_Sets.Membership_Set := IGV_Sets.Nil; + -- The set of elaboration root vertices - Vertex_Attributes : LGV_Tables.Dynamic_Hash_Table := LGV_Tables.Nil; + Signature_To_Vertex : Signature_Tables.Dynamic_Hash_Table := + Signature_Tables.Nil; + -- The map of signature -> vertex + + Vertex_Attributes : IGV_Tables.Dynamic_Hash_Table := IGV_Tables.Nil; -- The map of vertex -> vertex attributes for all vertices in the -- graph. + + Lib_Graph : Library_Graphs.Library_Graph; end record; - type Library_Graph is access Library_Graph_Attributes; - Nil : constant Library_Graph := null; + type Invocation_Graph is access Invocation_Graph_Attributes; + Nil : constant Invocation_Graph := null; --------------- -- Iterators -- --------------- - type All_Cycle_Iterator is new LGC_Lists.Iterator; - type All_Edge_Iterator is new DG.All_Edge_Iterator; - type All_Vertex_Iterator is new DG.All_Vertex_Iterator; - type Component_Iterator is new DG.Component_Iterator; - type Component_Vertex_Iterator is new DG.Component_Vertex_Iterator; - type Edges_Of_Cycle_Iterator is new LGE_Lists.Iterator; - type Edges_To_Successors_Iterator is new DG.Outgoing_Edge_Iterator; - end Library_Graphs; + type All_Edge_Iterator is new DG.All_Edge_Iterator; + type All_Vertex_Iterator is new DG.All_Vertex_Iterator; + type Edges_To_Targets_Iterator is new DG.Outgoing_Edge_Iterator; + type Elaboration_Root_Iterator is new IGV_Sets.Iterator; + end Invocation_Graphs; end Bindo.Graphs; diff --git a/gcc/ada/bindo-writers.adb b/gcc/ada/bindo-writers.adb index b2656b3bff1..298118e834c 100644 --- a/gcc/ada/bindo-writers.adb +++ b/gcc/ada/bindo-writers.adb @@ -927,6 +927,10 @@ package body Bindo.Writers is (G : Invocation_Graph; Vertex : Invocation_Graph_Vertex_Id) is + Lib_Graph : constant Library_Graph := Get_Lib_Graph (G); + + B : constant Library_Graph_Vertex_Id := Body_Vertex (G, Vertex); + S : constant Library_Graph_Vertex_Id := Spec_Vertex (G, Vertex); begin pragma Assert (Present (G)); pragma Assert (Present (Vertex)); @@ -938,8 +942,9 @@ package body Bindo.Writers is Write_Eol; Write_Str (" Body_Vertex (LGV_Id_"); - Write_Int (Int (Body_Vertex (G, Vertex))); - Write_Str (")"); + Write_Int (Int (B)); + Write_Str (") name = "); + Write_Name (Name (Lib_Graph, B)); Write_Eol; Write_Str (" Construct (IC_Id_"); @@ -948,8 +953,9 @@ package body Bindo.Writers is Write_Eol; Write_Str (" Spec_Vertex (LGV_Id_"); - Write_Int (Int (Spec_Vertex (G, Vertex))); - Write_Str (")"); + Write_Int (Int (S)); + Write_Str (") name = "); + Write_Name (Name (Lib_Graph, S)); Write_Eol; Write_Invocation_Graph_Edges (G, Vertex);