+2019-07-05 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * ali.adb: Relocate types Invocation_Construct_Record,
+ Invocation_Relation_Record, and Invocation_Signature_Record to
+ the body of ALI. Relocate tables Invocation_Constructs,
+ Invocation_Relations, and Invocation_Signatures to the body of
+ ALI. Remove type Body_Placement_Codes. Add new types
+ Declaration_Placement_Codes, and
+ Invocation_Graph_Encoding_Codes. Update the literals of type
+ Invocation_Graph_Line_Codes.
+ (Add_Invocation_Construct): Update the parameter profile. Add an
+ invocation construct built from all attributes provided.
+ (Add_Invocation_Relation): Update the parameter profile. Add an
+ invocation relation built from all attributes provided.
+ (Body_Placement): New routine.
+ (Body_Placement_Kind_To_Code, Code_To_Body_Placement_Kind):
+ Removed.
+ (Code_To_Declaration_Placement_Kind,
+ Code_To_Invocation_Graph_Encoding_Kind, Column,
+ Declaration_Placement_Kind_To_Code, Extra,
+ For_Each_Invocation_Construct, For_Each_Invocation_Relation,
+ Invocation_Graph_Encoding,
+ Invocation_Graph_Encoding_Kind_To_Code, Invoker, Kind, Line,
+ Locations, Name): New routine.
+ (Scan_Invocation_Construct_Line): Reimplement the scanning
+ mechanism.
+ (Scan_Invocation_Graph_Attributes_Line): New routine.
+ (Scan_Invocation_Graph_Line): Use a case statement to dispatch.
+ (Scan_Invocation_Relation_Line): Reimplement the scanning
+ mechanism.
+ (Scope): New routine.
+ (Set_Invocation_Graph_Encoding, Signature, Spec_Placement,
+ Target): New routine.
+ * ali.ads: Add new type Invocation_Graph_Encoding_Kind. Add
+ component Invocation_Graph_Encoding to type Unit_Record.
+ Relocate various types and data structures to the body of ALI.
+ (Add_Invocation_Construct, Add_Invocation_Relation): Update the
+ parameter profile.
+ (Body_Placement): New routine.
+ (Body_Placement_Kind_To_Code, Code_To_Body_Placement_Kind):
+ Removed.
+ (Code_To_Declaration_Placement_Kind,
+ Code_To_Invocation_Graph_Encoding_Kind, Column,
+ Declaration_Placement_Kind_To_Code, Extra,
+ For_Each_Invocation_Construct, For_Each_Invocation_Relation,
+ Invocation_Graph_Encoding,
+ Invocation_Graph_Encoding_Kind_To_Code, Invoker, Kind, Line,
+ Locations, Name, Scope, Set_Invocation_Graph_Encoding,
+ Signature, Spec_Placement, Target): New routine.
+ * bindo.adb: Add with clause for Binde. Add with and use
+ clauses for Debug. Update the documentation. Add new switches.
+ (Find_Elaboration_Order): Dispatch to the proper elaboration
+ mechanism.
+ * bindo-augmentors.adb:
+ Remove with and use clauses for GNAT and GNAT.Sets. Remove
+ membership set VS. Update the parameter profiles of most
+ routines to use better parameter names. Update the
+ implementation of most routine to use the new parameter names.
+ Remove various redundant assertions.
+ * bindo-builders.adb: Use better names for instantiated data
+ structures. Update all references to these names. Update the
+ parameter profiles of most routines to use better parameter
+ names. Update the implementation of most routine to use the new
+ parameter names.
+ (Build_Library_Graph): Update the parameter profile. Update the
+ call to Create.
+ (Create_Vertex): Reimplemented.
+ (Declaration_Placement_Vertex): New routine.
+ * bindo-builders.ads (Build_Library_Graph): Update the parameter
+ profile and comment on usage.
+ * bindo-diagnostics.adb: Almost a new unit.
+ * bindo-diagnostics.ads: Add a use clause for
+ Bindo.Graphs.Invocation_Graphs. Remove package
+ Cycle_Diagnostics.
+ (Diagnose_Circularities): New routine.
+ * bindo-elaborators.adb: Remove the with and use clauses for
+ Binderr and GNAT.Sets. Remove the use clause for
+ Bindo.Diagnostics.Cycle_Diagnostics. Remove membership set VS.
+ Update the parameter profiles of most routines to use better
+ parameter names. Update the implementation of most routine to
+ use the new parameter names. (Elaborate_Units_Common): Update
+ the parameter profile. Pass an infication to the library graph
+ builder whether the dynamic model is in effect.
+ (Elaborate_Units_Dynamic, Elaborate_Units_Static): Use
+ Diagnose_Circularities to provide diagnostics.
+ (Update_Successor): Use routine In_Same_Component to determine
+ whether the predecessor and successor reside in different
+ components.
+ * bindo-graphs.adb: Add with and use clauses for Butil, Debug,
+ Output, and Bindo.Writers. Remove with and use clauses for
+ GNAT.Lists. Update the parameter profiles of most routines to
+ use better parameter names. Update the implementation of most
+ routine to use the new parameter names. Remove various
+ redundant assertions. Remove doubly linked list EL. Add new
+ type Precedence_Kind.
+ (Add_Cycle): New routine.
+ (Add_Vertex): Update the parameter profile. Update the creation
+ of vertex attributes.
+ (Add_Vertex_And_Complement, Body_Vertex, Column,
+ Complementary_Vertex, Copy_Cycle_Path, Cycle_Kind_Of): New
+ routines.
+ (Destroy_Invocation_Graph_Edge, Destroy_Library_Graph_Cycle,
+ Destroy_Library_Graph_Edge, Extra, File_Name,
+ Find_All_Cycles_Through_Vertex, Find_All_Cycles_With_Edge,
+ Find_Cycles, Find_First_Lower_Precedence_Cycle,
+ Get_LGC_Attributes, Has_Next, Hash_Library_Graph_Cycle,
+ Hash_Library_Graph_Cycle_Attributes, Highest_Precedence_Cycle,
+ Highest_Precedence_Edge, In_Same_Component, Insert_And_Sort,
+ Invocation_Edge_Count, Invocation_Graph_Encoding,
+ Is_Cycle_Initiating_Edge, Is_Cyclic_Edge,
+ Is_Cyclic_Elaborate_All_Edge, Is_Cyclic_Elaborate_Body_Edge,
+ Is_Cyclic_Elaborate_Edge, Is_Cyclic_Forced_Edge,
+ Is_Cyclic_Invocation_Edge, Is_Cyclic_With_Edge,
+ Is_Dynamically_Elaborated, Is_Elaborate_All_Edge,
+ Is_Elaborate_Body_Edge, Is_Elaborate_Edge: New routines.
+ (Is_Existing_Predecessor_Successor_Relation): Removed.
+ (Is_Forced_Edge, Is_Invocation_Edge, Is_Recorded_Cycle,
+ Is_Recorded_Edge, Is_With_Edge, Iterate_Edges_Of_Cycle, Kind,
+ Length): New routine.
+ (Lib_Vertex): Removed.
+ (Line, Links_Vertices_In_Same_Component,
+ Maximum_Invocation_Edge_Count, Next, Normalize_And_Add_Cycle,
+ Normalize_Cycle_Path, Number_Of_Cycles, Path, Precedence,
+ Remove_Vertex_And_Complement, Sequence_Next_Cycle): New routines.
+ (Sequence_Next_IGE_Id): Renamed to Sequence_Next_Edge.
+ (Sequence_Next_IGV_Id): Renamed to Sequence_Next_Vertex.
+ (Sequence_Next_LGE_Id): Renamed to Sequence_Next_Edge.
+ (Sequence_Next_LGV_Id): Renamed to Sequence_Next_Vertex.
+ (Set_Is_Existing_Predecessor_Successor_Relation): Removed.
+ (Set_Is_Recorded_Cycle, Set_Is_Recorded_Edge,
+ Set_LGC_Attributes, Spec_Vertex, Trace_Cycle, Trace_Edge,
+ Trace_Eol, Trace_Vertex): New routines.
+ * bindo-graphs.ads: Add with and use clauses for Types and
+ GNAT.Lists. Update the parameter profiles of most routines to
+ use better parameter names. Update the implementation of most
+ routine to use the new parameter names. Add the new
+ instantiated data structures IGE_Lists, IGV_Sets, LGC_Lists,
+ LGE_Lists, LGE_Sets, LGV_Sets, and RC_Sets. Add new type
+ Library_Graph_Cycle_Id along with an empty and initial value.
+ Remove component Lib_Vertex and add new components Body_Vertex
+ and Spec_Vertex to type Invocation_Graph_Vertex_Attributes. Add
+ new type Library_Graph_Cycle_Kind. Add new iterators
+ All_Cycle_Iterator and Edges_Of_Cycle_Iterator. Add new type
+ Library_Graph_Cycle_Attributes. Add new components
+ Cycle_Attributes, Cycles, and Dynamically_Elaborated to type
+ Library_Graph_Attributes.
+ (Body_Vertex, Column, Destroy_Invocation_Graph_Edge,
+ Destroy_Library_Graph_Cycle_Attributes,
+ Destroy_Library_Graph_Edge, Extra, File_Name, Find_Cycles,
+ Has_Elaborate_All_Cycle, Has_Next, Hash_Library_Graph_Cycle,
+ Hash_Library_Graph_Cycle_Attributes, Highest_Precedence_Cycle,
+ In_Same_Component, Invocation_Edge_Count,
+ Invocation_Graph_Encoding, Is_Dynamically_Elaborated,
+ Is_Elaborate_All_Edge, Is_Elaborate_Body_Edge,
+ Is_Elaborate_Edge, Is_Forced_Edge, Is_Invocation_Edge,
+ Is_With_Edge, Iterate_All_Cycles, Iterate_Edges_Of_Cycle, Kind):
+ New routines.
+ (Length, Lib_Vertex, (Line, Next, Number_Of_Cycles, Present,
+ Same_Library_Graph_Cycle_Attributes, Spec_Vertex): New routines.
+ * bindo-units.adb (File_Name, Invocation_Graph_Encoding): New
+ routines.
+ * bindo-units.ads: Add new instantiated data structure
+ Unit_Sets.
+ (File_Name, Invocation_Graph_Encoding): New routine.
+ * bindo-validators.adb: Remove with and use clauses for GNAT and
+ GNAT.Sets. Remove membership set US. Update the parameter
+ profiles of most routines to use better parameter names. Update
+ the implementation of most routine to use the new parameter
+ names.
+ (Validate_Cycle, Validate_Cycle_Path, Validate_Cycles,
+ Validate_Invocation_Graph_Vertex): Remove the validation of
+ component Lib_Vertex. Add the validation of components
+ Body_Vertex and Spec_Vertex.
+ (Write_Error): New routine.
+ * bindo-validators.ads (Validate_Cycles): New routine.
+ * bindo-writers.adb: Update the parameter profiles of most
+ routines to use better parameter names. Update the
+ implementation of most routine to use the new parameter names.
+ (Write_Cycle, Write_Cyclic_Edge, Write_Cycles): New routines.
+ (Write_Invocation_Graph_Vertex): Remove the output of component
+ Lib_Vertex. Add the output of components Body_Vertex and
+ Spec_Vertex.
+ * bindo-writers.ads (Write_Cycles): New routine.
+ * debug.adb: Use binder switches -d_C and -d_P, add
+ documentation on their usage.
+ * gnatbind.adb: Remove with and use clauses for Binde. Delegate
+ the choice of elaboration mechanism to Bindo.
+ * lib-writ.adb (Column, Extra, Invoker, Kind, Line, Locations,
+ Name, Placement, Scope, Signature, Target): Removed.
+ (Write_Invocation_Graph): Moved at the top level.
+ (Write_Invocation_Graph_Attributes): New routine.
+ (Write_Invocation_Relation, Write_Invocation_Signature): Moved
+ at the top level.
+ * lib-writ.ads: Add a documentation section on invocation graph
+ attributes.
+ * sem_elab.adb (Body_Placement_Of): New routine.
+ (Declare_Invocation_Construct): Update the call to
+ Add_Invocation_Construct.
+ (Declaration_Placement_Of_Node): New routine.
+ (Get_Invocation_Attributes): Correct the retrieval of the
+ enclosing subprogram where the postcondition procedure lives.
+ (Placement_Of, Placement_Of_Node): Removed.
+ (Record_Invocation_Graph): Record the encoding format used.
+ (Record_Invocation_Graph_Encoding): New routine.
+ (Record_Invocation_Relation): Update the call to
+ Add_Invocation_Relation.
+ (Spec_Placement_Of): Removed.
+ * libgnat/g-lists.ads, libgnat/g-lists.adb (Equal): New routine.
+
2019-07-05 Ed Schonberg <schonberg@adacore.com>
* checks.adb (Apply_Predicate_Check): Except within the
use ASCII;
-- Make control characters visible
+ -----------
+ -- Types --
+ -----------
+
+ -- The following type represents an invocation construct
+
+ type Invocation_Construct_Record is record
+ Body_Placement : Declaration_Placement_Kind := No_Declaration_Placement;
+ -- The location of the invocation construct's body with respect to the
+ -- unit where it is declared.
+
+ Kind : Invocation_Construct_Kind := Regular_Construct;
+ -- The nature of the invocation construct
+
+ Signature : Invocation_Signature_Id := No_Invocation_Signature;
+ -- The invocation signature that uniquely identifies the invocation
+ -- construct in the ALI space.
+
+ Spec_Placement : Declaration_Placement_Kind := No_Declaration_Placement;
+ -- The location of the invocation construct's spec with respect to the
+ -- unit where it is declared.
+ end record;
+
+ -- The following type represents an invocation relation. It associates an
+ -- invoker that activates/calls/instantiates with a target.
+
+ type Invocation_Relation_Record is record
+ Extra : Name_Id := No_Name;
+ -- The name of an additional entity used in error diagnostics
+
+ Invoker : Invocation_Signature_Id := No_Invocation_Signature;
+ -- The invocation signature that uniquely identifies the invoker within
+ -- the ALI space.
+
+ Kind : Invocation_Kind := No_Invocation;
+ -- The nature of the invocation
+
+ Target : Invocation_Signature_Id := No_Invocation_Signature;
+ -- The invocation signature that uniquely identifies the target within
+ -- the ALI space.
+ end record;
+
+ -- The following type represents an invocation signature. Its purpose is
+ -- to uniquely identify an invocation construct within the ALI space. The
+ -- signature comprises several pieces, some of which are used in error
+ -- diagnostics by the binder. Identification issues are resolved as
+ -- follows:
+ --
+ -- * The Column, Line, and Locations attributes together differentiate
+ -- between homonyms. In most cases, the Column and Line are sufficient
+ -- except when generic instantiations are involved. Together, the three
+ -- attributes offer a sequence of column-line pairs that eventually
+ -- reflect the location within the generic template.
+ --
+ -- * The Name attribute differentiates between invocation constructs at
+ -- the scope level. Since it is illegal for two entities with the same
+ -- name to coexist in the same scope, the Name attribute is sufficient
+ -- to distinguish them. Overloaded entities are already handled by the
+ -- Column, Line, and Locations attributes.
+ --
+ -- * The Scope attribute differentiates between invocation constructs at
+ -- various levels of nesting.
+
+ type Invocation_Signature_Record is record
+ Column : Nat := 0;
+ -- The column number where the invocation construct is declared
+
+ Line : Nat := 0;
+ -- The line number where the invocation construct is declared
+
+ Locations : Name_Id := No_Name;
+ -- Sequence of column and line numbers within nested instantiations
+
+ Name : Name_Id := No_Name;
+ -- The name of the invocation construct
+
+ Scope : Name_Id := No_Name;
+ -- The qualified name of the scope where the invocation construct is
+ -- declared.
+ end record;
+
---------------------
-- Data structures --
---------------------
+ package Invocation_Constructs is new Table.Table
+ (Table_Index_Type => Invocation_Construct_Id,
+ Table_Component_Type => Invocation_Construct_Record,
+ Table_Low_Bound => First_Invocation_Construct,
+ Table_Initial => 2500,
+ Table_Increment => 200,
+ Table_Name => "Invocation_Constructs");
+
+ package Invocation_Relations is new Table.Table
+ (Table_Index_Type => Invocation_Relation_Id,
+ Table_Component_Type => Invocation_Relation_Record,
+ Table_Low_Bound => First_Invocation_Relation,
+ Table_Initial => 2500,
+ Table_Increment => 200,
+ Table_Name => "Invocation_Relation");
+
+ package Invocation_Signatures is new Table.Table
+ (Table_Index_Type => Invocation_Signature_Id,
+ Table_Component_Type => Invocation_Signature_Record,
+ Table_Low_Bound => First_Invocation_Signature,
+ Table_Initial => 2500,
+ Table_Increment => 200,
+ Table_Name => "Invocation_Signatures");
+
procedure Destroy (IS_Id : in out Invocation_Signature_Id);
-- Destroy an invocation signature with id IS_Id
Sig_To_Sig_Map : constant Sig_Map.Dynamic_Hash_Table :=
Sig_Map.Create (500);
- -- The folowing table maps body placement kinds to character codes for
- -- invocation construct encoding in ALI files.
+ -- The folowing table maps declaration placement kinds to character codes
+ -- for invocation construct encoding in ALI files.
- Body_Placement_Codes :
- constant array (Body_Placement_Kind) of Character :=
- (In_Body => 'b',
- In_Spec => 's',
- No_Body_Placement => 'Z');
+ Declaration_Placement_Codes :
+ constant array (Declaration_Placement_Kind) of Character :=
+ (In_Body => 'b',
+ In_Spec => 's',
+ No_Declaration_Placement => 'Z');
+
+ Compile_Time_Invocation_Graph_Encoding : Invocation_Graph_Encoding_Kind :=
+ No_Encoding;
+ -- The invocation-graph encoding format as specified at compile time. Do
+ -- not manipulate this value directly.
-- The following table maps invocation kinds to character codes for
-- invocation relation encoding in ALI files.
Elaborate_Spec_Procedure => 's',
Regular_Construct => 'Z');
- -- The following table maps invocation graph line kinds to character codes
+ -- The following table maps invocation-graph encoding kinds to character
+ -- codes for invocation-graph encoding in ALI files.
+
+ Invocation_Graph_Encoding_Codes :
+ constant array (Invocation_Graph_Encoding_Kind) of Character :=
+ (Full_Path_Encoding => 'f',
+ Endpoints_Encoding => 'e',
+ No_Encoding => 'Z');
+
+ -- The following table maps invocation-graph line kinds to character codes
-- used in ALI files.
Invocation_Graph_Line_Codes :
constant array (Invocation_Graph_Line_Kind) of Character :=
- (Invocation_Construct_Line => 'c',
- Invocation_Relation_Line => 'r');
+ (Invocation_Construct_Line => 'c',
+ Invocation_Graph_Attributes_Line => 'a',
+ Invocation_Relation_Line => 'r');
-- The following variable records which characters currently are used as
-- line type markers in the ALI file. This is used in Scan_ALI to detect
------------------------------
procedure Add_Invocation_Construct
- (IC_Rec : Invocation_Construct_Record;
- Update_Units : Boolean := True)
+ (Body_Placement : Declaration_Placement_Kind;
+ Kind : Invocation_Construct_Kind;
+ Signature : Invocation_Signature_Id;
+ Spec_Placement : Declaration_Placement_Kind;
+ Update_Units : Boolean := True)
is
- IC_Id : Invocation_Construct_Id;
-
begin
- pragma Assert (Present (IC_Rec.Signature));
+ pragma Assert (Present (Signature));
-- Create a invocation construct from the scanned attributes
- Invocation_Constructs.Append (IC_Rec);
- IC_Id := Invocation_Constructs.Last;
+ Invocation_Constructs.Append
+ ((Body_Placement => Body_Placement,
+ Kind => Kind,
+ Signature => Signature,
+ Spec_Placement => Spec_Placement));
-- Update the invocation construct counter of the current unit only when
-- requested by the caller.
Curr_Unit : Unit_Record renames Units.Table (Units.Last);
begin
- Curr_Unit.Last_Invocation_Construct := IC_Id;
+ Curr_Unit.Last_Invocation_Construct := Invocation_Constructs.Last;
end;
end if;
end Add_Invocation_Construct;
-----------------------------
procedure Add_Invocation_Relation
- (IR_Rec : Invocation_Relation_Record;
+ (Extra : Name_Id;
+ Invoker : Invocation_Signature_Id;
+ Kind : Invocation_Kind;
+ Target : Invocation_Signature_Id;
Update_Units : Boolean := True)
is
- IR_Id : Invocation_Relation_Id;
-
begin
- pragma Assert (Present (IR_Rec.Invoker));
- pragma Assert (Present (IR_Rec.Target));
- pragma Assert (IR_Rec.Kind /= No_Invocation);
+ pragma Assert (Present (Invoker));
+ pragma Assert (Kind /= No_Invocation);
+ pragma Assert (Present (Target));
-- Create an invocation relation from the scanned attributes
- Invocation_Relations.Append (IR_Rec);
- IR_Id := Invocation_Relations.Last;
+ Invocation_Relations.Append
+ ((Extra => Extra,
+ Invoker => Invoker,
+ Kind => Kind,
+ Target => Target));
-- Update the invocation relation counter of the current unit only when
-- requested by the caller.
Curr_Unit : Unit_Record renames Units.Table (Units.Last);
begin
- Curr_Unit.Last_Invocation_Relation := IR_Id;
+ Curr_Unit.Last_Invocation_Relation := Invocation_Relations.Last;
end;
end if;
end Add_Invocation_Relation;
- ---------------------------------
- -- Body_Placement_Kind_To_Code --
- ---------------------------------
+ --------------------
+ -- Body_Placement --
+ --------------------
- function Body_Placement_Kind_To_Code
- (Kind : Body_Placement_Kind) return Character
+ function Body_Placement
+ (IC_Id : Invocation_Construct_Id) return Declaration_Placement_Kind
is
begin
- return Body_Placement_Codes (Kind);
- end Body_Placement_Kind_To_Code;
+ pragma Assert (Present (IC_Id));
+ return Invocation_Constructs.Table (IC_Id).Body_Placement;
+ end Body_Placement;
- ---------------------------------
- -- Code_To_Body_Placement_Kind --
- ---------------------------------
+ ----------------------------------------
+ -- Code_To_Declaration_Placement_Kind --
+ ----------------------------------------
- function Code_To_Body_Placement_Kind
- (Code : Character) return Body_Placement_Kind
+ function Code_To_Declaration_Placement_Kind
+ (Code : Character) return Declaration_Placement_Kind
is
begin
- -- Determine which body placement kind corresponds to the character code
- -- by traversing the contents of the mapping table.
+ -- Determine which placement kind corresponds to the character code by
+ -- traversing the contents of the mapping table.
- for Kind in Body_Placement_Kind loop
- if Body_Placement_Codes (Kind) = Code then
+ for Kind in Declaration_Placement_Kind loop
+ if Declaration_Placement_Codes (Kind) = Code then
return Kind;
end if;
end loop;
raise Program_Error;
- end Code_To_Body_Placement_Kind;
+ end Code_To_Declaration_Placement_Kind;
---------------------------------------
-- Code_To_Invocation_Construct_Kind --
raise Program_Error;
end Code_To_Invocation_Construct_Kind;
+ --------------------------------------------
+ -- Code_To_Invocation_Graph_Encoding_Kind --
+ --------------------------------------------
+
+ function Code_To_Invocation_Graph_Encoding_Kind
+ (Code : Character) return Invocation_Graph_Encoding_Kind
+ is
+ begin
+ -- Determine which invocation-graph encoding kind matches the character
+ -- code by traversing the contents of the mapping table.
+
+ for Kind in Invocation_Graph_Encoding_Kind loop
+ if Invocation_Graph_Encoding_Codes (Kind) = Code then
+ return Kind;
+ end if;
+ end loop;
+
+ raise Program_Error;
+ end Code_To_Invocation_Graph_Encoding_Kind;
+
-----------------------------
-- Code_To_Invocation_Kind --
-----------------------------
(Code : Character) return Invocation_Graph_Line_Kind
is
begin
- -- Determine which invocation graph line kind matches the character
+ -- Determine which invocation-graph line kind matches the character
-- code by traversing the contents of the mapping table.
for Kind in Invocation_Graph_Line_Kind loop
raise Program_Error;
end Code_To_Invocation_Graph_Line_Kind;
+ ------------
+ -- Column --
+ ------------
+
+ function Column (IS_Id : Invocation_Signature_Id) return Nat is
+ begin
+ pragma Assert (Present (IS_Id));
+ return Invocation_Signatures.Table (IS_Id).Column;
+ end Column;
+
+ ----------------------------------------
+ -- Declaration_Placement_Kind_To_Code --
+ ----------------------------------------
+
+ function Declaration_Placement_Kind_To_Code
+ (Kind : Declaration_Placement_Kind) return Character
+ is
+ begin
+ return Declaration_Placement_Codes (Kind);
+ end Declaration_Placement_Kind_To_Code;
+
-------------
-- Destroy --
-------------
null;
end Destroy;
+ -----------
+ -- Extra --
+ -----------
+
+ function Extra (IR_Id : Invocation_Relation_Id) return Name_Id is
+ begin
+ pragma Assert (Present (IR_Id));
+ return Invocation_Relations.Table (IR_Id).Extra;
+ end Extra;
+
+ -----------------------------------
+ -- For_Each_Invocation_Construct --
+ -----------------------------------
+
+ procedure For_Each_Invocation_Construct
+ (Processor : Invocation_Construct_Processor_Ptr)
+ is
+ begin
+ pragma Assert (Processor /= null);
+
+ for IC_Id in Invocation_Constructs.First ..
+ Invocation_Constructs.Last
+ loop
+ Processor.all (IC_Id);
+ end loop;
+ end For_Each_Invocation_Construct;
+
+ ----------------------------------
+ -- For_Each_Invocation_Relation --
+ ----------------------------------
+
+ procedure For_Each_Invocation_Relation
+ (Processor : Invocation_Relation_Processor_Ptr)
+ is
+ begin
+ pragma Assert (Processor /= null);
+
+ for IR_Id in Invocation_Relations.First ..
+ Invocation_Relations.Last
+ loop
+ Processor.all (IR_Id);
+ end loop;
+ end For_Each_Invocation_Relation;
+
----------
-- Hash --
----------
return Invocation_Construct_Codes (Kind);
end Invocation_Construct_Kind_To_Code;
+ -------------------------------
+ -- Invocation_Graph_Encoding --
+ -------------------------------
+
+ function Invocation_Graph_Encoding return Invocation_Graph_Encoding_Kind is
+ begin
+ return Compile_Time_Invocation_Graph_Encoding;
+ end Invocation_Graph_Encoding;
+
+ --------------------------------------------
+ -- Invocation_Graph_Encoding_Kind_To_Code --
+ --------------------------------------------
+
+ function Invocation_Graph_Encoding_Kind_To_Code
+ (Kind : Invocation_Graph_Encoding_Kind) return Character
+ is
+ begin
+ return Invocation_Graph_Encoding_Codes (Kind);
+ end Invocation_Graph_Encoding_Kind_To_Code;
+
----------------------------------------
-- Invocation_Graph_Line_Kind_To_Code --
----------------------------------------
return IS_Id;
end Invocation_Signature_Of;
+ -------------
+ -- Invoker --
+ -------------
+
+ function Invoker
+ (IR_Id : Invocation_Relation_Id) return Invocation_Signature_Id
+ is
+ begin
+ pragma Assert (Present (IR_Id));
+ return Invocation_Relations.Table (IR_Id).Invoker;
+ end Invoker;
+
+ ----------
+ -- Kind --
+ ----------
+
+ function Kind
+ (IC_Id : Invocation_Construct_Id) return Invocation_Construct_Kind
+ is
+ begin
+ pragma Assert (Present (IC_Id));
+ return Invocation_Constructs.Table (IC_Id).Kind;
+ end Kind;
+
+ ----------
+ -- Kind --
+ ----------
+
+ function Kind (IR_Id : Invocation_Relation_Id) return Invocation_Kind is
+ begin
+ pragma Assert (Present (IR_Id));
+ return Invocation_Relations.Table (IR_Id).Kind;
+ end Kind;
+
+ ----------
+ -- Line --
+ ----------
+
+ function Line (IS_Id : Invocation_Signature_Id) return Nat is
+ begin
+ pragma Assert (Present (IS_Id));
+ return Invocation_Signatures.Table (IS_Id).Line;
+ end Line;
+
+ ---------------
+ -- Locations --
+ ---------------
+
+ function Locations (IS_Id : Invocation_Signature_Id) return Name_Id is
+ begin
+ pragma Assert (Present (IS_Id));
+ return Invocation_Signatures.Table (IS_Id).Locations;
+ end Locations;
+
+ ----------
+ -- Name --
+ ----------
+
+ function Name (IS_Id : Invocation_Signature_Id) return Name_Id is
+ begin
+ pragma Assert (Present (IS_Id));
+ return Invocation_Signatures.Table (IS_Id).Name;
+ end Name;
+
-------------
-- Present --
-------------
--
-- If Ignore_Special is False (normal case), the scan is terminated by
-- a typeref bracket or an equal sign except for the special case of
- -- an operator name starting with a double quote which is terminated
+ -- an operator name starting with a double quote that is terminated
-- by another double quote.
--
-- If May_Be_Quoted is True and the first non blank character is '"'
-- Parse the definition of a typeref (<...>, {...} or (...))
procedure Scan_Invocation_Graph_Line;
- -- Parse a single line which encodes a piece of the invocation graph
+ -- Parse a single line that encodes a piece of the invocation graph
procedure Skip_Eol;
-- Skip past spaces, then skip past end of line (fatal error if not
-- * Invocation_Constructs
-- * Units
+ procedure Scan_Invocation_Graph_Attributes_Line;
+ pragma Inline (Scan_Invocation_Graph_Attributes_Line);
+ -- Parse an invocation-graph attributes line. The following data
+ -- structures are updated:
+ --
+ -- * Units
+
procedure Scan_Invocation_Relation_Line;
pragma Inline (Scan_Invocation_Relation_Line);
-- Parse an invocation relation line and construct the corresponding
------------------------------------
procedure Scan_Invocation_Construct_Line is
- IC_Rec : Invocation_Construct_Record;
+ Body_Placement : Declaration_Placement_Kind;
+ Kind : Invocation_Construct_Kind;
+ Signature : Invocation_Signature_Id;
+ Spec_Placement : Declaration_Placement_Kind;
begin
-- construct-kind
- IC_Rec.Kind := Code_To_Invocation_Construct_Kind (Getc);
+ Kind := Code_To_Invocation_Construct_Kind (Getc);
+ Checkc (' ');
+ Skip_Space;
+
+ -- construct-spec-placement
+
+ Spec_Placement := Code_To_Declaration_Placement_Kind (Getc);
Checkc (' ');
Skip_Space;
-- construct-body-placement
- IC_Rec.Placement := Code_To_Body_Placement_Kind (Getc);
+ Body_Placement := Code_To_Declaration_Placement_Kind (Getc);
Checkc (' ');
Skip_Space;
-- construct-signature
- IC_Rec.Signature := Scan_Invocation_Signature;
- pragma Assert (Present (IC_Rec.Signature));
-
+ Signature := Scan_Invocation_Signature;
Skip_Eol;
- Add_Invocation_Construct (IC_Rec);
+ Add_Invocation_Construct
+ (Body_Placement => Body_Placement,
+ Kind => Kind,
+ Signature => Signature,
+ Spec_Placement => Spec_Placement);
end Scan_Invocation_Construct_Line;
+ -------------------------------------------
+ -- Scan_Invocation_Graph_Attributes_Line --
+ -------------------------------------------
+
+ procedure Scan_Invocation_Graph_Attributes_Line is
+ begin
+ -- encoding-kind
+
+ Set_Invocation_Graph_Encoding
+ (Code_To_Invocation_Graph_Encoding_Kind (Getc));
+ Skip_Eol;
+ end Scan_Invocation_Graph_Attributes_Line;
+
-----------------------------------
-- Scan_Invocation_Relation_Line --
-----------------------------------
procedure Scan_Invocation_Relation_Line is
- IR_Rec : Invocation_Relation_Record;
+ Extra : Name_Id;
+ Invoker : Invocation_Signature_Id;
+ Kind : Invocation_Kind;
+ Target : Invocation_Signature_Id;
begin
-- relation-kind
- IR_Rec.Kind := Code_To_Invocation_Kind (Getc);
+ Kind := Code_To_Invocation_Kind (Getc);
Checkc (' ');
Skip_Space;
-- (extra-name | "none")
- IR_Rec.Extra := Get_Name;
+ Extra := Get_Name;
- if IR_Rec.Extra = Name_None then
- IR_Rec.Extra := No_Name;
+ if Extra = Name_None then
+ Extra := No_Name;
end if;
Checkc (' ');
-- invoker-signature
- IR_Rec.Invoker := Scan_Invocation_Signature;
- pragma Assert (Present (IR_Rec.Invoker));
-
+ Invoker := Scan_Invocation_Signature;
Checkc (' ');
Skip_Space;
-- target-signature
- IR_Rec.Target := Scan_Invocation_Signature;
- pragma Assert (Present (IR_Rec.Target));
-
+ Target := Scan_Invocation_Signature;
Skip_Eol;
- Add_Invocation_Relation (IR_Rec);
+ Add_Invocation_Relation
+ (Extra => Extra,
+ Invoker => Invoker,
+ Kind => Kind,
+ Target => Target);
end Scan_Invocation_Relation_Line;
-------------------------------
-- line-attributes
- if Line = Invocation_Construct_Line then
- Scan_Invocation_Construct_Line;
+ case Line is
+ when Invocation_Construct_Line =>
+ Scan_Invocation_Construct_Line;
- else
- pragma Assert (Line = Invocation_Relation_Line);
- Scan_Invocation_Relation_Line;
- end if;
+ when Invocation_Graph_Attributes_Line =>
+ Scan_Invocation_Graph_Attributes_Line;
+
+ when Invocation_Relation_Line =>
+ Scan_Invocation_Relation_Line;
+ end case;
end Scan_Invocation_Graph_Line;
--------------
ALIs.Table (Id).Last_Sdep := Sdep.Last;
- -- Loop through invocation graph lines
+ -- Loop through invocation-graph lines
G_Loop : loop
Check_Unknown_Line;
return No_ALI_Id;
end Scan_ALI;
+ -----------
+ -- Scope --
+ -----------
+
+ function Scope (IS_Id : Invocation_Signature_Id) return Name_Id is
+ begin
+ pragma Assert (Present (IS_Id));
+ return Invocation_Signatures.Table (IS_Id).Scope;
+ end Scope;
+
---------
-- SEq --
---------
return F1.all = F2.all;
end SEq;
+ -----------------------------------
+ -- Set_Invocation_Graph_Encoding --
+ -----------------------------------
+
+ procedure Set_Invocation_Graph_Encoding
+ (Kind : Invocation_Graph_Encoding_Kind;
+ Update_Units : Boolean := True)
+ is
+ begin
+ Compile_Time_Invocation_Graph_Encoding := Kind;
+
+ -- Update the invocation-graph encoding of the current unit only when
+ -- requested by the caller.
+
+ if Update_Units then
+ declare
+ Curr_Unit : Unit_Record renames Units.Table (Units.Last);
+
+ begin
+ Curr_Unit.Invocation_Graph_Encoding := Kind;
+ end;
+ end if;
+ end Set_Invocation_Graph_Encoding;
+
-----------
-- SHash --
-----------
return Vindex (Vindex'First + Vindex (H mod Vindex'Range_Length));
end SHash;
+ ---------------
+ -- Signature --
+ ---------------
+
+ function Signature
+ (IC_Id : Invocation_Construct_Id) return Invocation_Signature_Id
+ is
+ begin
+ pragma Assert (Present (IC_Id));
+ return Invocation_Constructs.Table (IC_Id).Signature;
+ end Signature;
+
+ --------------------
+ -- Spec_Placement --
+ --------------------
+
+ function Spec_Placement
+ (IC_Id : Invocation_Construct_Id) return Declaration_Placement_Kind
+ is
+ begin
+ pragma Assert (Present (IC_Id));
+ return Invocation_Constructs.Table (IC_Id).Spec_Placement;
+ end Spec_Placement;
+
+ ------------
+ -- Target --
+ ------------
+
+ function Target
+ (IR_Id : Invocation_Relation_Id) return Invocation_Signature_Id
+ is
+ begin
+ pragma Assert (Present (IR_Id));
+ return Invocation_Relations.Table (IR_Id).Target;
+ end Target;
+
end ALI;
First_ALI_Entry : constant ALI_Id := No_ALI_Id + 1;
-- Id of first actual entry in table
+ -- The following type enumerates all possible invocation-graph encoding
+ -- kinds.
+
+ type Invocation_Graph_Encoding_Kind is
+ (Endpoints_Encoding,
+ -- The invocation construct and relation lines contain information for
+ -- the start construct and end target found on an invocation-graph path.
+
+ Full_Path_Encoding,
+ -- The invocation construct and relation lines contain information for
+ -- all constructs and targets found on a invocation-graph path.
+
+ No_Encoding);
+
type Main_Program_Type is (None, Proc, Func);
-- Indicator of whether unit can be used as main program
Last_Arg : Arg_Id;
-- Id of last args table entry for this file
+ Invocation_Graph_Encoding : Invocation_Graph_Encoding_Kind;
+ -- The encoding format used to capture information about the invocation
+ -- constructs and relations within the corresponding ALI file of this
+ -- unit.
+
First_Invocation_Construct : Invocation_Construct_Id;
-- Id of the first invocation construct for this unit
-- Invocation Graph Types --
----------------------------
+ -- The following type identifies an invocation construct
+
+ No_Invocation_Construct : constant Invocation_Construct_Id :=
+ Invocation_Construct_Id'First;
+ First_Invocation_Construct : constant Invocation_Construct_Id :=
+ No_Invocation_Construct + 1;
+
+ -- The following type identifies an invocation relation
+
+ No_Invocation_Relation : constant Invocation_Relation_Id :=
+ Invocation_Relation_Id'First;
+ First_Invocation_Relation : constant Invocation_Relation_Id :=
+ No_Invocation_Relation + 1;
+
-- The following type identifies an invocation signature
No_Invocation_Signature : constant Invocation_Signature_Id :=
First_Invocation_Signature : constant Invocation_Signature_Id :=
No_Invocation_Signature + 1;
- -- The following type represents an invocation signature. Its purpose is
- -- to uniquely identify an invocation construct within the ALI space. The
- -- signature is comprised out of several pieces, some of which are used in
- -- error diagnostics by the binder. Identification issues are resolved as
- -- follows:
- --
- -- * The Column, Line, and Locations attributes together differentiate
- -- between homonyms. In most cases, the Column and Line are sufficient
- -- except when generic instantiations are involved. Together, the three
- -- attributes offer a sequence of column-line pairs which eventually
- -- reflect the location within the generic template.
- --
- -- * The Name attribute differentiates between invocation constructs at
- -- the scope level. Since it is illegal for two entities with the same
- -- name to coexist in the same scope, the Name attribute is sufficient
- -- to distinguish them. Overloaded entities are already handled by the
- -- Column, Line, and Locations attributes.
- --
- -- * The Scope attribute differentiates between invocation constructs at
- -- various levels of nesting.
-
- type Invocation_Signature_Record is record
- Column : Nat := 0;
- -- The column number where the invocation construct is declared
-
- Line : Nat := 0;
- -- The line number where the invocation construct is declared
-
- Locations : Name_Id := No_Name;
- -- Sequence of column and line numbers within nested instantiations
-
- Name : Name_Id := No_Name;
- -- The name of the invocation construct
-
- Scope : Name_Id := No_Name;
- -- The qualified name of the scope where the invocation construct is
- -- declared.
- end record;
-
-- The following type enumerates all possible placements of an invocation
- -- construct's body body with respect to the unit it is declared in.
+ -- construct's spec and body with respect to the unit it is declared in.
- type Body_Placement_Kind is
+ type Declaration_Placement_Kind is
(In_Body,
- -- The body of the invocation construct is within the body of the unit
- -- it is declared in.
+ -- The declaration of the invocation construct is within the body of the
+ -- unit it is declared in.
In_Spec,
- -- The body of the invocation construct is within the spec of the unit
- -- it is declared in.
+ -- The declaration of the invocation construct is within the spec of the
+ -- unit it is declared in.
- No_Body_Placement);
- -- The invocation construct does not have a body
+ No_Declaration_Placement);
+ -- The invocation construct does not have a declaration
-- The following type enumerates all possible invocation construct kinds
Regular_Construct);
-- The invocation construct is a normal invocation construct
- -- The following type identifies an invocation construct
-
- No_Invocation_Construct : constant Invocation_Construct_Id :=
- Invocation_Construct_Id'First;
- First_Invocation_Construct : constant Invocation_Construct_Id :=
- No_Invocation_Construct + 1;
-
- -- The following type represents an invocation construct
-
- type Invocation_Construct_Record is record
- Kind : Invocation_Construct_Kind := Regular_Construct;
- -- The nature of the invocation construct
-
- Placement : Body_Placement_Kind := No_Body_Placement;
- -- The location of the invocation construct's body with respect to the
- -- body of the unit it is declared in.
-
- Signature : Invocation_Signature_Id := No_Invocation_Signature;
- -- The invocation signature which uniquely identifies the invocation
- -- construct in the ALI space.
- end record;
-
- -- The following type identifies an invocation relation
-
- No_Invocation_Relation : constant Invocation_Relation_Id :=
- Invocation_Relation_Id'First;
- First_Invocation_Relation : constant Invocation_Relation_Id :=
- No_Invocation_Relation + 1;
-
-- The following type enumerates all possible invocation kinds
type Invocation_Kind is
-- Internal_Controlled_Finalization
Internal_Controlled_Initialization;
- -- The following type represents an invocation relation. It associates an
- -- invoker which activates/calls/instantiates with a target.
-
- type Invocation_Relation_Record is record
- Extra : Name_Id := No_Name;
- -- The name of an additional entity used in error diagnostics
-
- Invoker : Invocation_Signature_Id := No_Invocation_Signature;
- -- The invocation signature which uniquely identifies the invoker within
- -- the ALI space.
-
- Kind : Invocation_Kind := No_Invocation;
- -- The nature of the invocation
-
- Target : Invocation_Signature_Id := No_Invocation_Signature;
- -- The invocation signature which uniquely identifies the target within
- -- the ALI space.
- end record;
-
- -- The following type enumerates all possible invocation graph ALI lines
+ -- The following type enumerates all possible invocation-graph ALI lines
type Invocation_Graph_Line_Kind is
(Invocation_Construct_Line,
+ Invocation_Graph_Attributes_Line,
Invocation_Relation_Line);
- --------------------------------------
- -- Invocation Graph Data Structures --
- --------------------------------------
-
- package Invocation_Constructs is new Table.Table
- (Table_Index_Type => Invocation_Construct_Id,
- Table_Component_Type => Invocation_Construct_Record,
- Table_Low_Bound => First_Invocation_Construct,
- Table_Initial => 2500,
- Table_Increment => 200,
- Table_Name => "Invocation_Constructs");
-
- package Invocation_Relations is new Table.Table
- (Table_Index_Type => Invocation_Relation_Id,
- Table_Component_Type => Invocation_Relation_Record,
- Table_Low_Bound => First_Invocation_Relation,
- Table_Initial => 2500,
- Table_Increment => 200,
- Table_Name => "Invocation_Relation");
-
- package Invocation_Signatures is new Table.Table
- (Table_Index_Type => Invocation_Signature_Id,
- Table_Component_Type => Invocation_Signature_Record,
- Table_Low_Bound => First_Invocation_Signature,
- Table_Initial => 2500,
- Table_Increment => 200,
- Table_Name => "Invocation_Signatures");
-
----------------------------------
-- Invocation Graph Subprograms --
----------------------------------
procedure Add_Invocation_Construct
- (IC_Rec : Invocation_Construct_Record;
- Update_Units : Boolean := True);
+ (Body_Placement : Declaration_Placement_Kind;
+ Kind : Invocation_Construct_Kind;
+ Signature : Invocation_Signature_Id;
+ Spec_Placement : Declaration_Placement_Kind;
+ Update_Units : Boolean := True);
pragma Inline (Add_Invocation_Construct);
- -- Add invocation construct attributes IC_Rec to internal data structures.
- -- Flag Undate_Units should be set when this addition must be reflected in
- -- the attributes of the current unit.
+ -- Add a new invocation construct described by its attributes. Update_Units
+ -- should be set when this addition must be reflected in the attributes of
+ -- the current unit.
procedure Add_Invocation_Relation
- (IR_Rec : Invocation_Relation_Record;
+ (Extra : Name_Id;
+ Invoker : Invocation_Signature_Id;
+ Kind : Invocation_Kind;
+ Target : Invocation_Signature_Id;
Update_Units : Boolean := True);
pragma Inline (Add_Invocation_Relation);
- -- Add invocation relation attributes IR_Rec to internal data structures.
- -- Flag Undate_Units should be set when this addition must be reflected in
- -- the attributes of the current unit.
+ -- Add a new invocation relation described by its attributes. Update_Units
+ -- should be set when this addition must be reflected in the attributes of
+ -- the current unit.
- function Body_Placement_Kind_To_Code
- (Kind : Body_Placement_Kind) return Character;
- pragma Inline (Body_Placement_Kind_To_Code);
- -- Obtain the character encoding of body placement kind Kind
+ function Body_Placement
+ (IC_Id : Invocation_Construct_Id) return Declaration_Placement_Kind;
+ pragma Inline (Body_Placement);
+ -- Obtain the location of invocation construct IC_Id's body with respect to
+ -- the unit where it is declared.
- function Code_To_Body_Placement_Kind
- (Code : Character) return Body_Placement_Kind;
- pragma Inline (Code_To_Body_Placement_Kind);
- -- Obtain the body placement kind of character encoding Code
+ function Code_To_Declaration_Placement_Kind
+ (Code : Character) return Declaration_Placement_Kind;
+ pragma Inline (Code_To_Declaration_Placement_Kind);
+ -- Obtain the declaration placement kind of character encoding Code
function Code_To_Invocation_Construct_Kind
(Code : Character) return Invocation_Construct_Kind;
pragma Inline (Code_To_Invocation_Construct_Kind);
-- Obtain the invocation construct kind of character encoding Code
+ function Code_To_Invocation_Graph_Encoding_Kind
+ (Code : Character) return Invocation_Graph_Encoding_Kind;
+ pragma Inline (Code_To_Invocation_Graph_Encoding_Kind);
+ -- Obtain the invocation-graph encoding kind of character encoding Code
+
function Code_To_Invocation_Kind
(Code : Character) return Invocation_Kind;
pragma Inline (Code_To_Invocation_Kind);
function Code_To_Invocation_Graph_Line_Kind
(Code : Character) return Invocation_Graph_Line_Kind;
pragma Inline (Code_To_Invocation_Graph_Line_Kind);
- -- Obtain the invocation graph line kind of character encoding Code
+ -- Obtain the invocation-graph line kind of character encoding Code
+
+ function Column (IS_Id : Invocation_Signature_Id) return Nat;
+ pragma Inline (Column);
+ -- Obtain the column number of invocation signature IS_Id
+
+ function Declaration_Placement_Kind_To_Code
+ (Kind : Declaration_Placement_Kind) return Character;
+ pragma Inline (Declaration_Placement_Kind_To_Code);
+ -- Obtain the character encoding of declaration placement kind Kind
+
+ function Extra (IR_Id : Invocation_Relation_Id) return Name_Id;
+ pragma Inline (Extra);
+ -- Obtain the name of the additional entity used in error diagnostics for
+ -- invocation relation IR_Id.
+
+ type Invocation_Construct_Processor_Ptr is
+ access procedure (IC_Id : Invocation_Construct_Id);
+
+ procedure For_Each_Invocation_Construct
+ (Processor : Invocation_Construct_Processor_Ptr);
+ pragma Inline (For_Each_Invocation_Construct);
+ -- Invoke Processor on each invocation construct
+
+ type Invocation_Relation_Processor_Ptr is
+ access procedure (IR_Id : Invocation_Relation_Id);
+
+ procedure For_Each_Invocation_Relation
+ (Processor : Invocation_Relation_Processor_Ptr);
+ pragma Inline (For_Each_Invocation_Relation);
+ -- Invoker Processor on each invocation relation
function Invocation_Construct_Kind_To_Code
(Kind : Invocation_Construct_Kind) return Character;
pragma Inline (Invocation_Construct_Kind_To_Code);
-- Obtain the character encoding of invocation kind Kind
+ function Invocation_Graph_Encoding return Invocation_Graph_Encoding_Kind;
+ pragma Inline (Invocation_Graph_Encoding);
+ -- Obtain the encoding format used to capture information about the
+ -- invocation constructs and relations within the ALI file of the main
+ -- unit.
+
+ function Invocation_Graph_Encoding_Kind_To_Code
+ (Kind : Invocation_Graph_Encoding_Kind) return Character;
+ pragma Inline (Invocation_Graph_Encoding_Kind_To_Code);
+ -- Obtain the character encoding for invocation-graph encoding kind Kind
+
function Invocation_Graph_Line_Kind_To_Code
(Kind : Invocation_Graph_Line_Kind) return Character;
pragma Inline (Invocation_Graph_Line_Kind_To_Code);
- -- Obtain the character encoding for invocation like kind Kind
+ -- Obtain the character encoding for invocation line kind Kind
function Invocation_Kind_To_Code
(Kind : Invocation_Kind) return Character;
pragma Inline (Invocation_Signature_Of);
-- Obtain the invocation signature that corresponds to the input attributes
+ function Invoker
+ (IR_Id : Invocation_Relation_Id) return Invocation_Signature_Id;
+ pragma Inline (Invoker);
+ -- Obtain the signature of the invocation relation IR_Id's invoker
+
+ function Kind
+ (IC_Id : Invocation_Construct_Id) return Invocation_Construct_Kind;
+ pragma Inline (Kind);
+ -- Obtain the nature of invocation construct IC_Id
+
+ function Kind
+ (IR_Id : Invocation_Relation_Id) return Invocation_Kind;
+ pragma Inline (Kind);
+ -- Obtain the nature of invocation relation IR_Id
+
+ function Line (IS_Id : Invocation_Signature_Id) return Nat;
+ pragma Inline (Line);
+ -- Obtain the line number of invocation signature IS_Id
+
+ function Locations (IS_Id : Invocation_Signature_Id) return Name_Id;
+ pragma Inline (Locations);
+ -- Obtain the sequence of column and line numbers within nested instances
+ -- of invocation signature IS_Id
+
+ function Name (IS_Id : Invocation_Signature_Id) return Name_Id;
+ pragma Inline (Name);
+ -- Obtain the name of invocation signature IS_Id
+
+ function Scope (IS_Id : Invocation_Signature_Id) return Name_Id;
+ pragma Inline (Scope);
+ -- Obtain the scope of invocation signature IS_Id
+
+ procedure Set_Invocation_Graph_Encoding
+ (Kind : Invocation_Graph_Encoding_Kind;
+ Update_Units : Boolean := True);
+ pragma Inline (Set_Invocation_Graph_Encoding);
+ -- Set the encoding format used to capture information about the invocation
+ -- constructs and relations within the ALI file of the main unit to Kind.
+ -- Update_Units should be set when this action must be reflected in the
+ -- attributes of the current unit.
+
+ function Signature
+ (IC_Id : Invocation_Construct_Id) return Invocation_Signature_Id;
+ pragma Inline (Signature);
+ -- Obtain the signature of invocation construct IC_Id
+
+ function Spec_Placement
+ (IC_Id : Invocation_Construct_Id) return Declaration_Placement_Kind;
+ pragma Inline (Spec_Placement);
+ -- Obtain the location of invocation construct IC_Id's spec with respect to
+ -- the unit where it is declared.
+
+ function Target
+ (IR_Id : Invocation_Relation_Id) return Invocation_Signature_Id;
+ pragma Inline (Target);
+ -- Obtain the signature of the invocation relation IR_Id's target
+
--------------------------------------
-- Subprograms for Reading ALI File --
--------------------------------------
with Bindo.Writers; use Bindo.Writers;
-with GNAT; use GNAT;
-with GNAT.Sets; use GNAT.Sets;
-
package body Bindo.Augmentors is
------------------------------
package body Library_Graph_Augmentors is
- -----------------
- -- Visited set --
- -----------------
-
- package VS is new Membership_Sets
- (Element_Type => Invocation_Graph_Vertex_Id,
- "=" => "=",
- Hash => Hash_Invocation_Graph_Vertex);
- use VS;
-
-----------------
-- Global data --
-----------------
- Inv_Graph : Invocation_Graph := Invocation_Graphs.Nil;
- Lib_Graph : Library_Graph := Library_Graphs.Nil;
- Visited : Membership_Set := VS.Nil;
+ Inv_Graph : Invocation_Graph := Invocation_Graphs.Nil;
+ Lib_Graph : Library_Graph := Library_Graphs.Nil;
+ Visited : IGV_Sets.Membership_Set := IGV_Sets.Nil;
----------------
-- Statistics --
-----------------------
function Is_Visited
- (IGV_Id : Invocation_Graph_Vertex_Id) return Boolean;
+ (Vertex : Invocation_Graph_Vertex_Id) return Boolean;
pragma Inline (Is_Visited);
- -- Determine whether invocation graph vertex IGV_Id has been visited
+ -- Determine whether invocation graph vertex Vertex has been visited
-- during the traversal.
procedure Set_Is_Visited
- (IGV_Id : Invocation_Graph_Vertex_Id;
+ (Vertex : Invocation_Graph_Vertex_Id;
Val : Boolean := True);
pragma Inline (Set_Is_Visited);
- -- Mark invocation graph vertex IGV_Id as visited during the traversal
+ -- Mark invocation graph vertex Vertex as visited during the traversal
-- depending on value Val.
procedure Visit_Elaboration_Root (Root : Invocation_Graph_Vertex_Id);
-- successor is the current root.
procedure Visit_Vertex
- (Curr_IGV_Id : Invocation_Graph_Vertex_Id;
- Last_LGV_Id : Library_Graph_Vertex_Id;
- Root_LGV_Id : Library_Graph_Vertex_Id;
- Internal_Ctrl : Boolean;
- Path : Natural);
+ (Invoker : Invocation_Graph_Vertex_Id;
+ Last_Vertex : Library_Graph_Vertex_Id;
+ Root_Vertex : Library_Graph_Vertex_Id;
+ Internal_Controlled_Action : Boolean;
+ Path : Natural);
pragma Inline (Visit_Vertex);
- -- Visit invocation graph vertex Curr_IGV_Id to:
+ -- Visit invocation graph vertex Invoker to:
--
-- * Detect a transition from the last library graph vertex denoted by
- -- Last_LGV_Id to the library graph vertex of Curr_IGV_Id.
+ -- Last_Vertex to the library graph vertex of Invoker.
--
-- * Create an invocation edge in library graph Lib_Graph to reflect
-- the transition, where the predecessor is the library graph vertex
- -- or Curr_IGV_Id, and the successor is Root_LGV_Id.
+ -- or Invoker, and the successor is Root_Vertex.
--
- -- * Visit the neighbours of Curr_IGV_Id.
+ -- * Visit the neighbours of Invoker.
--
- -- Flag Internal_Ctrl should be set when the DFS traversal visited an
- -- internal controlled invocation edge. Path denotes the length of the
- -- path.
+ -- Flag Internal_Controlled_Action should be set when the DFS traversal
+ -- visited an internal controlled invocation edge. Path is the length of
+ -- the path.
procedure Write_Statistics;
pragma Inline (Write_Statistics);
----------------
function Is_Visited
- (IGV_Id : Invocation_Graph_Vertex_Id) return Boolean
+ (Vertex : Invocation_Graph_Vertex_Id) return Boolean
is
begin
- pragma Assert (Present (Visited));
- pragma Assert (Present (IGV_Id));
+ pragma Assert (IGV_Sets.Present (Visited));
+ pragma Assert (Present (Vertex));
- return Contains (Visited, IGV_Id);
+ return IGV_Sets.Contains (Visited, Vertex);
end Is_Visited;
--------------------
--------------------
procedure Set_Is_Visited
- (IGV_Id : Invocation_Graph_Vertex_Id;
+ (Vertex : Invocation_Graph_Vertex_Id;
Val : Boolean := True)
is
begin
- pragma Assert (Present (Visited));
- pragma Assert (Present (IGV_Id));
+ pragma Assert (IGV_Sets.Present (Visited));
+ pragma Assert (Present (Vertex));
if Val then
- Insert (Visited, IGV_Id);
+ IGV_Sets.Insert (Visited, Vertex);
else
- Delete (Visited, IGV_Id);
+ IGV_Sets.Delete (Visited, Vertex);
end if;
end Set_Is_Visited;
pragma Assert (Present (Root));
pragma Assert (Present (Lib_Graph));
- Root_LGV_Id : constant Library_Graph_Vertex_Id :=
- Lib_Vertex (Inv_Graph, Root);
+ Root_Vertex : constant Library_Graph_Vertex_Id :=
+ Body_Vertex (Inv_Graph, Root);
- pragma Assert (Present (Root_LGV_Id));
+ pragma Assert (Present (Root_Vertex));
begin
-- Prepare the global data
- Visited := Create (Number_Of_Vertices (Inv_Graph));
+ Visited := IGV_Sets.Create (Number_Of_Vertices (Inv_Graph));
Visit_Vertex
- (Curr_IGV_Id => Root,
- Last_LGV_Id => Root_LGV_Id,
- Root_LGV_Id => Root_LGV_Id,
- Internal_Ctrl => False,
- Path => 0);
+ (Invoker => Root,
+ Last_Vertex => Root_Vertex,
+ Root_Vertex => Root_Vertex,
+ Internal_Controlled_Action => False,
+ Path => 0);
- Destroy (Visited);
+ IGV_Sets.Destroy (Visited);
end Visit_Elaboration_Root;
-----------------------------
Iter := Iterate_Elaboration_Roots (Inv_Graph);
while Has_Next (Iter) loop
Next (Iter, Root);
- pragma Assert (Present (Root));
Visit_Elaboration_Root (Root);
end loop;
------------------
procedure Visit_Vertex
- (Curr_IGV_Id : Invocation_Graph_Vertex_Id;
- Last_LGV_Id : Library_Graph_Vertex_Id;
- Root_LGV_Id : Library_Graph_Vertex_Id;
- Internal_Ctrl : Boolean;
- Path : Natural)
+ (Invoker : Invocation_Graph_Vertex_Id;
+ Last_Vertex : Library_Graph_Vertex_Id;
+ Root_Vertex : Library_Graph_Vertex_Id;
+ Internal_Controlled_Action : Boolean;
+ Path : Natural)
is
New_Path : constant Natural := Path + 1;
- Curr_LGV_Id : Library_Graph_Vertex_Id;
- IGE_Id : Invocation_Graph_Edge_Id;
- Iter : Edges_To_Targets_Iterator;
- Targ : Invocation_Graph_Vertex_Id;
+ Edge : Invocation_Graph_Edge_Id;
+ Invoker_Vertex : Library_Graph_Vertex_Id;
+ Iter : Edges_To_Targets_Iterator;
begin
pragma Assert (Present (Inv_Graph));
- pragma Assert (Present (Curr_IGV_Id));
pragma Assert (Present (Lib_Graph));
- pragma Assert (Present (Last_LGV_Id));
- pragma Assert (Present (Root_LGV_Id));
+ pragma Assert (Present (Invoker));
+ pragma Assert (Present (Last_Vertex));
+ pragma Assert (Present (Root_Vertex));
-- Nothing to do when the current invocation graph vertex has already
-- been visited.
- if Is_Visited (Curr_IGV_Id) then
+ if Is_Visited (Invoker) then
return;
end if;
- Set_Is_Visited (Curr_IGV_Id);
+ Set_Is_Visited (Invoker);
-- Update the statistics
-- indicates that elaboration is transitioning from one unit to
-- another. Add a library graph edge to capture this dependency.
- Curr_LGV_Id := Lib_Vertex (Inv_Graph, Curr_IGV_Id);
- pragma Assert (Present (Curr_LGV_Id));
+ Invoker_Vertex := Body_Vertex (Inv_Graph, Invoker);
+ pragma Assert (Present (Invoker_Vertex));
- if Curr_LGV_Id /= Last_LGV_Id then
+ if Invoker_Vertex /= Last_Vertex then
-- The path ultimately reaches back into the unit where the root
-- resides, resulting in a self dependency. In most cases this is
-- library graph edge because the circularity is the result of
-- expansion and thus spurious.
- if Curr_LGV_Id = Root_LGV_Id and then Internal_Ctrl then
+ if Invoker_Vertex = Root_Vertex
+ and then Internal_Controlled_Action
+ then
null;
-- Otherwise create the library graph edge, even if this results
else
Add_Edge
(G => Lib_Graph,
- Pred => Curr_LGV_Id,
- Succ => Root_LGV_Id,
+ Pred => Invoker_Vertex,
+ Succ => Root_Vertex,
Kind => Invocation_Edge);
end if;
end if;
-- Extend the DFS traversal to all targets of the invocation graph
-- vertex.
- Iter := Iterate_Edges_To_Targets (Inv_Graph, Curr_IGV_Id);
+ Iter := Iterate_Edges_To_Targets (Inv_Graph, Invoker);
while Has_Next (Iter) loop
- Next (Iter, IGE_Id);
- pragma Assert (Present (IGE_Id));
-
- Targ := Target (Inv_Graph, IGE_Id);
- pragma Assert (Present (Targ));
+ Next (Iter, Edge);
Visit_Vertex
- (Curr_IGV_Id => Targ,
- Last_LGV_Id => Curr_LGV_Id,
- Root_LGV_Id => Root_LGV_Id,
- Internal_Ctrl =>
- Internal_Ctrl
- or else Kind (Inv_Graph, IGE_Id) in
+ (Invoker => Target (Inv_Graph, Edge),
+ Last_Vertex => Invoker_Vertex,
+ Root_Vertex => Root_Vertex,
+ Internal_Controlled_Action =>
+ Internal_Controlled_Action
+ or else Kind (Inv_Graph, Edge) in
Internal_Controlled_Invocation_Kind,
- Path => New_Path);
+ Path => New_Path);
end loop;
end Visit_Vertex;
procedure Create_Vertex
(IC_Id : Invocation_Construct_Id;
- LGV_Id : Library_Graph_Vertex_Id);
+ Vertex : Library_Graph_Vertex_Id);
pragma Inline (Create_Vertex);
-- Create a new vertex for invocation construct IC_Id in invocation
- -- graph Inv_Graph. The vertex is linked to vertex LGV_Id of library
+ -- graph Inv_Graph. The vertex is linked to vertex Vertex of library
-- graph Lib_Graph.
procedure Create_Vertices (U_Id : Unit_Id);
-- Create new vertices for all invocation constructs of unit U_Id in
-- invocation graph Inv_Graph.
+ function Declaration_Placement_Vertex
+ (Vertex : Library_Graph_Vertex_Id;
+ Placement : Declaration_Placement_Kind)
+ return Library_Graph_Vertex_Id;
+ pragma Inline (Declaration_Placement_Vertex);
+ -- Obtain the spec or body of vertex Vertex depending on the requested
+ -- placement in Placement.
+
----------------------------
-- Build_Invocation_Graph --
----------------------------
-- Prepare the global data
Inv_Graph :=
- Create (Initial_Vertices => Number_Of_Elaborable_Units,
- Initial_Edges => Number_Of_Elaborable_Units);
+ Create
+ (Initial_Vertices => Number_Of_Elaborable_Units,
+ Initial_Edges => Number_Of_Elaborable_Units);
Lib_Graph := Lib_G;
For_Each_Elaborable_Unit (Create_Vertices'Access);
pragma Assert (Present (Lib_Graph));
pragma Assert (Present (IR_Id));
- IR_Rec : Invocation_Relation_Record renames
- Invocation_Relations.Table (IR_Id);
-
- pragma Assert (Present (IR_Rec.Invoker));
- pragma Assert (Present (IR_Rec.Target));
+ Invoker_Sig : constant Invocation_Signature_Id := Invoker (IR_Id);
+ Target_Sig : constant Invocation_Signature_Id := Target (IR_Id);
- Invoker : Invocation_Graph_Vertex_Id;
- Target : Invocation_Graph_Vertex_Id;
+ pragma Assert (Present (Invoker_Sig));
+ pragma Assert (Present (Target_Sig));
begin
-- Nothing to do when the target denotes an invocation construct that
-- resides in a unit which will never be elaborated.
- if not Needs_Elaboration (IR_Rec.Target) then
+ if not Needs_Elaboration (Target_Sig) then
return;
end if;
- Invoker := Corresponding_Vertex (Inv_Graph, IR_Rec.Invoker);
- Target := Corresponding_Vertex (Inv_Graph, IR_Rec.Target);
-
- pragma Assert (Present (Invoker));
- pragma Assert (Present (Target));
-
Add_Edge
(G => Inv_Graph,
- Source => Invoker,
- Target => Target,
+ Source => Corresponding_Vertex (Inv_Graph, Invoker_Sig),
+ Target => Corresponding_Vertex (Inv_Graph, Target_Sig),
IR_Id => IR_Id);
end Create_Edge;
procedure Create_Vertex
(IC_Id : Invocation_Construct_Id;
- LGV_Id : Library_Graph_Vertex_Id)
+ Vertex : Library_Graph_Vertex_Id)
is
+ begin
pragma Assert (Present (Inv_Graph));
pragma Assert (Present (Lib_Graph));
pragma Assert (Present (IC_Id));
- pragma Assert (Present (LGV_Id));
-
- IC_Rec : Invocation_Construct_Record renames
- Invocation_Constructs.Table (IC_Id);
-
- Body_LGV_Id : Library_Graph_Vertex_Id;
-
- begin
- -- Determine the proper library graph vertex which holds the body of
- -- the invocation construct.
-
- if IC_Rec.Placement = In_Body then
- Body_LGV_Id := Proper_Body (Lib_Graph, LGV_Id);
- else
- pragma Assert (IC_Rec.Placement = In_Spec);
- Body_LGV_Id := Proper_Spec (Lib_Graph, LGV_Id);
- end if;
-
- pragma Assert (Present (Body_LGV_Id));
+ pragma Assert (Present (Vertex));
Add_Vertex
- (G => Inv_Graph,
- IC_Id => IC_Id,
- LGV_Id => Body_LGV_Id);
+ (G => Inv_Graph,
+ IC_Id => IC_Id,
+ Body_Vertex =>
+ Declaration_Placement_Vertex
+ (Vertex => Vertex,
+ Placement => Body_Placement (IC_Id)),
+ Spec_Vertex =>
+ Declaration_Placement_Vertex
+ (Vertex => Vertex,
+ Placement => Spec_Placement (IC_Id)));
end Create_Vertex;
---------------------
pragma Assert (Present (U_Id));
U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
- LGV_Id : constant Library_Graph_Vertex_Id :=
+ Vertex : constant Library_Graph_Vertex_Id :=
Corresponding_Vertex (Lib_Graph, U_Id);
- pragma Assert (Present (LGV_Id));
-
begin
for IC_Id in U_Rec.First_Invocation_Construct ..
U_Rec.Last_Invocation_Construct
loop
- Create_Vertex (IC_Id, LGV_Id);
+ Create_Vertex (IC_Id, Vertex);
end loop;
end Create_Vertices;
+
+ ----------------------------------
+ -- Declaration_Placement_Vertex --
+ ----------------------------------
+
+ function Declaration_Placement_Vertex
+ (Vertex : Library_Graph_Vertex_Id;
+ Placement : Declaration_Placement_Kind)
+ return Library_Graph_Vertex_Id
+ is
+ begin
+ pragma Assert (Present (Lib_Graph));
+ pragma Assert (Present (Vertex));
+
+ if Placement = In_Body then
+ return Proper_Body (Lib_Graph, Vertex);
+ else
+ pragma Assert (Placement = In_Spec);
+ return Proper_Spec (Lib_Graph, Vertex);
+ end if;
+ end Declaration_Placement_Vertex;
end Invocation_Graph_Builders;
----------------------------
pragma Inline (Hash_Unit);
-- Obtain the hash value of key U_Id
- package UL is new Dynamic_Hash_Tables
+ package Unit_Line_Tables is new Dynamic_Hash_Tables
(Key_Type => Unit_Id,
Value_Type => Logical_Line_Number,
No_Value => No_Line_Number,
Lib_Graph : Library_Graph := Library_Graphs.Nil;
- Unit_To_Line : UL.Dynamic_Hash_Table := UL.Nil;
+ Unit_To_Line : Unit_Line_Tables.Dynamic_Hash_Table :=
+ Unit_Line_Tables.Nil;
-- The map of unit name -> line number, used to detect duplicate unit
- -- names and report errors.
+ -- names in the forced-elaboration-order file and report errors.
-----------------------
-- Local subprograms --
begin
pragma Assert (Present (U_Id));
- UL.Put (Unit_To_Line, U_Id, Line);
+ Unit_Line_Tables.Put (Unit_To_Line, U_Id, Line);
end Add_Unit;
-------------------------
-- Build_Library_Graph --
-------------------------
- function Build_Library_Graph return Library_Graph is
+ function Build_Library_Graph
+ (Dynamically_Elaborated : Boolean) return Library_Graph
+ is
begin
-- Prepare the global data
Lib_Graph :=
- Create (Initial_Vertices => Number_Of_Elaborable_Units,
- Initial_Edges => Number_Of_Elaborable_Units);
+ Create
+ (Initial_Vertices => Number_Of_Elaborable_Units,
+ Initial_Edges => Number_Of_Elaborable_Units,
+ Dynamically_Elaborated => Dynamically_Elaborated);
For_Each_Elaborable_Unit (Create_Vertex'Access);
For_Each_Elaborable_Unit (Create_Spec_And_Body_Edge'Access);
pragma Assert (Present (Pred));
pragma Assert (Present (Succ));
- Pred_LGV_Id : constant Library_Graph_Vertex_Id :=
+ Pred_Vertex : constant Library_Graph_Vertex_Id :=
Corresponding_Vertex (Lib_Graph, Pred);
- Succ_LGV_Id : constant Library_Graph_Vertex_Id :=
+ Succ_Vertex : constant Library_Graph_Vertex_Id :=
Corresponding_Vertex (Lib_Graph, Succ);
- pragma Assert (Present (Pred_LGV_Id));
- pragma Assert (Present (Succ_LGV_Id));
-
begin
Write_Unit_Name (Name (Pred));
Write_Str (" <-- ");
Add_Edge
(G => Lib_Graph,
- Pred => Pred_LGV_Id,
- Succ => Succ_LGV_Id,
+ Pred => Pred_Vertex,
+ Succ => Succ_Vertex,
Kind => Forced_Edge);
end Create_Forced_Edge;
-------------------------
procedure Create_Forced_Edges is
- Curr_Unit : Unit_Id;
- Iter : Forced_Units_Iterator;
- Prev_Unit : Unit_Id;
- Unit_Line : Logical_Line_Number;
- Unit_Name : Unit_Name_Type;
+ Current_Unit : Unit_Id;
+ Iter : Forced_Units_Iterator;
+ Previous_Unit : Unit_Id;
+ Unit_Line : Logical_Line_Number;
+ Unit_Name : Unit_Name_Type;
begin
- Prev_Unit := No_Unit_Id;
- Unit_To_Line := UL.Create (20);
+ Previous_Unit := No_Unit_Id;
+ Unit_To_Line := Unit_Line_Tables.Create (20);
-- Inspect the contents of the forced-elaboration-order file supplied
-- to the binder using switch -f, and diagnose each unit accordingly.
Iter := Iterate_Forced_Units;
while Has_Next (Iter) loop
Next (Iter, Unit_Name, Unit_Line);
- pragma Assert (Present (Unit_Name));
- Curr_Unit := Corresponding_Unit (Unit_Name);
+ Current_Unit := Corresponding_Unit (Unit_Name);
- if not Present (Curr_Unit) then
+ if not Present (Current_Unit) then
Missing_Unit_Info (Unit_Name);
- elsif Is_Internal_Unit (Curr_Unit) then
+ elsif Is_Internal_Unit (Current_Unit) then
Internal_Unit_Info (Unit_Name);
- elsif Is_Duplicate_Unit (Curr_Unit) then
- Duplicate_Unit_Error (Curr_Unit, Unit_Name, Unit_Line);
+ elsif Is_Duplicate_Unit (Current_Unit) then
+ Duplicate_Unit_Error (Current_Unit, Unit_Name, Unit_Line);
-- Otherwise the unit is a valid candidate for a vertex. Create a
-- forced edge between each pair of units.
else
- Add_Unit (Curr_Unit, Unit_Line);
+ Add_Unit (Current_Unit, Unit_Line);
- if Present (Prev_Unit) then
+ if Present (Previous_Unit) then
Create_Forced_Edge
- (Pred => Prev_Unit,
- Succ => Curr_Unit);
+ (Pred => Previous_Unit,
+ Succ => Current_Unit);
end if;
- Prev_Unit := Curr_Unit;
+ Previous_Unit := Current_Unit;
end if;
end loop;
- UL.Destroy (Unit_To_Line);
+ Unit_Line_Tables.Destroy (Unit_To_Line);
end Create_Forced_Edges;
-------------------------------
-------------------------------
procedure Create_Spec_And_Body_Edge (U_Id : Unit_Id) is
- Aux_LGV_Id : Library_Graph_Vertex_Id;
- LGV_Id : Library_Graph_Vertex_Id;
+ Extra_Vertex : Library_Graph_Vertex_Id;
+ Vertex : Library_Graph_Vertex_Id;
begin
pragma Assert (Present (Lib_Graph));
pragma Assert (Present (U_Id));
- LGV_Id := Corresponding_Vertex (Lib_Graph, U_Id);
- pragma Assert (Present (LGV_Id));
+ Vertex := Corresponding_Vertex (Lib_Graph, U_Id);
-- The unit denotes a body that completes a previous spec. Link the
-- spec and body. Add an edge between the predecessor spec and the
-- successor body.
- if Is_Body_With_Spec (Lib_Graph, LGV_Id) then
- Aux_LGV_Id :=
+ if Is_Body_With_Spec (Lib_Graph, Vertex) then
+ Extra_Vertex :=
Corresponding_Vertex (Lib_Graph, Corresponding_Spec (U_Id));
- pragma Assert (Present (Aux_LGV_Id));
-
- Set_Corresponding_Item (Lib_Graph, LGV_Id, Aux_LGV_Id);
+ Set_Corresponding_Item (Lib_Graph, Vertex, Extra_Vertex);
Add_Edge
(G => Lib_Graph,
- Pred => Aux_LGV_Id,
- Succ => LGV_Id,
+ Pred => Extra_Vertex,
+ Succ => Vertex,
Kind => Spec_Before_Body_Edge);
-- The unit denotes a spec with a completing body. Link the spec and
-- body.
- elsif Is_Spec_With_Body (Lib_Graph, LGV_Id) then
- Aux_LGV_Id :=
+ elsif Is_Spec_With_Body (Lib_Graph, Vertex) then
+ Extra_Vertex :=
Corresponding_Vertex (Lib_Graph, Corresponding_Body (U_Id));
- pragma Assert (Present (Aux_LGV_Id));
-
- Set_Corresponding_Item (Lib_Graph, LGV_Id, Aux_LGV_Id);
+ Set_Corresponding_Item (Lib_Graph, Vertex, Extra_Vertex);
end if;
end Create_Spec_And_Body_Edge;
Withed_U_Id : constant Unit_Id :=
Corresponding_Unit (Withed_Rec.Uname);
- pragma Assert (Present (Withed_U_Id));
-
- Aux_LGV_Id : Library_Graph_Vertex_Id;
Kind : Library_Graph_Edge_Kind;
- Withed_LGV_Id : Library_Graph_Vertex_Id;
+ Withed_Vertex : Library_Graph_Vertex_Id;
begin
-- Nothing to do when the withed unit does not need to be elaborated.
return;
end if;
- Withed_LGV_Id := Corresponding_Vertex (Lib_Graph, Withed_U_Id);
- pragma Assert (Present (Withed_LGV_Id));
+ Withed_Vertex := Corresponding_Vertex (Lib_Graph, Withed_U_Id);
-- The with comes with pragma Elaborate
-- between the body of the withed predecessor and the withing
-- successor.
- if Is_Spec_With_Body (Lib_Graph, Withed_LGV_Id) then
- Aux_LGV_Id :=
- Corresponding_Vertex
- (Lib_Graph, Corresponding_Body (Withed_U_Id));
- pragma Assert (Present (Aux_LGV_Id));
-
+ if Is_Spec_With_Body (Lib_Graph, Withed_Vertex) then
Add_Edge
(G => Lib_Graph,
- Pred => Aux_LGV_Id,
+ Pred =>
+ Corresponding_Vertex
+ (Lib_Graph, Corresponding_Body (Withed_U_Id)),
Succ => Succ,
Kind => Kind);
end if;
Add_Edge
(G => Lib_Graph,
- Pred => Withed_LGV_Id,
+ Pred => Withed_Vertex,
Succ => Succ,
Kind => Kind);
end Create_With_Edge;
-----------------------
procedure Create_With_Edges (U_Id : Unit_Id) is
- LGV_Id : Library_Graph_Vertex_Id;
-
begin
pragma Assert (Present (Lib_Graph));
pragma Assert (Present (U_Id));
- LGV_Id := Corresponding_Vertex (Lib_Graph, U_Id);
- pragma Assert (Present (LGV_Id));
-
Create_With_Edges
(U_Id => U_Id,
- Succ => LGV_Id);
+ Succ => Corresponding_Vertex (Lib_Graph, U_Id));
end Create_With_Edges;
-----------------------
pragma Assert (Present (Nam));
Prev_Line : constant Logical_Line_Number :=
- UL.Get (Unit_To_Line, U_Id);
+ Unit_Line_Tables.Get (Unit_To_Line, U_Id);
begin
Error_Msg_Nat_1 := Nat (Line);
begin
pragma Assert (Present (U_Id));
- return UL.Contains (Unit_To_Line, U_Id);
+ return Unit_Line_Tables.Contains (Unit_To_Line, U_Id);
end Is_Duplicate_Unit;
-------------------------
----------------------------
package Library_Graph_Builders is
- function Build_Library_Graph return Library_Graph;
+ function Build_Library_Graph
+ (Dynamically_Elaborated : Boolean) return Library_Graph;
-- Return a new library graph that reflects the dependencies between
- -- all units of the bind.
+ -- all units of the bind. Flag Dynamically_Elaborated must be set when
+ -- the main library unit was compiled using the dynamic model.
end Library_Graph_Builders;
-- --
------------------------------------------------------------------------------
+with Binderr; use Binderr;
+with Debug; use Debug;
+with Types; use Types;
+
+with Bindo.Validators;
+use Bindo.Validators;
+use Bindo.Validators.Cycle_Validators;
+
+with Bindo.Writers;
+use Bindo.Writers;
+use Bindo.Writers.Cycle_Writers;
+
package body Bindo.Diagnostics is
-----------------------
- -- Cycle_Diagnostics --
+ -- Local subprograms --
+ -----------------------
+
+ procedure Diagnose_All_Cycles
+ (Inv_Graph : Invocation_Graph;
+ Lib_Graph : Library_Graph);
+ pragma Inline (Diagnose_All_Cycles);
+ -- Emit diagnostics for all cycles of library graph G
+
+ procedure Diagnose_Cycle
+ (Inv_Graph : Invocation_Graph;
+ Lib_Graph : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id);
+ pragma Inline (Diagnose_Cycle);
+ -- Emit diagnostics for cycle Cycle of library graph G
+
+ procedure Find_And_Output_Invocation_Paths
+ (Inv_Graph : Invocation_Graph;
+ Lib_Graph : Library_Graph;
+ Source : Library_Graph_Vertex_Id;
+ Destination : Library_Graph_Vertex_Id);
+ pragma Inline (Find_And_Output_Invocation_Paths);
+ -- Find all paths in invocation graph Inv_Graph that originate from vertex
+ -- Source and reach vertex Destination of library graph Lib_Graph. Output
+ -- the transitions of each such path.
+
+ function Find_Elaboration_Root
+ (Inv_Graph : Invocation_Graph;
+ Lib_Graph : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Invocation_Graph_Vertex_Id;
+ pragma Inline (Find_Elaboration_Root);
+ -- Find the elaboration root in invocation graph Inv_Graph that corresponds
+ -- to vertex Vertex of library graph Lib_Graph.
+
+ procedure Output_All_Cycles_Suggestions (G : Library_Graph);
+ pragma Inline (Output_All_Cycles_Suggestions);
+ -- Suggest the diagnostic of all cycles in library graph G if circumstances
+ -- allow it.
+
+ procedure Output_Dynamic_Model_Suggestions
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id);
+ pragma Inline (Output_Dynamic_Model_Suggestions);
+ -- Suggest the use of the dynamic elaboration model to break cycle Cycle of
+ -- library graph G if circumstances allow it.
+
+ procedure Output_Elaborate_All_Suggestions
+ (G : Library_Graph;
+ Pred : Library_Graph_Vertex_Id;
+ Succ : Library_Graph_Vertex_Id);
+ pragma Inline (Output_Elaborate_All_Suggestions);
+ -- Suggest ways to break a cycle that involves an Elaborate_All edge that
+ -- links predecessor Pred and successor Succ of library graph G.
+
+ procedure Output_Elaborate_All_Transition
+ (G : Library_Graph;
+ Source : Library_Graph_Vertex_Id;
+ Actual_Destination : Library_Graph_Vertex_Id;
+ Expected_Destination : Library_Graph_Vertex_Id);
+ pragma Inline (Output_Elaborate_All_Transition);
+ -- Output a transition through an Elaborate_All edge of library graph G
+ -- with successor Source and predecessor Actual_Destination. Parameter
+ -- Expected_Destination denotes the predecessor as specified by the next
+ -- edge in a cycle.
+
+ procedure Output_Elaborate_Body_Suggestions
+ (G : Library_Graph;
+ Succ : Library_Graph_Vertex_Id);
+ pragma Inline (Output_Elaborate_Body_Suggestions);
+ -- Suggest ways to break a cycle that involves an edge where successor Succ
+ -- is either a spec subject to pragma Elaborate_Body or the body of such a
+ -- spec.
+
+ procedure Output_Elaborate_Body_Transition
+ (G : Library_Graph;
+ Source : Library_Graph_Vertex_Id;
+ Actual_Destination : Library_Graph_Vertex_Id;
+ Expected_Destination : Library_Graph_Vertex_Id);
+ pragma Inline (Output_Elaborate_Body_Transition);
+ -- Output a transition through an edge of library graph G with successor
+ -- Source and predecessor Actual_Destination. Vertex Source is either a
+ -- spec subject to pragma Elaborate_Body or denotes the body of such a
+ -- spec. Expected_Destination denotes the predecessor as specified by the
+ -- next edge in a cycle.
+
+ procedure Output_Elaborate_Suggestions
+ (G : Library_Graph;
+ Pred : Library_Graph_Vertex_Id;
+ Succ : Library_Graph_Vertex_Id);
+ pragma Inline (Output_Elaborate_Suggestions);
+ -- Suggest ways to break a cycle that involves an Elaborate edge that links
+ -- predecessor Pred and successor Succ of library graph G.
+
+ procedure Output_Elaborate_Transition
+ (G : Library_Graph;
+ Source : Library_Graph_Vertex_Id;
+ Actual_Destination : Library_Graph_Vertex_Id;
+ Expected_Destination : Library_Graph_Vertex_Id);
+ pragma Inline (Output_Elaborate_Transition);
+ -- Output a transition through an Elaborate edge of library graph G
+ -- with successor Source and predecessor Actual_Destination. Parameter
+ -- Expected_Destination denotes the predecessor as specified by the next
+ -- edge in a cycle.
+
+ procedure Output_Forced_Suggestions
+ (G : Library_Graph;
+ Pred : Library_Graph_Vertex_Id;
+ Succ : Library_Graph_Vertex_Id);
+ pragma Inline (Output_Forced_Suggestions);
+ -- Suggest ways to break a cycle that involves a Forced edge that links
+ -- predecessor Pred with successor Succ of library graph G.
+
+ procedure Output_Forced_Transition
+ (G : Library_Graph;
+ Source : Library_Graph_Vertex_Id;
+ Actual_Destination : Library_Graph_Vertex_Id;
+ Expected_Destination : Library_Graph_Vertex_Id;
+ Elaborate_All_Active : Boolean);
+ pragma Inline (Output_Forced_Transition);
+ -- Output a transition through a Forced edge of library graph G with
+ -- successor Source and predecessor Actual_Destination. Parameter
+ -- Expected_Destination denotes the predecessor as specified by the
+ -- next edge in a cycle.
+
+ procedure Output_Full_Encoding_Suggestions
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id;
+ First_Edge : Library_Graph_Edge_Id);
+ pragma Inline (Output_Full_Encoding_Suggestions);
+ -- Suggest the use of the full path invocation graph encoding to break
+ -- cycle Cycle with initial edge First_Edge of library graph G.
+
+ procedure Output_Invocation_Path
+ (Inv_Graph : Invocation_Graph;
+ Lib_Graph : Library_Graph;
+ Elaborated_Vertex : Library_Graph_Vertex_Id;
+ Path : IGE_Lists.Doubly_Linked_List;
+ Path_Id : in out Nat);
+ pragma Inline (Output_Invocation_Path);
+ -- Output path Path, which consists of invocation graph Inv_Graph edges.
+ -- Elaborated_Vertex is the vertex of library graph Lib_Graph whose
+ -- elaboration initiated the path. Path_Id is the unique id of the path.
+
+ procedure Output_Invocation_Path_Transition
+ (Inv_Graph : Invocation_Graph;
+ Lib_Graph : Library_Graph;
+ Edge : Invocation_Graph_Edge_Id);
+ pragma Inline (Output_Invocation_Path_Transition);
+ -- Output a transition through edge Edge of invocation graph G, which is
+ -- part of an invocation path. Lib_Graph is the related library graph.
+
+ procedure Output_Invocation_Transition
+ (Inv_Graph : Invocation_Graph;
+ Lib_Graph : Library_Graph;
+ Source : Library_Graph_Vertex_Id;
+ Destination : Library_Graph_Vertex_Id);
+ pragma Inline (Output_Invocation_Transition);
+ -- Output a transition through an invocation edge of library graph G with
+ -- successor Source and predecessor Destination. Inv_Graph is the related
+ -- invocation graph.
+
+ procedure Output_Reason_And_Circularity_Header
+ (G : Library_Graph;
+ First_Edge : Library_Graph_Edge_Id);
+ pragma Inline (Output_Reason_And_Circularity_Header);
+ -- Output the reason and circularity header for a circularity of library
+ -- graph G with initial edge First_Edge.
+
+ procedure Output_Suggestions
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id;
+ First_Edge : Library_Graph_Edge_Id);
+ pragma Inline (Output_Suggestions);
+ -- Suggest various ways to break cycle Cycle with initial edge First_Edge
+ -- of library graph G.
+
+ procedure Output_Transition
+ (Inv_Graph : Invocation_Graph;
+ Lib_Graph : Library_Graph;
+ Current_Edge : Library_Graph_Edge_Id;
+ Next_Edge : Library_Graph_Edge_Id;
+ Elaborate_All_Active : Boolean);
+ pragma Inline (Output_Transition);
+ -- Output a transition described by edge Current_Edge, which is followed by
+ -- edge Next_Edge of library graph Lib_Graph. Inv_Graph denotes the related
+ -- invocation graph. Elaborate_All_Active should be set when the transition
+ -- occurs within a cycle that involves an Elaborate_All edge.
+
+ procedure Output_With_Transition
+ (G : Library_Graph;
+ Source : Library_Graph_Vertex_Id;
+ Actual_Destination : Library_Graph_Vertex_Id;
+ Expected_Destination : Library_Graph_Vertex_Id;
+ Elaborate_All_Active : Boolean);
+ pragma Inline (Output_With_Transition);
+ -- Output a transition through a regular with edge of library graph G
+ -- with successor Source and predecessor Actual_Destination. Parameter
+ -- Expected_Destination denotes the predecessor as specified by the next
+ -- edge in a cycle. Elaborate_All_Active should be set when the transition
+ -- occurs within a cycle that involves an Elaborate_All edge.
+
+ procedure Visit_Vertex
+ (Inv_Graph : Invocation_Graph;
+ Lib_Graph : Library_Graph;
+ Invoker : Invocation_Graph_Vertex_Id;
+ Invoker_Vertex : Library_Graph_Vertex_Id;
+ Last_Vertex : Library_Graph_Vertex_Id;
+ Elaborated_Vertex : Library_Graph_Vertex_Id;
+ End_Vertex : Library_Graph_Vertex_Id;
+ Path : IGE_Lists.Doubly_Linked_List;
+ Path_Id : in out Nat);
+ pragma Inline (Visit_Vertex);
+ -- Visit invocation graph vertex Invoker that resides in library graph
+ -- vertex Invoker_Vertex as part of a DFS traversal. Last_Vertex denotes
+ -- the previous vertex in the traversal. Elaborated_Vertex is the vertex
+ -- whose elaboration started the traversal. End_Vertex is the vertex that
+ -- terminates the traversal. All edges along the path are recorded in Path.
+ -- Path_Id is the id of the path.
+
+ -------------------------
+ -- Diagnose_All_Cycles --
+ -------------------------
+
+ procedure Diagnose_All_Cycles
+ (Inv_Graph : Invocation_Graph;
+ Lib_Graph : Library_Graph)
+ is
+ Cycle : Library_Graph_Cycle_Id;
+ Iter : All_Cycle_Iterator;
+
+ begin
+ pragma Assert (Present (Inv_Graph));
+ pragma Assert (Present (Lib_Graph));
+
+ Iter := Iterate_All_Cycles (Lib_Graph);
+ while Has_Next (Iter) loop
+ Next (Iter, Cycle);
+
+ Diagnose_Cycle
+ (Inv_Graph => Inv_Graph,
+ Lib_Graph => Lib_Graph,
+ Cycle => Cycle);
+ end loop;
+ end Diagnose_All_Cycles;
+
+ --------------------------
+ -- Diagnose_Circularities --
+ --------------------------
+
+ procedure Diagnose_Circularities
+ (Inv_Graph : Invocation_Graph;
+ Lib_Graph : Library_Graph)
+ is
+ begin
+ pragma Assert (Present (Inv_Graph));
+ pragma Assert (Present (Lib_Graph));
+
+ -- Find, validate, and output all cycles of the library graph
+
+ Find_Cycles (Lib_Graph);
+ Validate_Cycles (Lib_Graph);
+ Write_Cycles (Lib_Graph);
+
+ -- Diagnose all cycles in the graph regardless of their importance when
+ -- switch -d_C (diagnose all cycles) is in effect.
+
+ if Debug_Flag_Underscore_CC then
+ Diagnose_All_Cycles (Inv_Graph, Lib_Graph);
+
+ -- Otherwise diagnose the most important cycle in the graph
+
+ else
+ Diagnose_Cycle
+ (Inv_Graph => Inv_Graph,
+ Lib_Graph => Lib_Graph,
+ Cycle => Highest_Precedence_Cycle (Lib_Graph));
+ end if;
+ end Diagnose_Circularities;
+
+ --------------------
+ -- Diagnose_Cycle --
+ --------------------
+
+ procedure Diagnose_Cycle
+ (Inv_Graph : Invocation_Graph;
+ Lib_Graph : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id)
+ is
+ Current_Edge : Library_Graph_Edge_Id;
+ Elaborate_All_Active : Boolean;
+ First_Edge : Library_Graph_Edge_Id;
+ Iter : Edges_Of_Cycle_Iterator;
+ Next_Edge : Library_Graph_Edge_Id;
+
+ begin
+ pragma Assert (Present (Inv_Graph));
+ pragma Assert (Present (Lib_Graph));
+ pragma Assert (Present (Cycle));
+
+ Elaborate_All_Active := False;
+ First_Edge := No_Library_Graph_Edge;
+
+ -- Inspect the edges of the cycle in pairs, emitting diagnostics based
+ -- on their successors and predecessors.
+
+ Iter := Iterate_Edges_Of_Cycle (Lib_Graph, Cycle);
+ while Has_Next (Iter) loop
+
+ -- Emit the reason for the cycle using the initial edge, which is the
+ -- most important edge in the cycle.
+
+ if not Present (First_Edge) then
+ Next (Iter, Current_Edge);
+
+ First_Edge := Current_Edge;
+ Elaborate_All_Active :=
+ Is_Elaborate_All_Edge
+ (G => Lib_Graph,
+ Edge => First_Edge);
+
+ Output_Reason_And_Circularity_Header
+ (G => Lib_Graph,
+ First_Edge => First_Edge);
+ end if;
+
+ -- Obtain the other edge of the pair
+
+ exit when not Has_Next (Iter);
+ Next (Iter, Next_Edge);
+
+ -- Describe the transition from the current edge to the next edge by
+ -- taking into account the predecessors and successors involved, as
+ -- well as the nature of the edge.
+
+ Output_Transition
+ (Inv_Graph => Inv_Graph,
+ Lib_Graph => Lib_Graph,
+ Current_Edge => Current_Edge,
+ Next_Edge => Next_Edge,
+ Elaborate_All_Active => Elaborate_All_Active);
+
+ Current_Edge := Next_Edge;
+ end loop;
+
+ -- Describe the transition from the last edge to the first edge
+
+ Output_Transition
+ (Inv_Graph => Inv_Graph,
+ Lib_Graph => Lib_Graph,
+ Current_Edge => Current_Edge,
+ Next_Edge => First_Edge,
+ Elaborate_All_Active => Elaborate_All_Active);
+
+ -- Suggest various alternatives for breaking the cycle
+
+ Output_Suggestions
+ (G => Lib_Graph,
+ Cycle => Cycle,
+ First_Edge => First_Edge);
+ end Diagnose_Cycle;
+
+ --------------------------------------
+ -- Find_And_Output_Invocation_Paths --
+ --------------------------------------
+
+ procedure Find_And_Output_Invocation_Paths
+ (Inv_Graph : Invocation_Graph;
+ Lib_Graph : Library_Graph;
+ Source : Library_Graph_Vertex_Id;
+ Destination : Library_Graph_Vertex_Id)
+ is
+ Path : IGE_Lists.Doubly_Linked_List;
+ Path_Id : Nat;
+
+ begin
+ pragma Assert (Present (Inv_Graph));
+ pragma Assert (Present (Lib_Graph));
+ pragma Assert (Present (Source));
+ pragma Assert (Present (Destination));
+
+ -- Nothing to do when the invocation graph encoding format of the source
+ -- vertex does not contain detailed information about invocation paths.
+
+ if Invocation_Graph_Encoding (Lib_Graph, Source) /=
+ Full_Path_Encoding
+ then
+ return;
+ end if;
+
+ Path := IGE_Lists.Create;
+ Path_Id := 1;
+
+ -- Start a DFS traversal over the invocation graph, in an attempt to
+ -- reach Destination from Source. The actual start of the path is the
+ -- elaboration root invocation vertex that corresponds to the Source.
+ -- Each unique path is emitted as part of the current cycle diagnostic.
+
+ Visit_Vertex
+ (Inv_Graph => Inv_Graph,
+ Lib_Graph => Lib_Graph,
+ Invoker =>
+ Find_Elaboration_Root
+ (Inv_Graph => Inv_Graph,
+ Lib_Graph => Lib_Graph,
+ Vertex => Source),
+ Invoker_Vertex => Source,
+ Last_Vertex => Source,
+ Elaborated_Vertex => Source,
+ End_Vertex => Destination,
+ Path => Path,
+ Path_Id => Path_Id);
+
+ IGE_Lists.Destroy (Path);
+ end Find_And_Output_Invocation_Paths;
+
+ ---------------------------
+ -- Find_Elaboration_Root --
+ ---------------------------
+
+ function Find_Elaboration_Root
+ (Inv_Graph : Invocation_Graph;
+ Lib_Graph : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return Invocation_Graph_Vertex_Id
+ is
+ Current_Vertex : Invocation_Graph_Vertex_Id;
+ Iter : Elaboration_Root_Iterator;
+ Root_Vertex : Invocation_Graph_Vertex_Id;
+
+ begin
+ pragma Assert (Present (Inv_Graph));
+ pragma Assert (Present (Lib_Graph));
+ pragma Assert (Present (Vertex));
+
+ -- Assume that the vertex does not have a corresponding elaboration root
+
+ Root_Vertex := No_Invocation_Graph_Vertex;
+
+ -- Inspect all elaboration roots trying to find the one that resides in
+ -- the input vertex.
+ --
+ -- IMPORTANT:
+ --
+ -- * The iterator must run to completion in order to unlock the
+ -- invocation graph.
+
+ Iter := Iterate_Elaboration_Roots (Inv_Graph);
+ while Has_Next (Iter) loop
+ Next (Iter, Current_Vertex);
+
+ if not Present (Root_Vertex)
+ and then Body_Vertex (Inv_Graph, Current_Vertex) = Vertex
+ then
+ Root_Vertex := Current_Vertex;
+ end if;
+ end loop;
+
+ return Root_Vertex;
+ end Find_Elaboration_Root;
+
+ -----------------------------------
+ -- Output_All_Cycles_Suggestions --
+ -----------------------------------
+
+ procedure Output_All_Cycles_Suggestions (G : Library_Graph) is
+ begin
+ pragma Assert (Present (G));
+
+ -- The library graph contains at least one cycle and only the highest
+ -- priority cycle was diagnosed. Diagnosing all cycles may yield extra
+ -- information for decision making.
+
+ if Number_Of_Cycles (G) > 1 and then not Debug_Flag_Underscore_CC then
+ Error_Msg_Info
+ (" diagnose all circularities (-d_C)");
+ end if;
+ end Output_All_Cycles_Suggestions;
+
+ --------------------------------------
+ -- Output_Dynamic_Model_Suggestions --
+ --------------------------------------
+
+ procedure Output_Dynamic_Model_Suggestions
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id)
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Cycle));
+
+ -- The cycle contains at least one invocation edge and the main library
+ -- unit was compiled with the static model. Using the dynamic model may
+ -- eliminate the invocation edge, and thus the cycle.
+
+ if Invocation_Edge_Count (G, Cycle) > 0
+ and then not Is_Dynamically_Elaborated (G)
+ then
+ Error_Msg_Info
+ (" use the dynamic elaboration model (-gnatE)");
+ end if;
+ end Output_Dynamic_Model_Suggestions;
+
+ --------------------------------------
+ -- Output_Elaborate_All_Suggestions --
+ --------------------------------------
+
+ procedure Output_Elaborate_All_Suggestions
+ (G : Library_Graph;
+ Pred : Library_Graph_Vertex_Id;
+ Succ : Library_Graph_Vertex_Id)
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Pred));
+ pragma Assert (Present (Succ));
+
+ Error_Msg_Unit_1 := Name (G, Pred);
+ Error_Msg_Unit_2 := Name (G, Succ);
+ Error_Msg_Info
+ (" change pragma Elaborate_All for unit $ to Elaborate in unit $");
+ Error_Msg_Info
+ (" remove pragma Elaborate_All for unit $ in unit $");
+ end Output_Elaborate_All_Suggestions;
+
+ -------------------------------------
+ -- Output_Elaborate_All_Transition --
+ -------------------------------------
+
+ procedure Output_Elaborate_All_Transition
+ (G : Library_Graph;
+ Source : Library_Graph_Vertex_Id;
+ Actual_Destination : Library_Graph_Vertex_Id;
+ Expected_Destination : Library_Graph_Vertex_Id)
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Source));
+ pragma Assert (Present (Actual_Destination));
+ pragma Assert (Present (Expected_Destination));
+
+ -- The actual and expected destination vertices match, and denote the
+ -- spec of a unit.
+ --
+ -- Elaborate_All Actual_Destination
+ -- Source ---------------> spec -->
+ -- Expected_Destination
+ --
+ -- Elaborate_All Actual_Destination
+ -- Source ---------------> stand-alone body -->
+ -- Expected_Destination
+
+ if Actual_Destination = Expected_Destination then
+ Error_Msg_Unit_1 := Name (G, Source);
+ Error_Msg_Unit_2 := Name (G, Actual_Destination);
+ Error_Msg_Info
+ (" unit $ has with clause and pragma Elaborate_All for unit $");
+
+ -- Otherwise the actual destination vertex denotes the spec of a unit,
+ -- while the expected destination is the corresponding body.
+ --
+ -- Elaborate_All Actual_Destination
+ -- Source ---------------> spec
+ --
+ -- body -->
+ -- Expected_Destination
+
+ else
+ pragma Assert (Is_Spec_With_Body (G, Actual_Destination));
+ pragma Assert (Is_Body_With_Spec (G, Expected_Destination));
+ pragma Assert
+ (Proper_Body (G, Actual_Destination) = Expected_Destination);
+
+ Error_Msg_Unit_1 := Name (G, Source);
+ Error_Msg_Unit_2 := Name (G, Actual_Destination);
+ Error_Msg_Info
+ (" unit $ has with clause and pragma Elaborate_All for unit $");
+
+ Error_Msg_Unit_1 := Name (G, Expected_Destination);
+ Error_Msg_Info
+ (" unit $ is in the closure of pragma Elaborate_All");
+ end if;
+ end Output_Elaborate_All_Transition;
+
+ ---------------------------------------
+ -- Output_Elaborate_Body_Suggestions --
+ ---------------------------------------
+
+ procedure Output_Elaborate_Body_Suggestions
+ (G : Library_Graph;
+ Succ : Library_Graph_Vertex_Id)
+ is
+ Spec : Library_Graph_Vertex_Id;
+
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Succ));
+
+ -- Find the initial declaration of the unit because it is the one
+ -- subject to pragma Elaborate_Body.
+
+ if Is_Body_With_Spec (G, Succ) then
+ Spec := Proper_Spec (G, Succ);
+ else
+ Spec := Succ;
+ end if;
+
+ Error_Msg_Unit_1 := Name (G, Spec);
+ Error_Msg_Info
+ (" remove pragma Elaborate_Body in unit $");
+ end Output_Elaborate_Body_Suggestions;
+
+ --------------------------------------
+ -- Output_Elaborate_Body_Transition --
+ --------------------------------------
+
+ procedure Output_Elaborate_Body_Transition
+ (G : Library_Graph;
+ Source : Library_Graph_Vertex_Id;
+ Actual_Destination : Library_Graph_Vertex_Id;
+ Expected_Destination : Library_Graph_Vertex_Id)
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Source));
+ pragma Assert (Present (Actual_Destination));
+ pragma Assert (Present (Expected_Destination));
+
+ -- The actual and expected destination vertices match, and denote the
+ -- spec of a unit subject to pragma Elaborate_Body. There is no need to
+ -- mention the pragma because it does not affect the path of the cycle.
+ -- Treat the edge as a regular with edge.
+ --
+ -- Actual_Destination
+ -- Source --> spec Elaborate_Body -->
+ -- Expected_Destination
+
+ if Actual_Destination = Expected_Destination then
+ pragma Assert (Is_Spec (G, Actual_Destination));
+
+ Error_Msg_Unit_1 := Name (G, Source);
+ Error_Msg_Unit_2 := Name (G, Actual_Destination);
+ Error_Msg_Info
+ (" unit $ has with clause for unit $");
+
+ -- Otherwise the actual destination vertex is the spec of a unit subject
+ -- to pragma Elaborate_Body and the expected destination vertex is the
+ -- completion body. The pragma must be mentioned because it directs the
+ -- path of the cycle from the spec to the body.
+ --
+ -- Actual_Destination
+ -- Source --> spec Elaborate_Body
+ --
+ -- body -->
+ -- Expected_Destination
+
+ else
+ pragma Assert (Is_Spec_With_Body (G, Actual_Destination));
+ pragma Assert (Is_Body_With_Spec (G, Expected_Destination));
+ pragma Assert
+ (Proper_Body (G, Actual_Destination) = Expected_Destination);
+
+ Error_Msg_Unit_1 := Name (G, Actual_Destination);
+ Error_Msg_Info
+ (" unit $ is subject to pragma Elaborate_Body");
+
+ Error_Msg_Unit_1 := Name (G, Source);
+ Error_Msg_Unit_2 := Name (G, Expected_Destination);
+ Error_Msg_Info
+ (" unit $ has with clause for unit $");
+ end if;
+ end Output_Elaborate_Body_Transition;
+
+ ----------------------------------
+ -- Output_Elaborate_Suggestions --
+ ----------------------------------
+
+ procedure Output_Elaborate_Suggestions
+ (G : Library_Graph;
+ Pred : Library_Graph_Vertex_Id;
+ Succ : Library_Graph_Vertex_Id)
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Pred));
+ pragma Assert (Present (Succ));
+
+ Error_Msg_Unit_1 := Name (G, Pred);
+ Error_Msg_Unit_2 := Name (G, Succ);
+ Error_Msg_Info
+ (" remove pragma Elaborate for unit $ in unit $");
+ end Output_Elaborate_Suggestions;
+
+ ---------------------------------
+ -- Output_Elaborate_Transition --
+ ---------------------------------
+
+ procedure Output_Elaborate_Transition
+ (G : Library_Graph;
+ Source : Library_Graph_Vertex_Id;
+ Actual_Destination : Library_Graph_Vertex_Id;
+ Expected_Destination : Library_Graph_Vertex_Id)
+ is
+ Spec : Library_Graph_Vertex_Id;
+
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Source));
+ pragma Assert (Present (Actual_Destination));
+ pragma Assert (Present (Expected_Destination));
+
+ -- The actual and expected destination vertices match, and denote the
+ -- spec of a unit.
+ --
+ -- Elaborate Actual_Destination
+ -- Source -----------> spec -->
+ -- Expected_Destination
+ --
+ -- Elaborate Actual_Destination
+ -- Source -----------> stand-alone body -->
+ -- Expected_Destination
+ --
+ -- The processing of pragma Elaborate body generates an edge between a
+ -- successor and predecessor body.
+ --
+ -- spec
+ --
+ -- Elaborate Actual_Destination
+ -- Source -----------> body -->
+ -- Expected_Destination
+
+ if Actual_Destination = Expected_Destination then
+
+ -- Find the initial declaration of the unit because it is the one
+ -- subject to pragma Elaborate.
+
+ if Is_Body_With_Spec (G, Actual_Destination) then
+ Spec := Proper_Spec (G, Actual_Destination);
+ else
+ Spec := Actual_Destination;
+ end if;
+
+ Error_Msg_Unit_1 := Name (G, Source);
+ Error_Msg_Unit_2 := Name (G, Spec);
+ Error_Msg_Info
+ (" unit $ has with clause and pragma Elaborate for unit $");
+
+ if Actual_Destination /= Spec then
+ Error_Msg_Unit_1 := Name (G, Actual_Destination);
+ Error_Msg_Info
+ (" unit $ is in the closure of pragma Elaborate");
+ end if;
+
+ -- Otherwise the actual destination vertex denotes the spec of a unit
+ -- while the expected destination vertex is the corresponding body.
+ --
+ -- Elaborate Actual_Destination
+ -- Source -----------> spec
+ --
+ -- body -->
+ -- Expected_Destination
+
+ else
+ pragma Assert (Is_Spec_With_Body (G, Actual_Destination));
+ pragma Assert (Is_Body_With_Spec (G, Expected_Destination));
+ pragma Assert
+ (Proper_Body (G, Actual_Destination) = Expected_Destination);
+
+ Error_Msg_Unit_1 := Name (G, Source);
+ Error_Msg_Unit_2 := Name (G, Actual_Destination);
+ Error_Msg_Info
+ (" unit $ has with clause and pragma Elaborate for unit $");
+
+ Error_Msg_Unit_1 := Name (G, Expected_Destination);
+ Error_Msg_Info
+ (" unit $ is in the closure of pragma Elaborate");
+ end if;
+ end Output_Elaborate_Transition;
+
+ -------------------------------
+ -- Output_Forced_Suggestions --
+ -------------------------------
+
+ procedure Output_Forced_Suggestions
+ (G : Library_Graph;
+ Pred : Library_Graph_Vertex_Id;
+ Succ : Library_Graph_Vertex_Id)
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Pred));
+ pragma Assert (Present (Succ));
+
+ Error_Msg_Unit_1 := Name (G, Succ);
+ Error_Msg_Unit_2 := Name (G, Pred);
+ Error_Msg_Info
+ (" remove the dependency of unit $ on unit $ from argument of -f "
+ & "switch");
+ end Output_Forced_Suggestions;
+
+ ------------------------------
+ -- Output_Forced_Transition --
+ ------------------------------
+
+ procedure Output_Forced_Transition
+ (G : Library_Graph;
+ Source : Library_Graph_Vertex_Id;
+ Actual_Destination : Library_Graph_Vertex_Id;
+ Expected_Destination : Library_Graph_Vertex_Id;
+ Elaborate_All_Active : Boolean)
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Source));
+ pragma Assert (Present (Actual_Destination));
+ pragma Assert (Present (Expected_Destination));
+
+ -- The actual and expected destination vertices match, and denote the
+ -- spec of a unit.
+ --
+ -- Forced Actual_Destination
+ -- Source --------> spec -->
+ -- Expected_Destination
+ --
+ -- Forced Actual_Destination
+ -- Source --------> body -->
+ -- Expected_Destination
+
+ if Actual_Destination = Expected_Destination then
+ Error_Msg_Unit_1 := Name (G, Source);
+ Error_Msg_Unit_2 := Name (G, Actual_Destination);
+ Error_Msg_Info
+ (" unit $ has a dependency on unit $ forced by -f switch");
+
+ -- The actual destination vertex denotes the spec of a unit while the
+ -- expected destination is the corresponding body, and the unit is in
+ -- the closure of an earlier Elaborate_All pragma.
+ --
+ -- Forced Actual_Destination
+ -- Source --------> spec
+ --
+ -- body -->
+ -- Expected_Destination
+
+ elsif Elaborate_All_Active then
+ pragma Assert (Is_Spec_With_Body (G, Actual_Destination));
+ pragma Assert (Is_Body_With_Spec (G, Expected_Destination));
+ pragma Assert
+ (Proper_Body (G, Actual_Destination) = Expected_Destination);
+
+ Error_Msg_Unit_1 := Name (G, Source);
+ Error_Msg_Unit_2 := Name (G, Actual_Destination);
+ Error_Msg_Info
+ (" unit $ has a dependency on unit $ forced by -f switch");
+
+ Error_Msg_Unit_1 := Name (G, Expected_Destination);
+ Error_Msg_Info
+ (" unit $ is in the closure of pragma Elaborate_All");
+
+ -- Otherwise the actual destination vertex denotes a spec subject to
+ -- pragma Elaborate_Body while the expected destination denotes the
+ -- corresponding body.
+ --
+ -- Forced Actual_Destination
+ -- Source --------> spec Elaborate_Body
+ --
+ -- body -->
+ -- Expected_Destination
+
+ else
+ pragma Assert (Is_Spec_With_Body (G, Actual_Destination));
+ pragma Assert (Is_Spec_With_Elaborate_Body (G, Actual_Destination));
+ pragma Assert (Is_Body_With_Spec (G, Expected_Destination));
+ pragma Assert
+ (Is_Body_Of_Spec_With_Elaborate_Body (G, Expected_Destination));
+ pragma Assert
+ (Proper_Body (G, Actual_Destination) = Expected_Destination);
+
+ Error_Msg_Unit_1 := Name (G, Source);
+ Error_Msg_Unit_2 := Name (G, Actual_Destination);
+ Error_Msg_Info
+ (" unit $ has a dependency on unit $ forced by -f switch");
+
+ Error_Msg_Unit_1 := Name (G, Actual_Destination);
+ Error_Msg_Info
+ (" unit $ is subject to pragma Elaborate_Body");
+
+ Error_Msg_Unit_1 := Name (G, Expected_Destination);
+ Error_Msg_Info
+ (" unit $ is in the closure of pragma Elaborate_Body");
+ end if;
+ end Output_Forced_Transition;
+
+ --------------------------------------
+ -- Output_Full_Encoding_Suggestions --
+ --------------------------------------
+
+ procedure Output_Full_Encoding_Suggestions
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id;
+ First_Edge : Library_Graph_Edge_Id)
+ is
+ Succ : Library_Graph_Vertex_Id;
+
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Cycle));
+ pragma Assert (Present (First_Edge));
+
+ if Is_Invocation_Edge (G, First_Edge) then
+ Succ := Successor (G, First_Edge);
+
+ if Invocation_Graph_Encoding (G, Succ) /= Full_Path_Encoding then
+ Error_Msg_Info
+ (" use detailed invocation information (-gnatd_F)");
+ end if;
+ end if;
+ end Output_Full_Encoding_Suggestions;
+
+ ----------------------------
+ -- Output_Invocation_Path --
+ -----------------------------
+
+ procedure Output_Invocation_Path
+ (Inv_Graph : Invocation_Graph;
+ Lib_Graph : Library_Graph;
+ Elaborated_Vertex : Library_Graph_Vertex_Id;
+ Path : IGE_Lists.Doubly_Linked_List;
+ Path_Id : in out Nat)
+ is
+ Edge : Invocation_Graph_Edge_Id;
+ Iter : IGE_Lists.Iterator;
+
+ begin
+ pragma Assert (Present (Inv_Graph));
+ pragma Assert (Present (Lib_Graph));
+ pragma Assert (Present (Elaborated_Vertex));
+ pragma Assert (IGE_Lists.Present (Path));
+
+ Error_Msg_Nat_1 := Path_Id;
+ Error_Msg_Info (" path #:");
+
+ Error_Msg_Unit_1 := Name (Lib_Graph, Elaborated_Vertex);
+ Error_Msg_Info (" elaboration of unit $");
+
+ Iter := IGE_Lists.Iterate (Path);
+ while IGE_Lists.Has_Next (Iter) loop
+ IGE_Lists.Next (Iter, Edge);
+
+ Output_Invocation_Path_Transition
+ (Inv_Graph => Inv_Graph,
+ Lib_Graph => Lib_Graph,
+ Edge => Edge);
+ end loop;
+
+ Path_Id := Path_Id + 1;
+ end Output_Invocation_Path;
+
+ ---------------------------------------
+ -- Output_Invocation_Path_Transition --
+ ---------------------------------------
+
+ procedure Output_Invocation_Path_Transition
+ (Inv_Graph : Invocation_Graph;
+ Lib_Graph : Library_Graph;
+ Edge : Invocation_Graph_Edge_Id)
+ is
+ pragma Assert (Present (Inv_Graph));
+ pragma Assert (Present (Lib_Graph));
+ pragma Assert (Present (Edge));
+
+ Declared : constant String := "declared at {:#:#";
+
+ Targ : constant Invocation_Graph_Vertex_Id :=
+ Target (Inv_Graph, Edge);
+ Targ_Extra : constant Name_Id :=
+ Extra (Inv_Graph, Edge);
+ Targ_Vertex : constant Library_Graph_Vertex_Id :=
+ Spec_Vertex (Inv_Graph, Targ);
+
+ begin
+ Error_Msg_Name_1 := Name (Inv_Graph, Targ);
+ Error_Msg_Nat_1 := Line (Inv_Graph, Targ);
+ Error_Msg_Nat_2 := Column (Inv_Graph, Targ);
+ Error_Msg_File_1 := File_Name (Lib_Graph, Targ_Vertex);
+
+ case Kind (Inv_Graph, Edge) is
+ when Accept_Alternative =>
+ Error_Msg_Info
+ (" selection of entry % "
+ & Declared);
+
+ when Access_Taken =>
+ Error_Msg_Info
+ (" aliasing of subprogram % "
+ & Declared);
+
+ when Call =>
+ Error_Msg_Info
+ (" call to subprogram % "
+ & Declared);
+
+ when Controlled_Adjustment
+ | Internal_Controlled_Adjustment
+ =>
+ Error_Msg_Name_1 := Targ_Extra;
+ Error_Msg_Info
+ (" adjustment actions for type % "
+ & Declared);
+
+ when Controlled_Finalization
+ | Internal_Controlled_Finalization
+ =>
+ Error_Msg_Name_1 := Targ_Extra;
+ Error_Msg_Info
+ (" finalization actions for type % "
+ & Declared);
+
+ when Controlled_Initialization
+ | Internal_Controlled_Initialization
+ | Type_Initialization
+ =>
+ Error_Msg_Name_1 := Targ_Extra;
+ Error_Msg_Info
+ (" initialization actions for type % "
+ & Declared);
+
+ when Default_Initial_Condition_Verification =>
+ Error_Msg_Name_1 := Targ_Extra;
+ Error_Msg_Info
+ (" verification of Default_Initial_Condition for type % "
+ & Declared);
+
+ when Initial_Condition_Verification =>
+ Error_Msg_Info
+ (" verification of Initial_Condition "
+ & Declared);
+
+ when Instantiation =>
+ Error_Msg_Info
+ (" instantiation % "
+ & Declared);
+
+ when Invariant_Verification =>
+ Error_Msg_Name_1 := Targ_Extra;
+ Error_Msg_Info
+ (" verification of invariant for type % "
+ & Declared);
+
+ when Postcondition_Verification =>
+ Error_Msg_Name_1 := Targ_Extra;
+ Error_Msg_Info
+ (" verification of postcondition for subprogram % "
+ & Declared);
+
+ when Protected_Entry_Call =>
+ Error_Msg_Info
+ (" call to protected entry % "
+ & Declared);
+
+ when Protected_Subprogram_Call =>
+ Error_Msg_Info
+ (" call to protected subprogram % "
+ & Declared);
+
+ when Task_Activation =>
+ Error_Msg_Info
+ (" activation of local task "
+ & Declared);
+
+ when Task_Entry_Call =>
+ Error_Msg_Info
+ (" call to task entry % "
+ & Declared);
+
+ when others =>
+ pragma Assert (False);
+ null;
+ end case;
+ end Output_Invocation_Path_Transition;
+
+ ----------------------------------
+ -- Output_Invocation_Transition --
+ ----------------------------------
+
+ procedure Output_Invocation_Transition
+ (Inv_Graph : Invocation_Graph;
+ Lib_Graph : Library_Graph;
+ Source : Library_Graph_Vertex_Id;
+ Destination : Library_Graph_Vertex_Id)
+ is
+ begin
+ pragma Assert (Present (Inv_Graph));
+ pragma Assert (Present (Lib_Graph));
+ pragma Assert (Present (Source));
+ pragma Assert (Present (Destination));
+
+ Error_Msg_Unit_1 := Name (Lib_Graph, Source);
+ Error_Msg_Unit_2 := Name (Lib_Graph, Destination);
+ Error_Msg_Info
+ (" unit $ invokes a construct of unit $ at elaboration time");
+
+ Find_And_Output_Invocation_Paths
+ (Inv_Graph => Inv_Graph,
+ Lib_Graph => Lib_Graph,
+ Source => Source,
+ Destination => Destination);
+ end Output_Invocation_Transition;
+
+ ------------------------------------------
+ -- Output_Reason_And_Circularity_Header --
+ ------------------------------------------
+
+ procedure Output_Reason_And_Circularity_Header
+ (G : Library_Graph;
+ First_Edge : Library_Graph_Edge_Id)
+ is
+ pragma Assert (Present (G));
+ pragma Assert (Present (First_Edge));
+
+ Succ : constant Library_Graph_Vertex_Id := Successor (G, First_Edge);
+
+ begin
+ Error_Msg_Unit_1 := Name (G, Succ);
+ Error_Msg ("Elaboration circularity detected");
+ Error_Msg_Info ("");
+ Error_Msg_Info (" Reason:");
+ Error_Msg_Info ("");
+ Error_Msg_Info (" unit $ depends on its own elaboration");
+ Error_Msg_Info ("");
+ Error_Msg_Info (" Circularity:");
+ Error_Msg_Info ("");
+ end Output_Reason_And_Circularity_Header;
+
+ ------------------------
+ -- Output_Suggestions --
+ ------------------------
+
+ procedure Output_Suggestions
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id;
+ First_Edge : Library_Graph_Edge_Id)
+ is
+ pragma Assert (Present (G));
+ pragma Assert (Present (Cycle));
+ pragma Assert (Present (First_Edge));
+
+ Pred : constant Library_Graph_Vertex_Id := Predecessor (G, First_Edge);
+ Succ : constant Library_Graph_Vertex_Id := Successor (G, First_Edge);
+
+ begin
+ Error_Msg_Info ("");
+ Error_Msg_Info (" Suggestions:");
+ Error_Msg_Info ("");
+
+ -- Output edge-specific suggestions
+
+ if Is_Elaborate_All_Edge (G, First_Edge) then
+ Output_Elaborate_All_Suggestions
+ (G => G,
+ Pred => Pred,
+ Succ => Succ);
+
+ elsif Is_Elaborate_Body_Edge (G, First_Edge) then
+ Output_Elaborate_Body_Suggestions
+ (G => G,
+ Succ => Succ);
+
+ elsif Is_Elaborate_Edge (G, First_Edge) then
+ Output_Elaborate_Suggestions
+ (G => G,
+ Pred => Pred,
+ Succ => Succ);
+
+ elsif Is_Forced_Edge (G, First_Edge) then
+ Output_Forced_Suggestions
+ (G => G,
+ Pred => Pred,
+ Succ => Succ);
+ end if;
+
+ -- Output general purpose suggestions
+
+ Output_Dynamic_Model_Suggestions
+ (G => G,
+ Cycle => Cycle);
+
+ Output_Full_Encoding_Suggestions
+ (G => G,
+ Cycle => Cycle,
+ First_Edge => First_Edge);
+
+ Output_All_Cycles_Suggestions (G);
+
+ Error_Msg_Info ("");
+ end Output_Suggestions;
+
+ -----------------------
+ -- Output_Transition --
-----------------------
- package body Cycle_Diagnostics is
+ procedure Output_Transition
+ (Inv_Graph : Invocation_Graph;
+ Lib_Graph : Library_Graph;
+ Current_Edge : Library_Graph_Edge_Id;
+ Next_Edge : Library_Graph_Edge_Id;
+ Elaborate_All_Active : Boolean)
+ is
+ pragma Assert (Present (Inv_Graph));
+ pragma Assert (Present (Lib_Graph));
+ pragma Assert (Present (Current_Edge));
+ pragma Assert (Present (Next_Edge));
+
+ Actual_Destination : constant Library_Graph_Vertex_Id :=
+ Predecessor (Lib_Graph, Current_Edge);
+ Expected_Destination : constant Library_Graph_Vertex_Id :=
+ Successor (Lib_Graph, Next_Edge);
+ Source : constant Library_Graph_Vertex_Id :=
+ Successor (Lib_Graph, Current_Edge);
- -----------------------------
- -- Has_Elaborate_All_Cycle --
- -----------------------------
+ begin
+ if Is_Elaborate_All_Edge (Lib_Graph, Current_Edge) then
+ Output_Elaborate_All_Transition
+ (G => Lib_Graph,
+ Source => Source,
+ Actual_Destination => Actual_Destination,
+ Expected_Destination => Expected_Destination);
- function Has_Elaborate_All_Cycle (G : Library_Graph) return Boolean is
- Has_Cycle : Boolean;
- Iter : All_Edge_Iterator;
- LGE_Id : Library_Graph_Edge_Id;
+ elsif Is_Elaborate_Body_Edge (Lib_Graph, Current_Edge) then
+ Output_Elaborate_Body_Transition
+ (G => Lib_Graph,
+ Source => Source,
+ Actual_Destination => Actual_Destination,
+ Expected_Destination => Expected_Destination);
- begin
- pragma Assert (Present (G));
+ elsif Is_Elaborate_Edge (Lib_Graph, Current_Edge) then
+ Output_Elaborate_Transition
+ (G => Lib_Graph,
+ Source => Source,
+ Actual_Destination => Actual_Destination,
+ Expected_Destination => Expected_Destination);
- -- Assume that the graph lacks a cycle
+ elsif Is_Forced_Edge (Lib_Graph, Current_Edge) then
+ Output_Forced_Transition
+ (G => Lib_Graph,
+ Source => Source,
+ Actual_Destination => Actual_Destination,
+ Expected_Destination => Expected_Destination,
+ Elaborate_All_Active => Elaborate_All_Active);
- Has_Cycle := False;
+ elsif Is_Invocation_Edge (Lib_Graph, Current_Edge) then
+ Output_Invocation_Transition
+ (Inv_Graph => Inv_Graph,
+ Lib_Graph => Lib_Graph,
+ Source => Source,
+ Destination => Expected_Destination);
- -- The library graph has an Elaborate_All cycle when one of its edges
- -- represents a with clause for a unit with pragma Elaborate_All, and
- -- both the predecessor and successor reside in the same component.
- -- Note that the iteration must run to completion in order to unlock
- -- the graph.
+ else
+ pragma Assert (Is_With_Edge (Lib_Graph, Current_Edge));
- Iter := Iterate_All_Edges (G);
+ Output_With_Transition
+ (G => Lib_Graph,
+ Source => Source,
+ Actual_Destination => Actual_Destination,
+ Expected_Destination => Expected_Destination,
+ Elaborate_All_Active => Elaborate_All_Active);
+ end if;
+ end Output_Transition;
+
+ ----------------------------
+ -- Output_With_Transition --
+ ----------------------------
+
+ procedure Output_With_Transition
+ (G : Library_Graph;
+ Source : Library_Graph_Vertex_Id;
+ Actual_Destination : Library_Graph_Vertex_Id;
+ Expected_Destination : Library_Graph_Vertex_Id;
+ Elaborate_All_Active : Boolean)
+ is
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Source));
+ pragma Assert (Present (Actual_Destination));
+ pragma Assert (Present (Expected_Destination));
+
+ -- The actual and expected destination vertices match, and denote the
+ -- spec of a unit.
+ --
+ -- with Actual_Destination
+ -- Source ------> spec -->
+ -- Expected_Destination
+ --
+ -- with Actual_Destination
+ -- Source ------> stand-alone body -->
+ -- Expected_Destination
+
+ if Actual_Destination = Expected_Destination then
+ Error_Msg_Unit_1 := Name (G, Source);
+ Error_Msg_Unit_2 := Name (G, Actual_Destination);
+ Error_Msg_Info
+ (" unit $ has with clause for unit $");
+
+ -- The actual destination vertex denotes the spec of a unit while the
+ -- expected destination is the corresponding body, and the unit is in
+ -- the closure of an earlier Elaborate_All pragma.
+ --
+ -- with Actual_Destination
+ -- Source ------> spec
+ --
+ -- body -->
+ -- Expected_Destination
+
+ elsif Elaborate_All_Active then
+ pragma Assert (Is_Spec_With_Body (G, Actual_Destination));
+ pragma Assert (Is_Body_With_Spec (G, Expected_Destination));
+ pragma Assert
+ (Proper_Body (G, Actual_Destination) = Expected_Destination);
+
+ Error_Msg_Unit_1 := Name (G, Source);
+ Error_Msg_Unit_2 := Name (G, Actual_Destination);
+ Error_Msg_Info
+ (" unit $ has with clause for unit $");
+
+ Error_Msg_Unit_1 := Name (G, Expected_Destination);
+ Error_Msg_Info
+ (" unit $ is in the closure of pragma Elaborate_All");
+
+ -- Otherwise the actual destination vertex denotes a spec subject to
+ -- pragma Elaborate_Body while the expected destination denotes the
+ -- corresponding body.
+ --
+ -- with Actual_Destination
+ -- Source ------> spec Elaborate_Body
+ --
+ -- body -->
+ -- Expected_Destination
+
+ else
+ pragma Assert (Is_Spec_With_Body (G, Actual_Destination));
+ pragma Assert (Is_Spec_With_Elaborate_Body (G, Actual_Destination));
+ pragma Assert (Is_Body_With_Spec (G, Expected_Destination));
+ pragma Assert
+ (Is_Body_Of_Spec_With_Elaborate_Body (G, Expected_Destination));
+ pragma Assert
+ (Proper_Body (G, Actual_Destination) = Expected_Destination);
+
+ Error_Msg_Unit_1 := Name (G, Source);
+ Error_Msg_Unit_2 := Name (G, Actual_Destination);
+ Error_Msg_Info
+ (" unit $ has with clause for unit $");
+
+ Error_Msg_Unit_1 := Name (G, Actual_Destination);
+ Error_Msg_Info
+ (" unit $ is subject to pragma Elaborate_Body");
+
+ Error_Msg_Unit_1 := Name (G, Expected_Destination);
+ Error_Msg_Info
+ (" unit $ is in the closure of pragma Elaborate_Body");
+ end if;
+ end Output_With_Transition;
+
+ ------------------
+ -- Visit_Vertex --
+ ------------------
+
+ procedure Visit_Vertex
+ (Inv_Graph : Invocation_Graph;
+ Lib_Graph : Library_Graph;
+ Invoker : Invocation_Graph_Vertex_Id;
+ Invoker_Vertex : Library_Graph_Vertex_Id;
+ Last_Vertex : Library_Graph_Vertex_Id;
+ Elaborated_Vertex : Library_Graph_Vertex_Id;
+ End_Vertex : Library_Graph_Vertex_Id;
+ Path : IGE_Lists.Doubly_Linked_List;
+ Path_Id : in out Nat)
+ is
+ Edge : Invocation_Graph_Edge_Id;
+ Iter : Edges_To_Targets_Iterator;
+ Targ : Invocation_Graph_Vertex_Id;
+
+ begin
+ pragma Assert (Present (Inv_Graph));
+ pragma Assert (Present (Lib_Graph));
+ pragma Assert (Present (Invoker));
+ pragma Assert (Present (Invoker_Vertex));
+ pragma Assert (Present (Last_Vertex));
+ pragma Assert (Present (Elaborated_Vertex));
+ pragma Assert (Present (End_Vertex));
+ pragma Assert (IGE_Lists.Present (Path));
+
+ -- The current invocation vertex resides within the end library vertex.
+ -- Emit the path that started from some elaboration root and ultimately
+ -- reached the desired library vertex.
+
+ if Body_Vertex (Inv_Graph, Invoker) = End_Vertex
+ and then Invoker_Vertex /= Last_Vertex
+ then
+ Output_Invocation_Path
+ (Inv_Graph => Inv_Graph,
+ Lib_Graph => Lib_Graph,
+ Elaborated_Vertex => Elaborated_Vertex,
+ Path => Path,
+ Path_Id => Path_Id);
+
+ -- Otherwise extend the search for the end library vertex via all edges
+ -- to targets.
+
+ else
+ Iter := Iterate_Edges_To_Targets (Inv_Graph, Invoker);
while Has_Next (Iter) loop
- Next (Iter, LGE_Id);
- pragma Assert (Present (LGE_Id));
-
- if Kind (G, LGE_Id) = Elaborate_All_Edge
- and then Links_Vertices_In_Same_Component (G, LGE_Id)
- then
- Has_Cycle := True;
- end if;
- end loop;
+ Next (Iter, Edge);
- return Has_Cycle;
- end Has_Elaborate_All_Cycle;
- end Cycle_Diagnostics;
+ -- Prepare for edge backtracking
+
+ IGE_Lists.Append (Path, Edge);
+
+ -- The traversal proceeds through the library vertex that houses
+ -- the body of the target.
+
+ Targ := Target (Inv_Graph, Edge);
+
+ Visit_Vertex
+ (Inv_Graph => Inv_Graph,
+ Lib_Graph => Lib_Graph,
+ Invoker => Targ,
+ Invoker_Vertex => Body_Vertex (Inv_Graph, Targ),
+ Last_Vertex => Invoker_Vertex,
+ Elaborated_Vertex => Elaborated_Vertex,
+ End_Vertex => End_Vertex,
+ Path => Path,
+ Path_Id => Path_Id);
+
+ -- Backtrack the edge
+
+ IGE_Lists.Delete_Last (Path);
+ end loop;
+ end if;
+ end Visit_Vertex;
end Bindo.Diagnostics;
with Bindo.Graphs;
use Bindo.Graphs;
+use Bindo.Graphs.Invocation_Graphs;
use Bindo.Graphs.Library_Graphs;
package Bindo.Diagnostics is
Order_Has_Elaborate_All_Circularity,
Order_OK);
- -----------------------
- -- Cycle_Diagnostics --
- -----------------------
+ ---------
+ -- API --
+ ---------
- package Cycle_Diagnostics is
- function Has_Elaborate_All_Cycle (G : Library_Graph) return Boolean;
- pragma Inline (Has_Elaborate_All_Cycle);
- -- Determine whether library graph G contains a cycle where pragma
- -- Elaborate_All appears within a component.
-
- end Cycle_Diagnostics;
+ procedure Diagnose_Circularities
+ (Inv_Graph : Invocation_Graph;
+ Lib_Graph : Library_Graph);
+ pragma Inline (Diagnose_Circularities);
+ -- Diagnose all cycles of library graph Lib_Graph with matching invocation
+ -- graph Inv_Graph.
end Bindo.Diagnostics;
-- --
------------------------------------------------------------------------------
-with Binderr; use Binderr;
-with Butil; use Butil;
-with Debug; use Debug;
-with Output; use Output;
-with Types; use Types;
+with Butil; use Butil;
+with Debug; use Debug;
+with Output; use Output;
+with Types; use Types;
with Bindo.Augmentors;
use Bindo.Augmentors;
with Bindo.Diagnostics;
use Bindo.Diagnostics;
-use Bindo.Diagnostics.Cycle_Diagnostics;
with Bindo.Units;
use Bindo.Units;
with GNAT; use GNAT;
with GNAT.Graphs; use GNAT.Graphs;
-with GNAT.Sets; use GNAT.Sets;
package body Bindo.Elaborators is
type String_Ptr is access all String;
- -----------------
- -- Visited set --
- -----------------
-
- package VS is new Membership_Sets
- (Element_Type => Library_Graph_Vertex_Id,
- "=" => "=",
- Hash => Hash_Library_Graph_Vertex);
- use VS;
-
-----------------------
-- Local subprograms --
-----------------------
procedure Add_Vertex
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id;
- Set : Membership_Set;
+ Vertex : Library_Graph_Vertex_Id;
+ Set : LGV_Sets.Membership_Set;
Msg : String;
Step : Elaboration_Order_Step;
Indent : Indentation_Level);
pragma Inline (Add_Vertex);
- -- Add vertex LGV_Id of library graph G to membership set Set. Msg is
+ -- Add vertex Vertex of library graph G to membership set Set. Msg is
-- a message emitted for tracing purposes. Step is the current step in
-- the elaboration order. Indent is the desired indentation level for
-- tracing.
procedure Add_Vertex_If_Elaborable
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id;
- Set : Membership_Set;
+ Vertex : Library_Graph_Vertex_Id;
+ Set : LGV_Sets.Membership_Set;
Msg : String;
Step : Elaboration_Order_Step;
Indent : Indentation_Level);
pragma Inline (Add_Vertex_If_Elaborable);
- -- Add vertex LGV_Id of library graph G to membership set Set if it can
+ -- Add vertex Vertex of library graph G to membership set Set if it can
-- be elaborated. Msg is a message emitted for tracing purposes. Step is
-- the current step in the elaboration order. Indent is the desired
-- indentation level for tracing.
function Create_All_Candidates_Set
(G : Library_Graph;
- Step : Elaboration_Order_Step) return Membership_Set;
+ Step : Elaboration_Order_Step) return LGV_Sets.Membership_Set;
pragma Inline (Create_All_Candidates_Set);
-- Collect all elaborable candidate vertices of library graph G in a
-- set. Step is the current step in the elaboration order.
function Create_Component_Candidates_Set
(G : Library_Graph;
Comp : Component_Id;
- Step : Elaboration_Order_Step) return Membership_Set;
+ Step : Elaboration_Order_Step) return LGV_Sets.Membership_Set;
pragma Inline (Create_Component_Candidates_Set);
-- Collect all elaborable candidate vertices that appear in component
-- Comp of library graph G in a set. Step is the current step in the
procedure Elaborate_Component
(G : Library_Graph;
Comp : Component_Id;
- All_Candidates : Membership_Set;
+ All_Candidates : LGV_Sets.Membership_Set;
Remaining_Vertices : in out Natural;
Order : in out Unit_Id_Table;
Step : Elaboration_Order_Step);
procedure Elaborate_Units_Common
(Use_Inv_Graph : Boolean;
+ Is_Dyn_Elab : Boolean;
Inv_Graph : out Invocation_Graph;
Lib_Graph : out Library_Graph;
Order : out Unit_Id_Table;
pragma Inline (Elaborate_Units_Common);
-- Find the elaboration order of all units in the bind. Use_Inv_Graph
-- should be set when library graph Lib_Graph is to be augmented with
- -- information from invocation graph Inv_Graph. Order is the elaboration
- -- order. Status is the condition of the elaboration order.
+ -- information from invocation graph Inv_Graph. Is_Dyn_Elab should be
+ -- set when the main library unit was compiled using the dynamic model.
+ -- Order is the elaboration order. Status is the condition of the
+ -- elaboration order.
procedure Elaborate_Units_Dynamic (Order : out Unit_Id_Table);
pragma Inline (Elaborate_Units_Dynamic);
procedure Elaborate_Vertex
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id;
- All_Candidates : Membership_Set;
- Comp_Candidates : Membership_Set;
+ Vertex : Library_Graph_Vertex_Id;
+ All_Candidates : LGV_Sets.Membership_Set;
+ Comp_Candidates : LGV_Sets.Membership_Set;
Remaining_Vertices : in out Natural;
Order : in out Unit_Id_Table;
Step : Elaboration_Order_Step;
Indent : Indentation_Level);
pragma Inline (Elaborate_Vertex);
- -- Elaborate vertex LGV_Id of library graph G by adding its unit to
+ -- Elaborate vertex Vertex of library graph G by adding its unit to
-- elaboration order Order. The routine updates awaiting successors
-- where applicable. All_Candidates denotes the set of all elaborable
-- vertices across the whole library graph. Comp_Candidates is the set
- -- of all elaborable vertices in the component of LGV_Id. Parameter
+ -- of all elaborable vertices in the component of Vertex. Parameter
-- Remaining_Vertices denotes the number of vertices that remain to
-- be elaborated. Step is the current step in the elaboration order.
-- Indent is the desired indentation level for tracing.
function Find_Best_Candidate
(G : Library_Graph;
- Set : Membership_Set;
+ Set : LGV_Sets.Membership_Set;
Step : Elaboration_Order_Step;
Indent : Indentation_Level) return Library_Graph_Vertex_Id;
pragma Inline (Find_Best_Candidate);
-- order. Indent is the desired indentation level for tracing.
function Is_Better_Candidate
- (G : Library_Graph;
- Best_Candid : Library_Graph_Vertex_Id;
- New_Candid : Library_Graph_Vertex_Id) return Boolean;
+ (G : Library_Graph;
+ Best_Candidate : Library_Graph_Vertex_Id;
+ New_Candidate : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (Is_Better_Candidate);
- -- Determine whether new candidate vertex New_Candid of library graph
+ -- Determine whether new candidate vertex New_Candidate of library graph
-- G is a more suitable choice for elaboration compared to the current
- -- best candidate Best_Candid.
+ -- best candidate Best_Candidate.
procedure Trace_Candidate_Vertices
(G : Library_Graph;
- Set : Membership_Set;
+ Set : LGV_Sets.Membership_Set;
Step : Elaboration_Order_Step);
pragma Inline (Trace_Candidate_Vertices);
-- Write the candidate vertices of library graph G present in membership
procedure Trace_Vertex
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id;
+ Vertex : Library_Graph_Vertex_Id;
Msg : String;
Step : Elaboration_Order_Step;
Indent : Indentation_Level);
pragma Inline (Trace_Vertex);
- -- Write elaboration-related information for vertex LGV_Id of library
+ -- Write elaboration-related information for vertex Vertex of library
-- graph G to standard output, starting with message Msg. Step is the
-- current step in the elaboration order. Indent denotes the desired
-- indentation level for tracing.
(G : Library_Graph;
Pred : Library_Graph_Vertex_Id;
Succ : Library_Graph_Vertex_Id;
- All_Candidates : Membership_Set;
- Comp_Candidates : Membership_Set;
+ All_Candidates : LGV_Sets.Membership_Set;
+ Comp_Candidates : LGV_Sets.Membership_Set;
Step : Elaboration_Order_Step;
Indent : Indentation_Level);
pragma Inline (Update_Successor);
procedure Update_Successors
(G : Library_Graph;
Pred : Library_Graph_Vertex_Id;
- All_Candidates : Membership_Set;
- Comp_Candidates : Membership_Set;
+ All_Candidates : LGV_Sets.Membership_Set;
+ Comp_Candidates : LGV_Sets.Membership_Set;
Step : Elaboration_Order_Step;
Indent : Indentation_Level);
pragma Inline (Update_Successors);
procedure Add_Vertex
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id;
- Set : Membership_Set;
+ Vertex : Library_Graph_Vertex_Id;
+ Set : LGV_Sets.Membership_Set;
Msg : String;
Step : Elaboration_Order_Step;
Indent : Indentation_Level)
is
begin
- pragma Assert (Present (LGV_Id));
- pragma Assert (Needs_Elaboration (G, LGV_Id));
- pragma Assert (Present (Set));
+ pragma Assert (Present (Vertex));
+ pragma Assert (Needs_Elaboration (G, Vertex));
+ pragma Assert (LGV_Sets.Present (Set));
-- Add vertex only when it is not present in the set. This is not
-- strictly necessary because the set implementation handles this
-- case, however the check eliminates spurious traces.
- if not Contains (Set, LGV_Id) then
+ if not LGV_Sets.Contains (Set, Vertex) then
Trace_Vertex
(G => G,
- LGV_Id => LGV_Id,
+ Vertex => Vertex,
Msg => Msg,
Step => Step,
Indent => Indent);
- Insert (Set, LGV_Id);
+ LGV_Sets.Insert (Set, Vertex);
end if;
end Add_Vertex;
procedure Add_Vertex_If_Elaborable
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id;
- Set : Membership_Set;
+ Vertex : Library_Graph_Vertex_Id;
+ Set : LGV_Sets.Membership_Set;
Msg : String;
Step : Elaboration_Order_Step;
Indent : Indentation_Level)
is
- Aux_LGV_Id : Library_Graph_Vertex_Id;
+ Extra_Vertex : Library_Graph_Vertex_Id;
begin
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
- pragma Assert (Needs_Elaboration (G, LGV_Id));
- pragma Assert (Present (Set));
+ pragma Assert (Present (Vertex));
+ pragma Assert (Needs_Elaboration (G, Vertex));
+ pragma Assert (LGV_Sets.Present (Set));
- if Is_Elaborable_Vertex (G, LGV_Id) then
+ if Is_Elaborable_Vertex (G, Vertex) then
Add_Vertex
(G => G,
- LGV_Id => LGV_Id,
+ Vertex => Vertex,
Set => Set,
Msg => Msg,
Step => Step,
-- Assume that there is no extra vertex that needs to be added
- Aux_LGV_Id := No_Library_Graph_Vertex;
+ Extra_Vertex := No_Library_Graph_Vertex;
-- A spec-body pair where the spec carries pragma Elaborate_Body
-- must be treated as one vertex for elaboration purposes. If one
-- of them is elaborable, then the other is also elaborable. This
-- property is guaranteed by predicate Is_Elaborable_Vertex.
- if Is_Body_Of_Spec_With_Elaborate_Body (G, LGV_Id) then
- Aux_LGV_Id := Proper_Spec (G, LGV_Id);
- pragma Assert (Present (Aux_LGV_Id));
+ if Is_Body_Of_Spec_With_Elaborate_Body (G, Vertex) then
+ Extra_Vertex := Proper_Spec (G, Vertex);
+ pragma Assert (Present (Extra_Vertex));
- elsif Is_Spec_With_Elaborate_Body (G, LGV_Id) then
- Aux_LGV_Id := Proper_Body (G, LGV_Id);
- pragma Assert (Present (Aux_LGV_Id));
+ elsif Is_Spec_With_Elaborate_Body (G, Vertex) then
+ Extra_Vertex := Proper_Body (G, Vertex);
+ pragma Assert (Present (Extra_Vertex));
end if;
- if Present (Aux_LGV_Id) then
- pragma Assert (Needs_Elaboration (G, Aux_LGV_Id));
+ if Present (Extra_Vertex) then
+ pragma Assert (Needs_Elaboration (G, Extra_Vertex));
Add_Vertex
(G => G,
- LGV_Id => Aux_LGV_Id,
+ Vertex => Extra_Vertex,
Set => Set,
Msg => Msg,
Step => Step,
function Create_All_Candidates_Set
(G : Library_Graph;
- Step : Elaboration_Order_Step) return Membership_Set
+ Step : Elaboration_Order_Step) return LGV_Sets.Membership_Set
is
Iter : Library_Graphs.All_Vertex_Iterator;
- LGV_Id : Library_Graph_Vertex_Id;
- Set : Membership_Set;
+ Set : LGV_Sets.Membership_Set;
+ Vertex : Library_Graph_Vertex_Id;
begin
pragma Assert (Present (G));
- Set := Create (Number_Of_Vertices (G));
+ Set := LGV_Sets.Create (Number_Of_Vertices (G));
Iter := Iterate_All_Vertices (G);
while Has_Next (Iter) loop
- Next (Iter, LGV_Id);
- pragma Assert (Present (LGV_Id));
+ Next (Iter, Vertex);
Add_Vertex_If_Elaborable
(G => G,
- LGV_Id => LGV_Id,
+ Vertex => Vertex,
Set => Set,
Msg => Add_To_All_Candidates_Msg,
Step => Step,
function Create_Component_Candidates_Set
(G : Library_Graph;
Comp : Component_Id;
- Step : Elaboration_Order_Step) return Membership_Set
+ Step : Elaboration_Order_Step) return LGV_Sets.Membership_Set
is
Iter : Component_Vertex_Iterator;
- LGV_Id : Library_Graph_Vertex_Id;
- Set : Membership_Set;
+ Set : LGV_Sets.Membership_Set;
+ Vertex : Library_Graph_Vertex_Id;
begin
pragma Assert (Present (G));
pragma Assert (Present (Comp));
- Set := Create (Number_Of_Component_Vertices (G, Comp));
+ Set := LGV_Sets.Create (Number_Of_Component_Vertices (G, Comp));
Iter := Iterate_Component_Vertices (G, Comp);
while Has_Next (Iter) loop
- Next (Iter, LGV_Id);
- pragma Assert (Present (LGV_Id));
+ Next (Iter, Vertex);
Add_Vertex_If_Elaborable
(G => G,
- LGV_Id => LGV_Id,
+ Vertex => Vertex,
Set => Set,
Msg => Add_To_Comp_Candidates_Msg,
Step => Step,
procedure Elaborate_Component
(G : Library_Graph;
Comp : Component_Id;
- All_Candidates : Membership_Set;
+ All_Candidates : LGV_Sets.Membership_Set;
Remaining_Vertices : in out Natural;
Order : in out Unit_Id_Table;
Step : Elaboration_Order_Step)
is
Candidate : Library_Graph_Vertex_Id;
- Comp_Candidates : Membership_Set;
+ Comp_Candidates : LGV_Sets.Membership_Set;
begin
pragma Assert (Present (G));
pragma Assert (Present (Comp));
- pragma Assert (Present (All_Candidates));
+ pragma Assert (LGV_Sets.Present (All_Candidates));
Trace_Component
(G => G,
Elaborate_Vertex
(G => G,
- LGV_Id => Candidate,
+ Vertex => Candidate,
All_Candidates => All_Candidates,
Comp_Candidates => Comp_Candidates,
Remaining_Vertices => Remaining_Vertices,
Indent => Nested_Indentation);
end loop;
- Destroy (Comp_Candidates);
+ LGV_Sets.Destroy (Comp_Candidates);
end Elaborate_Component;
-----------------------------
Order : out Unit_Id_Table;
Status : out Elaboration_Order_Status)
is
- All_Candidates : Membership_Set;
+ All_Candidates : LGV_Sets.Membership_Set;
Candidate : Library_Graph_Vertex_Id;
- Comp : Component_Id;
Remaining_Vertices : Natural;
Step : Elaboration_Order_Step;
-- and their components that they have one less predecessor to
-- wait on. This may add new candidates to set All_Candidates.
- Comp := Component (G, Candidate);
- pragma Assert (Present (Comp));
-
Elaborate_Component
(G => G,
- Comp => Comp,
+ Comp => Component (G, Candidate),
All_Candidates => All_Candidates,
Remaining_Vertices => Remaining_Vertices,
Order => Order,
Step => Step);
end loop;
- Destroy (All_Candidates);
+ LGV_Sets.Destroy (All_Candidates);
-- The library graph contains an Elaborate_All circularity when
-- at least one edge subject to the related pragma appears in a
Write_ALI_Tables;
-- Choose the proper elaboration strategy based on whether the main
- -- library unit was compiled with dynamic elaboration checks.
+ -- library unit was compiled using the dynamic model.
if Is_Dynamically_Elaborated (Main_Lib_Unit) then
Elaborate_Units_Dynamic (Order);
procedure Elaborate_Units_Common
(Use_Inv_Graph : Boolean;
+ Is_Dyn_Elab : Boolean;
Inv_Graph : out Invocation_Graph;
Lib_Graph : out Library_Graph;
Order : out Unit_Id_Table;
-- Create, validate, and output the library graph that captures the
-- dependencies between library items.
- Lib_Graph := Build_Library_Graph;
+ Lib_Graph := Build_Library_Graph (Is_Dyn_Elab);
Validate_Library_Graph (Lib_Graph);
Write_Library_Graph (Lib_Graph);
Elaborate_Units_Common
(Use_Inv_Graph => True,
+ Is_Dyn_Elab => True,
Inv_Graph => Mix_Inv_Graph,
Lib_Graph => Mix_Lib_Graph,
Order => Mix_Order,
-- the invocation graph because the circularity will persist.
elsif Status = Order_Has_Elaborate_All_Circularity then
- Error_Msg ("elaboration circularity detected");
-
- -- Report error here
+ Diagnose_Circularities
+ (Inv_Graph => Mix_Inv_Graph,
+ Lib_Graph => Mix_Lib_Graph);
-- Otherwise the library graph contains a circularity, or the extra
-- information provided by the invocation graph caused a circularity.
Elaborate_Units_Common
(Use_Inv_Graph => False,
+ Is_Dyn_Elab => True,
Inv_Graph => Dyn_Inv_Graph,
Lib_Graph => Dyn_Lib_Graph,
Order => Dyn_Order,
-- the circularity.
else
- Error_Msg ("elaboration circularity detected");
-
- -- Report error here
+ Diagnose_Circularities
+ (Inv_Graph => Dyn_Inv_Graph,
+ Lib_Graph => Dyn_Lib_Graph);
end if;
Destroy (Dyn_Inv_Graph);
Elaborate_Units_Common
(Use_Inv_Graph => True,
+ Is_Dyn_Elab => False,
Inv_Graph => Inv_Graph,
Lib_Graph => Lib_Graph,
Order => Order,
-- The augmented library graph contains a circularity
if Status /= Order_OK then
- Error_Msg ("elaboration circularity detected");
-
- -- Report error here
+ Diagnose_Circularities
+ (Inv_Graph => Inv_Graph,
+ Lib_Graph => Lib_Graph);
end if;
Destroy (Inv_Graph);
procedure Elaborate_Vertex
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id;
- All_Candidates : Membership_Set;
- Comp_Candidates : Membership_Set;
+ Vertex : Library_Graph_Vertex_Id;
+ All_Candidates : LGV_Sets.Membership_Set;
+ Comp_Candidates : LGV_Sets.Membership_Set;
Remaining_Vertices : in out Natural;
Order : in out Unit_Id_Table;
Step : Elaboration_Order_Step;
Indent : Indentation_Level)
is
- Body_LGV_Id : Library_Graph_Vertex_Id;
- U_Id : Unit_Id;
-
begin
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
- pragma Assert (Needs_Elaboration (G, LGV_Id));
- pragma Assert (Present (All_Candidates));
- pragma Assert (Present (Comp_Candidates));
+ pragma Assert (Present (Vertex));
+ pragma Assert (Needs_Elaboration (G, Vertex));
+ pragma Assert (LGV_Sets.Present (All_Candidates));
+ pragma Assert (LGV_Sets.Present (Comp_Candidates));
Trace_Vertex
(G => G,
- LGV_Id => LGV_Id,
+ Vertex => Vertex,
Msg => "elaborating vertex",
Step => Step,
Indent => Indent);
-- check that the vertex is present in either set because the set
-- implementation handles this case.
- Delete (All_Candidates, LGV_Id);
- Delete (Comp_Candidates, LGV_Id);
+ LGV_Sets.Delete (All_Candidates, Vertex);
+ LGV_Sets.Delete (Comp_Candidates, Vertex);
-- Mark the vertex as elaborated in order to prevent further attempts
-- to re-elaborate it.
- Set_In_Elaboration_Order (G, LGV_Id);
+ Set_In_Elaboration_Order (G, Vertex);
-- Add the unit represented by the vertex to the elaboration order
- U_Id := Unit (G, LGV_Id);
- pragma Assert (Present (U_Id));
-
- Unit_Id_Tables.Append (Order, U_Id);
+ Unit_Id_Tables.Append (Order, Unit (G, Vertex));
-- There is now one fewer vertex to elaborate
Update_Successors
(G => G,
- Pred => LGV_Id,
+ Pred => Vertex,
All_Candidates => All_Candidates,
Comp_Candidates => Comp_Candidates,
Step => Step,
-- to pragma Elaborate_Body. Elaborate the body in order to satisfy
-- the semantics of the pragma.
- if Is_Spec_With_Elaborate_Body (G, LGV_Id) then
- Body_LGV_Id := Proper_Body (G, LGV_Id);
- pragma Assert (Present (Body_LGV_Id));
-
+ if Is_Spec_With_Elaborate_Body (G, Vertex) then
Elaborate_Vertex
(G => G,
- LGV_Id => Body_LGV_Id,
+ Vertex => Proper_Body (G, Vertex),
All_Candidates => All_Candidates,
Comp_Candidates => Comp_Candidates,
Remaining_Vertices => Remaining_Vertices,
function Find_Best_Candidate
(G : Library_Graph;
- Set : Membership_Set;
+ Set : LGV_Sets.Membership_Set;
Step : Elaboration_Order_Step;
Indent : Indentation_Level) return Library_Graph_Vertex_Id
is
- Best : Library_Graph_Vertex_Id;
- Curr : Library_Graph_Vertex_Id;
- Iter : Iterator;
+ Best : Library_Graph_Vertex_Id;
+ Current : Library_Graph_Vertex_Id;
+ Iter : LGV_Sets.Iterator;
begin
pragma Assert (Present (G));
- pragma Assert (Present (Set));
+ pragma Assert (LGV_Sets.Present (Set));
-- Assume that there is no candidate
-- Inspect all vertices in the set, looking for the best candidate to
-- elaborate.
- Iter := Iterate (Set);
- while Has_Next (Iter) loop
- Next (Iter, Curr);
-
- pragma Assert (Present (Curr));
- pragma Assert (Needs_Elaboration (G, Curr));
+ Iter := LGV_Sets.Iterate (Set);
+ while LGV_Sets.Has_Next (Iter) loop
+ LGV_Sets.Next (Iter, Current);
+ pragma Assert (Needs_Elaboration (G, Current));
-- Update the best candidate when there is no such candidate
if not Present (Best) then
- Best := Curr;
+ Best := Current;
Trace_Vertex
(G => G,
- LGV_Id => Best,
+ Vertex => Best,
Msg => "initial best candidate vertex",
Step => Step,
Indent => Indent);
elsif Is_Better_Candidate
(G => G,
- Best_Candid => Best,
- New_Candid => Curr)
+ Best_Candidate => Best,
+ New_Candidate => Current)
then
- Best := Curr;
+ Best := Current;
Trace_Vertex
(G => G,
- LGV_Id => Best,
+ Vertex => Best,
Msg => "best candidate vertex",
Step => Step,
Indent => Indent);
-------------------------
function Is_Better_Candidate
- (G : Library_Graph;
- Best_Candid : Library_Graph_Vertex_Id;
- New_Candid : Library_Graph_Vertex_Id) return Boolean
+ (G : Library_Graph;
+ Best_Candidate : Library_Graph_Vertex_Id;
+ New_Candidate : Library_Graph_Vertex_Id) return Boolean
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Best_Candid));
- pragma Assert (Present (New_Candid));
+ pragma Assert (Present (Best_Candidate));
+ pragma Assert (Present (New_Candidate));
-- Prefer a predefined unit over a non-predefined unit
- if Is_Predefined_Unit (G, Best_Candid)
- and then not Is_Predefined_Unit (G, New_Candid)
+ if Is_Predefined_Unit (G, Best_Candidate)
+ and then not Is_Predefined_Unit (G, New_Candidate)
then
return False;
- elsif not Is_Predefined_Unit (G, Best_Candid)
- and then Is_Predefined_Unit (G, New_Candid)
+ elsif not Is_Predefined_Unit (G, Best_Candidate)
+ and then Is_Predefined_Unit (G, New_Candidate)
then
return True;
-- Prefer an internal unit over a non-iternal unit
- elsif Is_Internal_Unit (G, Best_Candid)
- and then not Is_Internal_Unit (G, New_Candid)
+ elsif Is_Internal_Unit (G, Best_Candidate)
+ and then not Is_Internal_Unit (G, New_Candidate)
then
return False;
- elsif not Is_Internal_Unit (G, Best_Candid)
- and then Is_Internal_Unit (G, New_Candid)
+ elsif not Is_Internal_Unit (G, Best_Candidate)
+ and then Is_Internal_Unit (G, New_Candidate)
then
return True;
-- Prefer a preelaborated unit over a non-preelaborated unit
- elsif Is_Preelaborated_Unit (G, Best_Candid)
- and then not Is_Preelaborated_Unit (G, New_Candid)
+ elsif Is_Preelaborated_Unit (G, Best_Candidate)
+ and then not Is_Preelaborated_Unit (G, New_Candidate)
then
return False;
- elsif not Is_Preelaborated_Unit (G, Best_Candid)
- and then Is_Preelaborated_Unit (G, New_Candid)
+ elsif not Is_Preelaborated_Unit (G, Best_Candidate)
+ and then Is_Preelaborated_Unit (G, New_Candidate)
then
return True;
-- behavior.
else
- return Uname_Less (Name (G, Best_Candid), Name (G, New_Candid));
+ return
+ Uname_Less (Name (G, Best_Candidate), Name (G, New_Candidate));
end if;
end Is_Better_Candidate;
procedure Trace_Candidate_Vertices
(G : Library_Graph;
- Set : Membership_Set;
+ Set : LGV_Sets.Membership_Set;
Step : Elaboration_Order_Step)
is
- Iter : Iterator;
- LGV_Id : Library_Graph_Vertex_Id;
+ Iter : LGV_Sets.Iterator;
+ Vertex : Library_Graph_Vertex_Id;
begin
pragma Assert (Present (G));
- pragma Assert (Present (Set));
+ pragma Assert (LGV_Sets.Present (Set));
- -- Nothing to do when switch -d_T (output elaboration order trace
- -- information) is not in effect.
+ -- Nothing to do when switch -d_T (output elaboration order and cycle
+ -- detection trace information) is not in effect.
if not Debug_Flag_Underscore_TT then
return;
Trace_Step (Step);
Write_Str ("candidate vertices: ");
- Write_Int (Int (Size (Set)));
+ Write_Int (Int (LGV_Sets.Size (Set)));
Write_Eol;
- Iter := Iterate (Set);
- while Has_Next (Iter) loop
- Next (Iter, LGV_Id);
- pragma Assert (Present (LGV_Id));
+ Iter := LGV_Sets.Iterate (Set);
+ while LGV_Sets.Has_Next (Iter) loop
+ LGV_Sets.Next (Iter, Vertex);
Trace_Vertex
(G => G,
- LGV_Id => LGV_Id,
+ Vertex => Vertex,
Msg => "candidate vertex",
Step => Step,
Indent => Nested_Indentation);
pragma Assert (Present (G));
pragma Assert (Present (Comp));
- -- Nothing to do when switch -d_T (output elaboration order trace
- -- information) is not in effect.
+ -- Nothing to do when switch -d_T (output elaboration order and cycle
+ -- detection trace information) is not in effect.
if not Debug_Flag_Underscore_TT then
return;
procedure Trace_Step (Step : Elaboration_Order_Step) is
begin
- -- Nothing to do when switch -d_T (output elaboration order trace
- -- information) is not in effect.
+ -- Nothing to do when switch -d_T (output elaboration order and cycle
+ -- detection trace information) is not in effect.
if not Debug_Flag_Underscore_TT then
return;
Step : Elaboration_Order_Step)
is
Iter : Library_Graphs.All_Vertex_Iterator;
- LGV_Id : Library_Graph_Vertex_Id;
+ Vertex : Library_Graph_Vertex_Id;
begin
pragma Assert (Present (G));
- -- Nothing to do when switch -d_T (output elaboration order trace
- -- information) is not in effect.
+ -- Nothing to do when switch -d_T (output elaboration order and cycle
+ -- detection trace information) is not in effect.
if not Debug_Flag_Underscore_TT then
return;
Iter := Iterate_All_Vertices (G);
while Has_Next (Iter) loop
- Next (Iter, LGV_Id);
- pragma Assert (Present (LGV_Id));
+ Next (Iter, Vertex);
- if Needs_Elaboration (G, LGV_Id)
- and then not In_Elaboration_Order (G, LGV_Id)
+ if Needs_Elaboration (G, Vertex)
+ and then not In_Elaboration_Order (G, Vertex)
then
Trace_Vertex
(G => G,
- LGV_Id => LGV_Id,
+ Vertex => Vertex,
Msg => "remaining vertex",
Step => Step,
Indent => Nested_Indentation);
procedure Trace_Vertex
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id;
+ Vertex : Library_Graph_Vertex_Id;
Msg : String;
Step : Elaboration_Order_Step;
Indent : Indentation_Level)
is
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
+ pragma Assert (Present (Vertex));
- Comp : constant Component_Id := Component (G, LGV_Id);
-
- pragma Assert (Present (Comp));
+ Attr_Indent : constant Indentation_Level :=
+ Indent + Nested_Indentation;
+ Comp : constant Component_Id := Component (G, Vertex);
begin
- -- Nothing to do when switch -d_T (output elaboration order trace
- -- information) is not in effect.
+ -- Nothing to do when switch -d_T (output elaboration order and cycle
+ -- detection trace information) is not in effect.
if not Debug_Flag_Underscore_TT then
return;
Indent_By (Indent);
Write_Str (Msg);
Write_Str (" (LGV_Id_");
- Write_Int (Int (LGV_Id));
+ Write_Int (Int (Vertex));
Write_Str (")");
Write_Eol;
Trace_Step (Step);
- Indent_By (Indent + Nested_Indentation);
+ Indent_By (Attr_Indent);
Write_Str ("name = ");
- Write_Name (Name (G, LGV_Id));
+ Write_Name (Name (G, Vertex));
Write_Eol;
Trace_Step (Step);
- Indent_By (Indent + Nested_Indentation);
+ Indent_By (Attr_Indent);
Write_Str ("Component (Comp_Id_");
Write_Int (Int (Comp));
Write_Str (")");
Write_Eol;
Trace_Step (Step);
- Indent_By (Indent + Nested_Indentation);
+ Indent_By (Attr_Indent);
Write_Str ("pending predecessors: ");
- Write_Num (Int (Pending_Predecessors (G, LGV_Id)));
+ Write_Num (Int (Pending_Predecessors (G, Vertex)));
Write_Eol;
Trace_Step (Step);
- Indent_By (Indent + Nested_Indentation);
+ Indent_By (Attr_Indent);
Write_Str ("pending components : ");
Write_Num (Int (Pending_Predecessors (G, Comp)));
Write_Eol;
(G : Library_Graph;
Pred : Library_Graph_Vertex_Id;
Succ : Library_Graph_Vertex_Id;
- All_Candidates : Membership_Set;
- Comp_Candidates : Membership_Set;
+ All_Candidates : LGV_Sets.Membership_Set;
+ Comp_Candidates : LGV_Sets.Membership_Set;
Step : Elaboration_Order_Step;
Indent : Indentation_Level)
is
pragma Assert (Needs_Elaboration (G, Pred));
pragma Assert (Present (Succ));
pragma Assert (Needs_Elaboration (G, Succ));
- pragma Assert (Present (All_Candidates));
- pragma Assert (Present (Comp_Candidates));
-
- Pred_Comp : constant Component_Id := Component (G, Pred);
- Succ_Comp : constant Component_Id := Component (G, Succ);
+ pragma Assert (LGV_Sets.Present (All_Candidates));
+ pragma Assert (LGV_Sets.Present (Comp_Candidates));
- pragma Assert (Present (Pred_Comp));
- pragma Assert (Present (Succ_Comp));
+ In_Different_Components : constant Boolean :=
+ not In_Same_Component
+ (G => G,
+ Left => Pred,
+ Right => Succ);
- In_Different_Components : constant Boolean := Pred_Comp /= Succ_Comp;
+ Succ_Comp : constant Component_Id := Component (G, Succ);
+ Vertex_Indent : constant Indentation_Level :=
+ Indent + Nested_Indentation;
Candidate : Library_Graph_Vertex_Id;
Iter : Component_Vertex_Iterator;
Msg : String_Ptr;
- Set : Membership_Set;
+ Set : LGV_Sets.Membership_Set;
begin
Trace_Vertex
(G => G,
- LGV_Id => Succ,
+ Vertex => Succ,
Msg => "updating successor",
Step => Step,
Indent => Indent);
Add_Vertex_If_Elaborable
(G => G,
- LGV_Id => Succ,
+ Vertex => Succ,
Set => Set,
Msg => Msg.all,
Step => Step,
- Indent => Indent + Nested_Indentation);
+ Indent => Vertex_Indent);
-- At this point the successor component may become elaborable when
-- its final predecessor component is elaborated. This in turn may
Iter := Iterate_Component_Vertices (G, Succ_Comp);
while Has_Next (Iter) loop
Next (Iter, Candidate);
- pragma Assert (Present (Candidate));
Add_Vertex_If_Elaborable
(G => G,
- LGV_Id => Candidate,
+ Vertex => Candidate,
Set => All_Candidates,
Msg => Add_To_All_Candidates_Msg,
Step => Step,
- Indent => Indent + Nested_Indentation);
+ Indent => Vertex_Indent);
end loop;
end if;
end Update_Successor;
procedure Update_Successors
(G : Library_Graph;
Pred : Library_Graph_Vertex_Id;
- All_Candidates : Membership_Set;
- Comp_Candidates : Membership_Set;
+ All_Candidates : LGV_Sets.Membership_Set;
+ Comp_Candidates : LGV_Sets.Membership_Set;
Step : Elaboration_Order_Step;
Indent : Indentation_Level)
is
- Iter : Edges_To_Successors_Iterator;
- LGE_Id : Library_Graph_Edge_Id;
- Succ : Library_Graph_Vertex_Id;
+ Edge : Library_Graph_Edge_Id;
+ Iter : Edges_To_Successors_Iterator;
begin
pragma Assert (Present (G));
pragma Assert (Present (Pred));
pragma Assert (Needs_Elaboration (G, Pred));
- pragma Assert (Present (All_Candidates));
- pragma Assert (Present (Comp_Candidates));
+ pragma Assert (LGV_Sets.Present (All_Candidates));
+ pragma Assert (LGV_Sets.Present (Comp_Candidates));
Iter := Iterate_Edges_To_Successors (G, Pred);
while Has_Next (Iter) loop
- Next (Iter, LGE_Id);
-
- pragma Assert (Present (LGE_Id));
- pragma Assert (Predecessor (G, LGE_Id) = Pred);
-
- Succ := Successor (G, LGE_Id);
- pragma Assert (Present (Succ));
+ Next (Iter, Edge);
+ pragma Assert (Predecessor (G, Edge) = Pred);
Update_Successor
(G => G,
Pred => Pred,
- Succ => Succ,
+ Succ => Successor (G, Edge),
All_Candidates => All_Candidates,
Comp_Candidates => Comp_Candidates,
Step => Step,
with Ada.Unchecked_Deallocation;
-with GNAT.Lists; use GNAT.Lists;
+with Butil; use Butil;
+with Debug; use Debug;
+with Output; use Output;
+
+with Bindo.Writers;
+use Bindo.Writers;
package body Bindo.Graphs is
-- Local subprograms --
-----------------------
- function Sequence_Next_IGE_Id return Invocation_Graph_Edge_Id;
- pragma Inline (Sequence_Next_IGE_Id);
- -- Generate a new unique invocation graph edge handle
+ 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_IGV_Id return Invocation_Graph_Vertex_Id;
- pragma Inline (Sequence_Next_IGV_Id);
- -- Generate a new unique invocation graph vertex 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_LGE_Id return Library_Graph_Edge_Id;
- pragma Inline (Sequence_Next_LGE_Id);
+ 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_LGV_Id return Library_Graph_Vertex_Id;
- pragma Inline (Sequence_Next_LGV_Id);
+ 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;
+
--------------------------------
-- Hash_Invocation_Graph_Edge --
--------------------------------
function Hash_Invocation_Graph_Edge
- (IGE_Id : Invocation_Graph_Edge_Id) return Bucket_Range_Type
+ (Edge : Invocation_Graph_Edge_Id) return Bucket_Range_Type
is
begin
- pragma Assert (Present (IGE_Id));
+ pragma Assert (Present (Edge));
- return Bucket_Range_Type (IGE_Id);
+ return Bucket_Range_Type (Edge);
end Hash_Invocation_Graph_Edge;
----------------------------------
----------------------------------
function Hash_Invocation_Graph_Vertex
- (IGV_Id : Invocation_Graph_Vertex_Id) return Bucket_Range_Type
+ (Vertex : Invocation_Graph_Vertex_Id) return Bucket_Range_Type
is
begin
- pragma Assert (Present (IGV_Id));
+ pragma Assert (Present (Vertex));
- return Bucket_Range_Type (IGV_Id);
+ 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
- (LGE_Id : Library_Graph_Edge_Id) return Bucket_Range_Type
+ (Edge : Library_Graph_Edge_Id) return Bucket_Range_Type
is
begin
- pragma Assert (Present (LGE_Id));
+ pragma Assert (Present (Edge));
- return Bucket_Range_Type (LGE_Id);
+ return Bucket_Range_Type (Edge);
end Hash_Library_Graph_Edge;
-------------------------------
-------------------------------
function Hash_Library_Graph_Vertex
- (LGV_Id : Library_Graph_Vertex_Id) return Bucket_Range_Type
+ (Vertex : Library_Graph_Vertex_Id) return Bucket_Range_Type
is
begin
- pragma Assert (Present (LGV_Id));
+ pragma Assert (Present (Vertex));
- return Bucket_Range_Type (LGV_Id);
+ return Bucket_Range_Type (Vertex);
end Hash_Library_Graph_Vertex;
-----------------------
(Invocation_Graph_Attributes, Invocation_Graph);
function Get_IGE_Attributes
- (G : Invocation_Graph;
- IGE_Id : Invocation_Graph_Edge_Id)
+ (G : Invocation_Graph;
+ Edge : Invocation_Graph_Edge_Id)
return Invocation_Graph_Edge_Attributes;
pragma Inline (Get_IGE_Attributes);
- -- Obtain the attributes of edge IGE_Id of invocation graph G
+ -- Obtain the attributes of edge Edge of invocation graph G
function Get_IGV_Attributes
(G : Invocation_Graph;
- IGV_Id : Invocation_Graph_Vertex_Id)
+ Vertex : Invocation_Graph_Vertex_Id)
return Invocation_Graph_Vertex_Attributes;
pragma Inline (Get_IGV_Attributes);
- -- Obtain the attributes of vertex IGV_Id of invocation graph G
+ -- Obtain the attributes of vertex Vertex of invocation graph G
procedure Increment_Invocation_Graph_Edge_Count
(G : Invocation_Graph;
function Is_Elaboration_Root
(G : Invocation_Graph;
- IGV_Id : Invocation_Graph_Vertex_Id) return Boolean;
+ Vertex : Invocation_Graph_Vertex_Id) return Boolean;
pragma Inline (Is_Elaboration_Root);
- -- Determine whether vertex IGV_Id of invocation graph denotes the
+ -- Determine whether vertex Vertex of invocation graph denotes the
-- elaboration procedure of a spec or a body.
function Is_Existing_Source_Target_Relation
procedure Set_Corresponding_Vertex
(G : Invocation_Graph;
IS_Id : Invocation_Signature_Id;
- IGV_Id : Invocation_Graph_Vertex_Id);
+ Vertex : Invocation_Graph_Vertex_Id);
pragma Inline (Set_Corresponding_Vertex);
- -- Associate vertex IGV_Id of invocation graph G with signature IS_Id
+ -- Associate vertex Vertex of invocation graph G with signature IS_Id
procedure Set_Is_Existing_Source_Target_Relation
(G : Invocation_Graph;
-- already related in invocation graph G depending on value Val.
procedure Set_IGE_Attributes
- (G : Invocation_Graph;
- IGE_Id : Invocation_Graph_Edge_Id;
- Val : Invocation_Graph_Edge_Attributes);
+ (G : Invocation_Graph;
+ Edge : Invocation_Graph_Edge_Id;
+ Val : Invocation_Graph_Edge_Attributes);
pragma Inline (Set_IGE_Attributes);
- -- Set the attributes of edge IGE_Id of invocation graph G to value Val
+ -- Set the attributes of edge Edge of invocation graph G to value Val
procedure Set_IGV_Attributes
(G : Invocation_Graph;
- IGV_Id : Invocation_Graph_Vertex_Id;
+ Vertex : Invocation_Graph_Vertex_Id;
Val : Invocation_Graph_Vertex_Attributes);
pragma Inline (Set_IGV_Attributes);
- -- Set the attributes of vertex IGV_Id of invocation graph G to value
+ -- Set the attributes of vertex Vertex of invocation graph G to value
-- Val.
--------------
(Source => Source,
Target => Target);
- IR_Rec : Invocation_Relation_Record renames
- Invocation_Relations.Table (IR_Id);
-
- IGE_Id : Invocation_Graph_Edge_Id;
+ Edge : Invocation_Graph_Edge_Id;
begin
-- Nothing to do when the source and target are already related by an
return;
end if;
- IGE_Id := Sequence_Next_IGE_Id;
+ Edge := Sequence_Next_Edge;
-- Add the edge to the underlying graph
DG.Add_Edge
(G => G.Graph,
- E => IGE_Id,
+ E => Edge,
Source => Source,
Destination => Target);
-- Build and save the attributes of the edge
Set_IGE_Attributes
- (G => G,
- IGE_Id => IGE_Id,
- Val => (Relation => IR_Id));
+ (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.
-- Update the edge statistics
- Increment_Invocation_Graph_Edge_Count (G, IR_Rec.Kind);
+ Increment_Invocation_Graph_Edge_Count (G, Kind (IR_Id));
end Add_Edge;
----------------
----------------
procedure Add_Vertex
- (G : Invocation_Graph;
- IC_Id : Invocation_Construct_Id;
- LGV_Id : Library_Graph_Vertex_Id)
+ (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 (LGV_Id));
+ pragma Assert (Present (Body_Vertex));
+ pragma Assert (Present (Spec_Vertex));
- IC_Rec : Invocation_Construct_Record renames
- Invocation_Constructs.Table (IC_Id);
-
- pragma Assert (Present (IC_Rec.Signature));
-
- IGV_Id : Invocation_Graph_Vertex_Id;
+ 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, IC_Rec.Signature)) then
+ if Present (Corresponding_Vertex (G, Construct_Signature)) then
return;
end if;
- IGV_Id := Sequence_Next_IGV_Id;
+ Vertex := Sequence_Next_Vertex;
-- Add the vertex to the underlying graph
- DG.Add_Vertex (G.Graph, IGV_Id);
+ DG.Add_Vertex (G.Graph, Vertex);
-- Build and save the attributes of the vertex
Set_IGV_Attributes
(G => G,
- IGV_Id => IGV_Id,
- Val => (Construct => IC_Id,
- Lib_Vertex => LGV_Id));
+ 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, IC_Rec.Signature, IGV_Id);
+ 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, IGV_Id) then
- Save_Elaboration_Root (G, IGV_Id);
+ 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;
- IGV_Id : Invocation_Graph_Vertex_Id) return Invocation_Construct_Id
+ Vertex : Invocation_Graph_Vertex_Id) return Invocation_Construct_Id
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (IGV_Id));
+ pragma Assert (Present (Vertex));
- return Get_IGV_Attributes (G, IGV_Id).Construct;
+ return Get_IGV_Attributes (G, Vertex).Construct;
end Construct;
--------------------------
pragma Assert (Present (G));
pragma Assert (Present (IS_Id));
- return SV.Get (G.Signature_To_Vertex, IS_Id);
+ return Signature_Tables.Get (G.Signature_To_Vertex, IS_Id);
end Corresponding_Vertex;
------------
G : constant Invocation_Graph := new Invocation_Graph_Attributes;
begin
- G.Edge_Attributes := EA.Create (Initial_Edges);
+ G.Edge_Attributes := IGE_Tables.Create (Initial_Edges);
G.Graph :=
DG.Create
(Initial_Vertices => Initial_Vertices,
Initial_Edges => Initial_Edges);
- G.Relations := ST.Create (Initial_Edges);
- G.Roots := ER.Create (Initial_Vertices);
- G.Signature_To_Vertex := SV.Create (Initial_Vertices);
- G.Vertex_Attributes := VA.Create (Initial_Vertices);
+ 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;
begin
pragma Assert (Present (G));
- EA.Destroy (G.Edge_Attributes);
- DG.Destroy (G.Graph);
- ST.Destroy (G.Relations);
- ER.Destroy (G.Roots);
- SV.Destroy (G.Signature_To_Vertex);
- VA.Destroy (G.Vertex_Attributes);
+ 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;
-----------------------------------
procedure Destroy_Invocation_Graph_Edge
- (IGE_Id : in out Invocation_Graph_Edge_Id)
+ (Edge : in out Invocation_Graph_Edge_Id)
is
- pragma Unreferenced (IGE_Id);
+ pragma Unreferenced (Edge);
begin
null;
end Destroy_Invocation_Graph_Edge;
-------------------------------------
procedure Destroy_Invocation_Graph_Vertex
- (IGV_Id : in out Invocation_Graph_Vertex_Id)
+ (Vertex : in out Invocation_Graph_Vertex_Id)
is
- pragma Unreferenced (IGV_Id);
+ pragma Unreferenced (Vertex);
begin
null;
end Destroy_Invocation_Graph_Vertex;
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;
- IGE_Id : Invocation_Graph_Edge_Id)
+ (G : Invocation_Graph;
+ Edge : Invocation_Graph_Edge_Id)
return Invocation_Graph_Edge_Attributes
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (IGE_Id));
+ pragma Assert (Present (Edge));
- return EA.Get (G.Edge_Attributes, IGE_Id);
+ return IGE_Tables.Get (G.Edge_Attributes, Edge);
end Get_IGE_Attributes;
------------------------
function Get_IGV_Attributes
(G : Invocation_Graph;
- IGV_Id : Invocation_Graph_Vertex_Id)
+ Vertex : Invocation_Graph_Vertex_Id)
return Invocation_Graph_Vertex_Attributes
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (IGV_Id));
+ pragma Assert (Present (Vertex));
- return VA.Get (G.Vertex_Attributes, IGV_Id);
+ return IGV_Tables.Get (G.Vertex_Attributes, Vertex);
end Get_IGV_Attributes;
--------------
function Has_Next (Iter : Elaboration_Root_Iterator) return Boolean is
begin
- return ER.Has_Next (ER.Iterator (Iter));
+ return IGV_Sets.Has_Next (IGV_Sets.Iterator (Iter));
end Has_Next;
-------------------------------
function Is_Elaboration_Root
(G : Invocation_Graph;
- IGV_Id : Invocation_Graph_Vertex_Id) return Boolean
+ Vertex : Invocation_Graph_Vertex_Id) return Boolean
is
pragma Assert (Present (G));
- pragma Assert (Present (IGV_Id));
-
- IC_Id : constant Invocation_Construct_Id := Construct (G, IGV_Id);
-
- pragma Assert (Present (IC_Id));
+ pragma Assert (Present (Vertex));
- IC_Rec : Invocation_Construct_Record renames
- Invocation_Constructs.Table (IC_Id);
+ Vertex_Kind : constant Invocation_Construct_Kind :=
+ Kind (Construct (G, Vertex));
begin
return
- IC_Rec.Kind = Elaborate_Body_Procedure
+ Vertex_Kind = Elaborate_Body_Procedure
or else
- IC_Rec.Kind = Elaborate_Spec_Procedure;
+ Vertex_Kind = Elaborate_Spec_Procedure;
end Is_Elaboration_Root;
----------------------------------------
begin
pragma Assert (Present (G));
- return ST.Contains (G.Relations, Rel);
+ return Relation_Sets.Contains (G.Relations, Rel);
end Is_Existing_Source_Target_Relation;
-----------------------
function Iterate_Edges_To_Targets
(G : Invocation_Graph;
- IGV_Id : Invocation_Graph_Vertex_Id) return Edges_To_Targets_Iterator
+ Vertex : Invocation_Graph_Vertex_Id) return Edges_To_Targets_Iterator
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (IGV_Id));
+ pragma Assert (Present (Vertex));
return
Edges_To_Targets_Iterator
- (DG.Iterate_Outgoing_Edges (G.Graph, IGV_Id));
+ (DG.Iterate_Outgoing_Edges (G.Graph, Vertex));
end Iterate_Edges_To_Targets;
-------------------------------
begin
pragma Assert (Present (G));
- return Elaboration_Root_Iterator (ER.Iterate (G.Roots));
+ return Elaboration_Root_Iterator (IGV_Sets.Iterate (G.Roots));
end Iterate_Elaboration_Roots;
----------
----------
function Kind
- (G : Invocation_Graph;
- IGE_Id : Invocation_Graph_Edge_Id) return Invocation_Kind
+ (G : Invocation_Graph;
+ Edge : Invocation_Graph_Edge_Id) return Invocation_Kind
is
+ begin
pragma Assert (Present (G));
- pragma Assert (Present (IGE_Id));
-
- IR_Id : constant Invocation_Relation_Id := Relation (G, IGE_Id);
+ pragma Assert (Present (Edge));
- pragma Assert (Present (IR_Id));
-
- IR_Rec : Invocation_Relation_Record renames
- Invocation_Relations.Table (IR_Id);
-
- begin
- return IR_Rec.Kind;
+ return Kind (Relation (G, Edge));
end Kind;
- ----------------
- -- Lib_Vertex --
- ----------------
+ ----------
+ -- Line --
+ ----------
- function Lib_Vertex
+ function Line
(G : Invocation_Graph;
- IGV_Id : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id
+ Vertex : Invocation_Graph_Vertex_Id) return Nat
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (IGV_Id));
+ pragma Assert (Present (Vertex));
- return Get_IGV_Attributes (G, IGV_Id).Lib_Vertex;
- end Lib_Vertex;
+ return Line (Signature (Construct (G, Vertex)));
+ end Line;
----------
-- Name --
function Name
(G : Invocation_Graph;
- IGV_Id : Invocation_Graph_Vertex_Id) return Name_Id
+ Vertex : Invocation_Graph_Vertex_Id) return Name_Id
is
+ begin
pragma Assert (Present (G));
- pragma Assert (Present (IGV_Id));
-
- IC_Id : constant Invocation_Construct_Id := Construct (G, IGV_Id);
-
- pragma Assert (Present (IC_Id));
+ pragma Assert (Present (Vertex));
- IC_Rec : Invocation_Construct_Record renames
- Invocation_Constructs.Table (IC_Id);
-
- pragma Assert (Present (IC_Rec.Signature));
-
- IS_Rec : Invocation_Signature_Record renames
- Invocation_Signatures.Table (IC_Rec.Signature);
-
- begin
- return IS_Rec.Name;
+ return Name (Signature (Construct (G, Vertex)));
end Name;
----------
----------
procedure Next
- (Iter : in out All_Edge_Iterator;
- IGE_Id : out Invocation_Graph_Edge_Id)
+ (Iter : in out All_Edge_Iterator;
+ Edge : out Invocation_Graph_Edge_Id)
is
begin
- DG.Next (DG.All_Edge_Iterator (Iter), IGE_Id);
+ DG.Next (DG.All_Edge_Iterator (Iter), Edge);
end Next;
----------
procedure Next
(Iter : in out All_Vertex_Iterator;
- IGV_Id : out Invocation_Graph_Vertex_Id)
+ Vertex : out Invocation_Graph_Vertex_Id)
is
begin
- DG.Next (DG.All_Vertex_Iterator (Iter), IGV_Id);
+ DG.Next (DG.All_Vertex_Iterator (Iter), Vertex);
end Next;
----------
----------
procedure Next
- (Iter : in out Edges_To_Targets_Iterator;
- IGE_Id : out Invocation_Graph_Edge_Id)
+ (Iter : in out Edges_To_Targets_Iterator;
+ Edge : out Invocation_Graph_Edge_Id)
is
begin
- DG.Next (DG.Outgoing_Edge_Iterator (Iter), IGE_Id);
+ DG.Next (DG.Outgoing_Edge_Iterator (Iter), Edge);
end Next;
----------
Root : out Invocation_Graph_Vertex_Id)
is
begin
- ER.Next (ER.Iterator (Iter), Root);
+ IGV_Sets.Next (IGV_Sets.Iterator (Iter), Root);
end Next;
---------------------
function Number_Of_Edges_To_Targets
(G : Invocation_Graph;
- IGV_Id : Invocation_Graph_Vertex_Id) return Natural
+ Vertex : Invocation_Graph_Vertex_Id) return Natural
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (IGV_Id));
+ pragma Assert (Present (Vertex));
- return DG.Number_Of_Outgoing_Edges (G.Graph, IGV_Id);
+ return DG.Number_Of_Outgoing_Edges (G.Graph, Vertex);
end Number_Of_Edges_To_Targets;
---------------------------------
begin
pragma Assert (Present (G));
- return ER.Size (G.Roots);
+ return IGV_Sets.Size (G.Roots);
end Number_Of_Elaboration_Roots;
------------------------
--------------
function Relation
- (G : Invocation_Graph;
- IGE_Id : Invocation_Graph_Edge_Id) return Invocation_Relation_Id
+ (G : Invocation_Graph;
+ Edge : Invocation_Graph_Edge_Id) return Invocation_Relation_Id
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (IGE_Id));
+ pragma Assert (Present (Edge));
- return Get_IGE_Attributes (G, IGE_Id).Relation;
+ return Get_IGE_Attributes (G, Edge).Relation;
end Relation;
---------------------------
pragma Assert (Present (G));
pragma Assert (Present (Root));
- ER.Insert (G.Roots, Root);
+ IGV_Sets.Insert (G.Roots, Root);
end Save_Elaboration_Root;
------------------------------
procedure Set_Corresponding_Vertex
(G : Invocation_Graph;
IS_Id : Invocation_Signature_Id;
- IGV_Id : Invocation_Graph_Vertex_Id)
+ Vertex : Invocation_Graph_Vertex_Id)
is
begin
pragma Assert (Present (G));
pragma Assert (Present (IS_Id));
- pragma Assert (Present (IGV_Id));
+ pragma Assert (Present (Vertex));
- SV.Put (G.Signature_To_Vertex, IS_Id, IGV_Id);
+ Signature_Tables.Put (G.Signature_To_Vertex, IS_Id, Vertex);
end Set_Corresponding_Vertex;
--------------------------------------------
pragma Assert (Present (Rel.Target));
if Val then
- ST.Insert (G.Relations, Rel);
+ Relation_Sets.Insert (G.Relations, Rel);
else
- ST.Delete (G.Relations, Rel);
+ Relation_Sets.Delete (G.Relations, Rel);
end if;
end Set_Is_Existing_Source_Target_Relation;
------------------------
procedure Set_IGE_Attributes
- (G : Invocation_Graph;
- IGE_Id : Invocation_Graph_Edge_Id;
- Val : Invocation_Graph_Edge_Attributes)
+ (G : Invocation_Graph;
+ Edge : Invocation_Graph_Edge_Id;
+ Val : Invocation_Graph_Edge_Attributes)
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (IGE_Id));
+ pragma Assert (Present (Edge));
- EA.Put (G.Edge_Attributes, IGE_Id, Val);
+ IGE_Tables.Put (G.Edge_Attributes, Edge, Val);
end Set_IGE_Attributes;
------------------------
procedure Set_IGV_Attributes
(G : Invocation_Graph;
- IGV_Id : Invocation_Graph_Vertex_Id;
+ Vertex : Invocation_Graph_Vertex_Id;
Val : Invocation_Graph_Vertex_Attributes)
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (IGV_Id));
+ pragma Assert (Present (Vertex));
- VA.Put (G.Vertex_Attributes, IGV_Id, Val);
+ 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;
- IGE_Id : Invocation_Graph_Edge_Id) return Invocation_Graph_Vertex_Id
+ Edge : Invocation_Graph_Edge_Id) return Invocation_Graph_Vertex_Id
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (IGE_Id));
+ pragma Assert (Present (Edge));
- return DG.Destination_Vertex (G.Graph, IGE_Id);
+ return DG.Destination_Vertex (G.Graph, Edge);
end Target;
end Invocation_Graphs;
package body Library_Graphs is
- ---------------
- -- Edge list --
- ---------------
+ -----------
+ -- Types --
+ -----------
+
+ -- The following type represents the various kinds of precedence between
+ -- two items.
- package EL is new Doubly_Linked_Lists
- (Element_Type => Library_Graph_Edge_Id,
- "=" => "=",
- Destroy_Element => Destroy_Library_Graph_Edge);
+ type Precedence_Kind is
+ (Lower_Precedence,
+ Equal_Precedence,
+ Higher_Precedence);
-----------------------
-- Local subprograms --
procedure Add_Body_Before_Spec_Edge
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id;
- Edges : EL.Doubly_Linked_List);
+ 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 LGV_Id and its
+ -- 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 : EL.Doubly_Linked_List);
+ Edges : LGE_Lists.Doubly_Linked_List);
pragma Inline (Add_Body_Before_Spec_Edges);
-- Create new edges in library graph G for all vertices and their
-- corresponding specs or bodies, where the body is a predecessor
-- and the spec is a successor. Add all edges to list Edges.
+ procedure Add_Cycle
+ (G : Library_Graph;
+ Attrs : Library_Graph_Cycle_Attributes;
+ Indent : Indentation_Level);
+ pragma Inline (Add_Cycle);
+ -- Store a cycle described by attribytes Attrs in library graph G,
+ -- unless a prior rotation of it already exists. The edges of the cycle
+ -- must be in normalized form. Indent is the desired indentation level
+ -- for tracing.
+
function Add_Edge_With_Return
(G : Library_Graph;
Pred : Library_Graph_Vertex_Id;
-- nature of the edge. If Pred and Succ are already related, no edge
-- is created and No_Library_Graph_Edge is returned.
+ procedure Add_Vertex_And_Complement
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id;
+ Set : LGV_Sets.Membership_Set;
+ Do_Complement : Boolean);
+ pragma Inline (Add_Vertex_And_Complement);
+ -- Add vertex Vertex of library graph G to set Set. If the vertex is
+ -- part of an Elaborate_Body pair, or flag Do_Complement is set, add
+ -- the complementary vertex to the set.
+
+ function Complementary_Vertex
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id;
+ Do_Complement : Boolean) return Library_Graph_Vertex_Id;
+ pragma Inline (Complementary_Vertex);
+ -- If vertex Vertex of library graph G is part of an Elaborate_Body
+ -- pair, or flag Do_Complement is set, return the spec when Vertex is
+ -- a body, the body when Vertex is a spec, or No_Library_Graph_Vertex.
+
+ 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_Kind_Of
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Library_Graph_Cycle_Kind;
+ pragma Inline (Cycle_Kind_Of);
+ -- Determine the cycle kind of edge Edge of library graph G if the edge
+ -- participated in a circuit.
+
procedure Decrement_Library_Graph_Edge_Count
(G : Library_Graph;
Kind : Library_Graph_Edge_Kind);
procedure Delete_Body_Before_Spec_Edges
(G : Library_Graph;
- Edges : EL.Doubly_Linked_List);
+ 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
procedure Delete_Edge
(G : Library_Graph;
- LGE_Id : Library_Graph_Edge_Id);
+ Edge : Library_Graph_Edge_Id);
pragma Inline (Delete_Edge);
- -- Delete edge LGE_Id from library graph G
+ -- Delete edge Edge from library graph G
+
+ procedure Find_All_Cycles_Through_Vertex
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id;
+ End_Vertices : LGV_Sets.Membership_Set;
+ Most_Significant_Edge : Library_Graph_Edge_Id;
+ Invocation_Edge_Count : Natural;
+ Spec_And_Body_Together : Boolean;
+ Cycle_Path : LGE_Lists.Doubly_Linked_List;
+ Visited_Vertices : LGV_Sets.Membership_Set;
+ Indent : Indentation_Level);
+ pragma Inline (Find_All_Cycles_Through_Vertex);
+ -- Explore all edges to successors of vertex Vertex of library graph G
+ -- in an attempt to find a cycle. A cycle is considered closed when the
+ -- Vertex appears in set End_Vertices. Most_Significant_Edge denotes the
+ -- edge with the highest significance along the candidate cycle path.
+ -- Invocation_Edge_Count denotes the number of invocation edges along
+ -- the candidate cycle path. Spec_And_Body_Together should be set when
+ -- spec and body vertices must be treated as one vertex. Cycle_Path is
+ -- the candidate cycle path. Visited_Vertices denotes the set of visited
+ -- vertices so far. Indent is the desired indentation level for tracing.
+
+ procedure Find_All_Cycles_With_Edge
+ (G : Library_Graph;
+ Initial_Edge : Library_Graph_Edge_Id;
+ Spec_And_Body_Together : Boolean;
+ Cycle_Path : LGE_Lists.Doubly_Linked_List;
+ Visited_Vertices : LGV_Sets.Membership_Set;
+ Indent : Indentation_Level);
+ pragma Inline (Find_All_Cycles_With_Edge);
+ -- Find all cycles which contain edge Initial_Edge of library graph G.
+ -- Spec_And_Body_Together should be set when spec and body vertices must
+ -- be treated as one vertex. Cycle_Path is the candidate cycle path.
+ -- Visited_Vertices is the set of visited vertices so far. Indent is
+ -- the desired indentation level for tracing.
+
+ 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
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;
- LGE_Id : Library_Graph_Edge_Id)
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id)
return Library_Graph_Edge_Attributes;
pragma Inline (Get_LGE_Attributes);
- -- Obtain the attributes of edge LGE_Id of library graph G
+ -- Obtain the attributes of edge Edge of library graph G
function Get_LGV_Attributes
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id)
+ Vertex : Library_Graph_Vertex_Id)
return Library_Graph_Vertex_Attributes;
pragma Inline (Get_LGV_Attributes);
- -- Obtain the attributes of vertex LGE_Id of library graph G
+ -- Obtain the attributes of vertex Edge of library graph G
function Has_Elaborate_Body
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Boolean;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (Has_Elaborate_Body);
- -- Determine whether vertex LGV_Id of library graph G is subject to
+ -- Determine whether vertex Vertex of library graph G is subject to
-- pragma Elaborate_Body.
+ 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);
procedure Increment_Pending_Predecessors
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id);
+ Vertex : Library_Graph_Vertex_Id);
pragma Inline (Increment_Pending_Predecessors);
- -- Increment the number of pending precedessors vertex LGV_Id of library
+ -- Increment the number of pending precedessors vertex Vertex of library
-- graph G must wait on before it can be elaborated by one.
procedure Initialize_Components (G : Library_Graph);
-- Initialize on the initial call or re-initialize on subsequent calls
-- all components of library graph G.
+ procedure Insert_And_Sort
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id);
+ pragma Inline (Insert_And_Sort);
+ -- Insert cycle Cycle in library graph G and sort it based on its
+ -- precedence relative to all recorded cycles.
+
+ 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 awith dependency between its successor
+ -- and predecessor.
+
function Is_Elaborable_Vertex
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id;
+ Vertex : Library_Graph_Vertex_Id;
Predecessors : Natural) return Boolean;
pragma Inline (Is_Elaborable_Vertex);
- -- Determine whether vertex LGV_Id of library graph G can be elaborated
+ -- Determine whether vertex Vertex of library graph G can be elaborated
-- given that it meets number of predecessors Predecessors.
- function Is_Existing_Predecessor_Successor_Relation
+ function Is_Recorded_Cycle
+ (G : Library_Graph;
+ Attrs : Library_Graph_Cycle_Attributes) return Boolean;
+ pragma Inline (Is_Recorded_Cycle);
+ -- Determine whether a cycle desctibed by its attributes Attrs has
+ -- has already been recorded in library graph G.
+
+ function Is_Recorded_Edge
(G : Library_Graph;
Rel : Predecessor_Successor_Relation) return Boolean;
- pragma Inline (Is_Existing_Predecessor_Successor_Relation);
+ pragma Inline (Is_Recorded_Edge);
-- Determine whether a predecessor vertex and a successor vertex
- -- desctibed by relation Rel are already related in library graph G.
+ -- desctibed by relation Rel are already linked in library graph G.
+
+ 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_And_Add_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 (Normalize_And_Add_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
+ -- denotes the number of invocation edges along the cycle path. Indent
+ -- is the desired indentation level for tracing.
+
+ 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.
+
+ function Path
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id) return LGE_Lists.Doubly_Linked_List;
+ pragma Inline (Path);
+ -- Obtain the path of edges which comprises cycle Cycle of library
+ -- graph G.
+
+ function Precedence
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id;
+ Compared_To : Library_Graph_Cycle_Id) return Precedence_Kind;
+ pragma Inline (Precedence);
+ -- Determine the precedence of cycle Cycle of library graph G compared
+ -- to cycle Compared_To.
+
+ function Precedence
+ (Kind : Library_Graph_Cycle_Kind;
+ Compared_To : Library_Graph_Cycle_Kind) return Precedence_Kind;
+ pragma Inline (Precedence);
+ -- Determine the precedence of cycle kind Kind compared to cycle kind
+ -- Compared_To.
+
+ function Precedence
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id;
+ Compared_To : Library_Graph_Edge_Id) return Precedence_Kind;
+ pragma Inline (Precedence);
+ -- Determine the precedence of edge Edge of library graph G compared to
+ -- edge Compared_To.
+
+ function Precedence
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id;
+ Compared_To : Library_Graph_Vertex_Id) return Precedence_Kind;
+ pragma Inline (Precedence);
+ -- Determine the precedence of vertex Vertex of library graph G compared
+ -- to vertex Compared_To.
+
+ procedure Remove_Vertex_And_Complement
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id;
+ Set : LGV_Sets.Membership_Set;
+ Do_Complement : Boolean);
+ pragma Inline (Remove_Vertex_And_Complement);
+ -- Remove vertex Vertex of library graph G from set Set. If the vertex
+ -- is part of an Elaborate_Body pair, or Do_Complement is set, remove
+ -- the complementary vertex from the set.
procedure Set_Component_Attributes
(G : Library_Graph;
pragma Inline (Set_Corresponding_Vertex);
-- Associate vertex Val of library graph G with unit U_Id
- procedure Set_Is_Existing_Predecessor_Successor_Relation
+ procedure Set_Is_Recorded_Cycle
+ (G : Library_Graph;
+ Attrs : Library_Graph_Cycle_Attributes;
+ Val : Boolean := True);
+ pragma Inline (Set_Is_Recorded_Cycle);
+ -- Mark a cycle described by its attributes Attrs as recorded in library
+ -- graph G depending on value Val.
+
+ procedure Set_Is_Recorded_Edge
(G : Library_Graph;
Rel : Predecessor_Successor_Relation;
Val : Boolean := True);
- pragma Inline (Set_Is_Existing_Predecessor_Successor_Relation);
- -- Mark a a predecessor vertex and a successor vertex desctibed by
- -- relation Rel as already related depending on value Val.
+ pragma Inline (Set_Is_Recorded_Edge);
+ -- Mark a predecessor vertex and a successor vertex desctibed 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;
- LGE_Id : Library_Graph_Edge_Id;
- Val : Library_Graph_Edge_Attributes);
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id;
+ Val : Library_Graph_Edge_Attributes);
pragma Inline (Set_LGE_Attributes);
- -- Set the attributes of edge LGE_Id of library graph G to value Val
+ -- Set the attributes of edge Edge of library graph G to value Val
procedure Set_LGV_Attributes
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id;
+ Vertex : Library_Graph_Vertex_Id;
Val : Library_Graph_Vertex_Attributes);
pragma Inline (Set_LGV_Attributes);
- -- Set the attributes of vertex LGV_Id of library graph G to value Val
+ -- Set the attributes of vertex Vertex of library graph G to value Val
+
+ 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_Eol;
+ pragma Inline (Trace_Eol);
+ -- Write an end-of-line to standard output
+
+ 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 Update_Pending_Predecessors_Of_Components (G : Library_Graph);
pragma Inline (Update_Pending_Predecessors_Of_Components);
-- graph G must wait on before they can be elaborated.
procedure Update_Pending_Predecessors_Of_Components
- (G : Library_Graph;
- LGE_Id : Library_Graph_Edge_Id);
+ (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
procedure Add_Body_Before_Spec_Edge
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id;
- Edges : EL.Doubly_Linked_List)
+ Vertex : Library_Graph_Vertex_Id;
+ Edges : LGE_Lists.Doubly_Linked_List)
is
- LGE_Id : Library_Graph_Edge_Id;
+ Edge : Library_Graph_Edge_Id;
begin
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
- pragma Assert (EL.Present (Edges));
+ pragma Assert (Present (Vertex));
+ pragma Assert (LGE_Lists.Present (Edges));
-- A vertex requires a special Body_Before_Spec edge to its
-- Corresponging_Item when it either denotes a
-- Assume that that no Body_Before_Spec is necessary
- LGE_Id := No_Library_Graph_Edge;
+ Edge := No_Library_Graph_Edge;
-- A body that completes a previous spec
- if Is_Body_With_Spec (G, LGV_Id) then
- LGE_Id :=
+ if Is_Body_With_Spec (G, Vertex) then
+ Edge :=
Add_Edge_With_Return
(G => G,
- Pred => LGV_Id, -- body
- Succ => Corresponding_Item (G, LGV_Id), -- spec
+ Pred => Vertex, -- body
+ Succ => Corresponding_Item (G, Vertex), -- spec
Kind => Body_Before_Spec_Edge);
-- A spec with a completing body
- elsif Is_Spec_With_Body (G, LGV_Id) then
- LGE_Id :=
+ elsif Is_Spec_With_Body (G, Vertex) then
+ Edge :=
Add_Edge_With_Return
(G => G,
- Pred => Corresponding_Item (G, LGV_Id), -- body
- Succ => LGV_Id, -- spec
+ Pred => Corresponding_Item (G, Vertex), -- body
+ Succ => Vertex, -- spec
Kind => Body_Before_Spec_Edge);
end if;
- if Present (LGE_Id) then
- EL.Append (Edges, LGE_Id);
+ if Present (Edge) then
+ LGE_Lists.Append (Edges, Edge);
end if;
end Add_Body_Before_Spec_Edge;
procedure Add_Body_Before_Spec_Edges
(G : Library_Graph;
- Edges : EL.Doubly_Linked_List)
+ Edges : LGE_Lists.Doubly_Linked_List)
is
- Iter : Elaborable_Units_Iterator;
- LGV_Id : Library_Graph_Vertex_Id;
- U_Id : Unit_Id;
+ Iter : Elaborable_Units_Iterator;
+ U_Id : Unit_Id;
begin
pragma Assert (Present (G));
- pragma Assert (EL.Present (Edges));
+ pragma Assert (LGE_Lists.Present (Edges));
Iter := Iterate_Elaborable_Units;
while Has_Next (Iter) loop
Next (Iter, U_Id);
- LGV_Id := Corresponding_Vertex (G, U_Id);
- pragma Assert (Present (LGV_Id));
-
- Add_Body_Before_Spec_Edge (G, LGV_Id, Edges);
+ Add_Body_Before_Spec_Edge
+ (G => G,
+ Vertex => Corresponding_Vertex (G, U_Id),
+ Edges => Edges);
end loop;
end Add_Body_Before_Spec_Edges;
+ ---------------
+ -- Add_Cycle --
+ ---------------
+
+ procedure Add_Cycle
+ (G : Library_Graph;
+ Attrs : Library_Graph_Cycle_Attributes;
+ Indent : Indentation_Level)
+ is
+ Cycle : Library_Graph_Cycle_Id;
+
+ begin
+ pragma Assert (Present (G));
+
+ -- Nothing to do when the cycle has already been recorded, possibly
+ -- in a rotated form.
+
+ if Is_Recorded_Cycle (G, Attrs) then
+ return;
+ end if;
+
+ -- Mark the cycle as recorded. This prevents further attempts to add
+ -- rotations of the same cycle.
+
+ Set_Is_Recorded_Cycle (G, Attrs);
+
+ -- Save the attributes of the cycle
+
+ Cycle := Sequence_Next_Cycle;
+ Set_LGC_Attributes (G, Cycle, Attrs);
+
+ Trace_Cycle (G, Cycle, Indent);
+
+ -- Insert the cycle in the list of all cycle based on its precedence
+
+ Insert_And_Sort (G, Cycle);
+ end Add_Cycle;
+
--------------
-- Add_Edge --
--------------
Succ : Library_Graph_Vertex_Id;
Kind : Library_Graph_Edge_Kind)
is
- LGE_Id : Library_Graph_Edge_Id;
- pragma Unreferenced (LGE_Id);
+ Edge : Library_Graph_Edge_Id;
+ pragma Unreferenced (Edge);
begin
pragma Assert (Present (G));
pragma Assert (Present (Succ));
pragma Assert (Kind /= No_Edge);
- LGE_Id :=
+ Edge :=
Add_Edge_With_Return
(G => G,
Pred => Pred,
(Predecessor => Pred,
Successor => Succ);
- LGE_Id : Library_Graph_Edge_Id;
+ Edge : Library_Graph_Edge_Id;
begin
-- Nothing to do when the predecessor and successor are already
-- related by an edge.
- if Is_Existing_Predecessor_Successor_Relation (G, Rel) then
+ if Is_Recorded_Edge (G, Rel) then
return No_Library_Graph_Edge;
end if;
- LGE_Id := Sequence_Next_LGE_Id;
+ 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
DG.Add_Edge
(G => G.Graph,
- E => LGE_Id,
+ E => Edge,
Source => Pred,
Destination => Succ);
-- Construct and save the attributes of the edge
Set_LGE_Attributes
- (G => G,
- LGE_Id => LGE_Id,
- Val => (Kind => Kind));
+ (G => G,
+ Edge => Edge,
+ Val => (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_Existing_Predecessor_Successor_Relation (G, Rel);
+ Set_Is_Recorded_Edge (G, Rel);
-- Update the number of pending predecessors the successor must wait
-- on before it is elaborated.
Increment_Library_Graph_Edge_Count (G, Kind);
- return LGE_Id;
+ return Edge;
end Add_Edge_With_Return;
----------------
(G : Library_Graph;
U_Id : Unit_Id)
is
- LGV_Id : Library_Graph_Vertex_Id;
+ Vertex : Library_Graph_Vertex_Id;
begin
pragma Assert (Present (G));
return;
end if;
- LGV_Id := Sequence_Next_LGV_Id;
+ Vertex := Sequence_Next_Vertex;
-- Add the vertex to the underlying graph
- DG.Add_Vertex (G.Graph, LGV_Id);
+ DG.Add_Vertex (G.Graph, Vertex);
-- Construct and save the attributes of the vertex
Set_LGV_Attributes
(G => G,
- LGV_Id => LGV_Id,
+ Vertex => Vertex,
Val => (Corresponding_Item => No_Library_Graph_Vertex,
In_Elaboration_Order => False,
Pending_Predecessors => 0,
-- Associate the unit with its corresponding vertex
- Set_Corresponding_Vertex (G, U_Id, LGV_Id);
+ Set_Corresponding_Vertex (G, U_Id, Vertex);
end Add_Vertex;
+ -------------------------------
+ -- Add_Vertex_And_Complement --
+ -------------------------------
+
+ procedure Add_Vertex_And_Complement
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id;
+ Set : LGV_Sets.Membership_Set;
+ Do_Complement : Boolean)
+ is
+ pragma Assert (Present (G));
+ pragma Assert (Present (Vertex));
+ pragma Assert (LGV_Sets.Present (Set));
+
+ Complement : constant Library_Graph_Vertex_Id :=
+ Complementary_Vertex
+ (G => G,
+ Vertex => Vertex,
+ Do_Complement => Do_Complement);
+
+ begin
+ LGV_Sets.Insert (Set, Vertex);
+
+ if Present (Complement) then
+ LGV_Sets.Insert (Set, Complement);
+ end if;
+ end Add_Vertex_And_Complement;
+
+ --------------------------
+ -- Complementary_Vertex --
+ --------------------------
+
+ function Complementary_Vertex
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id;
+ Do_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 Do_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;
- LGV_Id : Library_Graph_Vertex_Id) return Component_Id
+ Vertex : Library_Graph_Vertex_Id) return Component_Id
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
+ pragma Assert (Present (Vertex));
- return DG.Component (G.Graph, LGV_Id);
+ return DG.Component (G.Graph, Vertex);
end Component;
+ ---------------------
+ -- 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;
- LGV_Id : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id
+ Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
+ pragma Assert (Present (Vertex));
- return Get_LGV_Attributes (G, LGV_Id).Corresponding_Item;
+ return Get_LGV_Attributes (G, Vertex).Corresponding_Item;
end Corresponding_Item;
--------------------------
pragma Assert (Present (G));
pragma Assert (Present (U_Id));
- return UV.Get (G.Unit_To_Vertex, U_Id);
+ return Unit_Tables.Get (G.Unit_To_Vertex, U_Id);
end Corresponding_Vertex;
------------
------------
function Create
- (Initial_Vertices : Positive;
- Initial_Edges : Positive) return Library_Graph
+ (Initial_Vertices : Positive;
+ Initial_Edges : Positive;
+ Dynamically_Elaborated : Boolean) return Library_Graph
is
G : constant Library_Graph := new Library_Graph_Attributes;
begin
- G.Component_Attributes := CA.Create (Initial_Vertices);
- G.Edge_Attributes := EA.Create (Initial_Edges);
+ G.Dynamically_Elaborated := Dynamically_Elaborated;
+
+ 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.Relations := PS.Create (Initial_Edges);
- G.Unit_To_Vertex := UV.Create (Initial_Vertices);
- G.Vertex_Attributes := VA.Create (Initial_Vertices);
+ G.Recorded_Cycles := RC_Sets.Create (Initial_Vertices);
+ 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_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;
+
----------------------------------------
-- Decrement_Library_Graph_Edge_Count --
----------------------------------------
procedure Decrement_Pending_Predecessors
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id)
+ Vertex : Library_Graph_Vertex_Id)
is
Attrs : Library_Graph_Vertex_Attributes;
begin
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
+ pragma Assert (Present (Vertex));
- Attrs := Get_LGV_Attributes (G, LGV_Id);
+ Attrs := Get_LGV_Attributes (G, Vertex);
Attrs.Pending_Predecessors := Attrs.Pending_Predecessors - 1;
- Set_LGV_Attributes (G, LGV_Id, Attrs);
+ Set_LGV_Attributes (G, Vertex, Attrs);
end Decrement_Pending_Predecessors;
-----------------------------------
procedure Delete_Body_Before_Spec_Edges
(G : Library_Graph;
- Edges : EL.Doubly_Linked_List)
+ Edges : LGE_Lists.Doubly_Linked_List)
is
- Iter : EL.Iterator;
- LGE_Id : Library_Graph_Edge_Id;
+ Edge : Library_Graph_Edge_Id;
+ Iter : LGE_Lists.Iterator;
begin
pragma Assert (Present (G));
- pragma Assert (EL.Present (Edges));
+ pragma Assert (LGE_Lists.Present (Edges));
- Iter := EL.Iterate (Edges);
- while EL.Has_Next (Iter) loop
- EL.Next (Iter, LGE_Id);
- pragma Assert (Present (LGE_Id));
- pragma Assert (Kind (G, LGE_Id) = Body_Before_Spec_Edge);
+ 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, LGE_Id);
+ Delete_Edge (G, Edge);
end loop;
end Delete_Body_Before_Spec_Edges;
-----------------
procedure Delete_Edge
- (G : Library_Graph;
- LGE_Id : Library_Graph_Edge_Id)
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id)
is
pragma Assert (Present (G));
- pragma Assert (Present (LGE_Id));
-
- Pred : constant Library_Graph_Vertex_Id := Predecessor (G, LGE_Id);
- Succ : constant Library_Graph_Vertex_Id := Successor (G, LGE_Id);
-
- pragma Assert (Present (Pred));
- pragma Assert (Present (Succ));
+ pragma Assert (Present (Edge));
- Rel : constant Predecessor_Successor_Relation :=
- (Predecessor => Pred,
- Successor => Succ);
+ 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, LGE_Id));
+ Decrement_Library_Graph_Edge_Count (G, Kind (G, Edge));
-- Update the number of pending predecessors the successor must wait
-- on before it is elaborated.
-- Delete the link between the predecessor and successor. This allows
-- for further attempts to link the same predecessor and successor.
- PS.Delete (G.Relations, Rel);
+ RE_Sets.Delete (G.Recorded_Edges, Rel);
-- Delete the attributes of the edge
- EA.Delete (G.Edge_Attributes, LGE_Id);
+ LGE_Tables.Delete (G.Edge_Attributes, Edge);
-- Delete the edge from the underlying graph
- DG.Delete_Edge (G.Graph, LGE_Id);
+ DG.Delete_Edge (G.Graph, Edge);
end Delete_Edge;
-------------
begin
pragma Assert (Present (G));
- CA.Destroy (G.Component_Attributes);
- EA.Destroy (G.Edge_Attributes);
- DG.Destroy (G.Graph);
- PS.Destroy (G.Relations);
- UV.Destroy (G.Unit_To_Vertex);
- VA.Destroy (G.Vertex_Attributes);
+ 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);
+ RC_Sets.Destroy (G.Recorded_Cycles);
+ RE_Sets.Destroy (G.Recorded_Edges);
+ Unit_Tables.Destroy (G.Unit_To_Vertex);
+ LGV_Tables.Destroy (G.Vertex_Attributes);
Free (G);
end Destroy;
null;
end Destroy_Component_Attributes;
- --------------------------------
- -- Destroy_Library_Graph_Edge --
- --------------------------------
+ --------------------------------------------
+ -- Destroy_Library_Graph_Cycle_Attributes --
+ --------------------------------------------
- procedure Destroy_Library_Graph_Edge
- (LGE_Id : in out Library_Graph_Edge_Id)
+ procedure Destroy_Library_Graph_Cycle_Attributes
+ (Attrs : in out Library_Graph_Cycle_Attributes)
is
- pragma Unreferenced (LGE_Id);
begin
- null;
- end Destroy_Library_Graph_Edge;
+ LGE_Lists.Destroy (Attrs.Path);
+ end Destroy_Library_Graph_Cycle_Attributes;
-------------------------------------------
-- Destroy_Library_Graph_Edge_Attributes --
----------------------------------
procedure Destroy_Library_Graph_Vertex
- (LGV_Id : in out Library_Graph_Vertex_Id)
+ (Vertex : in out Library_Graph_Vertex_Id)
is
- pragma Unreferenced (LGV_Id);
+ pragma Unreferenced (Vertex);
begin
null;
end Destroy_Library_Graph_Vertex;
null;
end Destroy_Library_Graph_Vertex_Attributes;
- ---------------------
- -- Find_Components --
- ---------------------
-
- procedure Find_Components (G : Library_Graph) is
- Edges : EL.Doubly_Linked_List;
+ ---------------
+ -- 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));
- -- Initialize or reinitialize the components of the graph
+ return File_Name (Unit (G, Vertex));
+ end File_Name;
- Initialize_Components (G);
+ ------------------------------------
+ -- Find_All_Cycles_Through_Vertex --
+ ------------------------------------
+
+ procedure Find_All_Cycles_Through_Vertex
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id;
+ End_Vertices : LGV_Sets.Membership_Set;
+ Most_Significant_Edge : Library_Graph_Edge_Id;
+ Invocation_Edge_Count : Natural;
+ Spec_And_Body_Together : Boolean;
+ Cycle_Path : LGE_Lists.Doubly_Linked_List;
+ Visited_Vertices : LGV_Sets.Membership_Set;
+ Indent : Indentation_Level)
+ is
+ Edge_Indent : constant Indentation_Level :=
+ Indent + Nested_Indentation;
+
+ Iter : Edges_To_Successors_Iterator;
+ Next_Edge : Library_Graph_Edge_Id;
+
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (LGV_Sets.Present (End_Vertices));
+ pragma Assert (Present (Most_Significant_Edge));
+ pragma Assert (LGE_Lists.Present (Cycle_Path));
+ pragma Assert (LGV_Sets.Present (Visited_Vertices));
+
+ -- Nothing to do when there is no vertex
+
+ if not Present (Vertex) then
+ return;
+ end if;
+
+ Trace_Vertex (G, Vertex, Indent);
+
+ -- The current vertex denotes the end vertex of the cycle and closes
+ -- the circuit. Normalize the cycle such that it is rotated with its
+ -- most significant edge first, and record it for diagnostics.
+
+ if LGV_Sets.Contains (End_Vertices, Vertex) then
+ Normalize_And_Add_Cycle
+ (G => G,
+ Most_Significant_Edge => Most_Significant_Edge,
+ Invocation_Edge_Count => Invocation_Edge_Count,
+ Cycle_Path => Cycle_Path,
+ Indent => Indent + Nested_Indentation);
+
+ -- Otherwise extend the search for a cycle only when the vertex has
+ -- not been visited yet.
+
+ elsif not LGV_Sets.Contains (Visited_Vertices, Vertex) then
+
+ -- Prepare for vertex backtracking
+
+ LGV_Sets.Insert (Visited_Vertices, Vertex);
+
+ -- Extend the search via all edges to successors of the vertex
+
+ Iter := Iterate_Edges_To_Successors (G, Vertex);
+ while Has_Next (Iter) loop
+ Next (Iter, Next_Edge);
+
+ if Is_Cyclic_Edge (G, Next_Edge) then
+ Trace_Edge (G, Next_Edge, Edge_Indent);
+
+ -- Prepare for edge backtracking. Prepending ensures that
+ -- final ordering of edges can be traversed from successor
+ -- to predecessor.
+
+ LGE_Lists.Prepend (Cycle_Path, Next_Edge);
+
+ -- Extend the search via the successor of the next edge
+
+ Find_All_Cycles_Through_Vertex
+ (G => G,
+ Vertex => Successor (G, Next_Edge),
+ End_Vertices => End_Vertices,
+
+ -- The next edge may be more important than the current
+ -- most important edge, thus "upgrading" the nature of
+ -- the cycle, and shifting its point of normalization.
+
+ Most_Significant_Edge =>
+ Highest_Precedence_Edge
+ (G => G,
+ Left => Next_Edge,
+ Right => Most_Significant_Edge),
+
+ -- The next 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 => Next_Edge,
+ Count => Invocation_Edge_Count),
+ Spec_And_Body_Together => Spec_And_Body_Together,
+ Cycle_Path => Cycle_Path,
+ Visited_Vertices => Visited_Vertices,
+ Indent => Indent);
+
+ -- Backtrack the edge
+
+ LGE_Lists.Delete_First (Cycle_Path);
+ end if;
+ end loop;
+
+ -- Extend the search via the complementary vertex when the current
+ -- vertex is part of an Elaborate_Body pair, or the initial edge
+ -- is an Elaborate_All edge.
+
+ Find_All_Cycles_Through_Vertex
+ (G => G,
+ Vertex =>
+ Complementary_Vertex
+ (G => G,
+ Vertex => Vertex,
+ Do_Complement => Spec_And_Body_Together),
+ End_Vertices => End_Vertices,
+ Most_Significant_Edge => Most_Significant_Edge,
+ Invocation_Edge_Count => Invocation_Edge_Count,
+ Spec_And_Body_Together => Spec_And_Body_Together,
+ Cycle_Path => Cycle_Path,
+ Visited_Vertices => Visited_Vertices,
+ Indent => Indent);
+
+ -- Backtrack the vertex
+
+ LGV_Sets.Delete (Visited_Vertices, Vertex);
+ end if;
+ end Find_All_Cycles_Through_Vertex;
+
+ -------------------------------
+ -- Find_All_Cycles_With_Edge --
+ -------------------------------
+
+ procedure Find_All_Cycles_With_Edge
+ (G : Library_Graph;
+ Initial_Edge : Library_Graph_Edge_Id;
+ Spec_And_Body_Together : Boolean;
+ Cycle_Path : LGE_Lists.Doubly_Linked_List;
+ Visited_Vertices : LGV_Sets.Membership_Set;
+ Indent : Indentation_Level)
+ is
+ pragma Assert (Present (G));
+ pragma Assert (Present (Initial_Edge));
+ pragma Assert (LGE_Lists.Present (Cycle_Path));
+ pragma Assert (LGV_Sets.Present (Visited_Vertices));
+
+ Pred : constant Library_Graph_Vertex_Id :=
+ Predecessor (G, Initial_Edge);
+ Succ : constant Library_Graph_Vertex_Id :=
+ Successor (G, Initial_Edge);
+
+ End_Vertices : LGV_Sets.Membership_Set;
+
+ begin
+ Trace_Edge (G, Initial_Edge, Indent);
+
+ -- Use a set to represent the end vertices of the cycle. The set is
+ -- needed to accomodate the Elaborate_All and Elaborate_Body cases
+ -- where a cycle may terminate on either a spec or a body vertex.
+
+ End_Vertices := LGV_Sets.Create (2);
+ Add_Vertex_And_Complement
+ (G => G,
+ Vertex => Pred,
+ Set => End_Vertices,
+ Do_Complement => Spec_And_Body_Together);
+
+ -- Prepare for edge backtracking
+ --
+ -- The initial edge starts the path. During the traversal, edges with
+ -- higher precedence may be discovered, in which case they supersede
+ -- the initial edge in terms of significance. Prepending to the cycle
+ -- path ensures that the vertices can be visited in the proper order
+ -- for diagnostics.
+
+ LGE_Lists.Prepend (Cycle_Path, Initial_Edge);
+
+ -- Prepare for vertex backtracking
+ --
+ -- The predecessor is considered the terminator of the path. Add it
+ -- to the set of visited vertices along with its complement vertex
+ -- in the Elaborate_All and Elaborate_Body cases to prevent infinite
+ -- recursion.
+
+ Add_Vertex_And_Complement
+ (G => G,
+ Vertex => Pred,
+ Set => Visited_Vertices,
+ Do_Complement => Spec_And_Body_Together);
+
+ -- Traverse a potential cycle by continuously visiting successors
+ -- until either the predecessor of the initial edge is reached, or
+ -- no more successors are available.
+
+ Find_All_Cycles_Through_Vertex
+ (G => G,
+ Vertex => Succ,
+ End_Vertices => End_Vertices,
+ Most_Significant_Edge => Initial_Edge,
+ Invocation_Edge_Count =>
+ Maximum_Invocation_Edge_Count
+ (G => G,
+ Edge => Initial_Edge,
+ Count => 0),
+ Spec_And_Body_Together => Spec_And_Body_Together,
+ Cycle_Path => Cycle_Path,
+ Visited_Vertices => Visited_Vertices,
+ Indent => Indent + Nested_Indentation);
+
+ -- Backtrack the edge
+
+ LGE_Lists.Delete_First (Cycle_Path);
+
+ -- Backtrack the predecessor, along with the complement vertex in the
+ -- Elaborate_All and Elaborate_Body cases.
+
+ Remove_Vertex_And_Complement
+ (G => G,
+ Vertex => Pred,
+ Set => Visited_Vertices,
+ Do_Complement => Spec_And_Body_Together);
+
+ LGV_Sets.Destroy (End_Vertices);
+ end Find_All_Cycles_With_Edge;
+
+ ---------------------
+ -- Find_Components --
+ ---------------------
+
+ procedure Find_Components (G : Library_Graph) is
+ Edges : LGE_Lists.Doubly_Linked_List;
+
+ begin
+ pragma Assert (Present (G));
+
+ -- 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 := EL.Create;
+ Edges := LGE_Lists.Create;
Add_Body_Before_Spec_Edges (G, Edges);
DG.Find_Components (G.Graph);
-- successor spec because they cause unresolvable circularities.
Delete_Body_Before_Spec_Edges (G, Edges);
- EL.Destroy (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 Find_Components;
+ -----------------
+ -- Find_Cycles --
+ -----------------
+
+ procedure Find_Cycles (G : Library_Graph) is
+ Cycle_Path : LGE_Lists.Doubly_Linked_List;
+ Edge : Library_Graph_Edge_Id;
+ Iter : All_Edge_Iterator;
+ Visited_Vertices : LGV_Sets.Membership_Set;
+
+ begin
+ pragma Assert (Present (G));
+
+ -- Use a list of edges to describe the path of a cycle
+
+ Cycle_Path := LGE_Lists.Create;
+
+ -- Use a set of visited vertices to prevent infinite traversal of the
+ -- graph.
+
+ Visited_Vertices := LGV_Sets.Create (Number_Of_Vertices (G));
+
+ -- Inspect all edges, trying to find an edge that links two vertices
+ -- in the same component.
+
+ Iter := Iterate_All_Edges (G);
+ while Has_Next (Iter) loop
+ Next (Iter, Edge);
+
+ -- Find all cycles involving the current edge. Duplicate cycles in
+ -- the forms of rotations are not saved for diagnostic purposes.
+
+ if Is_Cycle_Initiating_Edge (G, Edge) then
+ Find_All_Cycles_With_Edge
+ (G => G,
+ Initial_Edge => Edge,
+ Spec_And_Body_Together => Is_Elaborate_All_Edge (G, Edge),
+ Cycle_Path => Cycle_Path,
+ Visited_Vertices => Visited_Vertices,
+ Indent => No_Indentation);
+
+ Trace_Eol;
+ end if;
+ end loop;
+
+ LGE_Lists.Destroy (Cycle_Path);
+ LGV_Sets.Destroy (Visited_Vertices);
+ end Find_Cycles;
+
+ ---------------------------------------
+ -- 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 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 --
------------------------------
pragma Assert (Present (G));
pragma Assert (Present (Comp));
- return CA.Get (G.Component_Attributes, 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;
- LGE_Id : Library_Graph_Edge_Id)
- return Library_Graph_Edge_Attributes
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Library_Graph_Edge_Attributes
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (LGE_Id));
+ pragma Assert (Present (Edge));
- return EA.Get (G.Edge_Attributes, LGE_Id);
+ return LGE_Tables.Get (G.Edge_Attributes, Edge);
end Get_LGE_Attributes;
------------------------
function Get_LGV_Attributes
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id)
+ Vertex : Library_Graph_Vertex_Id)
return Library_Graph_Vertex_Attributes
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
+ pragma Assert (Present (Vertex));
- return VA.Get (G.Vertex_Attributes, LGV_Id);
+ 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_Body --
------------------------
function Has_Elaborate_Body
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Boolean
+ Vertex : Library_Graph_Vertex_Id) return Boolean
is
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
-
- U_Id : constant Unit_Id := Unit (G, LGV_Id);
-
- pragma Assert (Present (U_Id));
+ pragma Assert (Present (Vertex));
+ U_Id : constant Unit_Id := Unit (G, Vertex);
U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
begin
-- 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));
-- 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;
+ -----------------------------------------
+ -- 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 --
-----------------------------------------
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 :=
+ 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;
- LGV_Id : Library_Graph_Vertex_Id) return Boolean
+ Vertex : Library_Graph_Vertex_Id) return Boolean
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
+ pragma Assert (Present (Vertex));
- return Get_LGV_Attributes (G, LGV_Id).In_Elaboration_Order;
+ 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_Pending_Predecessors
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id)
+ Vertex : Library_Graph_Vertex_Id)
is
Attrs : Library_Graph_Vertex_Attributes;
begin
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
+ pragma Assert (Present (Vertex));
- Attrs := Get_LGV_Attributes (G, LGV_Id);
+ Attrs := Get_LGV_Attributes (G, Vertex);
Attrs.Pending_Predecessors := Attrs.Pending_Predecessors + 1;
- Set_LGV_Attributes (G, LGV_Id, Attrs);
+ Set_LGV_Attributes (G, Vertex, Attrs);
end Increment_Pending_Predecessors;
---------------------------
-- be computed.
if Number_Of_Components (G) > 0 then
- CA.Destroy (G.Component_Attributes);
- G.Component_Attributes := CA.Create (Number_Of_Vertices (G));
+ Component_Tables.Destroy (G.Component_Attributes);
+
+ G.Component_Attributes :=
+ Component_Tables.Create (Number_Of_Vertices (G));
end if;
end Initialize_Components;
+ ---------------------
+ -- Insert_And_Sort --
+ ---------------------
+
+ procedure Insert_And_Sort
+ (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 Insert_And_Sort;
+
+ ---------------------------
+ -- 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;
- LGV_Id : Library_Graph_Vertex_Id) return Boolean
+ Vertex : Library_Graph_Vertex_Id) return Boolean
is
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
-
- U_Id : constant Unit_Id := Unit (G, LGV_Id);
-
- pragma Assert (Present (U_Id));
+ pragma Assert (Present (Vertex));
+ U_Id : constant Unit_Id := Unit (G, Vertex);
U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
begin
function Is_Body_Of_Spec_With_Elaborate_Body
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Boolean
+ Vertex : Library_Graph_Vertex_Id) return Boolean
is
- Spec_LGV_Id : Library_Graph_Vertex_Id;
-
begin
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
+ pragma Assert (Present (Vertex));
- if Is_Body_With_Spec (G, LGV_Id) then
- Spec_LGV_Id := Proper_Spec (G, LGV_Id);
- pragma Assert (Present (Spec_LGV_Id));
-
- return Is_Spec_With_Elaborate_Body (G, Spec_LGV_Id);
+ 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;
function Is_Body_With_Spec
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Boolean
+ Vertex : Library_Graph_Vertex_Id) return Boolean
is
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
-
- U_Id : constant Unit_Id := Unit (G, LGV_Id);
-
- pragma Assert (Present (U_Id));
+ 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) return Boolean is
+ begin
+ pragma Assert (Present (G));
+
+ return G.Dynamically_Elaborated;
+ end Is_Dynamically_Elaborated;
+
-----------------------------
-- Is_Elaborable_Component --
-----------------------------
function Is_Elaborable_Vertex
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Boolean
+ Vertex : Library_Graph_Vertex_Id) return Boolean
is
- Check_LGV_Id : Library_Graph_Vertex_Id;
+ Check_Vertex : Library_Graph_Vertex_Id;
begin
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
+ pragma Assert (Present (Vertex));
- Check_LGV_Id := LGV_Id;
+ Check_Vertex := Vertex;
-- A spec-body pair where the spec carries pragma Elaborate_Body must
-- be treated as one vertex for elaboration purposes. Use the spec as
-- the point of reference for the composite vertex.
- if Is_Body_Of_Spec_With_Elaborate_Body (G, Check_LGV_Id) then
- Check_LGV_Id := Proper_Spec (G, Check_LGV_Id);
- pragma Assert (Present (Check_LGV_Id));
+ if Is_Body_Of_Spec_With_Elaborate_Body (G, Check_Vertex) then
+ Check_Vertex := Proper_Spec (G, Check_Vertex);
end if;
return
Is_Elaborable_Vertex
(G => G,
- LGV_Id => Check_LGV_Id,
+ Vertex => Check_Vertex,
Predecessors => 0);
end Is_Elaborable_Vertex;
function Is_Elaborable_Vertex
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id;
+ Vertex : Library_Graph_Vertex_Id;
Predecessors : Natural) return Boolean
is
- pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
-
- Comp : constant Component_Id := Component (G, LGV_Id);
-
- pragma Assert (Present (Comp));
-
- Body_LGV_Id : Library_Graph_Vertex_Id;
+ Body_Vertex : Library_Graph_Vertex_Id;
begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Vertex));
+
-- The vertex must not be re-elaborated once it has been elaborated
- if In_Elaboration_Order (G, LGV_Id) then
+ if In_Elaboration_Order (G, Vertex) then
return False;
-- The vertex must not be waiting on more precedessors than requested
-- to be elaborated.
- elsif Pending_Predecessors (G, LGV_Id) /= Predecessors then
+ elsif Pending_Predecessors (G, Vertex) /= Predecessors then
return False;
-- The component where the vertex resides must not be waiting on any
-- of its precedessors to be elaborated.
- elsif not Is_Elaborable_Component (G, Comp) then
+ elsif not Is_Elaborable_Component (G, Component (G, Vertex)) then
return False;
-- The vertex denotes a spec with a completing body, and is subject
-- vertex to be elaborated. Account for the sole predecessor of the
-- body which is the vertex itself.
- elsif Is_Spec_With_Elaborate_Body (G, LGV_Id) then
- Body_LGV_Id := Proper_Body (G, LGV_Id);
- pragma Assert (Present (Body_LGV_Id));
+ elsif Is_Spec_With_Elaborate_Body (G, Vertex) then
+ Body_Vertex := Proper_Body (G, Vertex);
+ pragma Assert (Present (Body_Vertex));
return
Is_Elaborable_Vertex
(G => G,
- LGV_Id => Body_LGV_Id,
+ Vertex => Body_Vertex,
Predecessors => 1);
end if;
return True;
end Is_Elaborable_Vertex;
- ------------------------------------------------
- -- Is_Existing_Predecessor_Successor_Relation --
- ------------------------------------------------
+ ---------------------------
+ -- Is_Elaborate_All_Edge --
+ ---------------------------
- function Is_Existing_Predecessor_Successor_Relation
- (G : Library_Graph;
- Rel : Predecessor_Successor_Relation) return Boolean
+ function Is_Elaborate_All_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (Rel.Predecessor));
- pragma Assert (Present (Rel.Successor));
+ pragma Assert (Present (Edge));
- return PS.Contains (G.Relations, Rel);
- end Is_Existing_Predecessor_Successor_Relation;
+ 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
+ pragma Assert (Present (G));
+ pragma Assert (Present (Edge));
+
+ Succ : constant Library_Graph_Vertex_Id := Successor (G, Edge);
+
+ begin
+ return
+ Kind (G, Edge) = With_Edge
+ and then
+ (Is_Spec_With_Elaborate_Body (G, Succ)
+ or else Is_Body_Of_Spec_With_Elaborate_Body (G, Succ));
+ 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_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;
- LGV_Id : Library_Graph_Vertex_Id) return Boolean
+ Vertex : Library_Graph_Vertex_Id) return Boolean
is
+ begin
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
+ pragma Assert (Present (Vertex));
- U_Id : constant Unit_Id := Unit (G, LGV_Id);
+ return Is_Internal_Unit (Unit (G, Vertex));
+ end Is_Internal_Unit;
- pragma Assert (Present (U_Id));
+ ------------------------
+ -- Is_Invocation_Edge --
+ ------------------------
+ function Is_Invocation_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean
+ is
begin
- return Is_Internal_Unit (U_Id);
- end Is_Internal_Unit;
+ 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;
- LGV_Id : Library_Graph_Vertex_Id) return Boolean
+ Vertex : Library_Graph_Vertex_Id) return Boolean
is
+ begin
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
+ pragma Assert (Present (Vertex));
- U_Id : constant Unit_Id := Unit (G, LGV_Id);
-
- pragma Assert (Present (U_Id));
-
- begin
- return Is_Predefined_Unit (U_Id);
+ return Is_Predefined_Unit (Unit (G, Vertex));
end Is_Predefined_Unit;
---------------------------
function Is_Preelaborated_Unit
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Boolean
+ Vertex : Library_Graph_Vertex_Id) return Boolean
is
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
-
- U_Id : constant Unit_Id := Unit (G, LGV_Id);
-
- pragma Assert (Present (U_Id));
+ 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_Cycle --
+ -----------------------
+
+ function Is_Recorded_Cycle
+ (G : Library_Graph;
+ Attrs : Library_Graph_Cycle_Attributes) return Boolean
+ is
+ begin
+ pragma Assert (Present (G));
+
+ return RC_Sets.Contains (G.Recorded_Cycles, Attrs);
+ end Is_Recorded_Cycle;
+
+ ----------------------
+ -- 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;
- LGV_Id : Library_Graph_Vertex_Id) return Boolean
+ Vertex : Library_Graph_Vertex_Id) return Boolean
is
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
-
- U_Id : constant Unit_Id := Unit (G, LGV_Id);
-
- pragma Assert (Present (U_Id));
+ pragma Assert (Present (Vertex));
+ U_Id : constant Unit_Id := Unit (G, Vertex);
U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
begin
function Is_Spec_With_Body
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Boolean
+ Vertex : Library_Graph_Vertex_Id) return Boolean
is
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
-
- U_Id : constant Unit_Id := Unit (G, LGV_Id);
-
- pragma Assert (Present (U_Id));
+ pragma Assert (Present (Vertex));
+ U_Id : constant Unit_Id := Unit (G, Vertex);
U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
begin
function Is_Spec_With_Elaborate_Body
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Boolean
+ Vertex : Library_Graph_Vertex_Id) return Boolean
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
+ pragma Assert (Present (Vertex));
return
- Is_Spec_With_Body (G, LGV_Id)
- and then Has_Elaborate_Body (G, LGV_Id);
+ Is_Spec_With_Body (G, Vertex)
+ and then Has_Elaborate_Body (G, Vertex);
end Is_Spec_With_Elaborate_Body;
+ ------------------
+ -- 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 --
-----------------------
(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;
- LGV_Id : Library_Graph_Vertex_Id)
- return Edges_To_Successors_Iterator
+ Vertex : Library_Graph_Vertex_Id) return Edges_To_Successors_Iterator
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
+ pragma Assert (Present (Vertex));
return
Edges_To_Successors_Iterator
- (DG.Iterate_Outgoing_Edges (G.Graph, LGV_Id));
+ (DG.Iterate_Outgoing_Edges (G.Graph, Vertex));
end Iterate_Edges_To_Successors;
----------
function Kind
(G : Library_Graph;
- LGE_Id : Library_Graph_Edge_Id) return Library_Graph_Edge_Kind
+ Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Kind
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (LGE_Id));
+ pragma Assert (Present (Cycle));
- return Get_LGE_Attributes (G, LGE_Id).Kind;
+ 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 Links_Vertices_In_Same_Component
- (G : Library_Graph;
- LGE_Id : Library_Graph_Edge_Id) return Boolean
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean
is
+ begin
pragma Assert (Present (G));
- pragma Assert (Present (LGE_Id));
+ pragma Assert (Present (Edge));
- Pred : constant Library_Graph_Vertex_Id := Predecessor (G, LGE_Id);
- Succ : constant Library_Graph_Vertex_Id := Successor (G, LGE_Id);
+ -- An edge is part of a cycle when both the successor and predecessor
+ -- reside in the same component.
- pragma Assert (Present (Pred));
- pragma Assert (Present (Succ));
+ 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));
- Pred_Comp : constant Component_Id := Component (G, Pred);
- Succ_Comp : constant Component_Id := Component (G, Succ);
+ New_Count := Count;
- pragma Assert (Present (Pred_Comp));
- pragma Assert (Present (Succ_Comp));
+ if Present (Edge) and then Is_Invocation_Edge (G, Edge) then
+ New_Count := New_Count + 1;
+ end if;
- begin
- return Pred_Comp = Succ_Comp;
- end Links_Vertices_In_Same_Component;
+ return New_Count;
+ end Maximum_Invocation_Edge_Count;
----------
-- Name --
function Name
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Unit_Name_Type
+ Vertex : Library_Graph_Vertex_Id) return Unit_Name_Type
is
+ begin
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
-
- U_Id : constant Unit_Id := Unit (G, LGV_Id);
+ pragma Assert (Present (Vertex));
- pragma Assert (Present (U_Id));
-
- begin
- return Name (U_Id);
+ return Name (Unit (G, Vertex));
end Name;
-----------------------
function Needs_Elaboration
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Boolean
+ Vertex : Library_Graph_Vertex_Id) return Boolean
is
+ begin
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
+ pragma Assert (Present (Vertex));
- U_Id : constant Unit_Id := Unit (G, LGV_Id);
+ return Needs_Elaboration (Unit (G, Vertex));
+ end Needs_Elaboration;
- pragma Assert (Present (U_Id));
+ ----------
+ -- Next --
+ ----------
+ procedure Next
+ (Iter : in out All_Cycle_Iterator;
+ Cycle : out Library_Graph_Cycle_Id)
+ is
begin
- return Needs_Elaboration (U_Id);
- end Needs_Elaboration;
+ LGC_Lists.Next (LGC_Lists.Iterator (Iter), Cycle);
+ end Next;
----------
-- Next --
----------
procedure Next
- (Iter : in out All_Edge_Iterator;
- LGE_Id : out Library_Graph_Edge_Id)
+ (Iter : in out All_Edge_Iterator;
+ Edge : out Library_Graph_Edge_Id)
is
begin
- DG.Next (DG.All_Edge_Iterator (Iter), LGE_Id);
+ DG.Next (DG.All_Edge_Iterator (Iter), Edge);
end Next;
----------
procedure Next
(Iter : in out All_Vertex_Iterator;
- LGV_Id : out Library_Graph_Vertex_Id)
+ 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
- DG.Next (DG.All_Vertex_Iterator (Iter), LGV_Id);
+ LGE_Lists.Next (LGE_Lists.Iterator (Iter), Edge);
end Next;
----------
----------
procedure Next
- (Iter : in out Edges_To_Successors_Iterator;
- LGE_Id : out Library_Graph_Edge_Id)
+ (Iter : in out Edges_To_Successors_Iterator;
+ Edge : out Library_Graph_Edge_Id)
is
begin
- DG.Next (DG.Outgoing_Edge_Iterator (Iter), LGE_Id);
+ DG.Next (DG.Outgoing_Edge_Iterator (Iter), Edge);
end Next;
----------
procedure Next
(Iter : in out Component_Vertex_Iterator;
- LGV_Id : out Library_Graph_Vertex_Id)
+ Vertex : out Library_Graph_Vertex_Id)
is
begin
- DG.Next (DG.Component_Vertex_Iterator (Iter), LGV_Id);
+ DG.Next (DG.Component_Vertex_Iterator (Iter), Vertex);
end Next;
+ -----------------------------
+ -- Normalize_And_Add_Cycle --
+ -----------------------------
+
+ procedure Normalize_And_Add_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
+ 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.
+
+ Add_Cycle
+ (G => G,
+ Attrs =>
+ (Invocation_Edge_Count => Invocation_Edge_Count,
+ Kind =>
+ Cycle_Kind_Of
+ (G => G,
+ Edge => Most_Significant_Edge),
+ Path => Path),
+ Indent => Indent);
+ end Normalize_And_Add_Cycle;
+
+ --------------------------
+ -- 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 --
----------------------------------
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_To_Successors
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Natural
+ Vertex : Library_Graph_Vertex_Id) return Natural
is
begin
pragma Assert (Present (G));
- return DG.Number_Of_Outgoing_Edges (G.Graph, LGV_Id);
+ return DG.Number_Of_Outgoing_Edges (G.Graph, Vertex);
end Number_Of_Edges_To_Successors;
------------------------
return DG.Number_Of_Vertices (G.Graph);
end Number_Of_Vertices;
+ ----------
+ -- 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 --
--------------------------
function Pending_Predecessors
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Natural
+ Vertex : Library_Graph_Vertex_Id) return Natural
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
+ pragma Assert (Present (Vertex));
- return Get_LGV_Attributes (G, LGV_Id).Pending_Predecessors;
+ return Get_LGV_Attributes (G, Vertex).Pending_Predecessors;
end Pending_Predecessors;
+ ----------------
+ -- Precedence --
+ ----------------
+
+ function 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 :=
+ Precedence
+ (Kind => Kind (G, Cycle),
+ Compared_To => Kind (G, Compared_To));
+
+ begin
+ if Kind_Prec = Higher_Precedence
+ or else
+ Kind_Prec = Lower_Precedence
+ then
+ return Kind_Prec;
+
+ -- Otherwise both cycles have the same precedence based on their
+ -- kind. Prefer a cycle with fewer invocation edges.
+
+ elsif Cycle_Invs < Comp_Invs then
+ return Higher_Precedence;
+
+ elsif Cycle_Invs > Comp_Invs then
+ return Lower_Precedence;
+
+ -- Otherwise both cycles have the same number of invocation edges.
+ -- Prefer a cycle with a smaller length.
+
+ elsif Cycle_Len < Comp_Len then
+ return Higher_Precedence;
+
+ elsif Cycle_Len > Comp_Len then
+ return Lower_Precedence;
+
+ else
+ return Equal_Precedence;
+ end if;
+ end Precedence;
+
+ ----------------
+ -- Precedence --
+ ----------------
+
+ function 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 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 Precedence;
+
+ ----------------
+ -- Precedence --
+ ----------------
+
+ function 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));
+
+ Kind_Prec : constant Precedence_Kind :=
+ Precedence
+ (Kind => Cycle_Kind_Of (G, Edge),
+ Compared_To => Cycle_Kind_Of (G, Compared_To));
+
+ begin
+ if Kind_Prec = Higher_Precedence
+ or else
+ Kind_Prec = Lower_Precedence
+ then
+ return Kind_Prec;
+
+ -- Otherwise both edges have the same precedence based on their cycle
+ -- kinds. Prefer an edge whose successor has higher precedence.
+
+ else
+ return
+ Precedence
+ (G => G,
+ Vertex => Successor (G, Edge),
+ Compared_To => Successor (G, Compared_To));
+ end if;
+ end Precedence;
+
+ ----------------
+ -- Precedence --
+ ----------------
+
+ function 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 Precedence;
+
-----------------
-- Predecessor --
-----------------
function Predecessor
- (G : Library_Graph;
- LGE_Id : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (LGE_Id));
+ pragma Assert (Present (Edge));
- return DG.Source_Vertex (G.Graph, LGE_Id);
+ return DG.Source_Vertex (G.Graph, Edge);
end Predecessor;
-------------
function Proper_Body
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id
+ Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
+ pragma Assert (Present (Vertex));
-- When the vertex denotes a spec with a completing body, return the
-- body.
- if Is_Spec_With_Body (G, LGV_Id) then
- return Corresponding_Item (G, LGV_Id);
+ 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, LGV_Id));
- return LGV_Id;
+ pragma Assert (Is_Body (G, Vertex));
+ return Vertex;
end if;
end Proper_Body;
function Proper_Spec
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id
+ Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
+ pragma Assert (Present (Vertex));
-- When the vertex denotes a body that completes a spec, return the
-- spec.
- if Is_Body_With_Spec (G, LGV_Id) then
- return Corresponding_Item (G, LGV_Id);
+ 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, LGV_Id));
- return LGV_Id;
+ pragma Assert (Is_Spec (G, Vertex));
+ return Vertex;
end if;
end Proper_Spec;
+ ----------------------------------
+ -- Remove_Vertex_And_Complement --
+ ----------------------------------
+
+ procedure Remove_Vertex_And_Complement
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id;
+ Set : LGV_Sets.Membership_Set;
+ Do_Complement : Boolean)
+ is
+ pragma Assert (Present (G));
+ pragma Assert (Present (Vertex));
+ pragma Assert (LGV_Sets.Present (Set));
+
+ Complement : constant Library_Graph_Vertex_Id :=
+ Complementary_Vertex
+ (G => G,
+ Vertex => Vertex,
+ Do_Complement => Do_Complement);
+
+ begin
+ LGV_Sets.Delete (Set, Vertex);
+
+ if Present (Complement) then
+ LGV_Sets.Delete (Set, Complement);
+ end if;
+ end Remove_Vertex_And_Complement;
+
+ -----------------------------------------
+ -- 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 --
------------------------------
pragma Assert (Present (G));
pragma Assert (Present (Comp));
- CA.Put (G.Component_Attributes, Comp, Val);
+ Component_Tables.Put (G.Component_Attributes, Comp, Val);
end Set_Component_Attributes;
----------------------------
procedure Set_Corresponding_Item
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id;
+ Vertex : Library_Graph_Vertex_Id;
Val : Library_Graph_Vertex_Id)
is
Attrs : Library_Graph_Vertex_Attributes;
begin
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
+ pragma Assert (Present (Vertex));
- Attrs := Get_LGV_Attributes (G, LGV_Id);
+ Attrs := Get_LGV_Attributes (G, Vertex);
Attrs.Corresponding_Item := Val;
- Set_LGV_Attributes (G, LGV_Id, Attrs);
+ Set_LGV_Attributes (G, Vertex, Attrs);
end Set_Corresponding_Item;
------------------------------
pragma Assert (Present (G));
pragma Assert (Present (U_Id));
- UV.Put (G.Unit_To_Vertex, U_Id, Val);
+ Unit_Tables.Put (G.Unit_To_Vertex, U_Id, Val);
end Set_Corresponding_Vertex;
------------------------------
procedure Set_In_Elaboration_Order
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id;
+ Vertex : Library_Graph_Vertex_Id;
Val : Boolean := True)
is
Attrs : Library_Graph_Vertex_Attributes;
begin
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
+ pragma Assert (Present (Vertex));
- Attrs := Get_LGV_Attributes (G, LGV_Id);
+ Attrs := Get_LGV_Attributes (G, Vertex);
Attrs.In_Elaboration_Order := Val;
- Set_LGV_Attributes (G, LGV_Id, Attrs);
+ Set_LGV_Attributes (G, Vertex, Attrs);
end Set_In_Elaboration_Order;
- ----------------------------------------------------
- -- Set_Is_Existing_Predecessor_Successor_Relation --
- ----------------------------------------------------
+ ---------------------------
+ -- Set_Is_Recorded_Cycle --
+ ---------------------------
+
+ procedure Set_Is_Recorded_Cycle
+ (G : Library_Graph;
+ Attrs : Library_Graph_Cycle_Attributes;
+ Val : Boolean := True)
+ is
+ begin
+ pragma Assert (Present (G));
+
+ if Val then
+ RC_Sets.Insert (G.Recorded_Cycles, Attrs);
+ else
+ RC_Sets.Delete (G.Recorded_Cycles, Attrs);
+ end if;
+ end Set_Is_Recorded_Cycle;
+
+ --------------------------
+ -- Set_Is_Recorded_Edge --
+ --------------------------
- procedure Set_Is_Existing_Predecessor_Successor_Relation
+ procedure Set_Is_Recorded_Edge
(G : Library_Graph;
Rel : Predecessor_Successor_Relation;
Val : Boolean := True)
pragma Assert (Present (Rel.Successor));
if Val then
- PS.Insert (G.Relations, Rel);
+ RE_Sets.Insert (G.Recorded_Edges, Rel);
else
- PS.Delete (G.Relations, Rel);
+ RE_Sets.Delete (G.Recorded_Edges, Rel);
end if;
- end Set_Is_Existing_Predecessor_Successor_Relation;
+ 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;
- LGE_Id : Library_Graph_Edge_Id;
+ Edge : Library_Graph_Edge_Id;
Val : Library_Graph_Edge_Attributes)
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (LGE_Id));
+ pragma Assert (Present (Edge));
- EA.Put (G.Edge_Attributes, LGE_Id, Val);
+ LGE_Tables.Put (G.Edge_Attributes, Edge, Val);
end Set_LGE_Attributes;
------------------------
procedure Set_LGV_Attributes
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id;
+ Vertex : Library_Graph_Vertex_Id;
Val : Library_Graph_Vertex_Attributes)
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
+ pragma Assert (Present (Vertex));
- VA.Put (G.Vertex_Attributes, LGV_Id, Val);
+ LGV_Tables.Put (G.Vertex_Attributes, Vertex, Val);
end Set_LGV_Attributes;
---------------
---------------
function Successor
- (G : Library_Graph;
- LGE_Id : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (LGE_Id));
+ pragma Assert (Present (Edge));
- return DG.Destination_Vertex (G.Graph, LGE_Id);
+ return DG.Destination_Vertex (G.Graph, Edge);
end Successor;
+ -----------------
+ -- 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 elaboration order and cycle
+ -- detection trace information) is not in effect.
+
+ if not Debug_Flag_Underscore_TT then
+ return;
+ end if;
+
+ Indent_By (Indent);
+ Write_Str ("cycle (Cycle_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 (Edge_");
+ 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 elaboration order and cycle
+ -- detection trace information) is not in effect.
+
+ if not Debug_Flag_Underscore_TT then
+ return;
+ end if;
+
+ Indent_By (Indent);
+ Write_Str ("library graph edge (Edge_");
+ 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 (Vertex_");
+ Write_Int (Int (Pred));
+ Write_Str (") name = ");
+ Write_Name (Name (G, Pred));
+ Write_Eol;
+
+ Indent_By (Attr_Indent);
+ Write_Str ("Successor (Vertex_");
+ Write_Int (Int (Succ));
+ Write_Str (") name = ");
+ Write_Name (Name (G, Succ));
+ Write_Eol;
+ end Trace_Edge;
+
+ ---------------
+ -- Trace_Eol --
+ ---------------
+
+ procedure Trace_Eol is
+ begin
+ -- Nothing to do when switch -d_T (output elaboration order and cycle
+ -- detection trace information) is not in effect.
+
+ if not Debug_Flag_Underscore_TT then
+ return;
+ end if;
+
+ Write_Eol;
+ end Trace_Eol;
+
+ ------------------
+ -- 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 elaboration order and cycle
+ -- detection trace information) is not in effect.
+
+ if not Debug_Flag_Underscore_TT then
+ return;
+ end if;
+
+ Indent_By (Indent);
+ Write_Str ("library graph vertex (Vertex_");
+ Write_Int (Int (Vertex));
+ Write_Str (")");
+ Write_Eol;
+
+ Indent_By (Attr_Indent);
+ Write_Str ("Component (Comp_Id_");
+ Write_Int (Int (Component (G, 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;
- LGV_Id : Library_Graph_Vertex_Id) return Unit_Id
+ Vertex : Library_Graph_Vertex_Id) return Unit_Id
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
+ pragma Assert (Present (Vertex));
- return Get_LGV_Attributes (G, LGV_Id).Unit;
+ return Get_LGV_Attributes (G, Vertex).Unit;
end Unit;
-----------------------------------------------
procedure Update_Pending_Predecessors_Of_Components
(G : Library_Graph)
is
- Iter : All_Edge_Iterator;
- LGE_Id : Library_Graph_Edge_Id;
+ 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, LGE_Id);
- pragma Assert (Present (LGE_Id));
+ Next (Iter, Edge);
- Update_Pending_Predecessors_Of_Components (G, LGE_Id);
+ Update_Pending_Predecessors_Of_Components (G, Edge);
end loop;
end Update_Pending_Predecessors_Of_Components;
-----------------------------------------------
procedure Update_Pending_Predecessors_Of_Components
- (G : Library_Graph;
- LGE_Id : Library_Graph_Edge_Id)
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id)
is
pragma Assert (Present (G));
- pragma Assert (Present (LGE_Id));
-
- Pred : constant Library_Graph_Vertex_Id := Predecessor (G, LGE_Id);
- Succ : constant Library_Graph_Vertex_Id := Successor (G, LGE_Id);
-
- pragma Assert (Present (Pred));
- pragma Assert (Present (Succ));
+ pragma Assert (Present (Edge));
- Pred_Comp : constant Component_Id := Component (G, Pred);
- Succ_Comp : constant Component_Id := Component (G, Succ);
+ 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));
-- Present --
-------------
- function Present (IGE_Id : Invocation_Graph_Edge_Id) return Boolean is
+ 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 IGE_Id /= No_Invocation_Graph_Edge;
+ return Vertex /= No_Invocation_Graph_Vertex;
end Present;
-------------
-- Present --
-------------
- function Present (IGV_Id : Invocation_Graph_Vertex_Id) return Boolean is
+ function Present (Cycle : Library_Graph_Cycle_Id) return Boolean is
begin
- return IGV_Id /= No_Invocation_Graph_Vertex;
+ return Cycle /= No_Library_Graph_Cycle;
end Present;
-------------
-- Present --
-------------
- function Present (LGE_Id : Library_Graph_Edge_Id) return Boolean is
+ function Present (Edge : Library_Graph_Edge_Id) return Boolean is
begin
- return LGE_Id /= No_Library_Graph_Edge;
+ return Edge /= No_Library_Graph_Edge;
end Present;
-------------
-- Present --
-------------
- function Present (LGV_Id : Library_Graph_Vertex_Id) return Boolean is
+ function Present (Vertex : Library_Graph_Vertex_Id) return Boolean is
begin
- return LGV_Id /= No_Library_Graph_Vertex;
+ return Vertex /= No_Library_Graph_Vertex;
end Present;
--------------------------
- -- Sequence_Next_IGE_Id --
+ -- 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_IGE_Id return Invocation_Graph_Edge_Id is
- IGE_Id : constant Invocation_Graph_Edge_Id := IGE_Sequencer;
+ 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 IGE_Id;
- end Sequence_Next_IGE_Id;
+ return Edge;
+ end Sequence_Next_Edge;
--------------------------
- -- Sequence_Next_IGV_Id --
+ -- 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_IGV_Id --
+ -- Sequence_Next_Cycle --
--------------------------
- function Sequence_Next_IGV_Id return Invocation_Graph_Vertex_Id is
- IGV_Id : constant Invocation_Graph_Vertex_Id := IGV_Sequencer;
+ LGC_Sequencer : Library_Graph_Cycle_Id := First_Library_Graph_Cycle;
+ -- The couhnter 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
- IGV_Sequencer := IGV_Sequencer + 1;
- return IGV_Id;
- end Sequence_Next_IGV_Id;
+ LGC_Sequencer := LGC_Sequencer + 1;
+ return Cycle;
+ end Sequence_Next_Cycle;
--------------------------
- -- Sequence_Next_LGE_Id --
+ -- 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_LGE_Id return Library_Graph_Edge_Id is
- LGE_Id : constant Library_Graph_Edge_Id := LGE_Sequencer;
+ 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 LGE_Id;
- end Sequence_Next_LGE_Id;
+ return Edge;
+ end Sequence_Next_Edge;
--------------------------
- -- Sequence_Next_LGV_Id --
+ -- 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_LGV_Id return Library_Graph_Vertex_Id is
- LGV_Id : constant Library_Graph_Vertex_Id := LGV_Sequencer;
+ 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 LGV_Id;
- end Sequence_Next_LGV_Id;
+ return Vertex;
+ end Sequence_Next_Vertex;
end Bindo.Graphs;
-- The following unit defines the various graphs used in determining the
-- elaboration order of units.
+with Types; use Types;
+
with Bindo.Units; use Bindo.Units;
with GNAT; use GNAT;
with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables;
with GNAT.Graphs; use GNAT.Graphs;
+with GNAT.Lists; use GNAT.Lists;
with GNAT.Sets; use GNAT.Sets;
package Bindo.Graphs is
First_Invocation_Graph_Edge : constant Invocation_Graph_Edge_Id :=
No_Invocation_Graph_Edge + 1;
+ procedure Destroy_Invocation_Graph_Edge
+ (Edge : in out Invocation_Graph_Edge_Id);
+ pragma Inline (Destroy_Invocation_Graph_Edge);
+ -- Destroy invocation graph edge Edge
+
function Hash_Invocation_Graph_Edge
- (IGE_Id : Invocation_Graph_Edge_Id) return Bucket_Range_Type;
+ (Edge : Invocation_Graph_Edge_Id) return Bucket_Range_Type;
pragma Inline (Hash_Invocation_Graph_Edge);
- -- Obtain the hash value of key IGE_Id
+ -- Obtain the hash value of key Edge
- function Present (IGE_Id : Invocation_Graph_Edge_Id) return Boolean;
+ function Present (Edge : Invocation_Graph_Edge_Id) return Boolean;
pragma Inline (Present);
- -- Determine whether invocation graph edge IGE_Id exists
+ -- Determine whether invocation graph edge Edge exists
+
+ package IGE_Lists is new Doubly_Linked_Lists
+ (Element_Type => Invocation_Graph_Edge_Id,
+ "=" => "=",
+ Destroy_Element => Destroy_Invocation_Graph_Edge);
------------------------------
-- Invocation graph vertex --
No_Invocation_Graph_Vertex + 1;
function Hash_Invocation_Graph_Vertex
- (IGV_Id : Invocation_Graph_Vertex_Id) return Bucket_Range_Type;
+ (Vertex : Invocation_Graph_Vertex_Id) return Bucket_Range_Type;
pragma Inline (Hash_Invocation_Graph_Vertex);
- -- Obtain the hash value of key IGV_Id
+ -- Obtain the hash value of key Vertex
- function Present (IGV_Id : Invocation_Graph_Vertex_Id) return Boolean;
+ function Present (Vertex : Invocation_Graph_Vertex_Id) return Boolean;
+ pragma Inline (Present);
+ -- Determine whether invocation graph vertex Vertex exists
+
+ package IGV_Sets is new Membership_Sets
+ (Element_Type => Invocation_Graph_Vertex_Id,
+ "=" => "=",
+ Hash => Hash_Invocation_Graph_Vertex);
+
+ -------------------------
+ -- Library graph cycle --
+ -------------------------
+
+ type Library_Graph_Cycle_Id is new Natural;
+ No_Library_Graph_Cycle : constant Library_Graph_Cycle_Id :=
+ Library_Graph_Cycle_Id'First;
+ First_Library_Graph_Cycle : constant Library_Graph_Cycle_Id :=
+ No_Library_Graph_Cycle + 1;
+
+ procedure Destroy_Library_Graph_Cycle
+ (Cycle : in out Library_Graph_Cycle_Id);
+ pragma Inline (Destroy_Library_Graph_Cycle);
+ -- Destroy library graph cycle Cycle
+
+ function Hash_Library_Graph_Cycle
+ (Cycle : Library_Graph_Cycle_Id) return Bucket_Range_Type;
+ pragma Inline (Hash_Library_Graph_Cycle);
+ -- Obtain the hash value of key Cycle
+
+ function Present (Cycle : Library_Graph_Cycle_Id) return Boolean;
pragma Inline (Present);
- -- Determine whether invocation graph vertex IGV_Id exists
+ -- Determine whether library graph cycle Cycle exists
+
+ package LGC_Lists is new Doubly_Linked_Lists
+ (Element_Type => Library_Graph_Cycle_Id,
+ "=" => "=",
+ Destroy_Element => Destroy_Library_Graph_Cycle);
------------------------
-- Library graph edge --
First_Library_Graph_Edge : constant Library_Graph_Edge_Id :=
No_Library_Graph_Edge + 1;
+ procedure Destroy_Library_Graph_Edge
+ (Edge : in out Library_Graph_Edge_Id);
+ pragma Inline (Destroy_Library_Graph_Edge);
+ -- Destroy library graph edge Edge
+
function Hash_Library_Graph_Edge
- (LGE_Id : Library_Graph_Edge_Id) return Bucket_Range_Type;
+ (Edge : Library_Graph_Edge_Id) return Bucket_Range_Type;
pragma Inline (Hash_Library_Graph_Edge);
- -- Obtain the hash value of key LGE_Id
+ -- Obtain the hash value of key Edge
- function Present (LGE_Id : Library_Graph_Edge_Id) return Boolean;
+ function Present (Edge : Library_Graph_Edge_Id) return Boolean;
pragma Inline (Present);
- -- Determine whether library graph edge LGE_Id exists
+ -- Determine whether library graph edge Edge exists
+
+ package LGE_Lists is new Doubly_Linked_Lists
+ (Element_Type => Library_Graph_Edge_Id,
+ "=" => "=",
+ Destroy_Element => Destroy_Library_Graph_Edge);
+
+ package LGE_Sets is new Membership_Sets
+ (Element_Type => Library_Graph_Edge_Id,
+ "=" => "=",
+ Hash => Hash_Library_Graph_Edge);
--------------------------
-- Library graph vertex --
No_Library_Graph_Vertex + 1;
function Hash_Library_Graph_Vertex
- (LGV_Id : Library_Graph_Vertex_Id) return Bucket_Range_Type;
+ (Vertex : Library_Graph_Vertex_Id) return Bucket_Range_Type;
pragma Inline (Hash_Library_Graph_Vertex);
- -- Obtain the hash value of key LGV_Id
+ -- Obtain the hash value of key Vertex
- function Present (LGV_Id : Library_Graph_Vertex_Id) return Boolean;
+ function Present (Vertex : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (Present);
- -- Determine whether library graph vertex LGV_Id exists
+ -- Determine whether library graph vertex Vertex exists
+
+ package LGV_Sets is new Membership_Sets
+ (Element_Type => Library_Graph_Vertex_Id,
+ "=" => "=",
+ Hash => Hash_Library_Graph_Vertex);
-----------------------
-- Invocation_Graphs --
-- describes.
procedure Add_Vertex
- (G : Invocation_Graph;
- IC_Id : Invocation_Construct_Id;
- LGV_Id : Library_Graph_Vertex_Id);
+ (G : Invocation_Graph;
+ IC_Id : Invocation_Construct_Id;
+ Body_Vertex : Library_Graph_Vertex_Id;
+ Spec_Vertex : Library_Graph_Vertex_Id);
pragma Inline (Add_Vertex);
-- Create a new vertex in invocation graph G. IC_Id is the invocation
- -- construct the vertex describes. LGV_Id is the library graph vertex
- -- where the invocation construct appears.
+ -- construct the vertex describes. Body_Vertex denotes the library graph
+ -- vertex where the invocation construct's body is declared. Spec_Vertex
+ -- is the library graph vertex where the invocation construct's spec is
+ -- declared.
function Create
(Initial_Vertices : Positive;
-- Vertex attributes --
-----------------------
+ function Body_Vertex
+ (G : Invocation_Graph;
+ Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id;
+ pragma Inline (Body_Vertex);
+ -- Obtain the library graph vertex where the body of the invocation
+ -- construct represented by vertex Vertex of invocation graph G is
+ -- declared.
+
+ function Column
+ (G : Invocation_Graph;
+ Vertex : Invocation_Graph_Vertex_Id) return Nat;
+ pragma Inline (Column);
+ -- Obtain the column number where the invocation construct vertex Vertex
+ -- of invocation graph G describes.
+
function Construct
(G : Invocation_Graph;
- IGV_Id : Invocation_Graph_Vertex_Id) return Invocation_Construct_Id;
+ Vertex : Invocation_Graph_Vertex_Id) return Invocation_Construct_Id;
pragma Inline (Construct);
- -- Obtain the invocation construct vertex IGV_Id of invocation graph G
+ -- Obtain the invocation construct vertex Vertex of invocation graph G
-- describes.
function Corresponding_Vertex
-- Obtain the vertex of invocation graph G that corresponds to signature
-- IS_Id.
- function Lib_Vertex
+ function Line
(G : Invocation_Graph;
- IGV_Id : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id;
- pragma Inline (Lib_Vertex);
- -- Obtain the library graph vertex where vertex IGV_Id of invocation
- -- graph appears.
+ Vertex : Invocation_Graph_Vertex_Id) return Nat;
+ pragma Inline (Line);
+ -- Obtain the line number where the invocation construct vertex Vertex
+ -- of invocation graph G describes.
function Name
(G : Invocation_Graph;
- IGV_Id : Invocation_Graph_Vertex_Id) return Name_Id;
+ Vertex : Invocation_Graph_Vertex_Id) return Name_Id;
pragma Inline (Name);
- -- Obtain the name of the construct vertex IGV_Id of invocation graph G
+ -- Obtain the name of the construct vertex Vertex of invocation graph G
-- describes.
+ function Spec_Vertex
+ (G : Invocation_Graph;
+ Vertex : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id;
+ pragma Inline (Spec_Vertex);
+ -- Obtain the library graph vertex where the spec of the invocation
+ -- construct represented by vertex Vertex of invocation graph G is
+ -- declared.
+
---------------------
-- Edge attributes --
---------------------
+ function Extra
+ (G : Invocation_Graph;
+ Edge : Invocation_Graph_Edge_Id) return Name_Id;
+ pragma Inline (Extra);
+ -- Obtain the extra name used in error diagnostics of edge Edge of
+ -- invocation graph G.
+
function Kind
- (G : Invocation_Graph;
- IGE_Id : Invocation_Graph_Edge_Id) return Invocation_Kind;
+ (G : Invocation_Graph;
+ Edge : Invocation_Graph_Edge_Id) return Invocation_Kind;
pragma Inline (Kind);
- -- Obtain the nature of edge IGE_Id of invocation graph G
+ -- Obtain the nature of edge Edge of invocation graph G
function Relation
- (G : Invocation_Graph;
- IGE_Id : Invocation_Graph_Edge_Id) return Invocation_Relation_Id;
+ (G : Invocation_Graph;
+ Edge : Invocation_Graph_Edge_Id) return Invocation_Relation_Id;
pragma Inline (Relation);
- -- Obtain the relation edge IGE_Id of invocation graph G describes
+ -- Obtain the relation edge Edge of invocation graph G describes
function Target
- (G : Invocation_Graph;
- IGE_Id : Invocation_Graph_Edge_Id) return Invocation_Graph_Vertex_Id;
+ (G : Invocation_Graph;
+ Edge : Invocation_Graph_Edge_Id) return Invocation_Graph_Vertex_Id;
pragma Inline (Target);
- -- Obtain the target vertex edge IGE_Id of invocation graph G designates
+ -- Obtain the target vertex edge Edge of invocation graph G designates
----------------
-- Statistics --
function Number_Of_Edges_To_Targets
(G : Invocation_Graph;
- IGV_Id : Invocation_Graph_Vertex_Id) return Natural;
+ Vertex : Invocation_Graph_Vertex_Id) return Natural;
pragma Inline (Number_Of_Edges_To_Targets);
- -- Obtain the total number of edges to targets vertex IGV_Id of
+ -- Obtain the total number of edges to targets vertex Vertex of
-- invocation graph G has.
function Number_Of_Elaboration_Roots
-- Obtain an iterator over all edges of invocation graph G
procedure Next
- (Iter : in out All_Edge_Iterator;
- IGE_Id : out Invocation_Graph_Edge_Id);
+ (Iter : in out All_Edge_Iterator;
+ Edge : out Invocation_Graph_Edge_Id);
pragma Inline (Next);
-- Return the current edge referenced by iterator Iter and advance to
-- the next available edge.
procedure Next
(Iter : in out All_Vertex_Iterator;
- IGV_Id : out Invocation_Graph_Vertex_Id);
+ Vertex : out Invocation_Graph_Vertex_Id);
pragma Inline (Next);
-- Return the current vertex referenced by iterator Iter and advance
-- to the next available vertex.
function Iterate_Edges_To_Targets
(G : Invocation_Graph;
- IGV_Id : Invocation_Graph_Vertex_Id) return Edges_To_Targets_Iterator;
+ Vertex : Invocation_Graph_Vertex_Id) return Edges_To_Targets_Iterator;
pragma Inline (Iterate_Edges_To_Targets);
-- Obtain an iterator over all edges to targets with source vertex
- -- IGV_Id of invocation graph G.
+ -- Vertex of invocation graph G.
procedure Next
- (Iter : in out Edges_To_Targets_Iterator;
- IGE_Id : out Invocation_Graph_Edge_Id);
+ (Iter : in out Edges_To_Targets_Iterator;
+ Edge : out Invocation_Graph_Edge_Id);
pragma Inline (Next);
-- Return the current edge referenced by iterator Iter and advance to
-- the next available edge.
--------------
procedure Destroy_Invocation_Graph_Vertex
- (IGV_Id : in out Invocation_Graph_Vertex_Id);
+ (Vertex : in out Invocation_Graph_Vertex_Id);
pragma Inline (Destroy_Invocation_Graph_Vertex);
- -- Destroy invocation graph vertex IGV_Id
+ -- Destroy invocation graph vertex Vertex
-- The following type represents the attributes of an invocation graph
-- vertex.
type Invocation_Graph_Vertex_Attributes is record
+ Body_Vertex : Library_Graph_Vertex_Id := No_Library_Graph_Vertex;
+ -- Reference to the library graph vertex where the body of this
+ -- vertex resides.
+
Construct : Invocation_Construct_Id := No_Invocation_Construct;
-- Reference to the invocation construct this vertex represents
- Lib_Vertex : Library_Graph_Vertex_Id := No_Library_Graph_Vertex;
- -- Reference to the library graph vertex where this vertex resides
+ Spec_Vertex : Library_Graph_Vertex_Id := No_Library_Graph_Vertex;
+ -- Reference to the library graph vertex where the spec of this
+ -- vertex resides.
end record;
No_Invocation_Graph_Vertex_Attributes :
constant Invocation_Graph_Vertex_Attributes :=
- (Construct => No_Invocation_Construct,
- Lib_Vertex => No_Library_Graph_Vertex);
+ (Body_Vertex => No_Library_Graph_Vertex,
+ Construct => No_Invocation_Construct,
+ Spec_Vertex => No_Library_Graph_Vertex);
procedure Destroy_Invocation_Graph_Vertex_Attributes
(Attrs : in out Invocation_Graph_Vertex_Attributes);
pragma Inline (Destroy_Invocation_Graph_Vertex_Attributes);
-- Destroy the contents of attributes Attrs
- package VA is new Dynamic_Hash_Tables
+ package IGV_Tables is new Dynamic_Hash_Tables
(Key_Type => Invocation_Graph_Vertex_Id,
Value_Type => Invocation_Graph_Vertex_Attributes,
No_Value => No_Invocation_Graph_Vertex_Attributes,
-----------
procedure Destroy_Invocation_Graph_Edge
- (IGE_Id : in out Invocation_Graph_Edge_Id);
+ (Edge : in out Invocation_Graph_Edge_Id);
pragma Inline (Destroy_Invocation_Graph_Edge);
- -- Destroy invocation graph edge IGE_Id
+ -- Destroy invocation graph edge Edge
-- The following type represents the attributes of an invocation graph
-- edge.
pragma Inline (Destroy_Invocation_Graph_Edge_Attributes);
-- Destroy the contents of attributes Attrs
- package EA is new Dynamic_Hash_Tables
+ package IGE_Tables is new Dynamic_Hash_Tables
(Key_Type => Invocation_Graph_Edge_Id,
Value_Type => Invocation_Graph_Edge_Attributes,
No_Value => No_Invocation_Graph_Edge_Attributes,
pragma Inline (Hash_Source_Target_Relation);
-- Obtain the hash value of key Rel
- package ST is new Membership_Sets
+ package Relation_Sets is new Membership_Sets
(Element_Type => Source_Target_Relation,
"=" => "=",
Hash => Hash_Source_Target_Relation);
pragma Inline (Hash_Invocation_Signature);
-- Obtain the hash value of key IS_Id
- package SV is new Dynamic_Hash_Tables
+ package Signature_Tables is new Dynamic_Hash_Tables
(Key_Type => Invocation_Signature_Id,
Value_Type => Invocation_Graph_Vertex_Id,
No_Value => No_Invocation_Graph_Vertex,
-- Elaboration roots --
-----------------------
- package ER is new Membership_Sets
+ package IGV_Sets is new Membership_Sets
(Element_Type => Invocation_Graph_Vertex_Id,
"=" => "=",
Hash => Hash_Invocation_Graph_Vertex);
Counts : Invocation_Graph_Edge_Counts := (others => 0);
-- Edge statistics
- Edge_Attributes : EA.Dynamic_Hash_Table := EA.Nil;
+ Edge_Attributes : IGE_Tables.Dynamic_Hash_Table := IGE_Tables.Nil;
-- The map of edge -> edge attributes for all edges in the graph
Graph : DG.Directed_Graph := DG.Nil;
-- The underlying graph describing the relations between edges and
-- vertices.
- Relations : ST.Membership_Set := ST.Nil;
+ Relations : Relation_Sets.Membership_Set := Relation_Sets.Nil;
-- The set of relations between source and targets, used to prevent
-- duplicate edges in the graph.
- Roots : ER.Membership_Set := ER.Nil;
+ Roots : IGV_Sets.Membership_Set := IGV_Sets.Nil;
-- The set of elaboration root vertices
- Signature_To_Vertex : SV.Dynamic_Hash_Table := SV.Nil;
+ Signature_To_Vertex : Signature_Tables.Dynamic_Hash_Table :=
+ Signature_Tables.Nil;
-- The map of signature -> vertex
- Vertex_Attributes : VA.Dynamic_Hash_Table := VA.Nil;
+ Vertex_Attributes : IGV_Tables.Dynamic_Hash_Table := IGV_Tables.Nil;
-- The map of vertex -> vertex attributes for all vertices in the
-- graph.
end record;
type All_Edge_Iterator is new DG.All_Edge_Iterator;
type All_Vertex_Iterator is new DG.All_Vertex_Iterator;
type Edges_To_Targets_Iterator is new DG.Outgoing_Edge_Iterator;
- type Elaboration_Root_Iterator is new ER.Iterator;
+ type Elaboration_Root_Iterator is new IGV_Sets.Iterator;
end Invocation_Graphs;
--------------------
package Library_Graphs is
+ -- The following type represents the various kinds of library graph
+ -- cycles. The ordering of kinds is significant, where a literal with
+ -- lower ordinal has a higner precedence than one with higher ordinal.
+
+ type Library_Graph_Cycle_Kind is
+ (Elaborate_Body_Cycle,
+ -- A cycle that involves at least one spec-body pair, where the
+ -- spec is subject to pragma Elaborate_Body. This is the highest
+ -- precedence cycle.
+
+ Elaborate_Cycle,
+ -- A cycle that involves at least one Elaborate edge
+
+ Elaborate_All_Cycle,
+ -- A cycle that involves at least one Elaborate_All edge
+
+ Forced_Cycle,
+ -- A cycle that involves at least one edge which is a byproduct of
+ -- the forced-elaboration-order file.
+
+ Invocation_Cycle,
+ -- A cycle that involves at least one invocation edge. This is the
+ -- lowest precedence cycle.
+
+ No_Cycle_Kind);
+
-- The following type represents the various kinds of library edges
type Library_Graph_Edge_Kind is
-- describes.
function Create
- (Initial_Vertices : Positive;
- Initial_Edges : Positive) return Library_Graph;
+ (Initial_Vertices : Positive;
+ Initial_Edges : Positive;
+ Dynamically_Elaborated : Boolean) return Library_Graph;
pragma Inline (Create);
-- Create a new empty graph with vertex capacity Initial_Vertices and
- -- edge capacity Initial_Edges.
+ -- edge capacity Initial_Edges. Flag Dynamically_Elaborated must be set
+ -- when the main library unit was compiled using the dynamic model.
procedure Destroy (G : in out Library_Graph);
pragma Inline (Destroy);
pragma Inline (Find_Components);
-- Find all components in library graph G
+ procedure Find_Cycles (G : Library_Graph);
+ pragma Inline (Find_Cycles);
+ -- Find all cycles in library graph G
+
+ function Highest_Precedence_Cycle
+ (G : Library_Graph) return Library_Graph_Cycle_Id;
+ pragma Inline (Highest_Precedence_Cycle);
+ -- Obtain the cycle with highest precedence among all other cycles of
+ -- library graph G.
+
function Present (G : Library_Graph) return Boolean;
pragma Inline (Present);
-- Determine whether library graph G exists
function Component
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Component_Id;
+ Vertex : Library_Graph_Vertex_Id) return Component_Id;
pragma Inline (Component);
- -- Obtain the component where vertex LGV_Id of library graph G resides
+ -- Obtain the component where vertex Vertex of library graph G resides
function Corresponding_Item
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id;
+ Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id;
pragma Inline (Corresponding_Item);
-- Obtain the complementary vertex which represents the corresponding
- -- spec or body of vertex LGV_Id of library graph G.
+ -- spec or body of vertex Vertex of library graph G.
function Corresponding_Vertex
(G : Library_Graph;
procedure Decrement_Pending_Predecessors
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id);
+ Vertex : Library_Graph_Vertex_Id);
pragma Inline (Decrement_Pending_Predecessors);
- -- Decrease the number of pending predecessors vertex LGV_Id of library
+ -- Decrease the number of pending predecessors vertex Vertex of library
-- graph G must wait on until it can be elaborated.
+ function File_Name
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id) return File_Name_Type;
+ pragma Inline (File_Name);
+ -- Obtain the name of the file where vertex Vertex of library graph G
+ -- resides.
+
function In_Elaboration_Order
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Boolean;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (In_Elaboration_Order);
- -- Determine whether vertex LGV_Id of library graph G is already in some
+ -- Determine whether vertex Vertex of library graph G is already in some
-- elaboration order.
+ function Invocation_Graph_Encoding
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id)
+ return Invocation_Graph_Encoding_Kind;
+ pragma Inline (Invocation_Graph_Encoding);
+ -- Obtain the encoding format used to capture information related to
+ -- invocation vertices and edges that reside within vertex Vertex of
+ -- library graph G.
+
function Name
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Unit_Name_Type;
+ Vertex : Library_Graph_Vertex_Id) return Unit_Name_Type;
pragma Inline (Name);
- -- Obtain the name of the unit which vertex LGV_Id of library graph G
+ -- Obtain the name of the unit which vertex Vertex of library graph G
-- represents.
function Pending_Predecessors
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Natural;
+ Vertex : Library_Graph_Vertex_Id) return Natural;
pragma Inline (Pending_Predecessors);
- -- Obtain the number of pending predecessors vertex LGV_Id of library
+ -- Obtain the number of pending predecessors vertex Vertex of library
-- graph G must wait on until it can be elaborated.
procedure Set_Corresponding_Item
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id;
+ Vertex : Library_Graph_Vertex_Id;
Val : Library_Graph_Vertex_Id);
pragma Inline (Set_Corresponding_Item);
-- Set the complementary vertex which represents the corresponding
- -- spec or body of vertex LGV_Id of library graph G to value Val.
+ -- spec or body of vertex Vertex of library graph G to value Val.
procedure Set_In_Elaboration_Order
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id;
+ Vertex : Library_Graph_Vertex_Id;
Val : Boolean := True);
pragma Inline (Set_In_Elaboration_Order);
- -- Mark vertex LGV_Id of library graph G as included in some elaboration
+ -- Mark vertex Vertex of library graph G as included in some elaboration
-- order depending on value Val.
function Unit
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Unit_Id;
+ Vertex : Library_Graph_Vertex_Id) return Unit_Id;
pragma Inline (Unit);
- -- Obtain the unit vertex LGV_Id of library graph G represents
+ -- Obtain the unit vertex Vertex of library graph G represents
---------------------
-- Edge attributes --
---------------------
function Kind
- (G : Library_Graph;
- LGE_Id : Library_Graph_Edge_Id) return Library_Graph_Edge_Kind;
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Library_Graph_Edge_Kind;
pragma Inline (Kind);
- -- Obtain the nature of edge LGE_Id of library graph G
+ -- Obtain the nature of edge Edge of library graph G
function Predecessor
- (G : Library_Graph;
- LGE_Id : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id;
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id;
pragma Inline (Predecessor);
- -- Obtain the predecessor vertex of edge LGE_Id of library graph G
+ -- Obtain the predecessor vertex of edge Edge of library graph G
function Successor
- (G : Library_Graph;
- LGE_Id : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id;
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id;
pragma Inline (Successor);
- -- Obtain the successor vertex of edge LGE_Id of library graph G
+ -- Obtain the successor vertex of edge Edge of library graph G
--------------------------
-- Component attributes --
-- Obtain the number of pending predecessors component Comp of library
-- graph G must wait on until it can be elaborated.
+ ----------------------
+ -- Cycle attributes --
+ ----------------------
+
+ function Invocation_Edge_Count
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id) return Natural;
+ pragma Inline (Invocation_Edge_Count);
+ -- Obtain the number of invocation edges in cycle Cycle of library
+ -- graph G.
+
+ function Kind
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id) return Library_Graph_Cycle_Kind;
+ pragma Inline (Kind);
+ -- Obtain the nature of cycle Cycle of library graph G
+
+ function Length
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id) return Natural;
+ pragma Inline (Length);
+ -- Obtain the length of cycle Cycle of library graph G
+
---------------
-- Semantics --
---------------
+ function Has_Elaborate_All_Cycle (G : Library_Graph) return Boolean;
+ pragma Inline (Has_Elaborate_All_Cycle);
+ -- Determine whether library graph G contains a cycle involving pragma
+ -- Elaborate_All.
+
+ function In_Same_Component
+ (G : Library_Graph;
+ Left : Library_Graph_Vertex_Id;
+ Right : Library_Graph_Vertex_Id) return Boolean;
+ pragma Inline (In_Same_Component);
+ -- Determine whether vertices Left and Right of library graph G reside
+ -- in the same component.
+
function Is_Body
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Boolean;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (Is_Body);
- -- Determine whether vertex LGV_Id of library graph G denotes a body
+ -- Determine whether vertex Vertex of library graph G denotes a body
function Is_Body_Of_Spec_With_Elaborate_Body
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Boolean;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (Is_Body_Of_Spec_With_Elaborate_Body);
- -- Determine whether vertex LGV_Id of library graph G denotes a body
+ -- Determine whether vertex Vertex of library graph G denotes a body
-- with a corresponding spec, and the spec has pragma Elaborate_Body.
function Is_Body_With_Spec
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Boolean;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (Is_Body_With_Spec);
- -- Determine whether vertex LGV_Id of library graph G denotes a body
+ -- Determine whether vertex Vertex of library graph G denotes a body
-- with a corresponding spec.
+ function Is_Dynamically_Elaborated (G : Library_Graph) return Boolean;
+ pragma Inline (Is_Dynamically_Elaborated);
+ -- Determine whether library graph G was created from a set of units
+ -- where the main library unit was compiled using the dynamic model.
+
function Is_Elaborable_Component
(G : Library_Graph;
Comp : Component_Id) return Boolean;
function Is_Elaborable_Vertex
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Boolean;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (Is_Elaborable_Vertex);
- -- Determine whether vertex LGV_Id of library graph G can be elaborated
+ -- Determine whether vertex Vertex of library graph G can be elaborated
+
+ function Is_Elaborate_All_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean;
+ pragma Inline (Is_Elaborate_All_Edge);
+ -- Determine whether edge Edge of library graph G is an edge whose
+ -- predecessor is subject to pragma Elaborate_All.
+
+ function Is_Elaborate_Body_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean;
+ pragma Inline (Is_Elaborate_Body_Edge);
+ -- Determine whether edge Edge of library graph G has a successor
+ -- that is either a spec subject to pragma Elaborate_Body, or a body
+ -- that completes such a spec.
+
+ function Is_Elaborate_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean;
+ pragma Inline (Is_Elaborate_Edge);
+ -- Determine whether edge Edge of library graph G is an edge whose
+ -- predecessor is subject to pragma Elaborate.
+
+ function Is_Forced_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean;
+ pragma Inline (Is_Forced_Edge);
+ -- Determine whether edge Edge of library graph G is a byproduct of the
+ -- forced-elaboration-order file.
function Is_Internal_Unit
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Boolean;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (Is_Internal_Unit);
- -- Determine whether vertex LGV_Id of library graph G denotes an
+ -- Determine whether vertex Vertex of library graph G denotes an
-- internal unit.
+ function Is_Invocation_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean;
+ pragma Inline (Is_Invocation_Edge);
+ -- Determine whether edge Edge of library graph G came from the
+ -- traversal of the invocation graph.
+
function Is_Predefined_Unit
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Boolean;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (Is_Predefined_Unit);
- -- Determine whether vertex LGV_Id of library graph G denotes a
+ -- Determine whether vertex Vertex of library graph G denotes a
-- predefined unit.
function Is_Preelaborated_Unit
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Boolean;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (Is_Preelaborated_Unit);
- -- Determine whether vertex LGV_Id of library graph G denotes a unit
+ -- Determine whether vertex Vertex of library graph G denotes a unit
-- subjec to pragma Pure or Preelaborable.
function Is_Spec
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Boolean;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (Is_Spec);
- -- Determine whether vertex LGV_Id of library graph G denotes a spec
+ -- Determine whether vertex Vertex of library graph G denotes a spec
function Is_Spec_With_Body
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Boolean;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (Is_Spec_With_Body);
- -- Determine whether vertex LGV_Id of library graph G denotes a spec
+ -- Determine whether vertex Vertex of library graph G denotes a spec
-- with a corresponding body.
function Is_Spec_With_Elaborate_Body
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Boolean;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (Is_Spec_With_Elaborate_Body);
- -- Determine whether vertex LGV_Id of library graph G denotes a spec
+ -- Determine whether vertex Vertex of library graph G denotes a spec
-- with a corresponding body, and is subject to pragma Elaborate_Body.
- function Links_Vertices_In_Same_Component
- (G : Library_Graph;
- LGE_Id : Library_Graph_Edge_Id) return Boolean;
- pragma Inline (Links_Vertices_In_Same_Component);
- -- Determine whether edge LGE_Id of library graph G links a predecessor
- -- and a successor that reside within the same component.
+ function Is_With_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) return Boolean;
+ pragma Inline (Is_With_Edge);
+ -- Determine whether edge Edge of library graph G is the result of a
+ -- with dependency between its successor and predecessor.
function Needs_Elaboration
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Boolean;
+ Vertex : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (Needs_Elaboration);
- -- Determine whether vertex LGV_Id of library graph G represents a unit
+ -- Determine whether vertex Vertex of library graph G represents a unit
-- that needs to be elaborated.
function Proper_Body
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id;
+ Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id;
pragma Inline (Proper_Body);
- -- Obtain the body of vertex LGV_Id of library graph G
+ -- Obtain the body of vertex Vertex of library graph G
function Proper_Spec
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id;
+ Vertex : Library_Graph_Vertex_Id) return Library_Graph_Vertex_Id;
pragma Inline (Proper_Spec);
- -- Obtain the spec of vertex LGV_Id of library graph G
+ -- Obtain the spec of vertex Vertex of library graph G
----------------
-- Statistics --
pragma Inline (Number_Of_Components);
-- Obtain the total number of components in library graph G
+ function Number_Of_Cycles (G : Library_Graph) return Natural;
+ pragma Inline (Number_Of_Cycles);
+ -- Obtain the total number of cycles in library graph G
+
function Number_Of_Edges (G : Library_Graph) return Natural;
pragma Inline (Number_Of_Edges);
-- Obtain the total number of edges in library graph G
function Number_Of_Edges_To_Successors
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Natural;
+ Vertex : Library_Graph_Vertex_Id) return Natural;
pragma Inline (Number_Of_Edges_To_Successors);
- -- Obtain the total number of edges to successors vertex LGV_Id of
+ -- Obtain the total number of edges to successors vertex Vertex of
-- library graph G has.
function Number_Of_Vertices (G : Library_Graph) return Natural;
-- Iterators --
---------------
+ -- The following type represents an iterator over all cycles of a
+ -- library graph.
+
+ type All_Cycle_Iterator is private;
+
+ function Has_Next (Iter : All_Cycle_Iterator) return Boolean;
+ pragma Inline (Has_Next);
+ -- Determine whether iterator Iter has more cycles to examine
+
+ function Iterate_All_Cycles
+ (G : Library_Graph) return All_Cycle_Iterator;
+ pragma Inline (Iterate_All_Cycles);
+ -- Obtain an iterator over all cycles of library graph G
+
+ procedure Next
+ (Iter : in out All_Cycle_Iterator;
+ Cycle : out Library_Graph_Cycle_Id);
+ pragma Inline (Next);
+ -- Return the current cycle referenced by iterator Iter and advance to
+ -- the next available cycle.
+
-- The following type represents an iterator over all edges of a library
-- graph.
-- Obtain an iterator over all edges of library graph G
procedure Next
- (Iter : in out All_Edge_Iterator;
- LGE_Id : out Library_Graph_Edge_Id);
+ (Iter : in out All_Edge_Iterator;
+ Edge : out Library_Graph_Edge_Id);
pragma Inline (Next);
-- Return the current edge referenced by iterator Iter and advance to
-- the next available edge.
procedure Next
(Iter : in out All_Vertex_Iterator;
- LGV_Id : out Library_Graph_Vertex_Id);
+ Vertex : out Library_Graph_Vertex_Id);
pragma Inline (Next);
-- Return the current vertex referenced by iterator Iter and advance
-- to the next available vertex.
procedure Next
(Iter : in out Component_Vertex_Iterator;
- LGV_Id : out Library_Graph_Vertex_Id);
+ Vertex : out Library_Graph_Vertex_Id);
pragma Inline (Next);
-- Return the current vertex referenced by iterator Iter and advance
-- to the next available vertex.
+ -- The following type represents an iterator over all edges that form a
+ -- cycle.
+
+ type Edges_Of_Cycle_Iterator is private;
+
+ function Has_Next (Iter : Edges_Of_Cycle_Iterator) return Boolean;
+ pragma Inline (Has_Next);
+ -- Determine whether iterator Iter has more edges to examine
+
+ function Iterate_Edges_Of_Cycle
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id) return Edges_Of_Cycle_Iterator;
+ pragma Inline (Iterate_Edges_Of_Cycle);
+ -- Obtain an iterator over all edges that form cycle Cycle of library
+ -- graph G.
+
+ procedure Next
+ (Iter : in out Edges_Of_Cycle_Iterator;
+ Edge : out Library_Graph_Edge_Id);
+ pragma Inline (Next);
+ -- Return the current edge referenced by iterator Iter and advance to
+ -- the next available edge.
+
-- The following type represents an iterator over all edges that reach
-- successors starting from a particular predecessor vertex.
function Iterate_Edges_To_Successors
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) return Edges_To_Successors_Iterator;
+ Vertex : Library_Graph_Vertex_Id) return Edges_To_Successors_Iterator;
pragma Inline (Iterate_Components);
-- Obtain an iterator over all edges to successors with predecessor
- -- vertex LGV_Id of library graph G.
+ -- vertex Vertex of library graph G.
procedure Next
- (Iter : in out Edges_To_Successors_Iterator;
- LGE_Id : out Library_Graph_Edge_Id);
+ (Iter : in out Edges_To_Successors_Iterator;
+ Edge : out Library_Graph_Edge_Id);
pragma Inline (Next);
-- Return the current edge referenced by iterator Iter and advance to
-- the next available edge.
--------------
procedure Destroy_Library_Graph_Vertex
- (LGV_Id : in out Library_Graph_Vertex_Id);
+ (Vertex : in out Library_Graph_Vertex_Id);
pragma Inline (Destroy_Library_Graph_Vertex);
- -- Destroy library graph vertex LGV_Id
+ -- Destroy library graph vertex Vertex
-- The following type represents the attributes of a library graph
-- vertex.
pragma Inline (Destroy_Library_Graph_Vertex_Attributes);
-- Destroy the contents of attributes Attrs
- package VA is new Dynamic_Hash_Tables
+ package LGV_Tables is new Dynamic_Hash_Tables
(Key_Type => Library_Graph_Vertex_Id,
Value_Type => Library_Graph_Vertex_Attributes,
No_Value => No_Library_Graph_Vertex_Attributes,
-- Edges --
-----------
- procedure Destroy_Library_Graph_Edge
- (LGE_Id : in out Library_Graph_Edge_Id);
- pragma Inline (Destroy_Library_Graph_Edge);
- -- Destroy library graph edge LGE_Id
-
-- The following type represents the attributes of a library graph edge
type Library_Graph_Edge_Attributes is record
pragma Inline (Destroy_Library_Graph_Edge_Attributes);
-- Destroy the contents of attributes Attrs
- package EA is new Dynamic_Hash_Tables
+ package LGE_Tables is new Dynamic_Hash_Tables
(Key_Type => Library_Graph_Edge_Id,
Value_Type => Library_Graph_Edge_Attributes,
No_Value => No_Library_Graph_Edge_Attributes,
pragma Inline (Destroy_Component_Attributes);
-- Destroy the contents of attributes Attrs
- package CA is new Dynamic_Hash_Tables
+ package Component_Tables is new Dynamic_Hash_Tables
(Key_Type => Component_Id,
Value_Type => Component_Attributes,
No_Value => No_Component_Attributes,
Destroy_Value => Destroy_Component_Attributes,
Hash => Hash_Component);
- ---------------
- -- Relations --
- ---------------
+ ------------
+ -- Cycles --
+ ------------
+
+ -- The following type represents the attributes of a cycle
+
+ type Library_Graph_Cycle_Attributes is record
+ Invocation_Edge_Count : Natural := 0;
+ -- The number of invocation edges within the cycle
+
+ Kind : Library_Graph_Cycle_Kind := No_Cycle_Kind;
+ -- The nature of the cycle
+
+ Path : LGE_Lists.Doubly_Linked_List := LGE_Lists.Nil;
+ -- The path of edges that form the cycle
+ end record;
+
+ No_Library_Graph_Cycle_Attributes :
+ constant Library_Graph_Cycle_Attributes :=
+ (Invocation_Edge_Count => 0,
+ Kind => No_Cycle_Kind,
+ Path => LGE_Lists.Nil);
+
+ procedure Destroy_Library_Graph_Cycle_Attributes
+ (Attrs : in out Library_Graph_Cycle_Attributes);
+ pragma Inline (Destroy_Library_Graph_Cycle_Attributes);
+ -- Destroy the contents of attributes Attrs
+
+ function Hash_Library_Graph_Cycle_Attributes
+ (Attrs : Library_Graph_Cycle_Attributes) return Bucket_Range_Type;
+ pragma Inline (Hash_Library_Graph_Cycle_Attributes);
+ -- Obtain the hash of key Attrs
+
+ function Same_Library_Graph_Cycle_Attributes
+ (Left : Library_Graph_Cycle_Attributes;
+ Right : Library_Graph_Cycle_Attributes) return Boolean;
+ pragma Inline (Same_Library_Graph_Cycle_Attributes);
+ -- Determine whether cycle attributes Left and Right are the same
+
+ package LGC_Tables is new Dynamic_Hash_Tables
+ (Key_Type => Library_Graph_Cycle_Id,
+ Value_Type => Library_Graph_Cycle_Attributes,
+ No_Value => No_Library_Graph_Cycle_Attributes,
+ Expansion_Threshold => 1.5,
+ Expansion_Factor => 2,
+ Compression_Threshold => 0.3,
+ Compression_Factor => 2,
+ "=" => "=",
+ Destroy_Value => Destroy_Library_Graph_Cycle_Attributes,
+ Hash => Hash_Library_Graph_Cycle);
+
+ ---------------------
+ -- Recorded cycles --
+ ---------------------
+
+ package RC_Sets is new Membership_Sets
+ (Element_Type => Library_Graph_Cycle_Attributes,
+ "=" => Same_Library_Graph_Cycle_Attributes,
+ Hash => Hash_Library_Graph_Cycle_Attributes);
+
+ --------------------
+ -- Recorded edges --
+ --------------------
-- The following type represents a relation between a predecessor and
-- successor vertices.
pragma Inline (Hash_Predecessor_Successor_Relation);
-- Obtain the hash value of key Rel
- package PS is new Membership_Sets
+ package RE_Sets is new Membership_Sets
(Element_Type => Predecessor_Successor_Relation,
"=" => "=",
Hash => Hash_Predecessor_Successor_Relation);
-- Units --
-----------
- package UV is new Dynamic_Hash_Tables
+ package Unit_Tables is new Dynamic_Hash_Tables
(Key_Type => Unit_Id,
Value_Type => Library_Graph_Vertex_Id,
No_Value => No_Library_Graph_Vertex,
-- The following type represents the attributes of a library graph
type Library_Graph_Attributes is record
- Component_Attributes : CA.Dynamic_Hash_Table := CA.Nil;
+ Component_Attributes : Component_Tables.Dynamic_Hash_Table :=
+ Component_Tables.Nil;
-- The map of component -> component attributes for all components in
-- the graph.
Counts : Library_Graph_Edge_Counts := (others => 0);
-- Edge statistics
- Edge_Attributes : EA.Dynamic_Hash_Table := EA.Nil;
+ Cycle_Attributes : LGC_Tables.Dynamic_Hash_Table := LGC_Tables.Nil;
+ -- The map of cycle -> cycle attributes for all cycles in the graph
+
+ Cycles : LGC_Lists.Doubly_Linked_List := LGC_Lists.Nil;
+ -- The list of all cycles in the graph, sorted based on precedence
+
+ Dynamically_Elaborated : Boolean := False;
+ -- Set when the main library unit was compiled using the dynamic
+ -- model.
+
+ Edge_Attributes : LGE_Tables.Dynamic_Hash_Table := LGE_Tables.Nil;
-- The map of edge -> edge attributes for all edges in the graph
Graph : DG.Directed_Graph := DG.Nil;
-- The underlying graph describing the relations between edges and
-- vertices.
- Relations : PS.Membership_Set := PS.Nil;
- -- The set of relations between successors and predecessors, used to
- -- prevent duplicate edges in the graph.
+ Recorded_Cycles : RC_Sets.Membership_Set := RC_Sets.Nil;
+ -- The set of recorded cycles, used to prevent duplicate cycles in
+ -- the graph.
+
+ Recorded_Edges : RE_Sets.Membership_Set := RE_Sets.Nil;
+ -- The set of recorded edges, used to prevent duplicate edges in the
+ -- graph.
- Unit_To_Vertex : UV.Dynamic_Hash_Table := UV.Nil;
+ Unit_To_Vertex : Unit_Tables.Dynamic_Hash_Table := Unit_Tables.Nil;
-- The map of unit -> vertex
- Vertex_Attributes : VA.Dynamic_Hash_Table := VA.Nil;
+ Vertex_Attributes : LGV_Tables.Dynamic_Hash_Table := LGV_Tables.Nil;
-- The map of vertex -> vertex attributes for all vertices in the
-- graph.
end record;
-- Iterators --
---------------
+ type All_Cycle_Iterator is new LGC_Lists.Iterator;
type All_Edge_Iterator is new DG.All_Edge_Iterator;
type All_Vertex_Iterator is new DG.All_Vertex_Iterator;
type Component_Iterator is new DG.Component_Iterator;
type Component_Vertex_Iterator is new DG.Component_Vertex_Iterator;
+ type Edges_Of_Cycle_Iterator is new LGE_Lists.Iterator;
type Edges_To_Successors_Iterator is new DG.Outgoing_Edge_Iterator;
end Library_Graphs;
-- Signature set --
-------------------
- package SS is new Membership_Sets
+ package Signature_Sets is new Membership_Sets
(Element_Type => Invocation_Signature_Id,
"=" => "=",
Hash => Hash_Invocation_Signature);
-- The following set stores all invocation signatures that appear in
-- elaborable units.
- Elaborable_Constructs : SS.Membership_Set := SS.Nil;
+ Elaborable_Constructs : Signature_Sets.Membership_Set := Signature_Sets.Nil;
-- The following set stores all units the need to be elaborated
- Elaborable_Units : US.Membership_Set := US.Nil;
+ -- Kirchev
+
+ Elaborable_Units : Unit_Sets.Membership_Set := Unit_Sets.Nil;
-----------------------
-- Local subprograms --
return Corresponding_Unit (Name_Id (UNam));
end Corresponding_Unit;
+ ---------------
+ -- File_Name --
+ ---------------
+
+ function File_Name (U_Id : Unit_Id) return File_Name_Type is
+ pragma Assert (Present (U_Id));
+
+ U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
+
+ begin
+ return U_Rec.Sfile;
+ end File_Name;
+
--------------------
-- Finalize_Units --
--------------------
procedure Finalize_Units is
begin
- SS.Destroy (Elaborable_Constructs);
- US.Destroy (Elaborable_Units);
+ Signature_Sets.Destroy (Elaborable_Constructs);
+ Unit_Sets.Destroy (Elaborable_Units);
end Finalize_Units;
------------------------------
function Has_Next (Iter : Elaborable_Units_Iterator) return Boolean is
begin
- return US.Has_Next (US.Iterator (Iter));
+ return Unit_Sets.Has_Next (Unit_Sets.Iterator (Iter));
end Has_Next;
-------------------------------
procedure Initialize_Units is
begin
- Elaborable_Constructs := SS.Create (Number_Of_Units);
- Elaborable_Units := US.Create (Number_Of_Units);
+ Elaborable_Constructs := Signature_Sets.Create (Number_Of_Units);
+ Elaborable_Units := Unit_Sets.Create (Number_Of_Units);
end Initialize_Units;
+ -------------------------------
+ -- Invocation_Graph_Encoding --
+ -------------------------------
+
+ function Invocation_Graph_Encoding
+ (U_Id : Unit_Id) return Invocation_Graph_Encoding_Kind
+ is
+ pragma Assert (Present (U_Id));
+
+ U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
+
+ begin
+ return U_Rec.Invocation_Graph_Encoding;
+ end Invocation_Graph_Encoding;
+
-------------------------------
-- Is_Dynamically_Elaborated --
-------------------------------
function Iterate_Elaborable_Units return Elaborable_Units_Iterator is
begin
- return Elaborable_Units_Iterator (US.Iterate (Elaborable_Units));
+ return Elaborable_Units_Iterator (Unit_Sets.Iterate (Elaborable_Units));
end Iterate_Elaborable_Units;
----------
begin
pragma Assert (Present (IS_Id));
- return SS.Contains (Elaborable_Constructs, IS_Id);
+ return Signature_Sets.Contains (Elaborable_Constructs, IS_Id);
end Needs_Elaboration;
-----------------------
begin
pragma Assert (Present (U_Id));
- return US.Contains (Elaborable_Units, U_Id);
+ return Unit_Sets.Contains (Elaborable_Units, U_Id);
end Needs_Elaboration;
----------
U_Id : out Unit_Id)
is
begin
- US.Next (US.Iterator (Iter), U_Id);
+ Unit_Sets.Next (Unit_Sets.Iterator (Iter), U_Id);
end Next;
--------------------------------
function Number_Of_Elaborable_Units return Natural is
begin
- return US.Size (Elaborable_Units);
+ return Unit_Sets.Size (Elaborable_Units);
end Number_Of_Elaborable_Units;
---------------------
procedure Process_Invocation_Construct (IC_Id : Invocation_Construct_Id) is
pragma Assert (Present (IC_Id));
- IC_Rec : Invocation_Construct_Record renames
- Invocation_Constructs.Table (IC_Id);
- IC_Sig : constant Invocation_Signature_Id := IC_Rec.Signature;
+ IS_Id : constant Invocation_Signature_Id := Signature (IC_Id);
- pragma Assert (Present (IC_Sig));
+ pragma Assert (Present (IS_Id));
begin
- SS.Insert (Elaborable_Constructs, IC_Sig);
+ Signature_Sets.Insert (Elaborable_Constructs, IS_Id);
end Process_Invocation_Construct;
-----------------------------------
-- signatures of constructs it declares.
else
- US.Insert (Elaborable_Units, U_Id);
+ Unit_Sets.Insert (Elaborable_Units, U_Id);
Process_Invocation_Constructs (U_Id);
end if;
end Process_Unit;
package Bindo.Units is
+ ---------------
+ -- Unit sets --
+ ---------------
+
+ function Hash_Unit (U_Id : Unit_Id) return Bucket_Range_Type;
+ pragma Inline (Hash_Unit);
+ -- Obtain the hash value of key U_Id
+
+ package Unit_Sets is new Membership_Sets
+ (Element_Type => Unit_Id,
+ "=" => "=",
+ Hash => Hash_Unit);
+
procedure Collect_Elaborable_Units;
pragma Inline (Collect_Elaborable_Units);
-- Gather all units in the bind that require elaboration. The units are
pragma Inline (Corresponding_Unit);
-- Obtain the unit which corresponds to name FNam
+ function File_Name (U_Id : Unit_Id) return File_Name_Type;
+ pragma Inline (File_Name);
+ -- Obtain the file name of unit U_Id
+
type Unit_Processor_Ptr is access procedure (U_Id : Unit_Id);
procedure For_Each_Elaborable_Unit (Processor : Unit_Processor_Ptr);
pragma Inline (Hash_Invocation_Signature);
-- Obtain the hash value of key IS_Id
- function Hash_Unit (U_Id : Unit_Id) return Bucket_Range_Type;
- pragma Inline (Hash_Unit);
- -- Obtain the hash value of key U_Id
+ function Invocation_Graph_Encoding
+ (U_Id : Unit_Id) return Invocation_Graph_Encoding_Kind;
+ pragma Inline (Invocation_Graph_Encoding);
+ -- Obtain the encoding format used to capture invocation constructs and
+ -- relations in the ALI file of unit U_Id.
function Is_Dynamically_Elaborated (U_Id : Unit_Id) return Boolean;
pragma Inline (Is_Dynamically_Elaborated);
-- Initialize the internal structures of this unit
private
- package US is new Membership_Sets
- (Element_Type => Unit_Id,
- "=" => "=",
- Hash => Hash_Unit);
-
- type Elaborable_Units_Iterator is new US.Iterator;
+ type Elaborable_Units_Iterator is new Unit_Sets.Iterator;
end Bindo.Units;
with Bindo.Units; use Bindo.Units;
-with GNAT; use GNAT;
-with GNAT.Sets; use GNAT.Sets;
-
package body Bindo.Validators is
+ -----------------------
+ -- Local subprograms --
+ -----------------------
+
+ procedure Write_Error
+ (Msg : String;
+ Flag : out Boolean);
+ pragma Inline (Write_Error);
+ -- Write error message Msg to standard output and set flag Flag to True
+
+ ----------------------
+ -- Cycle_Validators --
+ ----------------------
+
+ package body Cycle_Validators is
+ Has_Invalid_Cycle : Boolean := False;
+ -- Flag set when the library graph contains an invalid cycle
+
+ -----------------------
+ -- Local subprograms --
+ -----------------------
+
+ procedure Validate_Cycle
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id);
+ pragma Inline (Validate_Cycle);
+ -- Ensure that a cycle meets the following requirements:
+ --
+ -- * Is of proper kind
+ -- * Has enough edges to form a circuit
+ -- * No edge is repeated
+
+ procedure Validate_Cycle_Path
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id);
+ pragma Inline (Validate_Cycle_Path);
+ -- Ensure that the path of a cycle meets the following requirements:
+ --
+ -- * No edge is repeated
+
+ --------------------
+ -- Validate_Cycle --
+ --------------------
+
+ procedure Validate_Cycle
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id)
+ is
+ Msg : constant String := "Validate_Cycle";
+
+ begin
+ pragma Assert (Present (G));
+
+ if not Present (Cycle) then
+ Write_Error (Msg, Has_Invalid_Cycle);
+
+ Write_Str (" empty cycle");
+ Write_Eol;
+ Write_Eol;
+ return;
+ end if;
+
+ if Kind (G, Cycle) = No_Cycle_Kind then
+ Write_Error (Msg, Has_Invalid_Cycle);
+
+ Write_Str (" cycle (LGC_Id_");
+ Write_Int (Int (Cycle));
+ Write_Str (") is a No_Cycle");
+ Write_Eol;
+ Write_Eol;
+ end if;
+
+ -- A cycle requires at least one edge (self cycle) to form a circuit
+
+ if Length (G, Cycle) < 1 then
+ Write_Error (Msg, Has_Invalid_Cycle);
+
+ Write_Str (" cycle (LGC_Id_");
+ Write_Int (Int (Cycle));
+ Write_Str (") does not contain enough edges");
+ Write_Eol;
+ Write_Eol;
+ end if;
+
+ Validate_Cycle_Path (G, Cycle);
+ end Validate_Cycle;
+
+ -------------------------
+ -- Validate_Cycle_Path --
+ -------------------------
+
+ procedure Validate_Cycle_Path
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id)
+ is
+ Msg : constant String := "Validate_Cycle_Path";
+
+ Edge : Library_Graph_Edge_Id;
+ Edges : LGE_Sets.Membership_Set;
+ Iter : Edges_Of_Cycle_Iterator;
+
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Cycle));
+
+ -- Use a set to detect duplicate edges while traversing the cycle
+
+ Edges := LGE_Sets.Create (Length (G, Cycle));
+
+ -- Inspect the edges of the cucle, trying to catch duplicates
+
+ Iter := Iterate_Edges_Of_Cycle (G, Cycle);
+ while Has_Next (Iter) loop
+ Next (Iter, Edge);
+
+ -- The current edge has already been encountered while traversing
+ -- the cycle. This indicates that the cycle is malformed as edges
+ -- are not repeated in the circuit.
+
+ if LGE_Sets.Contains (Edges, Edge) then
+ Write_Error (Msg, Has_Invalid_Cycle);
+
+ Write_Str (" library graph edge (LGE_Id_");
+ Write_Int (Int (Edge));
+ Write_Str (") is repeaded in cycle (LGC_Id_");
+ Write_Int (Int (Cycle));
+ Write_Str (")");
+ Write_Eol;
+
+ -- Otherwise add the current edge to the set of encountered edges
+
+ else
+ LGE_Sets.Insert (Edges, Edge);
+ end if;
+ end loop;
+
+ LGE_Sets.Destroy (Edges);
+ end Validate_Cycle_Path;
+
+ ---------------------
+ -- Validate_Cycles --
+ ---------------------
+
+ procedure Validate_Cycles (G : Library_Graph) is
+ Cycle : Library_Graph_Cycle_Id;
+ Iter : All_Cycle_Iterator;
+
+ begin
+ pragma Assert (Present (G));
+
+ -- Nothing to do when switch -d_V (validate bindo cycles, graphs, and
+ -- order) is not in effect.
+
+ if not Debug_Flag_Underscore_VV then
+ return;
+ end if;
+
+ Iter := Iterate_All_Cycles (G);
+ while Has_Next (Iter) loop
+ Next (Iter, Cycle);
+
+ Validate_Cycle (G, Cycle);
+ end loop;
+
+ if Has_Invalid_Cycle then
+ raise Invalid_Cycle;
+ end if;
+ end Validate_Cycles;
+ end Cycle_Validators;
+
----------------------------------
-- Elaboration_Order_Validators --
----------------------------------
package body Elaboration_Order_Validators is
- package US is new Membership_Sets
- (Element_Type => Unit_Id,
- "=" => "=",
- Hash => Hash_Unit);
- use US;
-
Has_Invalid_Data : Boolean := False;
-- Flag set when the elaboration order contains invalid data
-- Local subprograms --
-----------------------
- function Build_Elaborable_Unit_Set return Membership_Set;
+ function Build_Elaborable_Unit_Set return Unit_Sets.Membership_Set;
pragma Inline (Build_Elaborable_Unit_Set);
-- Create a set from all units that need to be elaborated
-- Emit an error concerning unit U_Id that must be elaborated, but was
-- not.
- procedure Report_Missing_Elaborations (Set : Membership_Set);
+ procedure Report_Missing_Elaborations (Set : Unit_Sets.Membership_Set);
pragma Inline (Report_Missing_Elaborations);
-- Emit errors on all units in set Set that must be elaborated, but were
-- not.
pragma Inline (Report_Spurious_Elaboration);
-- Emit an error concerning unit U_Id that is incorrectly elaborated
- procedure Validate_Unit (U_Id : Unit_Id; Elab_Set : Membership_Set);
+ procedure Validate_Unit
+ (U_Id : Unit_Id;
+ Elab_Set : Unit_Sets.Membership_Set);
pragma Inline (Validate_Unit);
-- Validate the elaboration status of unit U_Id. Elab_Set is the set of
-- all units that need to be elaborated.
pragma Inline (Validate_Units);
-- Validate all units in elaboration order Order
- procedure Write_Error (Msg : String);
- pragma Inline (Write_Error);
- -- Write error message Msg to standard output and signal that the
- -- elaboration order is incorrect.
-
-------------------------------
-- Build_Elaborable_Unit_Set --
-------------------------------
- function Build_Elaborable_Unit_Set return Membership_Set is
+ function Build_Elaborable_Unit_Set return Unit_Sets.Membership_Set is
Iter : Elaborable_Units_Iterator;
- Set : Membership_Set;
+ Set : Unit_Sets.Membership_Set;
U_Id : Unit_Id;
begin
- Set := Create (Number_Of_Elaborable_Units);
+ Set := Unit_Sets.Create (Number_Of_Elaborable_Units);
Iter := Iterate_Elaborable_Units;
while Has_Next (Iter) loop
Next (Iter, U_Id);
- pragma Assert (Present (U_Id));
- Insert (Set, U_Id);
+ Unit_Sets.Insert (Set, U_Id);
end loop;
return Set;
begin
pragma Assert (Present (U_Id));
- Write_Error (Msg);
+ Write_Error (Msg, Has_Invalid_Data);
Write_Str ("unit (U_Id_");
Write_Int (Int (U_Id));
-- Report_Missing_Elaborations --
---------------------------------
- procedure Report_Missing_Elaborations (Set : Membership_Set) is
- Iter : Iterator;
+ procedure Report_Missing_Elaborations (Set : Unit_Sets.Membership_Set) is
+ Iter : Unit_Sets.Iterator;
U_Id : Unit_Id;
begin
- Iter := Iterate (Set);
- while Has_Next (Iter) loop
- Next (Iter, U_Id);
- pragma Assert (Present (U_Id));
+ Iter := Unit_Sets.Iterate (Set);
+ while Unit_Sets.Has_Next (Iter) loop
+ Unit_Sets.Next (Iter, U_Id);
Report_Missing_Elaboration (U_Id);
end loop;
begin
pragma Assert (Present (U_Id));
- Write_Error (Msg);
+ Write_Error (Msg, Has_Invalid_Data);
Write_Str ("unit (U_Id_");
Write_Int (Int (U_Id));
procedure Validate_Elaboration_Order (Order : Unit_Id_Table) is
begin
- -- Nothing to do when switch -d_V (validate bindo graphs and order)
- -- is not in effect.
+ -- Nothing to do when switch -d_V (validate bindo cycles, graphs, and
+ -- order) is not in effect.
if not Debug_Flag_Underscore_VV then
return;
-- Validate_Unit --
-------------------
- procedure Validate_Unit (U_Id : Unit_Id; Elab_Set : Membership_Set) is
+ procedure Validate_Unit
+ (U_Id : Unit_Id;
+ Elab_Set : Unit_Sets.Membership_Set)
+ is
begin
pragma Assert (Present (U_Id));
-- The current unit in the elaboration order appears within the set
-- of units that require elaboration. Remove it from the set.
- if Contains (Elab_Set, U_Id) then
- Delete (Elab_Set, U_Id);
+ if Unit_Sets.Contains (Elab_Set, U_Id) then
+ Unit_Sets.Delete (Elab_Set, U_Id);
-- Otherwise the current unit in the elaboration order must not be
-- elaborated.
--------------------
procedure Validate_Units (Order : Unit_Id_Table) is
- Elab_Set : Membership_Set;
+ Elab_Set : Unit_Sets.Membership_Set;
begin
-- Collect all units in the compilation that need to be elaborated
-- their elaboration.
Report_Missing_Elaborations (Elab_Set);
- Destroy (Elab_Set);
+ Unit_Sets.Destroy (Elab_Set);
end Validate_Units;
-
- -----------------
- -- Write_Error --
- -----------------
-
- procedure Write_Error (Msg : String) is
- begin
- Has_Invalid_Data := True;
-
- Write_Str ("ERROR: ");
- Write_Str (Msg);
- Write_Eol;
- end Write_Error;
end Elaboration_Order_Validators;
---------------------------------
-----------------------
procedure Validate_Invocation_Graph_Edge
- (G : Invocation_Graph;
- IGE_Id : Invocation_Graph_Edge_Id);
+ (G : Invocation_Graph;
+ Edge : Invocation_Graph_Edge_Id);
pragma Inline (Validate_Invocation_Graph_Edge);
- -- Verify that the attributes of edge IGE_Id of invocation graph G are
+ -- Verify that the attributes of edge Edge of invocation graph G are
-- properly set.
procedure Validate_Invocation_Graph_Edges (G : Invocation_Graph);
procedure Validate_Invocation_Graph_Vertex
(G : Invocation_Graph;
- IGV_Id : Invocation_Graph_Vertex_Id);
+ Vertex : Invocation_Graph_Vertex_Id);
pragma Inline (Validate_Invocation_Graph_Vertex);
- -- Verify that the attributes of vertex IGV_Id of inbocation graph G are
+ -- Verify that the attributes of vertex Vertex of inbocation graph G are
-- properly set.
procedure Validate_Invocation_Graph_Vertices (G : Invocation_Graph);
-- Verify that the attributes of all vertices of invocation graph G are
-- properly set.
- procedure Write_Error (Msg : String);
- pragma Inline (Write_Error);
- -- Write error message Msg to standard output and signal that the
- -- invocation graph is incorrect.
-
-------------------------------
-- Validate_Invocation_Graph --
-------------------------------
begin
pragma Assert (Present (G));
- -- Nothing to do when switch -d_V (validate bindo graphs and order)
- -- is not in effect.
+ -- Nothing to do when switch -d_V (validate bindo cycles, graphs, and
+ -- order) is not in effect.
if not Debug_Flag_Underscore_VV then
return;
------------------------------------
procedure Validate_Invocation_Graph_Edge
- (G : Invocation_Graph;
- IGE_Id : Invocation_Graph_Edge_Id)
+ (G : Invocation_Graph;
+ Edge : Invocation_Graph_Edge_Id)
is
Msg : constant String := "Validate_Invocation_Graph_Edge";
begin
pragma Assert (Present (G));
- if not Present (IGE_Id) then
- Write_Error (Msg);
+ if not Present (Edge) then
+ Write_Error (Msg, Has_Invalid_Data);
Write_Str (" emply invocation graph edge");
Write_Eol;
return;
end if;
- if not Present (Relation (G, IGE_Id)) then
- Write_Error (Msg);
+ if not Present (Relation (G, Edge)) then
+ Write_Error (Msg, Has_Invalid_Data);
Write_Str (" invocation graph edge (IGE_Id_");
- Write_Int (Int (IGE_Id));
+ Write_Int (Int (Edge));
Write_Str (") lacks Relation");
Write_Eol;
Write_Eol;
end if;
- if not Present (Target (G, IGE_Id)) then
- Write_Error (Msg);
+ if not Present (Target (G, Edge)) then
+ Write_Error (Msg, Has_Invalid_Data);
Write_Str (" invocation graph edge (IGE_Id_");
- Write_Int (Int (IGE_Id));
+ Write_Int (Int (Edge));
Write_Str (") lacks Target");
Write_Eol;
Write_Eol;
-------------------------------------
procedure Validate_Invocation_Graph_Edges (G : Invocation_Graph) is
- IGE_Id : Invocation_Graph_Edge_Id;
- Iter : Invocation_Graphs.All_Edge_Iterator;
+ Edge : Invocation_Graph_Edge_Id;
+ Iter : Invocation_Graphs.All_Edge_Iterator;
begin
pragma Assert (Present (G));
Iter := Iterate_All_Edges (G);
while Has_Next (Iter) loop
- Next (Iter, IGE_Id);
+ Next (Iter, Edge);
- Validate_Invocation_Graph_Edge (G, IGE_Id);
+ Validate_Invocation_Graph_Edge (G, Edge);
end loop;
end Validate_Invocation_Graph_Edges;
procedure Validate_Invocation_Graph_Vertex
(G : Invocation_Graph;
- IGV_Id : Invocation_Graph_Vertex_Id)
+ Vertex : Invocation_Graph_Vertex_Id)
is
Msg : constant String := "Validate_Invocation_Graph_Vertex";
begin
pragma Assert (Present (G));
- if not Present (IGV_Id) then
- Write_Error (Msg);
+ if not Present (Vertex) then
+ Write_Error (Msg, Has_Invalid_Data);
Write_Str (" emply invocation graph vertex");
Write_Eol;
return;
end if;
- if not Present (Construct (G, IGV_Id)) then
- Write_Error (Msg);
+ if not Present (Body_Vertex (G, Vertex)) then
+ Write_Error (Msg, Has_Invalid_Data);
Write_Str (" invocation graph vertex (IGV_Id_");
- Write_Int (Int (IGV_Id));
+ Write_Int (Int (Vertex));
+ Write_Str (") lacks Body_Vertex");
+ Write_Eol;
+ Write_Eol;
+ end if;
+
+ if not Present (Construct (G, Vertex)) then
+ Write_Error (Msg, Has_Invalid_Data);
+
+ Write_Str (" invocation graph vertex (IGV_Id_");
+ Write_Int (Int (Vertex));
Write_Str (") lacks Construct");
Write_Eol;
Write_Eol;
end if;
- if not Present (Lib_Vertex (G, IGV_Id)) then
- Write_Error (Msg);
+ if not Present (Spec_Vertex (G, Vertex)) then
+ Write_Error (Msg, Has_Invalid_Data);
Write_Str (" invocation graph vertex (IGV_Id_");
- Write_Int (Int (IGV_Id));
- Write_Str (") lacks Lib_Vertex");
+ Write_Int (Int (Vertex));
+ Write_Str (") lacks Spec_Vertex");
Write_Eol;
Write_Eol;
end if;
----------------------------------------
procedure Validate_Invocation_Graph_Vertices (G : Invocation_Graph) is
- IGV_Id : Invocation_Graph_Vertex_Id;
Iter : Invocation_Graphs.All_Vertex_Iterator;
+ Vertex : Invocation_Graph_Vertex_Id;
begin
pragma Assert (Present (G));
Iter := Iterate_All_Vertices (G);
while Has_Next (Iter) loop
- Next (Iter, IGV_Id);
+ Next (Iter, Vertex);
- Validate_Invocation_Graph_Vertex (G, IGV_Id);
+ Validate_Invocation_Graph_Vertex (G, Vertex);
end loop;
end Validate_Invocation_Graph_Vertices;
-
- -----------------
- -- Write_Error --
- -----------------
-
- procedure Write_Error (Msg : String) is
- begin
- Has_Invalid_Data := True;
-
- Write_Str ("ERROR: ");
- Write_Str (Msg);
- Write_Eol;
- end Write_Error;
end Invocation_Graph_Validators;
------------------------------
-----------------------
procedure Validate_Library_Graph_Edge
- (G : Library_Graph;
- LGE_Id : Library_Graph_Edge_Id);
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id);
pragma Inline (Validate_Library_Graph_Edge);
- -- Verify that the attributes of edge LGE_Id of library graph G are
+ -- Verify that the attributes of edge Edge of library graph G are
-- properly set.
procedure Validate_Library_Graph_Edges (G : Library_Graph);
procedure Validate_Library_Graph_Vertex
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id);
+ Vertex : Library_Graph_Vertex_Id);
pragma Inline (Validate_Library_Graph_Vertex);
- -- Verify that the attributes of vertex LGV_Id of library graph G are
+ -- Verify that the attributes of vertex Vertex of library graph G are
-- properly set.
procedure Validate_Library_Graph_Vertices (G : Library_Graph);
-- Verify that the attributes of all vertices of library graph G are
-- properly set.
- procedure Write_Error (Msg : String);
- pragma Inline (Write_Error);
- -- Write error message Msg to standard output and signal that the
- -- library graph is incorrect.
-
----------------------------
-- Validate_Library_Graph --
----------------------------
begin
pragma Assert (Present (G));
- -- Nothing to do when switch -d_V (validate bindo graphs and order)
- -- is not in effect.
+ -- Nothing to do when switch -d_V (validate bindo cycles, graphs, and
+ -- order) is not in effect.
if not Debug_Flag_Underscore_VV then
return;
---------------------------------
procedure Validate_Library_Graph_Edge
- (G : Library_Graph;
- LGE_Id : Library_Graph_Edge_Id)
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id)
is
Msg : constant String := "Validate_Library_Graph_Edge";
begin
pragma Assert (Present (G));
- if not Present (LGE_Id) then
- Write_Error (Msg);
+ if not Present (Edge) then
+ Write_Error (Msg, Has_Invalid_Data);
Write_Str (" emply library graph edge");
Write_Eol;
return;
end if;
- if Kind (G, LGE_Id) = No_Edge then
- Write_Error (Msg);
+ if Kind (G, Edge) = No_Edge then
+ Write_Error (Msg, Has_Invalid_Data);
Write_Str (" library graph edge (LGE_Id_");
- Write_Int (Int (LGE_Id));
+ Write_Int (Int (Edge));
Write_Str (") is not a valid edge");
Write_Eol;
Write_Eol;
- elsif Kind (G, LGE_Id) = Body_Before_Spec_Edge then
- Write_Error (Msg);
+ elsif Kind (G, Edge) = Body_Before_Spec_Edge then
+ Write_Error (Msg, Has_Invalid_Data);
Write_Str (" library graph edge (LGE_Id_");
- Write_Int (Int (LGE_Id));
+ Write_Int (Int (Edge));
Write_Str (") is a Body_Before_Spec edge");
Write_Eol;
Write_Eol;
end if;
- if not Present (Predecessor (G, LGE_Id)) then
- Write_Error (Msg);
+ if not Present (Predecessor (G, Edge)) then
+ Write_Error (Msg, Has_Invalid_Data);
Write_Str (" library graph edge (LGE_Id_");
- Write_Int (Int (LGE_Id));
+ Write_Int (Int (Edge));
Write_Str (") lacks Predecessor");
Write_Eol;
Write_Eol;
end if;
- if not Present (Successor (G, LGE_Id)) then
- Write_Error (Msg);
+ if not Present (Successor (G, Edge)) then
+ Write_Error (Msg, Has_Invalid_Data);
Write_Str (" library graph edge (LGE_Id_");
- Write_Int (Int (LGE_Id));
+ Write_Int (Int (Edge));
Write_Str (") lacks Successor");
Write_Eol;
Write_Eol;
----------------------------------
procedure Validate_Library_Graph_Edges (G : Library_Graph) is
- Iter : Library_Graphs.All_Edge_Iterator;
- LGE_Id : Library_Graph_Edge_Id;
+ Edge : Library_Graph_Edge_Id;
+ Iter : Library_Graphs.All_Edge_Iterator;
begin
pragma Assert (Present (G));
Iter := Iterate_All_Edges (G);
while Has_Next (Iter) loop
- Next (Iter, LGE_Id);
- pragma Assert (Present (LGE_Id));
+ Next (Iter, Edge);
- Validate_Library_Graph_Edge (G, LGE_Id);
+ Validate_Library_Graph_Edge (G, Edge);
end loop;
end Validate_Library_Graph_Edges;
procedure Validate_Library_Graph_Vertex
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id)
+ Vertex : Library_Graph_Vertex_Id)
is
Msg : constant String := "Validate_Library_Graph_Vertex";
begin
pragma Assert (Present (G));
- if not Present (LGV_Id) then
- Write_Error (Msg);
+ if not Present (Vertex) then
+ Write_Error (Msg, Has_Invalid_Data);
Write_Str (" empty library graph vertex");
Write_Eol;
return;
end if;
- if (Is_Body_With_Spec (G, LGV_Id)
+ if (Is_Body_With_Spec (G, Vertex)
or else
- Is_Spec_With_Body (G, LGV_Id))
- and then not Present (Corresponding_Item (G, LGV_Id))
+ Is_Spec_With_Body (G, Vertex))
+ and then not Present (Corresponding_Item (G, Vertex))
then
- Write_Error (Msg);
+ Write_Error (Msg, Has_Invalid_Data);
Write_Str (" library graph vertex (LGV_Id_");
- Write_Int (Int (LGV_Id));
+ Write_Int (Int (Vertex));
Write_Str (") lacks Corresponding_Item");
Write_Eol;
Write_Eol;
end if;
- if not Present (Unit (G, LGV_Id)) then
- Write_Error (Msg);
+ if not Present (Unit (G, Vertex)) then
+ Write_Error (Msg, Has_Invalid_Data);
Write_Str (" library graph vertex (LGV_Id_");
- Write_Int (Int (LGV_Id));
+ Write_Int (Int (Vertex));
Write_Str (") lacks Unit");
Write_Eol;
Write_Eol;
procedure Validate_Library_Graph_Vertices (G : Library_Graph) is
Iter : Library_Graphs.All_Vertex_Iterator;
- LGV_Id : Library_Graph_Vertex_Id;
+ Vertex : Library_Graph_Vertex_Id;
begin
pragma Assert (Present (G));
Iter := Iterate_All_Vertices (G);
while Has_Next (Iter) loop
- Next (Iter, LGV_Id);
- pragma Assert (Present (LGV_Id));
+ Next (Iter, Vertex);
- Validate_Library_Graph_Vertex (G, LGV_Id);
+ Validate_Library_Graph_Vertex (G, Vertex);
end loop;
end Validate_Library_Graph_Vertices;
-
- -----------------
- -- Write_Error --
- -----------------
-
- procedure Write_Error (Msg : String) is
- begin
- Has_Invalid_Data := True;
-
- Write_Str ("ERROR: ");
- Write_Str (Msg);
- Write_Eol;
- end Write_Error;
end Library_Graph_Validators;
+ -----------------
+ -- Write_Error --
+ -----------------
+
+ procedure Write_Error
+ (Msg : String;
+ Flag : out Boolean)
+ is
+ begin
+ Write_Str ("ERROR: ");
+ Write_Str (Msg);
+ Write_Eol;
+
+ Flag := True;
+ end Write_Error;
+
end Bindo.Validators;
package Bindo.Validators is
+ ----------------------
+ -- Cycle_Validators --
+ ----------------------
+
+ package Cycle_Validators is
+ Invalid_Cycle : exception;
+ -- Exception raised when the library graph contains an invalid cycle
+
+ procedure Validate_Cycles (G : Library_Graph);
+ -- Ensure that all cycles of library graph G meet the following
+ -- requirements:
+ --
+ -- * Are of proper kind
+ -- * Have enough edges to form a circuit
+ -- * No edge is repeated
+ --
+ -- Diagnose issues and raise Invalid_Cycle if this is not the case.
+
+ end Cycle_Validators;
+
----------------------------------
-- Elaboration_Order_Validators --
----------------------------------
with Opt; use Opt;
with Output; use Output;
-with Bindo.Units; use Bindo.Units;
+with Bindo.Units;
+use Bindo.Units;
with GNAT; use GNAT;
with GNAT.Graphs; use GNAT.Graphs;
--------------------------------
procedure Write_Invocation_Construct (IC_Id : Invocation_Construct_Id) is
+ begin
pragma Assert (Present (IC_Id));
- IC_Rec : Invocation_Construct_Record renames
- Invocation_Constructs.Table (IC_Id);
-
- begin
Write_Str (" invocation construct (IC_Id_");
Write_Int (Int (IC_Id));
Write_Str (")");
Write_Eol;
+ Write_Str (" Body_Placement = ");
+ Write_Str (Body_Placement (IC_Id)'Img);
+ Write_Eol;
+
Write_Str (" Kind = ");
- Write_Str (IC_Rec.Kind'Img);
+ Write_Str (Kind (IC_Id)'Img);
Write_Eol;
- Write_Str (" Placement = ");
- Write_Str (IC_Rec.Placement'Img);
+ Write_Str (" Spec_Placement = ");
+ Write_Str (Spec_Placement (IC_Id)'Img);
Write_Eol;
- Write_Invocation_Signature (IC_Rec.Signature);
+ Write_Invocation_Signature (Signature (IC_Id));
Write_Eol;
end Write_Invocation_Construct;
-------------------------------
procedure Write_Invocation_Relation (IR_Id : Invocation_Relation_Id) is
+ begin
pragma Assert (Present (IR_Id));
- IR_Rec : Invocation_Relation_Record renames
- Invocation_Relations.Table (IR_Id);
-
- begin
Write_Str (" invocation relation (IR_Id_");
Write_Int (Int (IR_Id));
Write_Str (")");
Write_Eol;
- if Present (IR_Rec.Extra) then
+ if Present (Extra (IR_Id)) then
Write_Str (" Extra = ");
- Write_Name (IR_Rec.Extra);
+ Write_Name (Extra (IR_Id));
else
Write_Str (" Extra = none");
end if;
Write_Str (" Invoker");
Write_Eol;
- Write_Invocation_Signature (IR_Rec.Invoker);
+ Write_Invocation_Signature (Invoker (IR_Id));
Write_Str (" Kind = ");
- Write_Str (IR_Rec.Kind'Img);
+ Write_Str (Kind (IR_Id)'Img);
Write_Eol;
Write_Str (" Target");
Write_Eol;
- Write_Invocation_Signature (IR_Rec.Target);
+ Write_Invocation_Signature (Target (IR_Id));
Write_Eol;
end Write_Invocation_Relation;
--------------------------------
procedure Write_Invocation_Signature (IS_Id : Invocation_Signature_Id) is
+ begin
pragma Assert (Present (IS_Id));
- IS_Rec : Invocation_Signature_Record renames
- Invocation_Signatures.Table (IS_Id);
-
- begin
Write_Str (" Signature (IS_Id_");
Write_Int (Int (IS_Id));
Write_Str (")");
Write_Eol;
Write_Str (" Column = ");
- Write_Int (Int (IS_Rec.Column));
+ Write_Int (Int (Column (IS_Id)));
Write_Eol;
Write_Str (" Line = ");
- Write_Int (Int (IS_Rec.Line));
+ Write_Int (Int (Line (IS_Id)));
Write_Eol;
- if Present (IS_Rec.Locations) then
+ if Present (Locations (IS_Id)) then
Write_Str (" Locations = ");
- Write_Name (IS_Rec.Locations);
+ Write_Name (Locations (IS_Id));
else
Write_Str (" Locations = none");
end if;
Write_Eol;
Write_Str (" Name = ");
- Write_Name (IS_Rec.Name);
+ Write_Name (Name (IS_Id));
Write_Eol;
Write_Str (" Scope = ");
- Write_Name (IS_Rec.Scope);
+ Write_Name (Scope (IS_Id));
Write_Eol;
end Write_Invocation_Signature;
Write_Eol;
Write_Eol;
- for IC_Id in U_Rec.First_Invocation_Construct ..
- U_Rec.Last_Invocation_Construct
- loop
- Write_Invocation_Construct (IC_Id);
- end loop;
-
- for IR_Id in U_Rec.First_Invocation_Relation ..
- U_Rec.Last_Invocation_Relation
- loop
- Write_Invocation_Relation (IR_Id);
- end loop;
+ For_Each_Invocation_Construct (Write_Invocation_Construct'Access);
+ For_Each_Invocation_Relation (Write_Invocation_Relation'Access);
end Write_Unit;
-----------------------
end Write_Unit_Common;
end ALI_Writers;
+ -------------------
+ -- Cycle_Writers --
+ -------------------
+
+ package body Cycle_Writers is
+
+ -----------------------
+ -- Local subprograms --
+ -----------------------
+
+ procedure Write_Cycle
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id);
+ pragma Inline (Write_Cycle);
+ -- Write the path of cycle Cycle found in library graph G to standard
+ -- output.
+
+ procedure Write_Cyclic_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id);
+ pragma Inline (Write_Cyclic_Edge);
+ -- Write cyclic edge Edge of library graph G to standard
+
+ -----------------
+ -- Write_Cycle --
+ -----------------
+
+ procedure Write_Cycle
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id)
+ is
+ 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_P (output cycle paths) is not in
+ -- effect.
+
+ if not Debug_Flag_Underscore_PP then
+ return;
+ end if;
+
+ Write_Str ("cycle (LGC_Id_");
+ Write_Int (Int (Cycle));
+ Write_Str (")");
+ Write_Eol;
+
+ Iter := Iterate_Edges_Of_Cycle (G, Cycle);
+ while Has_Next (Iter) loop
+ Next (Iter, Edge);
+
+ Write_Cyclic_Edge (G, Edge);
+ end loop;
+
+ Write_Eol;
+ end Write_Cycle;
+
+ ------------------
+ -- Write_Cycles --
+ ------------------
+
+ procedure Write_Cycles (G : Library_Graph) is
+ Cycle : Library_Graph_Cycle_Id;
+ Iter : All_Cycle_Iterator;
+
+ begin
+ pragma Assert (Present (G));
+
+ Iter := Iterate_All_Cycles (G);
+ while Has_Next (Iter) loop
+ Next (Iter, Cycle);
+
+ Write_Cycle (G, Cycle);
+ end loop;
+ end Write_Cycles;
+
+ -----------------------
+ -- Write_Cyclic_Edge --
+ -----------------------
+
+ procedure Write_Cyclic_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);
+
+ begin
+ Indent_By (Nested_Indentation);
+ Write_Name (Name (G, Succ));
+ Write_Str (" --> ");
+ Write_Name (Name (G, Pred));
+ Write_Str (" ");
+
+ if Is_Elaborate_All_Edge (G, Edge) then
+ Write_Str ("Elaborate_All edge");
+
+ elsif Is_Elaborate_Body_Edge (G, Edge) then
+ Write_Str ("Elaborate_Body edge");
+
+ elsif Is_Elaborate_Edge (G, Edge) then
+ Write_Str ("Elaborate edge");
+
+ elsif Is_Forced_Edge (G, Edge) then
+ Write_Str ("forced edge");
+
+ elsif Is_Invocation_Edge (G, Edge) then
+ Write_Str ("invocation edge");
+
+ else
+ pragma Assert (Is_With_Edge (G, Edge));
+
+ Write_Str ("with edge");
+ end if;
+
+ Write_Eol;
+ end Write_Cyclic_Edge;
+ end Cycle_Writers;
+
-------------------------------
-- Elaboration_Order_Writers --
-------------------------------
-- Write all elaboration roots of invocation graph G to standard output
procedure Write_Invocation_Graph_Edge
- (G : Invocation_Graph;
- IGE_Id : Invocation_Graph_Edge_Id);
+ (G : Invocation_Graph;
+ Edge : Invocation_Graph_Edge_Id);
pragma Inline (Write_Invocation_Graph_Edge);
- -- Write edge IGE_Id of invocation graph G to standard output
+ -- Write edge Edge of invocation graph G to standard output
procedure Write_Invocation_Graph_Edges
(G : Invocation_Graph;
- IGV_Id : Invocation_Graph_Vertex_Id);
+ Vertex : Invocation_Graph_Vertex_Id);
pragma Inline (Write_Invocation_Graph_Edges);
- -- Write all edges of invocation graph G to standard output
+ -- Write all edges to targets of vertex Vertex of invocation graph G to
+ -- standard output.
procedure Write_Invocation_Graph_Vertex
(G : Invocation_Graph;
- IGV_Id : Invocation_Graph_Vertex_Id);
+ Vertex : Invocation_Graph_Vertex_Id);
pragma Inline (Write_Invocation_Graph_Vertex);
- -- Write vertex IGV_Id of invocation graph G to standard output
+ -- Write vertex Vertex of invocation graph G to standard output
procedure Write_Invocation_Graph_Vertices (G : Invocation_Graph);
pragma Inline (Write_Invocation_Graph_Vertices);
-----------
procedure pige
- (G : Invocation_Graph;
- IGE_Id : Invocation_Graph_Edge_Id)
- renames Write_Invocation_Graph_Edge;
+ (G : Invocation_Graph;
+ Edge : Invocation_Graph_Edge_Id) renames Write_Invocation_Graph_Edge;
pragma Unreferenced (pige);
procedure pigv
(G : Invocation_Graph;
- IGV_Id : Invocation_Graph_Vertex_Id)
+ Vertex : Invocation_Graph_Vertex_Id)
renames Write_Invocation_Graph_Vertex;
pragma Unreferenced (pigv);
Iter := Iterate_Elaboration_Roots (G);
while Has_Next (Iter) loop
Next (Iter, Root);
- pragma Assert (Present (Root));
Write_Elaboration_Root (G, Root);
end loop;
---------------------------------
procedure Write_Invocation_Graph_Edge
- (G : Invocation_Graph;
- IGE_Id : Invocation_Graph_Edge_Id)
+ (G : Invocation_Graph;
+ Edge : Invocation_Graph_Edge_Id)
is
pragma Assert (Present (G));
- pragma Assert (Present (IGE_Id));
-
- Targ : constant Invocation_Graph_Vertex_Id := Target (G, IGE_Id);
+ pragma Assert (Present (Edge));
- pragma Assert (Present (Targ));
+ Targ : constant Invocation_Graph_Vertex_Id := Target (G, Edge);
begin
Write_Str (" invocation graph edge (IGE_Id_");
- Write_Int (Int (IGE_Id));
+ Write_Int (Int (Edge));
Write_Str (")");
Write_Eol;
Write_Str (" Relation (IR_Id_");
- Write_Int (Int (Relation (G, IGE_Id)));
+ Write_Int (Int (Relation (G, Edge)));
Write_Str (")");
Write_Eol;
procedure Write_Invocation_Graph_Edges
(G : Invocation_Graph;
- IGV_Id : Invocation_Graph_Vertex_Id)
+ Vertex : Invocation_Graph_Vertex_Id)
is
pragma Assert (Present (G));
- pragma Assert (Present (IGV_Id));
+ pragma Assert (Present (Vertex));
Num_Of_Edges : constant Natural :=
- Number_Of_Edges_To_Targets (G, IGV_Id);
+ Number_Of_Edges_To_Targets (G, Vertex);
- IGE_Id : Invocation_Graph_Edge_Id;
- Iter : Invocation_Graphs.Edges_To_Targets_Iterator;
+ Edge : Invocation_Graph_Edge_Id;
+ Iter : Invocation_Graphs.Edges_To_Targets_Iterator;
begin
Write_Str (" Edges to targets: ");
Write_Eol;
if Num_Of_Edges > 0 then
- Iter := Iterate_Edges_To_Targets (G, IGV_Id);
+ Iter := Iterate_Edges_To_Targets (G, Vertex);
while Has_Next (Iter) loop
- Next (Iter, IGE_Id);
- pragma Assert (Present (IGE_Id));
+ Next (Iter, Edge);
- Write_Invocation_Graph_Edge (G, IGE_Id);
+ Write_Invocation_Graph_Edge (G, Edge);
end loop;
else
Write_Eol;
procedure Write_Invocation_Graph_Vertex
(G : Invocation_Graph;
- IGV_Id : Invocation_Graph_Vertex_Id)
+ Vertex : Invocation_Graph_Vertex_Id)
is
begin
pragma Assert (Present (G));
- pragma Assert (Present (IGV_Id));
+ pragma Assert (Present (Vertex));
Write_Str ("invocation graph vertex (IGV_Id_");
- Write_Int (Int (IGV_Id));
+ Write_Int (Int (Vertex));
Write_Str (") name = ");
- Write_Name (Name (G, IGV_Id));
+ Write_Name (Name (G, Vertex));
+ Write_Eol;
+
+ Write_Str (" Body_Vertex (LGV_Id_");
+ Write_Int (Int (Body_Vertex (G, Vertex)));
+ Write_Str (")");
Write_Eol;
Write_Str (" Construct (IC_Id_");
- Write_Int (Int (Construct (G, IGV_Id)));
+ Write_Int (Int (Construct (G, Vertex)));
Write_Str (")");
Write_Eol;
- Write_Str (" Lib_Vertex (LGV_Id_");
- Write_Int (Int (Lib_Vertex (G, IGV_Id)));
+ Write_Str (" Spec_Vertex (LGV_Id_");
+ Write_Int (Int (Spec_Vertex (G, Vertex)));
Write_Str (")");
Write_Eol;
- Write_Invocation_Graph_Edges (G, IGV_Id);
+ Write_Invocation_Graph_Edges (G, Vertex);
end Write_Invocation_Graph_Vertex;
-------------------------------------
-------------------------------------
procedure Write_Invocation_Graph_Vertices (G : Invocation_Graph) is
- IGV_Id : Invocation_Graph_Vertex_Id;
Iter : Invocation_Graphs.All_Vertex_Iterator;
+ Vertex : Invocation_Graph_Vertex_Id;
begin
pragma Assert (Present (G));
Iter := Iterate_All_Vertices (G);
while Has_Next (Iter) loop
- Next (Iter, IGV_Id);
- pragma Assert (Present (IGV_Id));
+ Next (Iter, Vertex);
- Write_Invocation_Graph_Vertex (G, IGV_Id);
+ Write_Invocation_Graph_Vertex (G, Vertex);
end loop;
end Write_Invocation_Graph_Vertices;
procedure Write_Edges_To_Successors
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id);
+ Vertex : Library_Graph_Vertex_Id);
pragma Inline (Write_Edges_To_Successors);
- -- Write all edges to successors of predecessor LGV_Id of library graph
+ -- Write all edges to successors of predecessor Vertex of library graph
-- G to standard output.
procedure Write_Library_Graph_Edge
- (G : Library_Graph;
- LGE_Id : Library_Graph_Edge_Id);
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id);
pragma Inline (Write_Library_Graph_Edge);
- -- Write edge LGE_Id of library graph G to standard output
+ -- Write edge Edge of library graph G to standard output
procedure Write_Library_Graph_Vertex
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id);
+ Vertex : Library_Graph_Vertex_Id);
pragma Inline (Write_Library_Graph_Vertex);
- -- Write vertex LGV_Id of library graph G to standard output
+ -- Write vertex Vertex of library graph G to standard output
procedure Write_Library_Graph_Vertices (G : Library_Graph);
pragma Inline (Write_Library_Graph_Vertices);
pragma Unreferenced (pc);
procedure plge
- (G : Library_Graph;
- LGE_Id : Library_Graph_Edge_Id) renames Write_Library_Graph_Edge;
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id) renames Write_Library_Graph_Edge;
pragma Unreferenced (plge);
procedure plgv
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id) renames Write_Library_Graph_Vertex;
+ Vertex : Library_Graph_Vertex_Id) renames Write_Library_Graph_Vertex;
pragma Unreferenced (plgv);
---------------------
Comp : Component_Id)
is
Iter : Component_Vertex_Iterator;
- LGV_Id : Library_Graph_Vertex_Id;
+ Vertex : Library_Graph_Vertex_Id;
begin
pragma Assert (Present (G));
Iter := Iterate_Component_Vertices (G, Comp);
while Has_Next (Iter) loop
- Next (Iter, LGV_Id);
- pragma Assert (Present (LGV_Id));
+ Next (Iter, Vertex);
Write_Str (" library graph vertex (LGV_Id_");
- Write_Int (Int (LGV_Id));
+ Write_Int (Int (Vertex));
Write_Str (") name = ");
- Write_Name (Name (G, LGV_Id));
+ Write_Name (Name (G, Vertex));
Write_Eol;
end loop;
Iter := Iterate_Components (G);
while Has_Next (Iter) loop
Next (Iter, Comp);
- pragma Assert (Present (Comp));
Write_Component (G, Comp);
end loop;
procedure Write_Edges_To_Successors
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id)
+ Vertex : Library_Graph_Vertex_Id)
is
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
+ pragma Assert (Present (Vertex));
Num_Of_Edges : constant Natural :=
- Number_Of_Edges_To_Successors (G, LGV_Id);
+ Number_Of_Edges_To_Successors (G, Vertex);
- Iter : Edges_To_Successors_Iterator;
- LGE_Id : Library_Graph_Edge_Id;
+ Edge : Library_Graph_Edge_Id;
+ Iter : Edges_To_Successors_Iterator;
begin
Write_Str (" Edges to successors: ");
Write_Eol;
if Num_Of_Edges > 0 then
- Iter := Iterate_Edges_To_Successors (G, LGV_Id);
+ Iter := Iterate_Edges_To_Successors (G, Vertex);
while Has_Next (Iter) loop
- Next (Iter, LGE_Id);
- pragma Assert (Present (LGE_Id));
+ Next (Iter, Edge);
- Write_Library_Graph_Edge (G, LGE_Id);
+ Write_Library_Graph_Edge (G, Edge);
end loop;
else
Write_Eol;
------------------------------
procedure Write_Library_Graph_Edge
- (G : Library_Graph;
- LGE_Id : Library_Graph_Edge_Id)
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id)
is
pragma Assert (Present (G));
- pragma Assert (Present (LGE_Id));
+ pragma Assert (Present (Edge));
- Pred : constant Library_Graph_Vertex_Id := Predecessor (G, LGE_Id);
- Succ : constant Library_Graph_Vertex_Id := Successor (G, LGE_Id);
-
- pragma Assert (Present (Pred));
- pragma Assert (Present (Succ));
+ Pred : constant Library_Graph_Vertex_Id := Predecessor (G, Edge);
+ Succ : constant Library_Graph_Vertex_Id := Successor (G, Edge);
begin
Write_Str (" library graph edge (LGE_Id_");
- Write_Int (Int (LGE_Id));
+ Write_Int (Int (Edge));
Write_Str (")");
Write_Eol;
Write_Str (" Kind = ");
- Write_Str (Kind (G, LGE_Id)'Img);
+ Write_Str (Kind (G, Edge)'Img);
Write_Eol;
Write_Str (" Predecessor (LGV_Id_");
procedure Write_Library_Graph_Vertex
(G : Library_Graph;
- LGV_Id : Library_Graph_Vertex_Id)
+ Vertex : Library_Graph_Vertex_Id)
is
pragma Assert (Present (G));
- pragma Assert (Present (LGV_Id));
+ pragma Assert (Present (Vertex));
Item : constant Library_Graph_Vertex_Id :=
- Corresponding_Item (G, LGV_Id);
- U_Id : constant Unit_Id := Unit (G, LGV_Id);
-
- pragma Assert (Present (U_Id));
+ Corresponding_Item (G, Vertex);
+ U_Id : constant Unit_Id := Unit (G, Vertex);
begin
Write_Str ("library graph vertex (LGV_Id_");
- Write_Int (Int (LGV_Id));
+ Write_Int (Int (Vertex));
Write_Str (") name = ");
- Write_Name (Name (G, LGV_Id));
+ Write_Name (Name (G, Vertex));
Write_Eol;
if Present (Item) then
Write_Eol;
Write_Str (" In_Elaboration_Order = ");
- if In_Elaboration_Order (G, LGV_Id) then
+ if In_Elaboration_Order (G, Vertex) then
Write_Str ("True");
else
Write_Str ("False");
Write_Eol;
Write_Str (" Pending_Predecessors = ");
- Write_Int (Int (Pending_Predecessors (G, LGV_Id)));
+ Write_Int (Int (Pending_Predecessors (G, Vertex)));
Write_Eol;
Write_Str (" Component (Comp_Id_");
- Write_Int (Int (Component (G, LGV_Id)));
+ Write_Int (Int (Component (G, Vertex)));
Write_Str (")");
Write_Eol;
Write_Name (Name (U_Id));
Write_Eol;
- Write_Edges_To_Successors (G, LGV_Id);
+ Write_Edges_To_Successors (G, Vertex);
end Write_Library_Graph_Vertex;
----------------------------------
procedure Write_Library_Graph_Vertices (G : Library_Graph) is
Iter : Library_Graphs.All_Vertex_Iterator;
- LGV_Id : Library_Graph_Vertex_Id;
+ Vertex : Library_Graph_Vertex_Id;
begin
pragma Assert (Present (G));
Iter := Iterate_All_Vertices (G);
while Has_Next (Iter) loop
- Next (Iter, LGV_Id);
- pragma Assert (Present (LGV_Id));
+ Next (Iter, Vertex);
- Write_Library_Graph_Vertex (G, LGV_Id);
+ Write_Library_Graph_Vertex (G, Vertex);
end loop;
end Write_Library_Graph_Vertices;
pragma Inline (Hash_File_Name);
-- Obtain the hash value of key Nam
- package FS is new Membership_Sets
+ package File_Name_Tables is new Membership_Sets
(Element_Type => File_Name_Type,
"=" => "=",
Hash => Hash_File_Name);
- use FS;
+ use File_Name_Tables;
-----------------------
-- Local subprograms --
end ALI_Writers;
+ -------------------
+ -- Cycle_Writers --
+ -------------------
+
+ package Cycle_Writers is
+ procedure Write_Cycles (G : Library_Graph);
+ -- Write all cycles of library graph G to standard output
+
+ end Cycle_Writers;
+
-------------------------------
-- Elaboration_Order_Writers --
-------------------------------
-- --
------------------------------------------------------------------------------
+with Binde;
+with Debug; use Debug;
+
with Bindo.Elaborators;
-use Bindo.Elaborators.Invocation_And_Library_Graph_Elaborators;
+use Bindo.Elaborators;
package body Bindo is
-- - The flow of execution at elaboration time.
--
-- - Additional dependencies between units supplied to the binder by
- -- means of a file.
+ -- means of a forced-elaboration-order file.
+ --
+ -- The high-level idea empoyed by the EO mechanism is to construct two
+ -- graphs and use the information they represent to find an ordering of
+ -- all units.
--
- -- The high-level idea is to construct two graphs:
+ -- The invocation graph represents the flow of execution at elaboration
+ -- time.
--
- -- - Invocation graph - Models the flow of execution at elaboration
- -- time.
+ -- The library graph captures the dependencies between units expressed
+ -- by with clause and elaboration-related pragmas. The library graph is
+ -- further augmented with additional information from the invocation
+ -- graph by exploring the execution paths from a unit with elaboration
+ -- code to other external units.
--
- -- - Library graph - Represents with clause and pragma dependencies
- -- between units.
+ -- The strongly connected components of the library graph are computed.
--
- -- The library graph is further augmented with additional information
- -- from the invocation graph by exploring the execution paths from a
- -- unit with elaboration code to other external units. All strongly
- -- connected components of the library graph are discovered. Finally,
- -- the order is obtained via a topological sort-like algorithm which
- -- attempts to order available units while enabling other units to be
+ -- The order is obtained using a topological sort-like algorithm which
+ -- traverses the library graph and its strongly connected components in
+ -- an attempt to order available units while enabling other units to be
-- ordered.
--
-- * Diagnose elaboration circularities between units
--
- -- The library graph may contain at least one cycle, in which case no
- -- ordering is possible.
+ -- An elaboration circularity arrises when either
+ --
+ -- - At least one unit cannot be ordered, or
+ --
+ -- - All units can be ordered, but an edge with an Elaborate_All
+ -- pragma links two vertices within the same component of the
+ -- library graph.
--
- -- ??? more on this later
+ -- The library graph is traversed to discover, collect, and sort all
+ -- cycles that hinder the elaboration order.
+ --
+ -- The most important cycle is diagnosed by describing its effects on
+ -- the elaboration order and listing all units comprising the circuit.
+ -- Various suggestions on how to break the cycle are offered.
-----------------
-- Terminology --
-- * Component - A strongly connected component of a graph.
--
+ -- * Elaboration circularity - A cycle involving units from the bind.
+ --
-- * Elaboration root - A special invocation construct which denotes the
-- elaboration procedure of a unit.
--
-- |
-- +------ | -------------- Diagnostics phase -------------------------+
-- | | |
- -- | +--> ??? more on this later |
+ -- | +--> Find_Cycles |
+ -- | +--> Validate_Cycles |
+ -- | +--> Write_Cycles |
+ -- | | |
+ -- | +--> Diagnose_Cycle / Diagnose_All_Cycles |
-- | |
-- +-------------------------------------------------------------------+
-- Diagnostics phase --
-----------------------
- -- ??? more on this later
+ -- The Diagnostics phase has the following objectives:
+ --
+ -- * Discover, save, and sort all cycles in the library graph. The cycles
+ -- are sorted based on the following heiristics:
+ --
+ -- - A cycle with higher precedence is preferred.
+ --
+ -- - A cycle with fewer invocation edges is preferred.
+ --
+ -- - A cycle with a shorter length is preferred.
+ --
+ -- * Validate the consistency of cycles, only when switch -d_V is in
+ -- effect.
+ --
+ -- * Write the contents of all cycles in human-readable form to standard
+ -- output when switch -d_O is in effect.
+ --
+ -- * Diagnose the most important cycle, or all cycles when switch -d_C is
+ -- in effect. The diagnostic consists of:
+ --
+ -- - The reason for the existance of the cycle, along with the unit
+ -- whose elaboration cannot be guaranteed.
+ --
+ -- - A detailed traceback of the cycle, showcasing the transition
+ -- between units, along with any other elaboration order-related
+ -- information.
+ --
+ -- - A set of suggestions on how to break the cycle considering the
+ -- the edges coprising the circuit, the elaboration model used to
+ -- compile the units, the availability of invocation information,
+ -- and the state of various relevant switches.
--------------
-- Switches --
-- GNATbind outputs the contents of ALI table Invocation_Constructs
-- and Invocation_Edges in textual format to standard output.
--
+ -- -d_C Diagnose all cycles
+ --
+ -- GNATbind outputs diagnostics for all unique cycles in the bind,
+ -- rather than just the most important one.
+ --
-- -d_I Output invocation graph
--
-- GNATbind outputs the invocation graph in text format to standard
-- GNATbind outputs the elaboration order in text format to standard
-- output.
--
+ -- -d_P Output cycle paths
+ --
+ -- GNATbind output the cycle paths in text format to standard output
+ --
-- -d_T Output elaboration order trace information
--
- -- GNATbind outputs trace information on elaboration order activities
- -- to standard output.
+ -- GNATbind outputs trace information on elaboration order and cycle
+ -- detection activities to standard output.
--
- -- -d_V Validate bindo graphs and order
+ -- -d_V Validate bindo cycles, graphs, and order
--
- -- GNATbind validates the invocation graph, library graph, SCC graph
- -- and elaboration order by detecting inconsistencies and producing
- -- error reports.
+ -- GNATbind validates the invocation graph, library graph along with
+ -- its cycles, and elaboration order by detecting inconsistencies and
+ -- producing error reports.
----------------------------------------
-- Debugging elaboration order issues --
Main_Lib_File : File_Name_Type)
is
begin
- Elaborate_Units (Order, Main_Lib_File);
+ -- Use the invocation and library graph-based elaboration order when
+ -- switch -d_N (new bindo order) is in effect.
+
+ if Debug_Flag_Underscore_NN then
+ Invocation_And_Library_Graph_Elaborators.Elaborate_Units
+ (Order => Order,
+ Main_Lib_File => Main_Lib_File);
+
+ -- Otherwise use the library graph and heuristic-based elaboration
+ -- order.
+
+ else
+ Binde.Find_Elab_Order (Order, Main_Lib_File);
+ end if;
end Find_Elaboration_Order;
end Bindo;
-- d_A Output ALI invocation tables
-- d_B
- -- d_C
+ -- d_C Diagnose all cycles
-- d_D
-- d_F
-- d_G
-- d_M
-- d_N New bindo order
-- d_O Output elaboration order
- -- d_P
+ -- d_P Output cycle paths
-- d_Q
-- d_R
-- d_S
- -- d_T Output elaboration order trace information
+ -- d_T Output elaboration order and cycle detection trace information
-- d_U
- -- d_V Validate bindo graphs and order
+ -- d_V Validate bindo cycles, graphs, and order
-- d_W
-- d_X
-- d_Y
-- d_A GNATBIND output the contents of all ALI invocation-related tables
-- in textual format to standard output.
- --
+
+ -- d_C GNATBIND diagnoses all unique cycles within the bind, rather than
+ -- just the most important one.
+
-- d_I GNATBIND outputs the contents of the invocation graph in textual
-- format to standard output.
- --
+
-- d_L GNATBIND outputs the contents of the library graph in textual
-- format to standard output.
- --
+
-- d_N GNATBIND utilizes the elaboration order provided by bindo
- --
+
-- d_O GNATBIND outputs the elaboration order of units to standard output
- --
- -- d_T GNATBIND outputs trace information of elaboration order activities
- -- to standard output.
- --
- -- d_V GNATBIND validates the invocation graph, library graph, SCC graph
- -- and elaboration order.
+
+ -- d_P GNATBIND outputs the cycle paths to standard output
+
+ -- d_T GNATBIND outputs trace information of elaboration order and cycle
+ -- detection activities to standard output.
+
+ -- d_V GNATBIND validates the invocation graph, library graph along with
+ -- its cycles, and the elaboration order.
--------------------------------------------
-- Documentation for gnatmake Debug Flags --
with ALI; use ALI;
with ALI.Util; use ALI.Util;
with Bcheck; use Bcheck;
-with Binde; use Binde;
with Binderr; use Binderr;
with Bindgen; use Bindgen;
with Bindo; use Bindo;
Elab_Order : Unit_Id_Table;
begin
- -- Use the invocation and library graph-based elaboration order
- -- when switch -d_N (new bindo order) is in effect.
-
- if Debug_Flag_Underscore_NN then
- Find_Elaboration_Order (Elab_Order, First_Main_Lib_File);
- else
- Find_Elab_Order (Elab_Order, First_Main_Lib_File);
- end if;
+ Find_Elaboration_Order (Elab_Order, First_Main_Lib_File);
if Errors_Detected = 0 and then not Check_Only then
Gen_Output_File
package body Lib.Writ is
-----------------------
- -- Local Subprograms --
+ -- Local subprograms --
-----------------------
- function Column (IS_Id : Invocation_Signature_Id) return Nat;
- pragma Inline (Column);
- -- Obtain attribute Column of an invocation signature with id IS_Id
-
- function Extra (IR_Id : Invocation_Relation_Id) return Name_Id;
- pragma Inline (Extra);
- -- Obtain attribute Extra of an invocation relation with id IR_Id
-
- function Invoker
- (IR_Id : Invocation_Relation_Id) return Invocation_Signature_Id;
- pragma Inline (Invoker);
- -- Obtain attribute Invoker of an invocation relation with id IR_Id
-
- function Kind
- (IC_Id : Invocation_Construct_Id) return Invocation_Construct_Kind;
- pragma Inline (Kind);
- -- Obtain attribute Kind of an invocation construct with id IC_Id
-
- function Kind (IR_Id : Invocation_Relation_Id) return Invocation_Kind;
- pragma Inline (Kind);
- -- Obtain attribute Kind of an invocation relation with id IR_Id
-
- function Line (IS_Id : Invocation_Signature_Id) return Nat;
- pragma Inline (Line);
- -- Obtain attribute Line of an invocation signature with id IS_Id
-
- function Locations (IS_Id : Invocation_Signature_Id) return Name_Id;
- pragma Inline (Locations);
- -- Obtain attribute Locations of an invocation signature with id IS_Id
-
- function Name (IS_Id : Invocation_Signature_Id) return Name_Id;
- pragma Inline (Name);
- -- Obtain attribute Name of an invocation signature with id IS_Id
-
- function Placement
- (IC_Id : Invocation_Construct_Id) return Body_Placement_Kind;
- pragma Inline (Placement);
- -- Obtain attribute Placement of an invocation construct with id IC_Id
-
function Present (N_Id : Name_Id) return Boolean;
pragma Inline (Present);
-- Determine whether a name with id N_Id exists
- function Scope (IS_Id : Invocation_Signature_Id) return Name_Id;
- pragma Inline (Scope);
- -- Obtain attribute Scope of an invocation signature with id IS_Id
+ procedure Write_Invocation_Construct (IC_Id : Invocation_Construct_Id);
+ pragma Inline (Write_Invocation_Construct);
+ -- Write invocation construct IC_Id to the ALI file
+
+ procedure Write_Invocation_Graph;
+ pragma Inline (Write_Invocation_Graph);
+ -- Write out the invocation graph
- function Signature
- (IC_Id : Invocation_Construct_Id) return Invocation_Signature_Id;
- pragma Inline (Signature);
- -- Obtain attribute Signature of an invocation construct with id IC_Id
+ procedure Write_Invocation_Graph_Attributes;
+ pragma Inline (Write_Invocation_Graph_Attributes);
+ -- Write out the attributes of the invocation graph
- function Target
- (IR_Id : Invocation_Relation_Id) return Invocation_Signature_Id;
- pragma Inline (Target);
- -- Obtain attribute Target of an invocation relation with id IR_Id
+ procedure Write_Invocation_Relation (IR_Id : Invocation_Relation_Id);
+ pragma Inline (Write_Invocation_Relation);
+ -- Write invocation relation IR_Id to the ALI file
+
+ procedure Write_Invocation_Signature (IS_Id : Invocation_Signature_Id);
+ pragma Inline (Write_Invocation_Signature);
+ -- Write invocation signature IS_Id to the ALI file
procedure Write_Unit_Name (N : Node_Id);
-- Used to write out the unit name for R (pragma Restriction) lines
OA_Setting => 'O');
end Add_Preprocessing_Dependency;
- ------------
- -- Column --
- ------------
-
- function Column (IS_Id : Invocation_Signature_Id) return Nat is
- begin
- pragma Assert (Present (IS_Id));
- return Invocation_Signatures.Table (IS_Id).Column;
- end Column;
-
------------------------------
-- Ensure_System_Dependency --
------------------------------
end;
end Ensure_System_Dependency;
- -----------
- -- Extra --
- -----------
-
- function Extra (IR_Id : Invocation_Relation_Id) return Name_Id is
- begin
- pragma Assert (Present (IR_Id));
- return Invocation_Relations.Table (IR_Id).Extra;
- end Extra;
-
- -------------
- -- Invoker --
- -------------
-
- function Invoker
- (IR_Id : Invocation_Relation_Id) return Invocation_Signature_Id
- is
- begin
- pragma Assert (Present (IR_Id));
- return Invocation_Relations.Table (IR_Id).Invoker;
- end Invoker;
-
- ----------
- -- Kind --
- ----------
-
- function Kind
- (IC_Id : Invocation_Construct_Id) return Invocation_Construct_Kind
- is
- begin
- pragma Assert (Present (IC_Id));
- return Invocation_Constructs.Table (IC_Id).Kind;
- end Kind;
-
- ----------
- -- Kind --
- ----------
-
- function Kind (IR_Id : Invocation_Relation_Id) return Invocation_Kind is
- begin
- pragma Assert (Present (IR_Id));
- return Invocation_Relations.Table (IR_Id).Kind;
- end Kind;
-
- ----------
- -- Line --
- ----------
-
- function Line (IS_Id : Invocation_Signature_Id) return Nat is
- begin
- pragma Assert (Present (IS_Id));
- return Invocation_Signatures.Table (IS_Id).Line;
- end Line;
-
- ---------------
- -- Locations --
- ---------------
-
- function Locations (IS_Id : Invocation_Signature_Id) return Name_Id is
- begin
- pragma Assert (Present (IS_Id));
- return Invocation_Signatures.Table (IS_Id).Locations;
- end Locations;
-
- ----------
- -- Name --
- ----------
-
- function Name (IS_Id : Invocation_Signature_Id) return Name_Id is
- begin
- pragma Assert (Present (IS_Id));
- return Invocation_Signatures.Table (IS_Id).Name;
- end Name;
-
- ---------------
- -- Placement --
- ---------------
-
- function Placement
- (IC_Id : Invocation_Construct_Id) return Body_Placement_Kind
- is
- begin
- pragma Assert (Present (IC_Id));
- return Invocation_Constructs.Table (IC_Id).Placement;
- end Placement;
-
-------------
-- Present --
-------------
return N_Id /= No_Name;
end Present;
- -----------
- -- Scope --
- -----------
-
- function Scope (IS_Id : Invocation_Signature_Id) return Name_Id is
- begin
- pragma Assert (Present (IS_Id));
- return Invocation_Signatures.Table (IS_Id).Scope;
- end Scope;
-
- ---------------
- -- Signature --
- ---------------
-
- function Signature
- (IC_Id : Invocation_Construct_Id) return Invocation_Signature_Id
- is
- begin
- pragma Assert (Present (IC_Id));
- return Invocation_Constructs.Table (IC_Id).Signature;
- end Signature;
-
- ------------
- -- Target --
- ------------
-
- function Target
- (IR_Id : Invocation_Relation_Id) return Invocation_Signature_Id
- is
- begin
- pragma Assert (Present (IR_Id));
- return Invocation_Relations.Table (IR_Id).Target;
- end Target;
-
---------------
-- Write_ALI --
---------------
-- this file (using Scan_ALI) and returns True. If no file exists,
-- or the file is not up to date, then False is returned.
- procedure Write_Invocation_Graph;
- -- Write out the invocation graph
-
procedure Write_Unit_Information (Unit_Num : Unit_Number_Type);
-- Write out the library information for one unit for which code is
-- generated (includes unit line and with lines).
end loop;
end Update_Tables_From_ALI_File;
- ----------------------------
- -- Write_Invocation_Graph --
- ----------------------------
-
- procedure Write_Invocation_Graph is
- procedure Write_Invocation_Construct
- (IC_Id : Invocation_Construct_Id);
- pragma Inline (Write_Invocation_Construct);
- -- Write invocation construct IC_Id to the ALI file
-
- procedure Write_Invocation_Relation (IR_Id : Invocation_Relation_Id);
- pragma Inline (Write_Invocation_Relation);
- -- Write invocation relation IR_Id to the ALI file
-
- procedure Write_Invocation_Signature
- (IS_Id : Invocation_Signature_Id);
- pragma Inline (Write_Invocation_Signature);
- -- Write invocation signature IS_Id to the ALI file
-
- --------------------------------
- -- Write_Invocation_Construct --
- --------------------------------
-
- procedure Write_Invocation_Construct
- (IC_Id : Invocation_Construct_Id)
- is
- begin
- -- G header
-
- Write_Info_Initiate ('G');
- Write_Info_Char (' ');
-
- -- line-kind
-
- Write_Info_Char
- (Invocation_Graph_Line_Kind_To_Code (Invocation_Construct_Line));
- Write_Info_Char (' ');
-
- -- construct-kind
-
- Write_Info_Char (Invocation_Construct_Kind_To_Code (Kind (IC_Id)));
- Write_Info_Char (' ');
-
- -- construct-body-placement
-
- Write_Info_Char (Body_Placement_Kind_To_Code (Placement (IC_Id)));
- Write_Info_Char (' ');
-
- -- construct-signature
-
- Write_Invocation_Signature (Signature (IC_Id));
- Write_Info_EOL;
- end Write_Invocation_Construct;
-
- -------------------------------
- -- Write_Invocation_Relation --
- -------------------------------
-
- procedure Write_Invocation_Relation
- (IR_Id : Invocation_Relation_Id)
- is
- begin
- -- G header
-
- Write_Info_Initiate ('G');
- Write_Info_Char (' ');
-
- -- line-kind
-
- Write_Info_Char
- (Invocation_Graph_Line_Kind_To_Code (Invocation_Relation_Line));
- Write_Info_Char (' ');
-
- -- relation-kind
-
- Write_Info_Char (Invocation_Kind_To_Code (Kind (IR_Id)));
- Write_Info_Char (' ');
-
- -- (extra-name | "none")
-
- if Present (Extra (IR_Id)) then
- Write_Info_Name (Extra (IR_Id));
- else
- Write_Info_Str ("none");
- end if;
-
- Write_Info_Char (' ');
-
- -- invoker-signature
-
- Write_Invocation_Signature (Invoker (IR_Id));
- Write_Info_Char (' ');
-
- -- target-signature
-
- Write_Invocation_Signature (Target (IR_Id));
-
- Write_Info_EOL;
- end Write_Invocation_Relation;
-
- --------------------------------
- -- Write_Invocation_Signature --
- --------------------------------
-
- procedure Write_Invocation_Signature
- (IS_Id : Invocation_Signature_Id)
- is
- begin
- -- [
-
- Write_Info_Char ('[');
-
- -- name
-
- Write_Info_Name (Name (IS_Id));
- Write_Info_Char (' ');
-
- -- scope
-
- Write_Info_Name (Scope (IS_Id));
- Write_Info_Char (' ');
-
- -- line
-
- Write_Info_Nat (Line (IS_Id));
- Write_Info_Char (' ');
-
- -- column
-
- Write_Info_Nat (Column (IS_Id));
- Write_Info_Char (' ');
-
- -- (locations | "none")
-
- if Present (Locations (IS_Id)) then
- Write_Info_Name (Locations (IS_Id));
- else
- Write_Info_Str ("none");
- end if;
-
- -- ]
-
- Write_Info_Char (']');
- end Write_Invocation_Signature;
-
- -- Start of processing for Write_Invocation_Graph
-
- begin
- -- First write out all invocation constructs declared within the
- -- current unit. This ensures that when this invocation is read,
- -- the invocation constructs are materialized before they are
- -- referenced by invocation relations.
-
- for IC_Id in Invocation_Constructs.First ..
- Invocation_Constructs.Last
- loop
- Write_Invocation_Construct (IC_Id);
- end loop;
-
- -- Write out all invocation relations that originate from invocation
- -- constructs delared in the current unit.
-
- for IR_Id in Invocation_Relations.First ..
- Invocation_Relations.Last
- loop
- Write_Invocation_Relation (IR_Id);
- end loop;
- end Write_Invocation_Graph;
-
----------------------------
-- Write_Unit_Information --
----------------------------
Close_Output_Library_Info;
end Write_ALI;
+ --------------------------------
+ -- Write_Invocation_Construct --
+ --------------------------------
+
+ procedure Write_Invocation_Construct (IC_Id : Invocation_Construct_Id) is
+ begin
+ -- G header
+
+ Write_Info_Initiate ('G');
+ Write_Info_Char (' ');
+
+ -- line-kind
+
+ Write_Info_Char
+ (Invocation_Graph_Line_Kind_To_Code (Invocation_Construct_Line));
+ Write_Info_Char (' ');
+
+ -- construct-kind
+
+ Write_Info_Char (Invocation_Construct_Kind_To_Code (Kind (IC_Id)));
+ Write_Info_Char (' ');
+
+ -- construct-spec-placement
+
+ Write_Info_Char
+ (Declaration_Placement_Kind_To_Code (Spec_Placement (IC_Id)));
+ Write_Info_Char (' ');
+
+ -- construct-body-placement
+
+ Write_Info_Char
+ (Declaration_Placement_Kind_To_Code (Body_Placement (IC_Id)));
+ Write_Info_Char (' ');
+
+ -- construct-signature
+
+ Write_Invocation_Signature (Signature (IC_Id));
+ Write_Info_EOL;
+ end Write_Invocation_Construct;
+
+ ---------------------------------------
+ -- Write_Invocation_Graph_Attributes --
+ ---------------------------------------
+
+ procedure Write_Invocation_Graph_Attributes is
+ begin
+ -- G header
+
+ Write_Info_Initiate ('G');
+ Write_Info_Char (' ');
+
+ -- line-kind
+
+ Write_Info_Char
+ (Invocation_Graph_Line_Kind_To_Code
+ (Invocation_Graph_Attributes_Line));
+ Write_Info_Char (' ');
+
+ -- encoding-kind
+
+ Write_Info_Char
+ (Invocation_Graph_Encoding_Kind_To_Code (Invocation_Graph_Encoding));
+ Write_Info_EOL;
+ end Write_Invocation_Graph_Attributes;
+
+ ----------------------------
+ -- Write_Invocation_Graph --
+ ----------------------------
+
+ procedure Write_Invocation_Graph is
+ begin
+ Write_Invocation_Graph_Attributes;
+
+ -- First write out all invocation constructs declared within the current
+ -- unit. This ensures that when this invocation is read, the invocation
+ -- constructs are materialized before they are referenced by invocation
+ -- relations.
+
+ For_Each_Invocation_Construct (Write_Invocation_Construct'Access);
+
+ -- Write out all invocation relations that originate from invocation
+ -- constructs delared in the current unit.
+
+ For_Each_Invocation_Relation (Write_Invocation_Relation'Access);
+ end Write_Invocation_Graph;
+
+ -------------------------------
+ -- Write_Invocation_Relation --
+ -------------------------------
+
+ procedure Write_Invocation_Relation (IR_Id : Invocation_Relation_Id) is
+ begin
+ -- G header
+
+ Write_Info_Initiate ('G');
+ Write_Info_Char (' ');
+
+ -- line-kind
+
+ Write_Info_Char
+ (Invocation_Graph_Line_Kind_To_Code (Invocation_Relation_Line));
+ Write_Info_Char (' ');
+
+ -- relation-kind
+
+ Write_Info_Char (Invocation_Kind_To_Code (Kind (IR_Id)));
+ Write_Info_Char (' ');
+
+ -- (extra-name | "none")
+
+ if Present (Extra (IR_Id)) then
+ Write_Info_Name (Extra (IR_Id));
+ else
+ Write_Info_Str ("none");
+ end if;
+
+ Write_Info_Char (' ');
+
+ -- invoker-signature
+
+ Write_Invocation_Signature (Invoker (IR_Id));
+ Write_Info_Char (' ');
+
+ -- target-signature
+
+ Write_Invocation_Signature (Target (IR_Id));
+
+ Write_Info_EOL;
+ end Write_Invocation_Relation;
+
+ --------------------------------
+ -- Write_Invocation_Signature --
+ --------------------------------
+
+ procedure Write_Invocation_Signature (IS_Id : Invocation_Signature_Id) is
+ begin
+ -- [
+
+ Write_Info_Char ('[');
+
+ -- name
+
+ Write_Info_Name (Name (IS_Id));
+ Write_Info_Char (' ');
+
+ -- scope
+
+ Write_Info_Name (Scope (IS_Id));
+ Write_Info_Char (' ');
+
+ -- line
+
+ Write_Info_Nat (Line (IS_Id));
+ Write_Info_Char (' ');
+
+ -- column
+
+ Write_Info_Nat (Column (IS_Id));
+ Write_Info_Char (' ');
+
+ -- (locations | "none")
+
+ if Present (Locations (IS_Id)) then
+ Write_Info_Name (Locations (IS_Id));
+ else
+ Write_Info_Str ("none");
+ end if;
+
+ -- ]
+
+ Write_Info_Char (']');
+ end Write_Invocation_Signature;
+
---------------------
-- Write_Unit_Name --
---------------------
-- locations of all instances where the initial declaration of the
-- construct appears.
--
+ -- When the line-kind denotes invocation graph attributes, line-attributes
+ -- are set as follows:
+ --
+ -- encoding-kind
+ --
+ -- Attribute encoding-kind is a Character which specifies the encoding
+ -- kind used when collecting invocation constructs and relations. Table
+ -- ALI.Invocation_Graph_Encoding_Codes lists all legal values.
+ --
-- When the line-kind denotes an invocation construct, line-attributes are
-- set as follows:
--
- -- construct-kind construct-body-placement construct-signature
+ -- construct-kind construct-spec-placement construct-body-placement
+ -- construct-signature
--
-- Attribute construct-kind is a Character which denotes the nature of
-- the construct. Table ALI.Invocation_Construct_Codes lists all legal
-- values.
--
+ -- Attribute construct-spec-placement is a Character which denotes the
+ -- placement of the construct's spec within the unit. All legal values
+ -- are listed in table ALI.Spec_And_Body_Placement_Codes.
+ --
-- Attribute construct-body-placement is a Character which denotes the
-- placement of the construct's body within the unit. All legal values
- -- are listed in table ALI.Body_Placement_Codes.
+ -- are listed in table ALI.Spec_And_Body_Placement_Codes.
--
-- Attribute construct-signature is the invocation signature of the
-- construct.
-- Postcondition_Verification - related routine
-- Protected_Entry_Call - not present
-- Protected_Subprogram_Call - not present
- -- Task_Activation - related task object
+ -- Task_Activation - not present
-- Task_Entry_Call - not present
-- Type_Initialization - related type
--
end if;
end Ensure_Unlocked;
+ -----------
+ -- Equal --
+ -----------
+
+ function Equal
+ (Left : Doubly_Linked_List;
+ Right : Doubly_Linked_List) return Boolean
+ is
+ Left_Head : Node_Ptr;
+ Left_Nod : Node_Ptr;
+ Right_Head : Node_Ptr;
+ Right_Nod : Node_Ptr;
+
+ begin
+ -- Two non-existent lists are considered equal
+
+ if Left = Nil and then Right = Nil then
+ return True;
+
+ -- A non-existent list is never equal to an already created list
+
+ elsif Left = Nil or else Right = Nil then
+ return False;
+
+ -- The two lists must contain the same number of elements to be equal
+
+ elsif Size (Left) /= Size (Right) then
+ return False;
+ end if;
+
+ -- Compare the two lists element by element
+
+ Left_Head := Left.Nodes'Access;
+ Left_Nod := Left_Head.Next;
+ Right_Head := Right.Nodes'Access;
+ Right_Nod := Right_Head.Next;
+ while Is_Valid (Left_Nod, Left_Head)
+ and then
+ Is_Valid (Right_Nod, Right_Head)
+ loop
+ if Left_Nod.Elem /= Right_Nod.Elem then
+ return False;
+ end if;
+
+ Left_Nod := Left_Nod.Next;
+ Right_Nod := Right_Nod.Next;
+ end loop;
+
+ return True;
+ end Equal;
+
---------------
-- Find_Node --
---------------
-- end of a list's lifetime. This action will raise Iterated if the
-- list has outstanding iterators.
+ function Equal
+ (Left : Doubly_Linked_List;
+ Right : Doubly_Linked_List) return Boolean;
+ -- Determine whether lists Left and Right have the same characteristics
+ -- and contain the same elements.
+
function First (L : Doubly_Linked_List) return Element_Type;
-- Obtain an element from the start of list L. This action will raise
-- List_Empty if the list is empty.
-- active scenarios. In_State is the current state of the Processing
-- phase.
+ procedure Record_Invocation_Graph_Encoding;
+ pragma Inline (Record_Invocation_Graph_Encoding);
+ -- Record the encoding format used to capture information related to
+ -- invocation constructs and relations.
+
procedure Record_Invocation_Path (In_State : Processing_In_State);
pragma Inline (Record_Invocation_Path);
-- Record the invocation relations found within the path represented in
(Constr_Id : Entity_Id;
In_State : Processing_In_State)
is
+ function Body_Placement_Of
+ (Id : Entity_Id) return Declaration_Placement_Kind;
+ pragma Inline (Body_Placement_Of);
+ -- Obtain the placement of arbitrary entity Id's body
+
+ function Declaration_Placement_Of_Node
+ (N : Node_Id) return Declaration_Placement_Kind;
+ pragma Inline (Declaration_Placement_Of_Node);
+ -- Obtain the placement of arbitrary node N
+
function Kind_Of (Id : Entity_Id) return Invocation_Construct_Kind;
pragma Inline (Kind_Of);
-- Obtain the invocation construct kind of arbitrary entity Id
- function Placement_Of (Id : Entity_Id) return Body_Placement_Kind;
- pragma Inline (Placement_Of);
- -- Obtain the body placement of arbitrary entity Id
-
- function Placement_Of_Node (N : Node_Id) return Body_Placement_Kind;
- pragma Inline (Placement_Of_Node);
- -- Obtain the body placement of arbitrary node N
-
- -------------
- -- Kind_Of --
- -------------
-
- function Kind_Of (Id : Entity_Id) return Invocation_Construct_Kind is
- begin
- if Id = Elab_Body_Id then
- return Elaborate_Body_Procedure;
-
- elsif Id = Elab_Spec_Id then
- return Elaborate_Spec_Procedure;
-
- else
- return Regular_Construct;
- end if;
- end Kind_Of;
+ function Spec_Placement_Of
+ (Id : Entity_Id) return Declaration_Placement_Kind;
+ pragma Inline (Spec_Placement_Of);
+ -- Obtain the placement of arbitrary entity Id's spec
- ------------------
- -- Placement_Of --
- ------------------
+ -----------------------
+ -- Body_Placement_Of --
+ -----------------------
- function Placement_Of (Id : Entity_Id) return Body_Placement_Kind is
+ function Body_Placement_Of
+ (Id : Entity_Id) return Declaration_Placement_Kind
+ is
Id_Rep : constant Target_Rep_Id :=
Target_Representation_Of (Id, In_State);
Body_Decl : constant Node_Id := Body_Declaration (Id_Rep);
-- The entity has a body
if Present (Body_Decl) then
- return Placement_Of_Node (Body_Decl);
+ return Declaration_Placement_Of_Node (Body_Decl);
-- Otherwise the entity must have a spec
else
pragma Assert (Present (Spec_Decl));
- return Placement_Of_Node (Spec_Decl);
+ return Declaration_Placement_Of_Node (Spec_Decl);
end if;
- end Placement_Of;
+ end Body_Placement_Of;
- -----------------------
- -- Placement_Of_Node --
- -----------------------
+ -----------------------------------
+ -- Declaration_Placement_Of_Node --
+ -----------------------------------
- function Placement_Of_Node (N : Node_Id) return Body_Placement_Kind is
+ function Declaration_Placement_Of_Node
+ (N : Node_Id) return Declaration_Placement_Kind
+ is
Main_Unit_Id : constant Entity_Id := Cunit_Entity (Main_Unit);
N_Unit_Id : constant Entity_Id := Find_Top_Unit (N);
else
return In_Body;
end if;
- end Placement_Of_Node;
+ end Declaration_Placement_Of_Node;
- -- Local variables
+ -------------
+ -- Kind_Of --
+ -------------
+
+ function Kind_Of (Id : Entity_Id) return Invocation_Construct_Kind is
+ begin
+ if Id = Elab_Body_Id then
+ return Elaborate_Body_Procedure;
+
+ elsif Id = Elab_Spec_Id then
+ return Elaborate_Spec_Procedure;
+
+ else
+ return Regular_Construct;
+ end if;
+ end Kind_Of;
- IC_Rec : Invocation_Construct_Record;
+ -----------------------
+ -- Spec_Placement_Of --
+ -----------------------
+
+ function Spec_Placement_Of
+ (Id : Entity_Id) return Declaration_Placement_Kind
+ is
+ Id_Rep : constant Target_Rep_Id :=
+ Target_Representation_Of (Id, In_State);
+ Body_Decl : constant Node_Id := Body_Declaration (Id_Rep);
+ Spec_Decl : constant Node_Id := Spec_Declaration (Id_Rep);
+
+ begin
+ -- The entity has a spec
+
+ if Present (Spec_Decl) then
+ return Declaration_Placement_Of_Node (Spec_Decl);
+
+ -- Otherwise the entity must have a body
+
+ else
+ pragma Assert (Present (Body_Decl));
+ return Declaration_Placement_Of_Node (Body_Decl);
+ end if;
+ end Spec_Placement_Of;
-- Start of processing for Declare_Invocation_Construct
Set_Is_Saved_Construct (Constr_Id);
- IC_Rec.Kind := Kind_Of (Constr_Id);
- IC_Rec.Placement := Placement_Of (Constr_Id);
- IC_Rec.Signature := Signature_Of (Constr_Id);
-
-- Add the construct in the ALI file
Add_Invocation_Construct
- (IC_Rec => IC_Rec,
- Update_Units => False);
+ (Body_Placement => Body_Placement_Of (Constr_Id),
+ Kind => Kind_Of (Constr_Id),
+ Signature => Signature_Of (Constr_Id),
+ Spec_Placement => Spec_Placement_Of (Constr_Id),
+ Update_Units => False);
end Declare_Invocation_Construct;
-------------------------------
return;
end if;
+ -- Save the encoding format used to capture information about the
+ -- invocation constructs and relations in the ALI file of the main
+ -- unit.
+
+ Record_Invocation_Graph_Encoding;
+
-- Examine all library level invocation scenarios and perform DFS
-- traversals from each one. Encode a path in the ALI file of the
-- main unit if it reaches into an external unit.
Process_Main_Unit;
end Record_Invocation_Graph;
+ --------------------------------------
+ -- Record_Invocation_Graph_Encoding --
+ --------------------------------------
+
+ procedure Record_Invocation_Graph_Encoding is
+ Kind : Invocation_Graph_Encoding_Kind := No_Encoding;
+
+ begin
+ -- Switch -gnatd_F (encode full invocation paths in ALI files) is in
+ -- effect.
+
+ if Debug_Flag_Underscore_FF then
+ Kind := Full_Path_Encoding;
+ else
+ Kind := Endpoints_Encoding;
+ end if;
+
+ -- Save the encoding format in the ALI file of the main unit
+
+ Set_Invocation_Graph_Encoding
+ (Kind => Kind,
+ Update_Units => False);
+ end Record_Invocation_Graph_Encoding;
+
----------------------------
-- Record_Invocation_Path --
----------------------------
(Extra : out Entity_Id;
Kind : out Invocation_Kind)
is
+ Targ_Rep : constant Target_Rep_Id :=
+ Target_Representation_Of (Targ_Id, In_State);
+ Spec_Decl : constant Node_Id := Spec_Declaration (Targ_Rep);
+
begin
-- Accept within a task body
-- Postcondition verification
elsif Is_Postconditions_Proc (Targ_Id) then
- Extra := Find_Enclosing_Scope (Targ_Id);
+ Extra := Find_Enclosing_Scope (Spec_Decl);
Kind := Postcondition_Verification;
-- Protected entry call
Extra : Entity_Id;
Extra_Nam : Name_Id;
- IR_Rec : Invocation_Relation_Record;
Kind : Invocation_Kind;
Rel : Invoker_Target_Relation;
Extra_Nam := No_Name;
end if;
- IR_Rec.Extra := Extra_Nam;
- IR_Rec.Invoker := Signature_Of (Invk_Id);
- IR_Rec.Kind := Kind;
- IR_Rec.Target := Signature_Of (Targ_Id);
-
-- Add the relation in the ALI file
Add_Invocation_Relation
- (IR_Rec => IR_Rec,
+ (Extra => Extra_Nam,
+ Invoker => Signature_Of (Invk_Id),
+ Kind => Kind,
+ Target => Signature_Of (Targ_Id),
Update_Units => False);
end Record_Invocation_Relation;
projects / gcc.git / commitdiff