Mercurial > hg > CbC > CbC_gcc
diff gcc/ada/bindo-graphs.adb @ 145:1830386684a0
gcc-9.2.0
| author | anatofuz |
|---|---|
| date | Thu, 13 Feb 2020 11:34:05 +0900 |
| parents | |
| children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/gcc/ada/bindo-graphs.adb Thu Feb 13 11:34:05 2020 +0900 @@ -0,0 +1,5714 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- B I N D O . G R A P H S -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2019, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING3. If not, go to -- +-- http://www.gnu.org/licenses for a complete copy of the license. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +with Ada.Unchecked_Deallocation; + +with Butil; use Butil; +with Debug; use Debug; +with Output; use Output; + +with Bindo.Writers; +use Bindo.Writers; +use Bindo.Writers.Phase_Writers; + +package body Bindo.Graphs is + + ----------------------- + -- Local subprograms -- + ----------------------- + + function Sequence_Next_Cycle return Library_Graph_Cycle_Id; + pragma Inline (Sequence_Next_Cycle); + -- Generate a new unique library graph cycle handle + + function Sequence_Next_Edge return Invocation_Graph_Edge_Id; + pragma Inline (Sequence_Next_Edge); + -- Generate a new unique invocation graph edge handle + + function Sequence_Next_Edge return Library_Graph_Edge_Id; + pragma Inline (Sequence_Next_Edge); + -- Generate a new unique library graph edge handle + + function Sequence_Next_Vertex return Invocation_Graph_Vertex_Id; + pragma Inline (Sequence_Next_Vertex); + -- Generate a new unique invocation graph vertex handle + + function Sequence_Next_Vertex return Library_Graph_Vertex_Id; + pragma Inline (Sequence_Next_Vertex); + -- Generate a new unique library graph vertex handle + + ----------------------------------- + -- Destroy_Invocation_Graph_Edge -- + ----------------------------------- + + procedure Destroy_Invocation_Graph_Edge + (Edge : in out Invocation_Graph_Edge_Id) + is + pragma Unreferenced (Edge); + begin + null; + end Destroy_Invocation_Graph_Edge; + + --------------------------------- + -- Destroy_Library_Graph_Cycle -- + --------------------------------- + + procedure Destroy_Library_Graph_Cycle + (Cycle : in out Library_Graph_Cycle_Id) + is + pragma Unreferenced (Cycle); + begin + null; + end Destroy_Library_Graph_Cycle; + + -------------------------------- + -- Destroy_Library_Graph_Edge -- + -------------------------------- + + procedure Destroy_Library_Graph_Edge + (Edge : in out Library_Graph_Edge_Id) + is + pragma Unreferenced (Edge); + begin + null; + end Destroy_Library_Graph_Edge; + + ---------------------------------- + -- Destroy_Library_Graph_Vertex -- + ---------------------------------- + + procedure Destroy_Library_Graph_Vertex + (Vertex : in out Library_Graph_Vertex_Id) + is + pragma Unreferenced (Vertex); + begin + null; + end Destroy_Library_Graph_Vertex; + + -------------------------------- + -- Hash_Invocation_Graph_Edge -- + -------------------------------- + + function Hash_Invocation_Graph_Edge + (Edge : Invocation_Graph_Edge_Id) return Bucket_Range_Type + is + begin + pragma Assert (Present (Edge)); + + return Bucket_Range_Type (Edge); + end Hash_Invocation_Graph_Edge; + + ---------------------------------- + -- Hash_Invocation_Graph_Vertex -- + ---------------------------------- + + function Hash_Invocation_Graph_Vertex + (Vertex : Invocation_Graph_Vertex_Id) return Bucket_Range_Type + is + begin + pragma Assert (Present (Vertex)); + + return Bucket_Range_Type (Vertex); + end Hash_Invocation_Graph_Vertex; + + ------------------------------ + -- Hash_Library_Graph_Cycle -- + ------------------------------ + + function Hash_Library_Graph_Cycle + (Cycle : Library_Graph_Cycle_Id) return Bucket_Range_Type + is + begin + pragma Assert (Present (Cycle)); + + return Bucket_Range_Type (Cycle); + end Hash_Library_Graph_Cycle; + + ----------------------------- + -- Hash_Library_Graph_Edge -- + ----------------------------- + + function Hash_Library_Graph_Edge + (Edge : Library_Graph_Edge_Id) return Bucket_Range_Type + is + begin + pragma Assert (Present (Edge)); + + return Bucket_Range_Type (Edge); + end Hash_Library_Graph_Edge; + + ------------------------------- + -- Hash_Library_Graph_Vertex -- + ------------------------------- + + function Hash_Library_Graph_Vertex + (Vertex : Library_Graph_Vertex_Id) return Bucket_Range_Type + is + begin + pragma Assert (Present (Vertex)); + + return Bucket_Range_Type (Vertex); + end Hash_Library_Graph_Vertex; + + ----------------------- + -- Invocation_Graphs -- + ----------------------- + + package body Invocation_Graphs is + + ----------------------- + -- Local subprograms -- + ----------------------- + + procedure Free is + new Ada.Unchecked_Deallocation + (Invocation_Graph_Attributes, Invocation_Graph); + + 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 + + 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 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 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 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. + + 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 + + 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 + + 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. + + 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 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. + + -------------- + -- 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 (Source)); + pragma Assert (Present (Target)); + pragma Assert (Present (IR_Id)); + + Rel : constant Source_Target_Relation := + (Source => Source, + Target => Target); + + Edge : Invocation_Graph_Edge_Id; + + begin + -- Nothing to do when the source and target are already related by an + -- edge. + + if Is_Existing_Source_Target_Relation (G, Rel) then + return; + end if; + + Edge := Sequence_Next_Edge; + + -- Add the edge to the underlying graph + + DG.Add_Edge + (G => G.Graph, + E => Edge, + Source => Source, + Destination => Target); + + -- Build and save the attributes of the edge + + Set_IGE_Attributes + (G => G, + Edge => Edge, + Val => (Relation => IR_Id)); + + -- Mark the source and target as related by the new edge. This + -- prevents all further attempts to link the same source and target. + + Set_Is_Existing_Source_Target_Relation (G, Rel); + + -- Update the edge statistics + + 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 + -- Nothing to do when the construct already has a vertex + + if Present (Corresponding_Vertex (G, Construct_Signature)) then + return; + end if; + + Vertex := Sequence_Next_Vertex; + + -- Add the vertex to the underlying graph + + DG.Add_Vertex (G.Graph, Vertex); + + -- Build and save the attributes of the vertex + + Set_IGV_Attributes + (G => G, + Vertex => Vertex, + Val => (Body_Vertex => Body_Vertex, + Construct => IC_Id, + Spec_Vertex => Spec_Vertex)); + + -- Associate the construct with its corresponding vertex + + Set_Corresponding_Vertex (G, Construct_Signature, Vertex); + + -- Save the vertex for later processing when it denotes a spec or + -- body elaboration procedure. + + if Is_Elaboration_Root (G, Vertex) then + Save_Elaboration_Root (G, Vertex); + end if; + end Add_Vertex; + + ----------------- + -- 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)); + + return Get_IGV_Attributes (G, Vertex).Body_Vertex; + end Body_Vertex; + + ------------ + -- Column -- + ------------ + + function Column + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Nat + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + return Column (Signature (Construct (G, Vertex))); + end Column; + + --------------- + -- Construct -- + --------------- + + function Construct + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Invocation_Construct_Id + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + return Get_IGV_Attributes (G, Vertex).Construct; + end Construct; + + -------------------------- + -- Corresponding_Vertex -- + -------------------------- + + 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)); + + return Signature_Tables.Get (G.Signature_To_Vertex, IS_Id); + end Corresponding_Vertex; + + ------------ + -- Create -- + ------------ + + function Create + (Initial_Vertices : Positive; + Initial_Edges : Positive) return Invocation_Graph + is + G : constant Invocation_Graph := new Invocation_Graph_Attributes; + + 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); + + return G; + end Create; + + ------------- + -- Destroy -- + ------------- + + procedure Destroy (G : in out Invocation_Graph) is + begin + pragma Assert (Present (G)); + + 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); + + Free (G); + end Destroy; + + ----------------------------------- + -- Destroy_Invocation_Graph_Edge -- + ----------------------------------- + + procedure Destroy_Invocation_Graph_Edge + (Edge : in out Invocation_Graph_Edge_Id) + is + pragma Unreferenced (Edge); + begin + null; + end Destroy_Invocation_Graph_Edge; + + ---------------------------------------------- + -- Destroy_Invocation_Graph_Edge_Attributes -- + ---------------------------------------------- + + 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; + + ------------------------------------- + -- Destroy_Invocation_Graph_Vertex -- + ------------------------------------- + + procedure Destroy_Invocation_Graph_Vertex + (Vertex : in out Invocation_Graph_Vertex_Id) + is + pragma Unreferenced (Vertex); + begin + null; + end Destroy_Invocation_Graph_Vertex; + + ------------------------------------------------ + -- Destroy_Invocation_Graph_Vertex_Attributes -- + ------------------------------------------------ + + 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; + + ----------- + -- Extra -- + ----------- + + function Extra + (G : Invocation_Graph; + Edge : Invocation_Graph_Edge_Id) return Name_Id + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); + + return Extra (Relation (G, Edge)); + end Extra; + + ------------------------ + -- 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 (Edge)); + + return IGE_Tables.Get (G.Edge_Attributes, Edge); + end Get_IGE_Attributes; + + ------------------------ + -- Get_IGV_Attributes -- + ------------------------ + + 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)); + + return IGV_Tables.Get (G.Vertex_Attributes, Vertex); + end Get_IGV_Attributes; + + -------------- + -- 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; + + -------------- + -- Has_Next -- + -------------- + + function Has_Next (Iter : All_Vertex_Iterator) return Boolean is + begin + return DG.Has_Next (DG.All_Vertex_Iterator (Iter)); + end Has_Next; + + -------------- + -- Has_Next -- + -------------- + + function Has_Next (Iter : Edges_To_Targets_Iterator) return Boolean is + begin + return DG.Has_Next (DG.Outgoing_Edge_Iterator (Iter)); + end Has_Next; + + -------------- + -- Has_Next -- + -------------- + + function Has_Next (Iter : Elaboration_Root_Iterator) return Boolean is + begin + return IGV_Sets.Has_Next (IGV_Sets.Iterator (Iter)); + end Has_Next; + + ------------------------------- + -- Hash_Invocation_Signature -- + ------------------------------- + + function Hash_Invocation_Signature + (IS_Id : Invocation_Signature_Id) return Bucket_Range_Type + is + begin + pragma Assert (Present (IS_Id)); + + return Bucket_Range_Type (IS_Id); + end Hash_Invocation_Signature; + + --------------------------------- + -- Hash_Source_Target_Relation -- + --------------------------------- + + 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)); + + Count : Natural renames G.Counts (Kind); + + begin + Count := Count + 1; + end Increment_Invocation_Graph_Edge_Count; + + --------------------------------- + -- Invocation_Graph_Edge_Count -- + --------------------------------- + + function Invocation_Graph_Edge_Count + (G : Invocation_Graph; + Kind : Invocation_Kind) return Natural + is + begin + pragma Assert (Present (G)); + + return G.Counts (Kind); + end Invocation_Graph_Edge_Count; + + ------------------------- + -- Is_Elaboration_Root -- + ------------------------- + + function Is_Elaboration_Root + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Boolean + is + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + Vertex_Kind : constant Invocation_Construct_Kind := + Kind (Construct (G, Vertex)); + + begin + return + Vertex_Kind = Elaborate_Body_Procedure + or else + Vertex_Kind = Elaborate_Spec_Procedure; + end Is_Elaboration_Root; + + ---------------------------------------- + -- 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)); + + return Relation_Sets.Contains (G.Relations, Rel); + end Is_Existing_Source_Target_Relation; + + ----------------------- + -- Iterate_All_Edges -- + ----------------------- + + function Iterate_All_Edges + (G : Invocation_Graph) return All_Edge_Iterator + is + begin + pragma Assert (Present (G)); + + return All_Edge_Iterator (DG.Iterate_All_Edges (G.Graph)); + end Iterate_All_Edges; + + -------------------------- + -- Iterate_All_Vertices -- + -------------------------- + + function Iterate_All_Vertices + (G : Invocation_Graph) return All_Vertex_Iterator + is + begin + pragma Assert (Present (G)); + + return All_Vertex_Iterator (DG.Iterate_All_Vertices (G.Graph)); + end Iterate_All_Vertices; + + ------------------------------ + -- Iterate_Edges_To_Targets -- + ------------------------------ + + 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)); + + return + Edges_To_Targets_Iterator + (DG.Iterate_Outgoing_Edges (G.Graph, Vertex)); + end Iterate_Edges_To_Targets; + + ------------------------------- + -- Iterate_Elaboration_Roots -- + ------------------------------- + + function Iterate_Elaboration_Roots + (G : Invocation_Graph) return Elaboration_Root_Iterator + is + begin + pragma Assert (Present (G)); + + return Elaboration_Root_Iterator (IGV_Sets.Iterate (G.Roots)); + end Iterate_Elaboration_Roots; + + ---------- + -- Kind -- + ---------- + + function Kind + (G : Invocation_Graph; + Edge : Invocation_Graph_Edge_Id) return Invocation_Kind + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); + + return Kind (Relation (G, Edge)); + end Kind; + + ---------- + -- Line -- + ---------- + + function Line + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Nat + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + return Line (Signature (Construct (G, Vertex))); + end Line; + + ---------- + -- Name -- + ---------- + + function Name + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id) return Name_Id + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + return Name (Signature (Construct (G, Vertex))); + end Name; + + ---------- + -- Next -- + ---------- + + 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; + + ---------- + -- Next -- + ---------- + + procedure Next + (Iter : in out All_Vertex_Iterator; + Vertex : out Invocation_Graph_Vertex_Id) + is + begin + DG.Next (DG.All_Vertex_Iterator (Iter), Vertex); + end Next; + + ---------- + -- Next -- + ---------- + + 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; + + ---------- + -- Next -- + ---------- + + 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; + + --------------------- + -- Number_Of_Edges -- + --------------------- + + function Number_Of_Edges (G : Invocation_Graph) return Natural is + begin + pragma Assert (Present (G)); + + return DG.Number_Of_Edges (G.Graph); + end Number_Of_Edges; + + -------------------------------- + -- Number_Of_Edges_To_Targets -- + -------------------------------- + + 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)); + + return DG.Number_Of_Outgoing_Edges (G.Graph, Vertex); + end Number_Of_Edges_To_Targets; + + --------------------------------- + -- Number_Of_Elaboration_Roots -- + --------------------------------- + + function Number_Of_Elaboration_Roots + (G : Invocation_Graph) return Natural + is + begin + pragma Assert (Present (G)); + + return IGV_Sets.Size (G.Roots); + end Number_Of_Elaboration_Roots; + + ------------------------ + -- Number_Of_Vertices -- + ------------------------ + + function Number_Of_Vertices (G : Invocation_Graph) return Natural is + begin + pragma Assert (Present (G)); + + return DG.Number_Of_Vertices (G.Graph); + end Number_Of_Vertices; + + ------------- + -- Present -- + ------------- + + function Present (G : Invocation_Graph) return Boolean is + begin + return G /= Nil; + end Present; + + -------------- + -- Relation -- + -------------- + + function Relation + (G : Invocation_Graph; + Edge : Invocation_Graph_Edge_Id) return Invocation_Relation_Id + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); + + return Get_IGE_Attributes (G, Edge).Relation; + end Relation; + + --------------------------- + -- Save_Elaboration_Root -- + --------------------------- + + procedure Save_Elaboration_Root + (G : Invocation_Graph; + Root : Invocation_Graph_Vertex_Id) + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Root)); + + IGV_Sets.Insert (G.Roots, Root); + end Save_Elaboration_Root; + + ------------------------------ + -- 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)); + + Signature_Tables.Put (G.Signature_To_Vertex, IS_Id, Vertex); + end Set_Corresponding_Vertex; + + -------------------------------------------- + -- Set_Is_Existing_Source_Target_Relation -- + -------------------------------------------- + + 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)); + + 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)); + + IGE_Tables.Put (G.Edge_Attributes, Edge, Val); + end Set_IGE_Attributes; + + ------------------------ + -- Set_IGV_Attributes -- + ------------------------ + + procedure Set_IGV_Attributes + (G : Invocation_Graph; + Vertex : Invocation_Graph_Vertex_Id; + Val : Invocation_Graph_Vertex_Attributes) + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + IGV_Tables.Put (G.Vertex_Attributes, Vertex, Val); + end Set_IGV_Attributes; + + ----------------- + -- Spec_Vertex -- + ----------------- + + 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)); + + return Get_IGV_Attributes (G, Vertex).Spec_Vertex; + end Spec_Vertex; + + ------------ + -- Target -- + ------------ + + function Target + (G : Invocation_Graph; + Edge : Invocation_Graph_Edge_Id) return Invocation_Graph_Vertex_Id + 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. + + function Add_Edge_With_Return + (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_With_Return); + -- 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. + + 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. + + 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. + + 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. + + 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. + + 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. + + procedure Free is + new Ada.Unchecked_Deallocation + (Library_Graph_Attributes, Library_Graph); + + 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 + + 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 + + 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 + + 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 + + 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. + + 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. + + 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. + + 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. + + 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 + + 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. + + 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. + + 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. + + 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 + + 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 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. + + 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. + + 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. + + 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. + + 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. + + 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 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. + + 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 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. + + 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. + + 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. + + 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. + + 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. + + 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. + + 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. + + 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 + + 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 + + procedure Set_Is_Recorded_Edge + (G : Library_Graph; + Rel : Predecessor_Successor_Relation; + Val : Boolean := True); + pragma Inline (Set_Is_Recorded_Edge); + -- Mark a predecessor vertex and a successor vertex described by + -- relation Rel as already linked depending on value Val. + + 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 + + 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 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 + + 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. + + 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. + + 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 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. + + 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 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. + + 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 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. + + 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 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. + + -------------------- + -- Activates_Task -- + -------------------- + + function Activates_Task + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); + + return + Kind (G, Edge) = Invocation_Edge + and then Get_LGE_Attributes (G, Edge).Activates_Task; + end Activates_Task; + + ------------------------------- + -- Add_Body_Before_Spec_Edge -- + ------------------------------- + + procedure Add_Body_Before_Spec_Edge + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id; + Edges : LGE_Lists.Doubly_Linked_List) + is + Edge : Library_Graph_Edge_Id; + + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + pragma Assert (LGE_Lists.Present (Edges)); + + -- 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_With_Return will prevent the creation of the second edge. + + -- Assume that no Body_Before_Spec is necessary + + Edge := No_Library_Graph_Edge; + + -- A body that completes a previous spec + + if Is_Body_With_Spec (G, Vertex) then + Edge := + Add_Edge_With_Return + (G => G, + Pred => Vertex, + Succ => Corresponding_Item (G, Vertex), + Kind => Body_Before_Spec_Edge, + Activates_Task => False); + + -- A spec with a completing body + + elsif Is_Spec_With_Body (G, Vertex) then + Edge := + Add_Edge_With_Return + (G => G, + Pred => Corresponding_Item (G, Vertex), + Succ => Vertex, + Kind => Body_Before_Spec_Edge, + Activates_Task => False); + end if; + + if Present (Edge) then + LGE_Lists.Append (Edges, Edge); + end if; + end Add_Body_Before_Spec_Edge; + + -------------------------------- + -- Add_Body_Before_Spec_Edges -- + -------------------------------- + + procedure Add_Body_Before_Spec_Edges + (G : Library_Graph; + Edges : LGE_Lists.Doubly_Linked_List) + is + Iter : Elaborable_Units_Iterator; + U_Id : Unit_Id; + + begin + pragma Assert (Present (G)); + pragma Assert (LGE_Lists.Present (Edges)); + + Iter := Iterate_Elaborable_Units; + while Has_Next (Iter) loop + Next (Iter, U_Id); + + Add_Body_Before_Spec_Edge + (G => G, + Vertex => Corresponding_Vertex (G, U_Id), + Edges => Edges); + end loop; + end Add_Body_Before_Spec_Edges; + + -------------- + -- Add_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) + is + Edge : Library_Graph_Edge_Id; + pragma Unreferenced (Edge); + + begin + pragma Assert (Present (G)); + pragma Assert (Present (Pred)); + pragma Assert (Present (Succ)); + pragma Assert (Kind /= No_Edge); + pragma Assert (not Activates_Task or else Kind = Invocation_Edge); + + Edge := + Add_Edge_With_Return + (G => G, + Pred => Pred, + Succ => Succ, + Kind => Kind, + Activates_Task => Activates_Task); + end Add_Edge; + + -------------------------- + -- Add_Edge_With_Return -- + -------------------------- + + function Add_Edge_With_Return + (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 + pragma Assert (Present (G)); + pragma Assert (Present (Pred)); + pragma Assert (Present (Succ)); + pragma Assert (Kind /= No_Edge); + + Rel : constant Predecessor_Successor_Relation := + (Predecessor => Pred, + Successor => Succ); + + Edge : Library_Graph_Edge_Id; + + begin + -- Nothing to do when the predecessor and successor are already + -- related by an edge. + + if Is_Recorded_Edge (G, Rel) then + return No_Library_Graph_Edge; + end if; + + Edge := Sequence_Next_Edge; + + -- 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. + + DG.Add_Edge + (G => G.Graph, + E => Edge, + Source => Pred, + Destination => Succ); + + -- Construct and save the attributes of the edge + + Set_LGE_Attributes + (G => G, + Edge => Edge, + Val => + (Activates_Task => Activates_Task, + Kind => Kind)); + + -- Mark the predecessor and successor as related by the new edge. + -- This prevents all further attempts to link the same predecessor + -- and successor. + + Set_Is_Recorded_Edge (G, Rel); + + -- Update the number of pending predecessors the successor must wait + -- on before it is elaborated. + + Increment_Pending_Predecessors + (G => G, + Vertex => Succ, + Edge => Edge); + + -- Update the edge statistics + + Increment_Library_Graph_Edge_Count (G, Kind); + + return Edge; + end Add_Edge_With_Return; + + ---------------- + -- Add_Vertex -- + ---------------- + + procedure Add_Vertex + (G : Library_Graph; + U_Id : Unit_Id) + is + Vertex : Library_Graph_Vertex_Id; + + begin + pragma Assert (Present (G)); + pragma Assert (Present (U_Id)); + + -- Nothing to do when the unit already has a vertex + + if Present (Corresponding_Vertex (G, U_Id)) then + return; + end if; + + Vertex := Sequence_Next_Vertex; + + -- Add the vertex to the underlying graph + + DG.Add_Vertex (G.Graph, Vertex); + + -- Construct and save the attributes of the 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)); + + -- Associate the unit with its corresponding vertex + + Set_Corresponding_Vertex (G, U_Id, Vertex); + end Add_Vertex; + + --------------------------------- + -- At_Least_One_Edge_Satisfies -- + --------------------------------- + + 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); + + -- Assume that the predicate cannot be satisfied + + 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; + + 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 + + if Force_Complement then + Complement := Corresponding_Item (G, Vertex); + + -- 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 (Vertex)); + + return DG.Component (G.Graph, Vertex); + end Component; + + --------------------------------- + -- Contains_Elaborate_All_Edge -- + --------------------------------- + + 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)); + + return + At_Least_One_Edge_Satisfies + (G => G, + Cycle => Cycle, + Predicate => Is_Elaborate_All_Edge'Access); + end Contains_Elaborate_All_Edge; + + ------------------------------------ + -- Contains_Static_Successor_Edge -- + ------------------------------------ + + function Contains_Static_Successor_Edge + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Cycle)); + + return + At_Least_One_Edge_Satisfies + (G => G, + Cycle => Cycle, + Predicate => Is_Static_Successor_Edge'Access); + end Contains_Static_Successor_Edge; + + ------------------------------ + -- Contains_Task_Activation -- + ------------------------------ + + function Contains_Task_Activation + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Cycle)); + + return + At_Least_One_Edge_Satisfies + (G => G, + Cycle => Cycle, + Predicate => Activates_Task'Access); + end Contains_Task_Activation; + + --------------------- + -- Copy_Cycle_Path -- + --------------------- + + 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 (LGE_Lists.Present (Cycle_Path)); + + 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; + + ------------------------ + -- Corresponding_Item -- + ------------------------ + + 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)); + + return Get_LGV_Attributes (G, Vertex).Corresponding_Item; + end Corresponding_Item; + + -------------------------- + -- Corresponding_Vertex -- + -------------------------- + + 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)); + + return Unit_Tables.Get (G.Unit_To_Vertex, U_Id); + end Corresponding_Vertex; + + ------------ + -- Create -- + ------------ + + function Create + (Initial_Vertices : Positive; + Initial_Edges : Positive) return Library_Graph + is + G : constant Library_Graph := new Library_Graph_Attributes; + + 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); + + return G; + end Create; + + ------------------------ + -- Cycle_End_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; + + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + End_Vertices := LGV_Sets.Create (2); + + -- The input vertex always terminates a cycle path + + LGV_Sets.Insert (End_Vertices, Vertex); + + -- 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. + + 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); + + if Present (Complement) then + LGV_Sets.Insert (End_Vertices, Complement); + end if; + end if; + + return End_Vertices; + end Cycle_End_Vertices; + + ------------------- + -- Cycle_Kind_Of -- + ------------------- + + function Cycle_Kind_Of + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Library_Graph_Cycle_Kind + is + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); + + begin + if Is_Cyclic_Elaborate_All_Edge (G, Edge) then + return Elaborate_All_Cycle; + + elsif Is_Cyclic_Elaborate_Body_Edge (G, Edge) then + return Elaborate_Body_Cycle; + + elsif Is_Cyclic_Elaborate_Edge (G, Edge) then + return Elaborate_Cycle; + + elsif Is_Cyclic_Forced_Edge (G, Edge) then + return Forced_Cycle; + + elsif Is_Cyclic_Invocation_Edge (G, Edge) then + return Invocation_Cycle; + + else + return No_Cycle_Kind; + end if; + end Cycle_Kind_Of; + + --------------------------- + -- Cycle_Kind_Precedence -- + --------------------------- + + 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); + + begin + -- A lower ordinal indicates a higher precedence + + if Kind_Pos < Comp_Pos then + return Higher_Precedence; + + elsif Kind_Pos > Comp_Pos then + return Lower_Precedence; + + else + return Equal_Precedence; + end if; + end Cycle_Kind_Precedence; + + --------------------------- + -- Cycle_Path_Precedence -- + --------------------------- + + 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; + + if LGE_Lists.Has_Next (Iter) then + LGE_Lists.Next (Iter, Edge); + end if; + end Next_Available; + + -- Local variables + + 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; + + -- Start of processing for Cycle_Path_Precedence + + 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; + + Comp_Iter := LGE_Lists.Iterate (Compared_To); + Path_Iter := LGE_Lists.Iterate (Path); + + Next_Available (Comp_Iter, Comp_Edge); + Next_Available (Path_Iter, Path_Edge); + + -- IMPORTANT: + -- + -- * The iteration must run to completion in order to unlock the + -- edges of both paths. + + 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; + + Next_Available (Comp_Iter, Comp_Edge); + Next_Available (Path_Iter, Path_Edge); + end loop; + + return Prec; + end Cycle_Path_Precedence; + + ---------------------- + -- Cycle_Precedence -- + ---------------------- + + 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)); + + 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)); + + begin + -- Prefer a cycle with higher precedence based on its kind + + if Kind_Prec = Higher_Precedence + or else + Kind_Prec = Lower_Precedence + then + return Kind_Prec; + + -- Prefer a shorter cycle + + elsif Cycle_Len < Comp_Len then + return Higher_Precedence; + + elsif Cycle_Len > Comp_Len then + return Lower_Precedence; + + -- Prefer a cycle wih fewer invocation edges + + elsif Cycle_Invs < Comp_Invs then + return Higher_Precedence; + + elsif Cycle_Invs > Comp_Invs then + return Lower_Precedence; + + -- Prefer a cycle with a higher path precedence + + else + return + Cycle_Path_Precedence + (G => G, + Path => Path (G, Cycle), + Compared_To => Path (G, Compared_To)); + end if; + end Cycle_Precedence; + + ---------------------------------------- + -- Decrement_Library_Graph_Edge_Count -- + ---------------------------------------- + + procedure Decrement_Library_Graph_Edge_Count + (G : Library_Graph; + Kind : Library_Graph_Edge_Kind) + is + pragma Assert (Present (G)); + + Count : Natural renames G.Counts (Kind); + + begin + Count := Count - 1; + end Decrement_Library_Graph_Edge_Count; + + ------------------------------------ + -- Decrement_Pending_Predecessors -- + ------------------------------------ + + procedure Decrement_Pending_Predecessors + (G : Library_Graph; + Comp : Component_Id; + Edge : Library_Graph_Edge_Id) + is + Attrs : Component_Attributes; + + begin + pragma Assert (Present (G)); + pragma Assert (Present (Comp)); + + Attrs := Get_Component_Attributes (G, Comp); + + 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_Component_Attributes (G, Comp, Attrs); + end Decrement_Pending_Predecessors; + + ------------------------------------ + -- Decrement_Pending_Predecessors -- + ------------------------------------ + + procedure Decrement_Pending_Predecessors + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id; + Edge : Library_Graph_Edge_Id) + is + Attrs : Library_Graph_Vertex_Attributes; + + 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 -- + ----------------------------------- + + 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; + + begin + pragma Assert (Present (G)); + pragma Assert (LGE_Lists.Present (Edges)); + + 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); + + Delete_Edge (G, Edge); + end loop; + end Delete_Body_Before_Spec_Edges; + + ----------------- + -- Delete_Edge -- + ----------------- + + procedure Delete_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) + is + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); + + 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); + + 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. + + RE_Sets.Delete (G.Recorded_Edges, Rel); + + -- Delete the attributes of the edge + + 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)); + + 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; + + ---------------------------------- + -- Destroy_Component_Attributes -- + ---------------------------------- + + procedure Destroy_Component_Attributes + (Attrs : in out Component_Attributes) + is + pragma Unreferenced (Attrs); + begin + null; + end Destroy_Component_Attributes; + + -------------------------------------------- + -- Destroy_Library_Graph_Cycle_Attributes -- + -------------------------------------------- + + 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; + + ------------------------------------------- + -- Destroy_Library_Graph_Edge_Attributes -- + ------------------------------------------- + + 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; + + --------------------------------------------- + -- Destroy_Library_Graph_Vertex_Attributes -- + --------------------------------------------- + + 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; + + --------------------- + -- Edge_Precedence -- + --------------------- + + 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)); + + 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); + + 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; + + -- Prefer an edge whose successor has a higher precedence + + elsif Comp_Succ /= Edge_Succ + and then (Succ_Prec = Higher_Precedence + or else + Succ_Prec = Lower_Precedence) + then + return Succ_Prec; + + -- Prefer an edge whose predecessor has a higher precedence + + else + return + Vertex_Precedence + (G => G, + Vertex => Predecessor (G, Edge), + Compared_To => Predecessor (G, Compared_To)); + end if; + end Edge_Precedence; + + --------------- + -- File_Name -- + --------------- + + function File_Name + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return File_Name_Type + is + 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)); + + Start_Phase (Component_Discovery); + + -- Initialize or reinitialize the components of the graph + + Initialize_Components (G); + + -- 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. + + Edges := LGE_Lists.Create; + Add_Body_Before_Spec_Edges (G, Edges); + + DG.Find_Components (G.Graph); + + -- Remove the special edges that link a predecessor body with a + -- successor spec because they cause unresolvable circularities. + + Delete_Body_Before_Spec_Edges (G, Edges); + LGE_Lists.Destroy (Edges); + + -- Update the number of predecessors various components must wait on + -- before they can be elaborated. + + Update_Pending_Predecessors_Of_Components (G); + End_Phase (Component_Discovery); + end Find_Components; + + ----------------- + -- 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)); + + 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 + + Cycle_Count := 0; + + -- Run the modified version of the algorithm on each component of the + -- graph. + + Iter := Iterate_Components (G); + while Has_Next (Iter) loop + Next (Iter, Comp); + + Find_Cycles_In_Component + (G => G, + Comp => Comp, + Cycle_Count => Cycle_Count, + Cycle_Limit => All_Cycle_Limit); + end loop; + + End_Phase (Cycle_Discovery); + end Find_Cycles; + + -------------------------------- + -- Find_Cycles_From_Successor -- + -------------------------------- + + 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 + 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; + + begin + -- Assume that the successor reached via the edge does not result in + -- a cycle. + + Has_Cycle := False; + + -- Nothing to do when the edge connects two vertices residing in two + -- different components. + + if not Is_Cyclic_Edge (G, Edge) then + return; + end if; + + Trace_Edge (G, Edge, Indent); + + -- The modified version does not place vertices on the "point stack", + -- but instead collects the edges comprising the cycle. Prepare the + -- edge for backtracking. + + LGE_Lists.Prepend (Cycle_Path_Stack, 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); + + -- The modified version does not place vertices on the "point stack", + -- but instead collects the edges comprising the cycle. Backtrack the + -- edge. + + LGE_Lists.Delete_First (Cycle_Path_Stack); + end Find_Cycles_From_Successor; + + ----------------------------- + -- Find_Cycles_From_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; + + Complement : Library_Graph_Vertex_Id; + Edge : Library_Graph_Edge_Id; + Iter : Edges_To_Successors_Iterator; + + 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. + + 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 + + Has_Cycle := False; + + -- 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. + + if Cycle_Count >= Cycle_Limit then + return; + + -- 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. + + elsif not Is_Start_Vertex + and then LGV_Sets.Contains (End_Vertices, Vertex) + then + Trace_Vertex (G, Vertex, Indent); + + Record_Cycle + (G => G, + Most_Significant_Edge => Most_Significant_Edge, + Invocation_Edge_Count => Invocation_Edge_Count, + Cycle_Path => Cycle_Path_Stack, + Indent => Indent); + + Has_Cycle := True; + Cycle_Count := Cycle_Count + 1; + return; + + -- 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. + + elsif LGV_Sets.Contains (Deleted_Vertices, Vertex) then + return; + + -- 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. + + elsif LGV_Sets.Contains (Visited_Set, Vertex) then + return; + end if; + + Trace_Vertex (G, Vertex, Indent); + + -- Mark the vertex as visited + + Visit + (Vertex => Vertex, + Visited_Set => Visited_Set, + Visited_Stack => Visited_Stack); + + -- Extend the depth-first search via all the edges to successors + + Iter := Iterate_Edges_To_Successors (G, Vertex); + while Has_Next (Iter) loop + Next (Iter, Edge); + + Find_Cycles_From_Successor + (G => G, + Edge => Edge, + End_Vertices => End_Vertices, + Deleted_Vertices => Deleted_Vertices, + + -- 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. + + Most_Significant_Edge => + Highest_Precedence_Edge + (G => G, + Left => Edge, + Right => Most_Significant_Edge), + + -- The edge may be an invocation edge, in which case the count + -- of invocation edges increases by one. + + Invocation_Edge_Count => + Maximum_Invocation_Edge_Count + (G => G, + Edge => 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, + Has_Cycle => Successor_Has_Cycle, + Indent => Edge_Indent); + + 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) + then + Complement := + Complementary_Vertex + (G => G, + Vertex => Vertex, + Force_Complement => Elaborate_All_Active); + + 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); + + Has_Cycle := Has_Cycle or Complement_Has_Cycle; + end if; + end if; + + -- 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. + + if Has_Cycle or else Is_Start_Vertex then + Unvisit + (Vertex => Vertex, + Visited_Set => Visited_Set, + Visited_Stack => Visited_Stack); + end if; + + -- 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 (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 + Trace_Component (G, Comp, No_Indentation); + + -- Initialize all component-level data structures + + 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; + + -- 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. + + Iter := Iterate_Component_Vertices (G, Comp); + while Has_Next (Iter) loop + Next (Iter, Vertex); + + -- 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); + + -- 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. + + 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); + + -- Destroy the cycle-terminating vertices because a new set must + -- be constructed for the next vertex. + + LGV_Sets.Destroy (End_Vertices); + end loop; + + -- Destroy all component-level data structures + + 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; + + --------------------------------------- + -- Find_First_Lower_Precedence_Cycle -- + --------------------------------------- + + 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 (Present (Cycle)); + + -- Assume that there is no lesser cycle + + Lesser_Cycle := No_Library_Graph_Cycle; + + -- 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. + + 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 + Lesser_Cycle := Current_Cycle; + end if; + end loop; + + return Lesser_Cycle; + end Find_First_Lower_Precedence_Cycle; + + ------------------------------ + -- Get_Component_Attributes -- + ------------------------------ + + 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)); + + 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 + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); + + return LGE_Tables.Get (G.Edge_Attributes, Edge); + end Get_LGE_Attributes; + + ------------------------ + -- Get_LGV_Attributes -- + ------------------------ + + 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)); + + 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; + + ---------------------------- + -- Has_Elaborate_All_Edge -- + ---------------------------- + + function Has_Elaborate_All_Edge + (G : Library_Graph; + Comp : Component_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; + + 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) 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; + + ------------------------ + -- 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 (Vertex)); + + U_Id : constant Unit_Id := Unit (G, Vertex); + 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; + + -------------- + -- Has_Next -- + -------------- + + function Has_Next (Iter : All_Vertex_Iterator) return Boolean is + begin + return DG.Has_Next (DG.All_Vertex_Iterator (Iter)); + end Has_Next; + + -------------- + -- Has_Next -- + -------------- + + function Has_Next (Iter : Component_Iterator) return Boolean is + begin + return DG.Has_Next (DG.Component_Iterator (Iter)); + end Has_Next; + + -------------- + -- Has_Next -- + -------------- + + function Has_Next (Iter : Component_Vertex_Iterator) return Boolean is + begin + return DG.Has_Next (DG.Component_Vertex_Iterator (Iter)); + end Has_Next; + + -------------- + -- Has_Next -- + -------------- + + function Has_Next (Iter : Edges_Of_Cycle_Iterator) return Boolean is + begin + return LGE_Lists.Has_Next (LGE_Lists.Iterator (Iter)); + end Has_Next; + + -------------- + -- Has_Next -- + -------------- + + function Has_Next (Iter : Edges_To_Successors_Iterator) return Boolean is + begin + return DG.Has_Next (DG.Outgoing_Edge_Iterator (Iter)); + end Has_Next; + + ----------------------------- + -- Has_No_Elaboration_Code -- + ----------------------------- + + function Has_No_Elaboration_Code + (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; + + 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; + + ----------------------------------------- + -- Hash_Predecessor_Successor_Relation -- + ----------------------------------------- + + function Hash_Predecessor_Successor_Relation + (Rel : Predecessor_Successor_Relation) return Bucket_Range_Type + is + begin + pragma Assert (Present (Rel.Predecessor)); + pragma Assert (Present (Rel.Successor)); + + return + Hash_Two_Keys + (Bucket_Range_Type (Rel.Predecessor), + Bucket_Range_Type (Rel.Successor)); + end Hash_Predecessor_Successor_Relation; + + ------------------------------ + -- 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)); + + 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. + + else + return LGC_Lists.First (G.Cycles); + end if; + end Highest_Precedence_Cycle; + + ----------------------------- + -- Highest_Precedence_Edge -- + ----------------------------- + + 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; + + begin + pragma Assert (Present (G)); + + -- 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; + + -------------------------- + -- In_Elaboration_Order -- + -------------------------- + + function In_Elaboration_Order + (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; + + ----------------------- + -- In_Same_Component -- + ----------------------- + + 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)); + + return Component (G, Left) = Component (G, Right); + end In_Same_Component; + + ---------------------------------------- + -- Increment_Library_Graph_Edge_Count -- + ---------------------------------------- + + procedure Increment_Library_Graph_Edge_Count + (G : Library_Graph; + Kind : Library_Graph_Edge_Kind) + is + pragma Assert (Present (G)); + + Count : Natural renames G.Counts (Kind); + + begin + Count := Count + 1; + end Increment_Library_Graph_Edge_Count; + + ------------------------------------ + -- Increment_Pending_Predecessors -- + ------------------------------------ + + procedure Increment_Pending_Predecessors + (G : Library_Graph; + Comp : Component_Id; + Edge : Library_Graph_Edge_Id) + is + Attrs : Component_Attributes; + + begin + pragma Assert (Present (G)); + pragma Assert (Present (Comp)); + + Attrs := Get_Component_Attributes (G, Comp); + + 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_Component_Attributes (G, Comp, Attrs); + end Increment_Pending_Predecessors; + + ------------------------------------ + -- Increment_Pending_Predecessors -- + ------------------------------------ + + procedure Increment_Pending_Predecessors + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id; + Edge : Library_Graph_Edge_Id) + is + Attrs : Library_Graph_Vertex_Attributes; + + 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 Increment_Pending_Predecessors; + + --------------------------- + -- Initialize_Components -- + --------------------------- + + procedure Initialize_Components (G : Library_Graph) 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. + + if Number_Of_Components (G) > 0 then + Component_Tables.Destroy (G.Component_Attributes); + + G.Component_Attributes := + Component_Tables.Create (Number_Of_Vertices (G)); + end if; + end Initialize_Components; + + --------------------------- + -- Invocation_Edge_Count -- + --------------------------- + + function Invocation_Edge_Count + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) return Natural + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Cycle)); + + return Get_LGC_Attributes (G, Cycle).Invocation_Edge_Count; + end Invocation_Edge_Count; + + ------------------------------- + -- Invocation_Graph_Encoding -- + ------------------------------- + + 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)); + + return Invocation_Graph_Encoding (Unit (G, Vertex)); + end Invocation_Graph_Encoding; + + ------------- + -- Is_Body -- + ------------- + + 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); + + begin + return U_Rec.Utype = Is_Body or else U_Rec.Utype = Is_Body_Only; + end Is_Body; + + ----------------------------------------- + -- Is_Body_Of_Spec_With_Elaborate_Body -- + ----------------------------------------- + + 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)); + + if Is_Body_With_Spec (G, Vertex) then + return + Is_Spec_With_Elaborate_Body + (G => G, + Vertex => Proper_Spec (G, Vertex)); + end if; + + return False; + end Is_Body_Of_Spec_With_Elaborate_Body; + + ----------------------- + -- Is_Body_With_Spec -- + ----------------------- + + function Is_Body_With_Spec + (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); + + begin + return U_Rec.Utype = Is_Body; + end Is_Body_With_Spec; + + ------------------------------ + -- Is_Cycle_Initiating_Edge -- + ------------------------------ + + 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)); + + 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; + + -------------------- + -- Is_Cyclic_Edge -- + -------------------- + + function Is_Cyclic_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean + is + 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; + + ---------------------------------- + -- Is_Cyclic_Elaborate_All_Edge -- + ---------------------------------- + + 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)); + + return + Is_Elaborate_All_Edge (G, Edge) + and then Links_Vertices_In_Same_Component (G, Edge); + end Is_Cyclic_Elaborate_All_Edge; + + ----------------------------------- + -- Is_Cyclic_Elaborate_Body_Edge -- + ----------------------------------- + + 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)); + + return + Is_Elaborate_Body_Edge (G, Edge) + and then Links_Vertices_In_Same_Component (G, Edge); + end Is_Cyclic_Elaborate_Body_Edge; + + ------------------------------ + -- Is_Cyclic_Elaborate_Edge -- + ------------------------------ + + function Is_Cyclic_Elaborate_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean + 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; + + --------------------------- + -- Is_Cyclic_Forced_Edge -- + --------------------------- + + 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)); + + return + Is_Forced_Edge (G, Edge) + and then Links_Vertices_In_Same_Component (G, Edge); + end Is_Cyclic_Forced_Edge; + + ------------------------------- + -- Is_Cyclic_Invocation_Edge -- + ------------------------------- + + function Is_Cyclic_Invocation_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); + + return + Is_Invocation_Edge (G, Edge) + and then Links_Vertices_In_Same_Component (G, Edge); + end Is_Cyclic_Invocation_Edge; + + ------------------------- + -- Is_Cyclic_With_Edge -- + ------------------------- + + 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)); + + -- Ignore Elaborate_Body edges because they also appear as with + -- edges, but have special successors. + + 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; + + ------------------------------- + -- Is_Dynamically_Elaborated -- + ------------------------------- + + function Is_Dynamically_Elaborated + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + return Is_Dynamically_Elaborated (Unit (G, Vertex)); + end Is_Dynamically_Elaborated; + + ----------------------------- + -- Is_Elaborable_Component -- + ----------------------------- + + function Is_Elaborable_Component + (G : Library_Graph; + Comp : Component_Id) return Boolean + 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; + + -------------------------- + -- Is_Elaborable_Vertex -- + -------------------------- + + function Is_Elaborable_Vertex + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean + is + 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 + -- 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; + + elsif Present (Complement) + and then In_Elaboration_Order (G, Complement) + then + return False; + + elsif not Is_Elaborable_Component (G, Component (G, Vertex)) then + return False; + end if; + + Pending_Predecessors_For_Elaboration + (G => G, + Vertex => Vertex, + Strong_Preds => Strong_Preds, + Weak_Preds => Weak_Preds); + + return Strong_Preds = 0 and then Weak_Preds = 0; + end Is_Elaborable_Vertex; + + --------------------------- + -- 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 (Edge)); + + return Kind (G, Edge) = Elaborate_All_Edge; + end Is_Elaborate_All_Edge; + + ---------------------------- + -- Is_Elaborate_Body_Edge -- + ---------------------------- + + 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 + Kind (G, Edge) = With_Edge + and then Is_Vertex_With_Elaborate_Body (G, Successor (G, Edge)); + end Is_Elaborate_Body_Edge; + + ----------------------- + -- Is_Elaborate_Edge -- + ----------------------- + + function Is_Elaborate_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); + + return Kind (G, Edge) = Elaborate_Edge; + end Is_Elaborate_Edge; + + ---------------------------- + -- Is_Elaborate_Body_Pair -- + ---------------------------- + + 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)); + + 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; + + -------------------- + -- Is_Forced_Edge -- + -------------------- + + function Is_Forced_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); + + return Kind (G, Edge) = Forced_Edge; + end Is_Forced_Edge; + + ---------------------- + -- Is_Internal_Unit -- + ---------------------- + + function Is_Internal_Unit + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + return Is_Internal_Unit (Unit (G, Vertex)); + end Is_Internal_Unit; + + ------------------------ + -- Is_Invocation_Edge -- + ------------------------ + + function Is_Invocation_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); + + return Kind (G, Edge) = Invocation_Edge; + end Is_Invocation_Edge; + + ------------------------ + -- Is_Predefined_Unit -- + ------------------------ + + function Is_Predefined_Unit + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + return Is_Predefined_Unit (Unit (G, Vertex)); + end Is_Predefined_Unit; + + --------------------------- + -- Is_Preelaborated_Unit -- + --------------------------- + + function Is_Preelaborated_Unit + (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); + + begin + return U_Rec.Preelab or else U_Rec.Pure; + end Is_Preelaborated_Unit; + + ---------------------- + -- Is_Recorded_Edge -- + ---------------------- + + function Is_Recorded_Edge + (G : Library_Graph; + Rel : Predecessor_Successor_Relation) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Rel.Predecessor)); + pragma Assert (Present (Rel.Successor)); + + return RE_Sets.Contains (G.Recorded_Edges, Rel); + end Is_Recorded_Edge; + + ------------- + -- Is_Spec -- + ------------- + + function Is_Spec + (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); + + begin + return U_Rec.Utype = Is_Spec or else U_Rec.Utype = Is_Spec_Only; + end Is_Spec; + + ------------------------------ + -- Is_Spec_Before_Body_Edge -- + ------------------------------ + + function Is_Spec_Before_Body_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); + + return Kind (G, Edge) = Spec_Before_Body_Edge; + end Is_Spec_Before_Body_Edge; + + ----------------------- + -- Is_Spec_With_Body -- + ----------------------- + + function Is_Spec_With_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); + + begin + return U_Rec.Utype = Is_Spec; + end Is_Spec_With_Body; + + --------------------------------- + -- Is_Spec_With_Elaborate_Body -- + --------------------------------- + + function Is_Spec_With_Elaborate_Body + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean + 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; + + ------------------------------ + -- Is_Static_Successor_Edge -- + ------------------------------ + + 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)); + + return + Is_Invocation_Edge (G, Edge) + and then not Is_Dynamically_Elaborated (G, Successor (G, Edge)); + end Is_Static_Successor_Edge; + + ----------------------------------- + -- Is_Vertex_With_Elaborate_Body -- + ----------------------------------- + + function Is_Vertex_With_Elaborate_Body + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + 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; + + --------------------------------- + -- Is_Weakly_Elaborable_Vertex -- + ---------------------------------- + + function Is_Weakly_Elaborable_Vertex + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean + is + 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 + -- 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 + + if In_Elaboration_Order (G, Vertex) then + return False; + + elsif Present (Complement) + and then In_Elaboration_Order (G, Complement) + then + return False; + + elsif not Is_Elaborable_Component (G, Component (G, Vertex)) then + return False; + end if; + + Pending_Predecessors_For_Elaboration + (G => G, + Vertex => Vertex, + Strong_Preds => Strong_Preds, + Weak_Preds => Weak_Preds); + + return Strong_Preds = 0 and then Weak_Preds >= 1; + end Is_Weakly_Elaborable_Vertex; + + ------------------ + -- Is_With_Edge -- + ------------------ + + function Is_With_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); + + return Kind (G, Edge) = With_Edge; + end Is_With_Edge; + + ------------------------ + -- Iterate_All_Cycles -- + ------------------------ + + function Iterate_All_Cycles + (G : Library_Graph) return All_Cycle_Iterator + is + begin + pragma Assert (Present (G)); + + return All_Cycle_Iterator (LGC_Lists.Iterate (G.Cycles)); + end Iterate_All_Cycles; + + ----------------------- + -- Iterate_All_Edges -- + ----------------------- + + function Iterate_All_Edges + (G : Library_Graph) return All_Edge_Iterator + is + begin + pragma Assert (Present (G)); + + return All_Edge_Iterator (DG.Iterate_All_Edges (G.Graph)); + end Iterate_All_Edges; + + -------------------------- + -- Iterate_All_Vertices -- + -------------------------- + + function Iterate_All_Vertices + (G : Library_Graph) return All_Vertex_Iterator + is + begin + pragma Assert (Present (G)); + + return All_Vertex_Iterator (DG.Iterate_All_Vertices (G.Graph)); + end Iterate_All_Vertices; + + ------------------------ + -- Iterate_Components -- + ------------------------ + + function Iterate_Components + (G : Library_Graph) return Component_Iterator + is + begin + pragma Assert (Present (G)); + + return Component_Iterator (DG.Iterate_Components (G.Graph)); + end Iterate_Components; + + -------------------------------- + -- Iterate_Component_Vertices -- + -------------------------------- + + function Iterate_Component_Vertices + (G : Library_Graph; + Comp : Component_Id) return Component_Vertex_Iterator + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Comp)); + + return + Component_Vertex_Iterator + (DG.Iterate_Component_Vertices (G.Graph, Comp)); + end Iterate_Component_Vertices; + + ---------------------------- + -- Iterate_Edges_Of_Cycle -- + ---------------------------- + + function Iterate_Edges_Of_Cycle + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) return Edges_Of_Cycle_Iterator + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Cycle)); + + return Edges_Of_Cycle_Iterator (LGE_Lists.Iterate (Path (G, Cycle))); + end Iterate_Edges_Of_Cycle; + + --------------------------------- + -- Iterate_Edges_To_Successors -- + --------------------------------- + + function Iterate_Edges_To_Successors + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Edges_To_Successors_Iterator + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + return + Edges_To_Successors_Iterator + (DG.Iterate_Outgoing_Edges (G.Graph, Vertex)); + end Iterate_Edges_To_Successors; + + ---------- + -- Kind -- + ---------- + + function Kind + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Kind + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Cycle)); + + 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 + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); + + return Get_LGE_Attributes (G, Edge).Kind; + end Kind; + + ------------ + -- Length -- + ------------ + + function Length + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) return Natural + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Cycle)); + + return LGE_Lists.Size (Path (G, Cycle)); + end Length; + + ------------------------------ + -- Library_Graph_Edge_Count -- + ------------------------------ + + function Library_Graph_Edge_Count + (G : Library_Graph; + Kind : Library_Graph_Edge_Kind) return Natural + is + begin + pragma Assert (Present (G)); + + return G.Counts (Kind); + end Library_Graph_Edge_Count; + + -------------------------------------- + -- Links_Vertices_In_Same_Component -- + -------------------------------------- + + 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)); + + -- An edge is part of a cycle when both the successor and predecessor + -- reside in the same component. + + return + In_Same_Component + (G => G, + Left => Predecessor (G, Edge), + Right => Successor (G, Edge)); + end Links_Vertices_In_Same_Component; + + ----------------------------------- + -- Maximum_Invocation_Edge_Count -- + ----------------------------------- + + 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)); + + New_Count := Count; + + if Present (Edge) and then Is_Invocation_Edge (G, Edge) then + New_Count := New_Count + 1; + end if; + + 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 (Vertex)); + + return Name (Unit (G, Vertex)); + end Name; + + ----------------------- + -- Needs_Elaboration -- + ----------------------- + + function Needs_Elaboration + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + return Needs_Elaboration (Unit (G, Vertex)); + end Needs_Elaboration; + + ---------- + -- Next -- + ---------- + + 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; + + ---------- + -- Next -- + ---------- + + 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; + + ---------- + -- Next -- + ---------- + + 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; + + ---------- + -- Next -- + ---------- + + 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; + + ---------- + -- Next -- + ---------- + + procedure Next + (Iter : in out Component_Iterator; + Comp : out Component_Id) + is + begin + DG.Next (DG.Component_Iterator (Iter), Comp); + end Next; + + ---------- + -- Next -- + ---------- + + 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; + + ---------- + -- Next -- + ---------- + + 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; + + -------------------------- + -- Normalize_Cycle_Path -- + -------------------------- + + 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 (LGE_Lists.Present (Cycle_Path)); + pragma Assert (Present (Most_Significant_Edge)); + + -- Perform at most |Cycle_Path| rotations in case the cycle is + -- malformed and the significant edge does not appear within. + + for Rotation in 1 .. LGE_Lists.Size (Cycle_Path) loop + Edge := LGE_Lists.First (Cycle_Path); + + -- 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 Natural + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Comp)); + + return DG.Number_Of_Component_Vertices (G.Graph, Comp); + end Number_Of_Component_Vertices; + + -------------------------- + -- Number_Of_Components -- + -------------------------- + + function Number_Of_Components (G : Library_Graph) return Natural is + begin + pragma Assert (Present (G)); + + return DG.Number_Of_Components (G.Graph); + end Number_Of_Components; + + ---------------------- + -- Number_Of_Cycles -- + ---------------------- + + function Number_Of_Cycles (G : Library_Graph) return Natural is + begin + pragma Assert (Present (G)); + + return LGC_Lists.Size (G.Cycles); + end Number_Of_Cycles; + + --------------------- + -- Number_Of_Edges -- + --------------------- + + function Number_Of_Edges (G : Library_Graph) return Natural is + begin + pragma Assert (Present (G)); + + return DG.Number_Of_Edges (G.Graph); + end Number_Of_Edges; + + ----------------------------------- + -- Number_Of_Edges_To_Successors -- + ----------------------------------- + + function Number_Of_Edges_To_Successors + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Natural + is + begin + pragma Assert (Present (G)); + + return DG.Number_Of_Outgoing_Edges (G.Graph, Vertex); + end Number_Of_Edges_To_Successors; + + ------------------------ + -- Number_Of_Vertices -- + ------------------------ + + function Number_Of_Vertices (G : Library_Graph) return Natural is + begin + pragma Assert (Present (G)); + + return DG.Number_Of_Vertices (G.Graph); + end Number_Of_Vertices; + + ----------------- + -- Order_Cycle -- + ----------------- + + 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 (Cycle)); + pragma Assert (LGC_Lists.Present (G.Cycles)); + + -- The input cycle is the first to be inserted + + if LGC_Lists.Is_Empty (G.Cycles) then + LGC_Lists.Prepend (G.Cycles, Cycle); + + -- Otherwise the list of all cycles contains at least one cycle. + -- Insert the input cycle based on its precedence. + + else + Lesser_Cycle := Find_First_Lower_Precedence_Cycle (G, Cycle); + + -- The list contains at least one cycle, and the input cycle has a + -- higher precedence compared to some cycle in the list. + + 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 (Cycle)); + + return Get_LGC_Attributes (G, Cycle).Path; + end Path; + + ------------------------------------------ + -- Pending_Predecessors_For_Elaboration -- + ------------------------------------------ + + 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)); + + Total_Strong_Preds := Pending_Strong_Predecessors (G, Vertex); + Total_Weak_Preds := Pending_Weak_Predecessors (G, Vertex); + + -- Assume that there is no complementary vertex that needs to be + -- examined. + + Complement := No_Library_Graph_Vertex; + Spec_Vertex := No_Library_Graph_Vertex; + + if Is_Body_Of_Spec_With_Elaborate_Body (G, Vertex) then + Complement := Proper_Spec (G, Vertex); + Spec_Vertex := Complement; + + elsif Is_Spec_With_Elaborate_Body (G, Vertex) then + Complement := Proper_Body (G, Vertex); + Spec_Vertex := Vertex; + end if; + + -- 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 (Comp)); + + return Get_Component_Attributes (G, Comp).Pending_Strong_Predecessors; + end Pending_Strong_Predecessors; + + --------------------------------- + -- Pending_Strong_Predecessors -- + --------------------------------- + + function Pending_Strong_Predecessors + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Natural + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + return Get_LGV_Attributes (G, Vertex).Pending_Strong_Predecessors; + end Pending_Strong_Predecessors; + + ------------------------------- + -- Pending_Weak_Predecessors -- + ------------------------------- + + function Pending_Weak_Predecessors + (G : Library_Graph; + Comp : Component_Id) return Natural + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Comp)); + + return Get_Component_Attributes (G, Comp).Pending_Weak_Predecessors; + end Pending_Weak_Predecessors; + + ------------------------------- + -- Pending_Weak_Predecessors -- + ------------------------------- + + function Pending_Weak_Predecessors + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Natural + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + return Get_LGV_Attributes (G, Vertex).Pending_Weak_Predecessors; + end Pending_Weak_Predecessors; + + ----------------- + -- Predecessor -- + ----------------- + + function Predecessor + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); + + return DG.Source_Vertex (G.Graph, Edge); + end Predecessor; + + ------------- + -- Present -- + ------------- + + 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 Library_Graph_Vertex_Id + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + -- When the vertex denotes a spec with a completing body, return the + -- body. + + if Is_Spec_With_Body (G, Vertex) then + return Corresponding_Item (G, Vertex); + + -- Otherwise the vertex must be a 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 Library_Graph_Vertex_Id + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + -- When the vertex denotes a body that completes a spec, return the + -- spec. + + if Is_Body_With_Spec (G, Vertex) then + return Corresponding_Item (G, Vertex); + + -- Otherwise the vertex must denote a spec + + else + pragma Assert (Is_Spec (G, Vertex)); + return Vertex; + end if; + end Proper_Spec; + + ------------------ + -- Record_Cycle -- + ------------------ + + 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 (Most_Significant_Edge)); + pragma Assert (LGE_Lists.Present (Cycle_Path)); + + -- Replicate the path of the cycle in order to avoid sharing lists + + Path := Copy_Cycle_Path (Cycle_Path); + + -- Normalize the path of the cycle such that its most significant + -- edge is the first in the list of edges. + + Normalize_Cycle_Path + (Cycle_Path => Path, + Most_Significant_Edge => Most_Significant_Edge); + + -- 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 + -- 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; + + ------------------------------ + -- Set_Component_Attributes -- + ------------------------------ + + procedure Set_Component_Attributes + (G : Library_Graph; + Comp : Component_Id; + Val : Component_Attributes) + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Comp)); + + Component_Tables.Put (G.Component_Attributes, Comp, Val); + end Set_Component_Attributes; + + ---------------------------- + -- 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 (Vertex)); + + Attrs := Get_LGV_Attributes (G, Vertex); + Attrs.Corresponding_Item := Val; + Set_LGV_Attributes (G, Vertex, Attrs); + end Set_Corresponding_Item; + + ------------------------------ + -- Set_Corresponding_Vertex -- + ------------------------------ + + 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)); + + Unit_Tables.Put (G.Unit_To_Vertex, U_Id, Val); + end Set_Corresponding_Vertex; + + ------------------------------ + -- Set_In_Elaboration_Order -- + ------------------------------ + + 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)); + + Attrs := Get_LGV_Attributes (G, Vertex); + Attrs.In_Elaboration_Order := Val; + Set_LGV_Attributes (G, Vertex, Attrs); + end Set_In_Elaboration_Order; + + -------------------------- + -- Set_Is_Recorded_Edge -- + -------------------------- + + procedure Set_Is_Recorded_Edge + (G : Library_Graph; + Rel : Predecessor_Successor_Relation; + Val : Boolean := True) + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Rel.Predecessor)); + pragma Assert (Present (Rel.Successor)); + + if Val then + RE_Sets.Insert (G.Recorded_Edges, Rel); + else + RE_Sets.Delete (G.Recorded_Edges, Rel); + end if; + end Set_Is_Recorded_Edge; + + ------------------------ + -- Set_LGC_Attributes -- + ------------------------ + + 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)); + + LGC_Tables.Put (G.Cycle_Attributes, Cycle, Val); + end Set_LGC_Attributes; + + ------------------------ + -- Set_LGE_Attributes -- + ------------------------ + + procedure Set_LGE_Attributes + (G : Library_Graph; + Edge : Library_Graph_Edge_Id; + Val : Library_Graph_Edge_Attributes) + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); + + LGE_Tables.Put (G.Edge_Attributes, Edge, Val); + end Set_LGE_Attributes; + + ------------------------ + -- Set_LGV_Attributes -- + ------------------------ + + 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 (Vertex)); + + LGV_Tables.Put (G.Vertex_Attributes, Vertex, Val); + end Set_LGV_Attributes; + + --------------- + -- Successor -- + --------------- + + function Successor + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); + + return DG.Destination_Vertex (G.Graph, Edge); + end Successor; + + --------------------- + -- Trace_Component -- + --------------------- + + procedure Trace_Component + (G : Library_Graph; + Comp : Component_Id; + Indent : Indentation_Level) + 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; + + Write_Eol; + Indent_By (Indent); + Write_Str ("component (Comp_"); + Write_Int (Int (Comp)); + Write_Str (")"); + Write_Eol; + end Trace_Component; + + ----------------- + -- Trace_Cycle -- + ----------------- + + 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)); + + -- 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; + + Indent_By (Indent); + Write_Str ("cycle (LGC_Id_"); + Write_Int (Int (Cycle)); + Write_Str (")"); + Write_Eol; + + Indent_By (Attr_Indent); + Write_Str ("kind = "); + Write_Str (Kind (G, Cycle)'Img); + Write_Eol; + + Indent_By (Attr_Indent); + Write_Str ("invocation edges = "); + Write_Int (Int (Invocation_Edge_Count (G, Cycle))); + Write_Eol; + + Indent_By (Attr_Indent); + Write_Str ("length: "); + Write_Int (Int (Length (G, Cycle))); + Write_Eol; + + Iter := Iterate_Edges_Of_Cycle (G, Cycle); + while Has_Next (Iter) loop + Next (Iter, Edge); + + Indent_By (Edge_Indent); + Write_Str ("library graph edge (LGE_Id_"); + Write_Int (Int (Edge)); + Write_Str (")"); + Write_Eol; + end loop; + end Trace_Cycle; + + ---------------- + -- Trace_Edge -- + ---------------- + + procedure Trace_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id; + Indent : Indentation_Level) + is + 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 + -- 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; + + Indent_By (Indent); + Write_Str ("library graph edge (LGE_Id_"); + Write_Int (Int (Edge)); + Write_Str (")"); + Write_Eol; + + Indent_By (Attr_Indent); + Write_Str ("kind = "); + Write_Str (Kind (G, Edge)'Img); + Write_Eol; + + Indent_By (Attr_Indent); + Write_Str ("Predecessor (LGV_Id_"); + Write_Int (Int (Pred)); + Write_Str (") name = "); + Write_Name (Name (G, Pred)); + Write_Eol; + + 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; + + ------------------ + -- Trace_Vertex -- + ------------------ + + procedure Trace_Vertex + (G : Library_Graph; + 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)); + + -- 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; + + Indent_By (Indent); + Write_Str ("library graph vertex (LGV_Id_"); + Write_Int (Int (Vertex)); + Write_Str (")"); + Write_Eol; + + 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; + + ---------- + -- Unit -- + ---------- + + function Unit + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Unit_Id + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + return Get_LGV_Attributes (G, Vertex).Unit; + end Unit; + + ------------- + -- Unvisit -- + ------------- + + 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 + pragma Assert (Present (Vertex)); + pragma Assert (LGV_Sets.Present (Visited_Set)); + pragma Assert (LGV_Lists.Present (Visited_Stack)); + + while not LGV_Lists.Is_Empty (Visited_Stack) loop + Current_Vertex := LGV_Lists.First (Visited_Stack); + + LGV_Lists.Delete_First (Visited_Stack); + LGV_Sets.Delete (Visited_Set, Current_Vertex); + + exit when Current_Vertex = Vertex; + end loop; + end Unvisit; + + --------------------------------- + -- Update_Pending_Predecessors -- + --------------------------------- + + procedure Update_Pending_Predecessors + (Strong_Predecessors : in out Natural; + Weak_Predecessors : in out Natural; + Update_Weak : Boolean; + Value : Integer) + is + begin + if Update_Weak then + Weak_Predecessors := Weak_Predecessors + Value; + else + Strong_Predecessors := Strong_Predecessors + Value; + end if; + end Update_Pending_Predecessors; + + ----------------------------------------------- + -- Update_Pending_Predecessors_Of_Components -- + ----------------------------------------------- + + procedure Update_Pending_Predecessors_Of_Components + (G : Library_Graph) + is + Edge : Library_Graph_Edge_Id; + Iter : All_Edge_Iterator; + + begin + pragma Assert (Present (G)); + + Iter := Iterate_All_Edges (G); + while Has_Next (Iter) loop + Next (Iter, Edge); + + Update_Pending_Predecessors_Of_Components (G, Edge); + end loop; + end Update_Pending_Predecessors_Of_Components; + + ----------------------------------------------- + -- Update_Pending_Predecessors_Of_Components -- + ----------------------------------------------- + + procedure Update_Pending_Predecessors_Of_Components + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) + is + 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)); + + pragma Assert (Present (Pred_Comp)); + pragma Assert (Present (Succ_Comp)); + + 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. + + 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 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 (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; + + ----------- + -- 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 (Vertex)); + pragma Assert (LGV_Sets.Present (Visited_Set)); + pragma Assert (LGV_Lists.Present (Visited_Stack)); + + LGV_Sets.Insert (Visited_Set, Vertex); + LGV_Lists.Prepend (Visited_Stack, Vertex); + end Visit; + end Library_Graphs; + + ------------- + -- Present -- + ------------- + + function Present (Edge : Invocation_Graph_Edge_Id) return Boolean is + begin + return Edge /= No_Invocation_Graph_Edge; + end Present; + + ------------- + -- Present -- + ------------- + + function Present (Vertex : Invocation_Graph_Vertex_Id) return Boolean is + begin + return Vertex /= No_Invocation_Graph_Vertex; + end Present; + + ------------- + -- Present -- + ------------- + + function Present (Cycle : Library_Graph_Cycle_Id) return Boolean is + begin + return Cycle /= No_Library_Graph_Cycle; + end Present; + + ------------- + -- Present -- + ------------- + + function Present (Edge : Library_Graph_Edge_Id) return Boolean is + begin + return Edge /= No_Library_Graph_Edge; + end Present; + + ------------- + -- Present -- + ------------- + + function Present (Vertex : Library_Graph_Vertex_Id) return Boolean is + begin + return Vertex /= No_Library_Graph_Vertex; + end Present; + + -------------------------- + -- Sequence_Next_Edge -- + -------------------------- + + IGE_Sequencer : Invocation_Graph_Edge_Id := First_Invocation_Graph_Edge; + -- The counter for invocation graph edges. Do not directly manipulate its + -- value. + + function Sequence_Next_Edge return Invocation_Graph_Edge_Id is + Edge : constant Invocation_Graph_Edge_Id := IGE_Sequencer; + + begin + IGE_Sequencer := IGE_Sequencer + 1; + return Edge; + end Sequence_Next_Edge; + + -------------------------- + -- Sequence_Next_Vertex -- + -------------------------- + + IGV_Sequencer : Invocation_Graph_Vertex_Id := First_Invocation_Graph_Vertex; + -- The counter for invocation graph vertices. Do not directly manipulate + -- its value. + + function Sequence_Next_Vertex return Invocation_Graph_Vertex_Id is + Vertex : constant Invocation_Graph_Vertex_Id := IGV_Sequencer; + + begin + IGV_Sequencer := IGV_Sequencer + 1; + return Vertex; + end Sequence_Next_Vertex; + + -------------------------- + -- Sequence_Next_Cycle -- + -------------------------- + + LGC_Sequencer : Library_Graph_Cycle_Id := First_Library_Graph_Cycle; + -- The counter for library graph cycles. Do not directly manipulate its + -- value. + + function Sequence_Next_Cycle return Library_Graph_Cycle_Id is + Cycle : constant Library_Graph_Cycle_Id := LGC_Sequencer; + + begin + LGC_Sequencer := LGC_Sequencer + 1; + return Cycle; + end Sequence_Next_Cycle; + + -------------------------- + -- Sequence_Next_Edge -- + -------------------------- + + LGE_Sequencer : Library_Graph_Edge_Id := First_Library_Graph_Edge; + -- The counter for library graph edges. Do not directly manipulate its + -- value. + + function Sequence_Next_Edge return Library_Graph_Edge_Id is + Edge : constant Library_Graph_Edge_Id := LGE_Sequencer; + + begin + LGE_Sequencer := LGE_Sequencer + 1; + return Edge; + end Sequence_Next_Edge; + + -------------------------- + -- Sequence_Next_Vertex -- + -------------------------- + + LGV_Sequencer : Library_Graph_Vertex_Id := First_Library_Graph_Vertex; + -- The counter for library graph vertices. Do not directly manipulate its + -- value. + + function Sequence_Next_Vertex return Library_Graph_Vertex_Id is + Vertex : constant Library_Graph_Vertex_Id := LGV_Sequencer; + + begin + LGV_Sequencer := LGV_Sequencer + 1; + return Vertex; + end Sequence_Next_Vertex; + +end Bindo.Graphs;