diff options
author | Hristian Kirtchev <kirtchev@adacore.com> | 2019-07-05 07:02:08 +0000 |
---|---|---|
committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2019-07-05 07:02:08 +0000 |
commit | 9795b20366362d63be058f1e4f3009d6bad79310 (patch) | |
tree | aba3763d81a519c490994b1fce8918c7e31e31c2 /gcc | |
parent | db6261488e4e53e4ac09ec9db50ea2e4a1859377 (diff) | |
download | gcc-9795b20366362d63be058f1e4f3009d6bad79310.zip gcc-9795b20366362d63be058f1e4f3009d6bad79310.tar.gz gcc-9795b20366362d63be058f1e4f3009d6bad79310.tar.bz2 |
[Ada] Diagnostics in Elaboration order v4.0
This patch introduces several changes to the new elaboration order
mechanism:
* The library graph can now discover, store, and organize the various
cycles it contains.
* The elaboration order mechanism can now diagnose one or all cycles
within the library graph. Diagnostics consist of describing the
reason for the cycle, listing all units comprising the circuit, and
offering suggestions on how to break the cycle.
The patch also modifies unit ALI to hide all invocation-related data
structures and several implementation-specific types by relocating them
in the body of the unit.
The patch cleans up most children of Bindo by using better names of
routines and formal parameters.
------------
-- Source --
------------
-- a.ads
with B; pragma Elaborate_All (B);
with C; pragma Elaborate_All (C);
package A is
end A;
-- b.ads
package B is
procedure Force_Body;
end B;
-- b.adb
with D;
package body B is
procedure Force_Body is null;
Elab : constant Integer := D.Func;
end B;
-- c.ads
package C is
procedure Force_Body;
end C;
-- c.adb
with E;
package body C is
procedure Force_Body is null;
end C;
-- d.ads
package D is
function Func return Integer;
end D;
-- d.adb
with A;
package body D is
Local : Integer := 123;
function Func return Integer is
begin
return Local;
end Func;
end D;
-- e.ads
with A;
package E is
end E;
-- main.adb
with B;
-- Elaborate_All Elaborate_All with
-- C spec <--------------- A spec ---------------------> B spec <------ Main
-- ^ ^ ^ ^
-- | | | |
-- sbb | | | | sbb
-- | | | |
-- C body -----------> E spec | D spec <--------- B body
-- with | ^ with |
-- | | |
-- | sbb | |
-- | | |
-- +------ D body <------------+
-- with Invocation
--
-- The cycles are
--
-- A spec --> C spec --> E spec --> A spec
-- C body
--
-- A spec --> B spec --> D body --> A spec
-- B body
procedure Main is begin null; end Main;
----------------------------
-- Compilation and output --
----------------------------
$ gnatmake -q main.adb -bargs -d_C -d_N
error: Elaboration circularity detected
info:
info: Reason:
info:
info: unit "a (spec)" depends on its own elaboration
info:
info: Circularity:
info:
info: unit "a (spec)" has with clause and pragma Elaborate_All for unit
"b (spec)"
info: unit "b (body)" is in the closure of pragma Elaborate_All
info: unit "b (body)" has with clause for unit "d (spec)"
info: unit "d (body)" is in the closure of pragma Elaborate_All
info: unit "d (body)" has with clause for unit "a (spec)"
info:
info: Suggestions:
info:
info: change pragma Elaborate_All for unit "b (spec)" to Elaborate in unit
"a (spec)"
info: remove pragma Elaborate_All for unit "b (spec)" in unit "a (spec)"
info:
error: Elaboration circularity detected
info:
info: Reason:
info:
info: unit "a (spec)" depends on its own elaboration
info:
info: Circularity:
info:
info: unit "a (spec)" has with clause and pragma Elaborate_All for unit
"c (spec)"
info: unit "c (body)" is in the closure of pragma Elaborate_All
info: unit "c (body)" has with clause for unit "e (spec)"
info: unit "e (spec)" has with clause for unit "a (spec)"
info:
info: Suggestions:
info:
info: change pragma Elaborate_All for unit "c (spec)" to Elaborate in unit
"a (spec)"
info: remove pragma Elaborate_All for unit "c (spec)" in unit "a (spec)"
info:
gnatmake: *** bind failed.
2019-07-05 Hristian Kirtchev <kirtchev@adacore.com>
gcc/ada/
* 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.
From-SVN: r273107
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ChangeLog | 209 | ||||
-rw-r--r-- | gcc/ada/ali.adb | 551 | ||||
-rw-r--r-- | gcc/ada/ali.ads | 315 | ||||
-rw-r--r-- | gcc/ada/bindo-augmentors.adb | 153 | ||||
-rw-r--r-- | gcc/ada/bindo-builders.adb | 229 | ||||
-rw-r--r-- | gcc/ada/bindo-builders.ads | 6 | ||||
-rw-r--r-- | gcc/ada/bindo-diagnostics.adb | 1469 | ||||
-rw-r--r-- | gcc/ada/bindo-diagnostics.ads | 20 | ||||
-rw-r--r-- | gcc/ada/bindo-elaborators.adb | 447 | ||||
-rw-r--r-- | gcc/ada/bindo-graphs.adb | 3155 | ||||
-rw-r--r-- | gcc/ada/bindo-graphs.ads | 680 | ||||
-rw-r--r-- | gcc/ada/bindo-units.adb | 66 | ||||
-rw-r--r-- | gcc/ada/bindo-units.ads | 32 | ||||
-rw-r--r-- | gcc/ada/bindo-validators.adb | 460 | ||||
-rw-r--r-- | gcc/ada/bindo-validators.ads | 20 | ||||
-rw-r--r-- | gcc/ada/bindo-writers.adb | 369 | ||||
-rw-r--r-- | gcc/ada/bindo-writers.ads | 10 | ||||
-rw-r--r-- | gcc/ada/bindo.adb | 125 | ||||
-rw-r--r-- | gcc/ada/debug.adb | 33 | ||||
-rw-r--r-- | gcc/ada/gnatbind.adb | 10 | ||||
-rw-r--r-- | gcc/ada/lib-writ.adb | 544 | ||||
-rw-r--r-- | gcc/ada/lib-writ.ads | 20 | ||||
-rw-r--r-- | gcc/ada/libgnat/g-lists.adb | 51 | ||||
-rw-r--r-- | gcc/ada/libgnat/g-lists.ads | 6 | ||||
-rw-r--r-- | gcc/ada/sem_elab.adb | 172 |
25 files changed, 6931 insertions, 2221 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b1b98f2..279eac5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,212 @@ +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 diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index 978fb3d..aa8b242 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -39,10 +39,115 @@ package body ALI is 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 @@ -68,14 +173,19 @@ package body ALI is 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. @@ -112,13 +222,23 @@ package body ALI is 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 @@ -153,18 +273,22 @@ package body ALI is ------------------------------ 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. @@ -174,7 +298,7 @@ package body ALI is 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; @@ -184,20 +308,24 @@ package body ALI is ----------------------------- 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. @@ -207,41 +335,42 @@ package body ALI is 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 -- @@ -263,6 +392,26 @@ package body ALI is 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 -- ----------------------------- @@ -291,7 +440,7 @@ package body ALI is (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 @@ -303,6 +452,27 @@ package body ALI is 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 -- ------------- @@ -313,6 +483,50 @@ package body ALI is 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 -- ---------- @@ -428,6 +642,26 @@ package body ALI is 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 -- ---------------------------------------- @@ -489,6 +723,70 @@ package body ALI is 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 -- ------------- @@ -638,7 +936,7 @@ package body ALI is -- -- 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 '"' @@ -674,7 +972,7 @@ package body ALI 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 @@ -1204,6 +1502,13 @@ package body ALI is -- * 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 @@ -1225,51 +1530,78 @@ package body ALI is ------------------------------------ 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 (' '); @@ -1277,20 +1609,20 @@ package body ALI is -- 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; ------------------------------- @@ -1378,13 +1710,16 @@ package body ALI is -- 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; -------------- @@ -3064,7 +3399,7 @@ package body ALI is ALIs.Table (Id).Last_Sdep := Sdep.Last; - -- Loop through invocation graph lines + -- Loop through invocation-graph lines G_Loop : loop Check_Unknown_Line; @@ -3436,6 +3771,16 @@ package body ALI is 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 -- --------- @@ -3445,6 +3790,30 @@ package body ALI is 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 -- ----------- @@ -3461,4 +3830,40 @@ package body ALI is 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; diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads index 79eabb1..6db9e49 100644 --- a/gcc/ada/ali.ads +++ b/gcc/ada/ali.ads @@ -112,6 +112,20 @@ package ALI is 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 @@ -368,6 +382,11 @@ package ALI is 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 @@ -1087,6 +1106,20 @@ package ALI is -- 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 := @@ -1094,59 +1127,20 @@ package ALI is 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 @@ -1162,35 +1156,6 @@ package ALI is 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 @@ -1220,94 +1185,60 @@ package ALI 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); @@ -1316,17 +1247,58 @@ package ALI is 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; @@ -1342,6 +1314,63 @@ package ALI is 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 -- -------------------------------------- diff --git a/gcc/ada/bindo-augmentors.adb b/gcc/ada/bindo-augmentors.adb index f97f0d0..af39464 100644 --- a/gcc/ada/bindo-augmentors.adb +++ b/gcc/ada/bindo-augmentors.adb @@ -29,9 +29,6 @@ with Types; use Types; with Bindo.Writers; use Bindo.Writers; -with GNAT; use GNAT; -with GNAT.Sets; use GNAT.Sets; - package body Bindo.Augmentors is ------------------------------ @@ -41,22 +38,12 @@ 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 -- @@ -75,16 +62,16 @@ package body Bindo.Augmentors is ----------------------- 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); @@ -106,26 +93,26 @@ package body Bindo.Augmentors is -- 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); @@ -166,13 +153,13 @@ package body Bindo.Augmentors is ---------------- 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; -------------------- @@ -180,17 +167,17 @@ package body Bindo.Augmentors is -------------------- 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; @@ -203,24 +190,24 @@ package body Bindo.Augmentors is 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; ----------------------------- @@ -237,7 +224,6 @@ package body Bindo.Augmentors is Iter := Iterate_Elaboration_Roots (Inv_Graph); while Has_Next (Iter) loop Next (Iter, Root); - pragma Assert (Present (Root)); Visit_Elaboration_Root (Root); end loop; @@ -248,34 +234,33 @@ package body Bindo.Augmentors is ------------------ 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 @@ -287,10 +272,10 @@ package body Bindo.Augmentors is -- 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 @@ -299,7 +284,9 @@ package body Bindo.Augmentors 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 @@ -308,8 +295,8 @@ package body Bindo.Augmentors is 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; @@ -317,23 +304,19 @@ package body Bindo.Augmentors is -- 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; diff --git a/gcc/ada/bindo-builders.adb b/gcc/ada/bindo-builders.adb index c0340c0..f4b8e42 100644 --- a/gcc/ada/bindo-builders.adb +++ b/gcc/ada/bindo-builders.adb @@ -64,10 +64,10 @@ package body Bindo.Builders is 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); @@ -75,6 +75,14 @@ package body Bindo.Builders is -- 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 -- ---------------------------- @@ -88,8 +96,9 @@ package body Bindo.Builders is -- 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); @@ -107,33 +116,24 @@ package body Bindo.Builders is 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; @@ -162,35 +162,25 @@ package body Bindo.Builders is 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; --------------------- @@ -203,18 +193,37 @@ package body Bindo.Builders is 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; ---------------------------- @@ -235,7 +244,7 @@ package body Bindo.Builders is 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, @@ -253,9 +262,10 @@ package body Bindo.Builders is 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 -- @@ -348,20 +358,24 @@ package body Bindo.Builders is 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); @@ -383,14 +397,11 @@ package body Bindo.Builders is 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 (" <-- "); @@ -399,8 +410,8 @@ package body Bindo.Builders is 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; @@ -409,15 +420,15 @@ package body Bindo.Builders is ------------------------- 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. @@ -425,36 +436,35 @@ package body Bindo.Builders is 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; ------------------------------- @@ -462,42 +472,37 @@ package body Bindo.Builders is ------------------------------- 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; @@ -531,11 +536,8 @@ package body Bindo.Builders is 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. @@ -545,8 +547,7 @@ package body Bindo.Builders is 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 @@ -557,15 +558,12 @@ package body Bindo.Builders is -- 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; @@ -586,7 +584,7 @@ package body Bindo.Builders is Add_Edge (G => Lib_Graph, - Pred => Withed_LGV_Id, + Pred => Withed_Vertex, Succ => Succ, Kind => Kind); end Create_With_Edge; @@ -596,18 +594,13 @@ package body Bindo.Builders is ----------------------- 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; ----------------------- @@ -655,7 +648,7 @@ package body Bindo.Builders is 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); @@ -698,7 +691,7 @@ package body Bindo.Builders is 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; ------------------------- diff --git a/gcc/ada/bindo-builders.ads b/gcc/ada/bindo-builders.ads index 54c39e4..0e8519f 100644 --- a/gcc/ada/bindo-builders.ads +++ b/gcc/ada/bindo-builders.ads @@ -56,9 +56,11 @@ package Bindo.Builders is ---------------------------- 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; diff --git a/gcc/ada/bindo-diagnostics.adb b/gcc/ada/bindo-diagnostics.adb index bf11d39..a4b031d 100644 --- a/gcc/ada/bindo-diagnostics.adb +++ b/gcc/ada/bindo-diagnostics.adb @@ -23,50 +23,1457 @@ -- -- ------------------------------------------------------------------------------ +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; diff --git a/gcc/ada/bindo-diagnostics.ads b/gcc/ada/bindo-diagnostics.ads index 3b1d01c..3835a68 100644 --- a/gcc/ada/bindo-diagnostics.ads +++ b/gcc/ada/bindo-diagnostics.ads @@ -30,6 +30,7 @@ with Bindo.Graphs; use Bindo.Graphs; +use Bindo.Graphs.Invocation_Graphs; use Bindo.Graphs.Library_Graphs; package Bindo.Diagnostics is @@ -46,16 +47,15 @@ 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; diff --git a/gcc/ada/bindo-elaborators.adb b/gcc/ada/bindo-elaborators.adb index b11598c..d26101a 100644 --- a/gcc/ada/bindo-elaborators.adb +++ b/gcc/ada/bindo-elaborators.adb @@ -23,11 +23,10 @@ -- -- ------------------------------------------------------------------------------ -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; @@ -40,7 +39,6 @@ use Bindo.Builders.Library_Graph_Builders; with Bindo.Diagnostics; use Bindo.Diagnostics; -use Bindo.Diagnostics.Cycle_Diagnostics; with Bindo.Units; use Bindo.Units; @@ -61,7 +59,6 @@ use Bindo.Writers.Unit_Closure_Writers; with GNAT; use GNAT; with GNAT.Graphs; use GNAT.Graphs; -with GNAT.Sets; use GNAT.Sets; package body Bindo.Elaborators is @@ -89,49 +86,39 @@ 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. @@ -139,7 +126,7 @@ package body Bindo.Elaborators is 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 @@ -148,7 +135,7 @@ package body Bindo.Elaborators is 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); @@ -170,6 +157,7 @@ package body Bindo.Elaborators is 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; @@ -177,8 +165,10 @@ package body Bindo.Elaborators is 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); @@ -196,26 +186,26 @@ package body Bindo.Elaborators is 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); @@ -224,17 +214,17 @@ package body Bindo.Elaborators is -- 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 @@ -266,12 +256,12 @@ package body Bindo.Elaborators is 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. @@ -280,8 +270,8 @@ package body Bindo.Elaborators is (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); @@ -297,8 +287,8 @@ package body Bindo.Elaborators is 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); @@ -317,30 +307,30 @@ package body Bindo.Elaborators is 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; @@ -350,24 +340,24 @@ package body Bindo.Elaborators is 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, @@ -375,28 +365,28 @@ package body Bindo.Elaborators is -- 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, @@ -411,24 +401,23 @@ package body Bindo.Elaborators is 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, @@ -445,25 +434,24 @@ package body Bindo.Elaborators is 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, @@ -480,18 +468,18 @@ package body Bindo.Elaborators is 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, @@ -518,7 +506,7 @@ package body Bindo.Elaborators is Elaborate_Vertex (G => G, - LGV_Id => Candidate, + Vertex => Candidate, All_Candidates => All_Candidates, Comp_Candidates => Comp_Candidates, Remaining_Vertices => Remaining_Vertices, @@ -527,7 +515,7 @@ package body Bindo.Elaborators is Indent => Nested_Indentation); end loop; - Destroy (Comp_Candidates); + LGV_Sets.Destroy (Comp_Candidates); end Elaborate_Component; ----------------------------- @@ -539,9 +527,8 @@ package body Bindo.Elaborators is 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; @@ -585,19 +572,16 @@ package body Bindo.Elaborators is -- 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 @@ -642,7 +626,7 @@ package body Bindo.Elaborators is 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); @@ -673,6 +657,7 @@ package body Bindo.Elaborators is 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; @@ -682,7 +667,7 @@ package body Bindo.Elaborators is -- 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); @@ -746,6 +731,7 @@ package body Bindo.Elaborators is Elaborate_Units_Common (Use_Inv_Graph => True, + Is_Dyn_Elab => True, Inv_Graph => Mix_Inv_Graph, Lib_Graph => Mix_Lib_Graph, Order => Mix_Order, @@ -761,9 +747,9 @@ package body Bindo.Elaborators is -- 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. @@ -776,6 +762,7 @@ package body Bindo.Elaborators is Elaborate_Units_Common (Use_Inv_Graph => False, + Is_Dyn_Elab => True, Inv_Graph => Dyn_Inv_Graph, Lib_Graph => Dyn_Lib_Graph, Order => Dyn_Order, @@ -792,9 +779,9 @@ package body Bindo.Elaborators is -- 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); @@ -827,6 +814,7 @@ package body Bindo.Elaborators is Elaborate_Units_Common (Use_Inv_Graph => True, + Is_Dyn_Elab => False, Inv_Graph => Inv_Graph, Lib_Graph => Lib_Graph, Order => Order, @@ -835,9 +823,9 @@ package body Bindo.Elaborators is -- 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); @@ -856,27 +844,24 @@ package body Bindo.Elaborators is 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); @@ -887,20 +872,17 @@ package body Bindo.Elaborators is -- 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 @@ -912,7 +894,7 @@ package body Bindo.Elaborators is Update_Successors (G => G, - Pred => LGV_Id, + Pred => Vertex, All_Candidates => All_Candidates, Comp_Candidates => Comp_Candidates, Step => Step, @@ -922,13 +904,10 @@ package body Bindo.Elaborators is -- 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, @@ -944,17 +923,17 @@ package body Bindo.Elaborators is 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 @@ -963,21 +942,19 @@ package body Bindo.Elaborators is -- 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); @@ -987,14 +964,14 @@ package body Bindo.Elaborators is 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); @@ -1009,48 +986,48 @@ package body Bindo.Elaborators is ------------------------- 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; @@ -1058,7 +1035,8 @@ package body Bindo.Elaborators is -- 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; @@ -1068,18 +1046,18 @@ package body Bindo.Elaborators is 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; @@ -1087,17 +1065,16 @@ package body Bindo.Elaborators is 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); @@ -1118,8 +1095,8 @@ package body Bindo.Elaborators is 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; @@ -1145,8 +1122,8 @@ package body Bindo.Elaborators is 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; @@ -1168,13 +1145,13 @@ package body Bindo.Elaborators is 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; @@ -1187,15 +1164,14 @@ package body Bindo.Elaborators is 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); @@ -1209,21 +1185,21 @@ package body Bindo.Elaborators is 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; @@ -1233,31 +1209,31 @@ package body Bindo.Elaborators is 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; @@ -1271,8 +1247,8 @@ package body Bindo.Elaborators is (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 @@ -1281,26 +1257,28 @@ package body Bindo.Elaborators 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); @@ -1341,11 +1319,11 @@ package body Bindo.Elaborators is 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 @@ -1357,15 +1335,14 @@ package body Bindo.Elaborators is 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; @@ -1377,36 +1354,30 @@ package body Bindo.Elaborators is 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, diff --git a/gcc/ada/bindo-graphs.adb b/gcc/ada/bindo-graphs.adb index b2f458c..c68e367 100644 --- a/gcc/ada/bindo-graphs.adb +++ b/gcc/ada/bindo-graphs.adb @@ -25,7 +25,12 @@ 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 @@ -33,33 +38,73 @@ 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; ---------------------------------- @@ -67,25 +112,38 @@ package body Bindo.Graphs is ---------------------------------- 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; ------------------------------- @@ -93,12 +151,12 @@ package body Bindo.Graphs is ------------------------------- 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; ----------------------- @@ -116,18 +174,18 @@ package body Bindo.Graphs is (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; @@ -138,9 +196,9 @@ package body Bindo.Graphs is 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 @@ -159,9 +217,9 @@ package body Bindo.Graphs is 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; @@ -172,18 +230,18 @@ package body Bindo.Graphs is -- 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. -------------- @@ -205,10 +263,7 @@ package body Bindo.Graphs is (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 @@ -218,22 +273,22 @@ package body Bindo.Graphs is 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. @@ -242,7 +297,7 @@ package body Bindo.Graphs is -- 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; ---------------- @@ -250,67 +305,97 @@ package body Bindo.Graphs is ---------------- 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)); - - IC_Rec : Invocation_Construct_Record renames - Invocation_Constructs.Table (IC_Id); + pragma Assert (Present (Body_Vertex)); + pragma Assert (Present (Spec_Vertex)); - 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; -------------------------- @@ -325,7 +410,7 @@ package body Bindo.Graphs is 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; ------------ @@ -339,15 +424,15 @@ package body Bindo.Graphs is 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; @@ -360,12 +445,12 @@ package body Bindo.Graphs is 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; @@ -375,9 +460,9 @@ package body Bindo.Graphs is ----------------------------------- 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; @@ -399,9 +484,9 @@ package body Bindo.Graphs is ------------------------------------- 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; @@ -418,20 +503,35 @@ package body Bindo.Graphs is 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; ------------------------ @@ -440,14 +540,14 @@ package body Bindo.Graphs is 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; -------------- @@ -483,7 +583,7 @@ package body Bindo.Graphs is 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; ------------------------------- @@ -552,23 +652,19 @@ package body Bindo.Graphs is 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)); + pragma Assert (Present (Vertex)); - IC_Id : constant Invocation_Construct_Id := Construct (G, IGV_Id); - - pragma Assert (Present (IC_Id)); - - 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; ---------------------------------------- @@ -582,7 +678,7 @@ package body Bindo.Graphs is begin pragma Assert (Present (G)); - return ST.Contains (G.Relations, Rel); + return Relation_Sets.Contains (G.Relations, Rel); end Is_Existing_Source_Target_Relation; ----------------------- @@ -617,15 +713,15 @@ package body Bindo.Graphs is 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; ------------------------------- @@ -638,7 +734,7 @@ package body Bindo.Graphs is 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; ---------- @@ -646,37 +742,30 @@ package body Bindo.Graphs is ---------- 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 (IR_Id)); - - IR_Rec : Invocation_Relation_Record renames - Invocation_Relations.Table (IR_Id); + pragma Assert (Present (Edge)); - 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 -- @@ -684,25 +773,13 @@ package body Bindo.Graphs is 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)); + pragma Assert (Present (Vertex)); - IC_Id : constant Invocation_Construct_Id := Construct (G, IGV_Id); - - pragma Assert (Present (IC_Id)); - - 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; ---------- @@ -710,11 +787,11 @@ package body Bindo.Graphs is ---------- 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; ---------- @@ -723,10 +800,10 @@ package body Bindo.Graphs is 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; ---------- @@ -734,11 +811,11 @@ package body Bindo.Graphs is ---------- 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; ---------- @@ -750,7 +827,7 @@ package body Bindo.Graphs is Root : out Invocation_Graph_Vertex_Id) is begin - ER.Next (ER.Iterator (Iter), Root); + IGV_Sets.Next (IGV_Sets.Iterator (Iter), Root); end Next; --------------------- @@ -770,13 +847,13 @@ package body Bindo.Graphs is 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; --------------------------------- @@ -789,7 +866,7 @@ package body Bindo.Graphs is begin pragma Assert (Present (G)); - return ER.Size (G.Roots); + return IGV_Sets.Size (G.Roots); end Number_Of_Elaboration_Roots; ------------------------ @@ -817,14 +894,14 @@ package body Bindo.Graphs is -------------- 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; --------------------------- @@ -839,7 +916,7 @@ package body Bindo.Graphs is pragma Assert (Present (G)); pragma Assert (Present (Root)); - ER.Insert (G.Roots, Root); + IGV_Sets.Insert (G.Roots, Root); end Save_Elaboration_Root; ------------------------------ @@ -849,14 +926,14 @@ package body Bindo.Graphs is 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; -------------------------------------------- @@ -874,9 +951,9 @@ package body Bindo.Graphs is 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; @@ -885,15 +962,15 @@ package body Bindo.Graphs is ------------------------ 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; ------------------------ @@ -902,29 +979,44 @@ package body Bindo.Graphs is 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; @@ -934,14 +1026,17 @@ package body Bindo.Graphs is 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 -- @@ -949,21 +1044,31 @@ package body Bindo.Graphs is 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; @@ -975,6 +1080,38 @@ package body Bindo.Graphs is -- 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); @@ -983,7 +1120,7 @@ package body Bindo.Graphs is 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 @@ -991,9 +1128,52 @@ package body Bindo.Graphs is 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 @@ -1005,27 +1185,41 @@ package body Bindo.Graphs is 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); @@ -1041,9 +1235,9 @@ package body Bindo.Graphs is 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); @@ -1051,20 +1245,174 @@ package body Bindo.Graphs is -- 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; @@ -1080,27 +1428,70 @@ package body Bindo.Graphs is 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); @@ -1108,8 +1499,8 @@ package body Bindo.Graphs is -- 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 @@ -1121,15 +1512,15 @@ package body Bindo.Graphs is 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 @@ -1150,31 +1541,31 @@ package body Bindo.Graphs is -- 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; @@ -1184,27 +1575,64 @@ package body Bindo.Graphs is 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 -- -------------- @@ -1215,8 +1643,8 @@ package body Bindo.Graphs is 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)); @@ -1224,7 +1652,7 @@ package body Bindo.Graphs is pragma Assert (Present (Succ)); pragma Assert (Kind /= No_Edge); - LGE_Id := + Edge := Add_Edge_With_Return (G => G, Pred => Pred, @@ -1251,17 +1679,17 @@ package body Bindo.Graphs is (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 @@ -1269,22 +1697,22 @@ package body Bindo.Graphs is 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. @@ -1295,7 +1723,7 @@ package body Bindo.Graphs is Increment_Library_Graph_Edge_Count (G, Kind); - return LGE_Id; + return Edge; end Add_Edge_With_Return; ---------------- @@ -1306,7 +1734,7 @@ package body Bindo.Graphs is (G : Library_Graph; U_Id : Unit_Id) is - LGV_Id : Library_Graph_Vertex_Id; + Vertex : Library_Graph_Vertex_Id; begin pragma Assert (Present (G)); @@ -1318,17 +1746,17 @@ package body Bindo.Graphs is 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, @@ -1336,37 +1764,131 @@ package body Bindo.Graphs is -- 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; -------------------------- @@ -1381,7 +1903,7 @@ package body Bindo.Graphs is 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; ------------ @@ -1389,25 +1911,63 @@ package body Bindo.Graphs is ------------ 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 -- ---------------------------------------- @@ -1449,17 +2009,17 @@ package body Bindo.Graphs is 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; ----------------------------------- @@ -1468,22 +2028,21 @@ package body Bindo.Graphs is 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; @@ -1492,26 +2051,22 @@ package body Bindo.Graphs is ----------------- 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)); + 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)); - - 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. @@ -1521,15 +2076,15 @@ package body Bindo.Graphs is -- 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; ------------- @@ -1540,12 +2095,15 @@ package body Bindo.Graphs is 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; @@ -1562,17 +2120,16 @@ package body Bindo.Graphs is 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 -- @@ -1591,9 +2148,9 @@ package body Bindo.Graphs is ---------------------------------- 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; @@ -1610,12 +2167,256 @@ package body Bindo.Graphs is null; end Destroy_Library_Graph_Vertex_Attributes; + --------------- + -- File_Name -- + --------------- + + function File_Name + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return File_Name_Type + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + return File_Name (Unit (G, Vertex)); + end File_Name; + + ------------------------------------ + -- Find_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 : EL.Doubly_Linked_List; + Edges : LGE_Lists.Doubly_Linked_List; begin pragma Assert (Present (G)); @@ -1629,7 +2430,7 @@ package body Bindo.Graphs is -- 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); @@ -1638,7 +2439,7 @@ package body Bindo.Graphs is -- 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. @@ -1646,6 +2447,100 @@ package body Bindo.Graphs is 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 -- ------------------------------ @@ -1658,23 +2553,37 @@ package body Bindo.Graphs is 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; ------------------------ @@ -1683,31 +2592,61 @@ package body Bindo.Graphs is 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 @@ -1718,6 +2657,15 @@ package body Bindo.Graphs is -- 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)); @@ -1754,12 +2702,50 @@ package body Bindo.Graphs is -- 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 -- ----------------------------------------- @@ -1776,21 +2762,106 @@ package body Bindo.Graphs is 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 -- ---------------------------------------- @@ -1832,17 +2903,17 @@ package body Bindo.Graphs is 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; --------------------------- @@ -1858,26 +2929,100 @@ package body Bindo.Graphs is -- 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 @@ -1890,19 +3035,17 @@ package body Bindo.Graphs is 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)); - - if Is_Body_With_Spec (G, LGV_Id) then - Spec_LGV_Id := Proper_Spec (G, LGV_Id); - pragma Assert (Present (Spec_LGV_Id)); + pragma Assert (Present (Vertex)); - 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; @@ -1914,21 +3057,172 @@ package body Bindo.Graphs is 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 -- ----------------------------- @@ -1955,29 +3249,28 @@ package body Bindo.Graphs is 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; @@ -1987,34 +3280,30 @@ package body Bindo.Graphs is 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 @@ -2022,14 +3311,14 @@ package body Bindo.Graphs is -- 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; @@ -2038,21 +3327,71 @@ package body Bindo.Graphs is 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 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; - return PS.Contains (G.Relations, Rel); - end Is_Existing_Predecessor_Successor_Relation; + -------------------- + -- 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 -- @@ -2060,18 +3399,29 @@ package body Bindo.Graphs is 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 -- @@ -2079,17 +3429,13 @@ package body Bindo.Graphs is 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)); - - U_Id : constant Unit_Id := Unit (G, LGV_Id); - - pragma Assert (Present (U_Id)); + pragma Assert (Present (Vertex)); - begin - return Is_Predefined_Unit (U_Id); + return Is_Predefined_Unit (Unit (G, Vertex)); end Is_Predefined_Unit; --------------------------- @@ -2098,36 +3444,60 @@ package body Bindo.Graphs is 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 @@ -2140,15 +3510,12 @@ package body Bindo.Graphs is 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 @@ -2161,17 +3528,45 @@ package body Bindo.Graphs is 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 -- ----------------------- @@ -2228,22 +3623,36 @@ package body Bindo.Graphs is (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; ---------- @@ -2252,15 +3661,45 @@ package body Bindo.Graphs is 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 -- ------------------------------ @@ -2280,27 +3719,45 @@ package body Bindo.Graphs is -------------------------------------- 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; - Pred_Comp : constant Component_Id := Component (G, Pred); - Succ_Comp : constant Component_Id := Component (G, Succ); + ----------------------------------- + -- Maximum_Invocation_Edge_Count -- + ----------------------------------- - pragma Assert (Present (Pred_Comp)); - pragma Assert (Present (Succ_Comp)); + function Maximum_Invocation_Edge_Count + (G : Library_Graph; + Edge : Library_Graph_Edge_Id; + Count : Natural) return Natural + is + New_Count : Natural; begin - return Pred_Comp = Succ_Comp; - end Links_Vertices_In_Same_Component; + pragma Assert (Present (G)); + + New_Count := Count; + + if Present (Edge) and then Is_Invocation_Edge (G, Edge) then + New_Count := New_Count + 1; + end if; + + return New_Count; + end Maximum_Invocation_Edge_Count; ---------- -- Name -- @@ -2308,17 +3765,13 @@ package body Bindo.Graphs is 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 (U_Id)); + pragma Assert (Present (Vertex)); - begin - return Name (U_Id); + return Name (Unit (G, Vertex)); end Name; ----------------------- @@ -2327,29 +3780,37 @@ package body Bindo.Graphs is 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; ---------- @@ -2358,10 +3819,22 @@ package body Bindo.Graphs is 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), LGV_Id); + DG.Next (DG.All_Vertex_Iterator (Iter), Vertex); + end Next; + + ---------- + -- Next -- + ---------- + + procedure Next + (Iter : in out Edges_Of_Cycle_Iterator; + Edge : out Library_Graph_Edge_Id) + is + begin + LGE_Lists.Next (LGE_Lists.Iterator (Iter), Edge); end Next; ---------- @@ -2381,11 +3854,11 @@ package body Bindo.Graphs is ---------- 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; ---------- @@ -2394,12 +3867,95 @@ package body Bindo.Graphs is 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 -- ---------------------------------- @@ -2426,6 +3982,17 @@ package body Bindo.Graphs is 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 -- --------------------- @@ -2443,12 +4010,12 @@ package body Bindo.Graphs is 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; ------------------------ @@ -2462,6 +4029,21 @@ package body Bindo.Graphs is 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 -- -------------------------- @@ -2483,28 +4065,168 @@ package body Bindo.Graphs is 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; ------------- @@ -2522,23 +4244,23 @@ package body Bindo.Graphs is 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; @@ -2548,26 +4270,76 @@ package body Bindo.Graphs is 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 -- ------------------------------ @@ -2581,7 +4353,7 @@ package body Bindo.Graphs is 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; ---------------------------- @@ -2590,18 +4362,18 @@ package body Bindo.Graphs is 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; ------------------------------ @@ -2617,7 +4389,7 @@ package body Bindo.Graphs is 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; ------------------------------ @@ -2626,25 +4398,44 @@ package body Bindo.Graphs is 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_Existing_Predecessor_Successor_Relation + 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_Recorded_Edge (G : Library_Graph; Rel : Predecessor_Successor_Relation; Val : Boolean := True) @@ -2655,11 +4446,27 @@ package body Bindo.Graphs is 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 -- @@ -2667,14 +4474,14 @@ package body Bindo.Graphs is 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; ------------------------ @@ -2683,14 +4490,14 @@ package body Bindo.Graphs is 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; --------------- @@ -2698,29 +4505,201 @@ package body Bindo.Graphs is --------------- 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; ----------------------------------------------- @@ -2730,18 +4709,17 @@ package body Bindo.Graphs is 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; @@ -2750,20 +4728,16 @@ package body Bindo.Graphs is ----------------------------------------------- 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)); @@ -2783,104 +4757,125 @@ package body Bindo.Graphs is -- 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; diff --git a/gcc/ada/bindo-graphs.ads b/gcc/ada/bindo-graphs.ads index a5dc6ea..02f8e52 100644 --- a/gcc/ada/bindo-graphs.ads +++ b/gcc/ada/bindo-graphs.ads @@ -28,11 +28,14 @@ -- 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 @@ -49,14 +52,24 @@ 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 -- @@ -71,13 +84,47 @@ package Bindo.Graphs is 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 -- @@ -91,14 +138,29 @@ package Bindo.Graphs is 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 -- @@ -113,13 +175,18 @@ package Bindo.Graphs is 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 -- @@ -152,13 +219,16 @@ package Bindo.Graphs is -- 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; @@ -179,11 +249,26 @@ package Bindo.Graphs is -- 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 @@ -193,41 +278,56 @@ package Bindo.Graphs is -- 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 -- @@ -245,9 +345,9 @@ package Bindo.Graphs is 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 @@ -278,8 +378,8 @@ package Bindo.Graphs is -- 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. @@ -300,7 +400,7 @@ package Bindo.Graphs is 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. @@ -316,14 +416,14 @@ package Bindo.Graphs is 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. @@ -357,32 +457,38 @@ package Bindo.Graphs is -------------- 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, @@ -399,9 +505,9 @@ package Bindo.Graphs is ----------- 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. @@ -420,7 +526,7 @@ package Bindo.Graphs is 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, @@ -457,7 +563,7 @@ package Bindo.Graphs is 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); @@ -477,7 +583,7 @@ package Bindo.Graphs is 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, @@ -493,7 +599,7 @@ package Bindo.Graphs is -- 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); @@ -518,24 +624,25 @@ package Bindo.Graphs is 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; @@ -550,7 +657,7 @@ package Bindo.Graphs is 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; -------------------- @@ -559,6 +666,32 @@ package Bindo.Graphs is package Library_Graphs is + -- The following type represents the various kinds of library graph + -- cycles. The ordering of kinds is significant, where a literal with + -- lower ordinal has a 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 @@ -620,11 +753,13 @@ package Bindo.Graphs 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); @@ -634,6 +769,16 @@ package Bindo.Graphs is 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 @@ -644,16 +789,16 @@ package Bindo.Graphs is 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; @@ -664,75 +809,91 @@ package Bindo.Graphs is 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 -- @@ -752,30 +913,71 @@ package Bindo.Graphs is -- 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; @@ -784,76 +986,112 @@ package Bindo.Graphs is 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 -- @@ -876,15 +1114,19 @@ package Bindo.Graphs is 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; @@ -895,6 +1137,27 @@ package Bindo.Graphs is -- 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. @@ -909,8 +1172,8 @@ package Bindo.Graphs is -- 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. @@ -931,7 +1194,7 @@ package Bindo.Graphs is 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. @@ -975,11 +1238,34 @@ package Bindo.Graphs is 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. @@ -991,14 +1277,14 @@ package Bindo.Graphs is 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. @@ -1010,9 +1296,9 @@ package Bindo.Graphs is -------------- 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. @@ -1054,7 +1340,7 @@ package Bindo.Graphs is 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, @@ -1070,11 +1356,6 @@ package Bindo.Graphs is -- 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 @@ -1091,7 +1372,7 @@ package Bindo.Graphs is 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, @@ -1123,7 +1404,7 @@ package Bindo.Graphs is 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, @@ -1135,9 +1416,69 @@ package Bindo.Graphs is 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. @@ -1160,7 +1501,7 @@ package Bindo.Graphs is 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); @@ -1176,7 +1517,7 @@ package Bindo.Graphs is -- 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, @@ -1205,28 +1546,43 @@ package Bindo.Graphs is -- 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; @@ -1238,10 +1594,12 @@ package Bindo.Graphs is -- 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; diff --git a/gcc/ada/bindo-units.adb b/gcc/ada/bindo-units.adb index de0afb9f..d2501e0 100644 --- a/gcc/ada/bindo-units.adb +++ b/gcc/ada/bindo-units.adb @@ -29,7 +29,7 @@ package body Bindo.Units is -- Signature set -- ------------------- - package SS is new Membership_Sets + package Signature_Sets is new Membership_Sets (Element_Type => Invocation_Signature_Id, "=" => "=", Hash => Hash_Invocation_Signature); @@ -41,11 +41,13 @@ package body Bindo.Units is -- 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 -- @@ -139,14 +141,27 @@ package body Bindo.Units is 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; ------------------------------ @@ -183,7 +198,7 @@ package body Bindo.Units is 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; ------------------------------- @@ -216,11 +231,26 @@ package body Bindo.Units is 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 -- ------------------------------- @@ -278,7 +308,7 @@ package body Bindo.Units is 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; ---------- @@ -304,7 +334,7 @@ package body Bindo.Units is begin pragma Assert (Present (IS_Id)); - return SS.Contains (Elaborable_Constructs, IS_Id); + return Signature_Sets.Contains (Elaborable_Constructs, IS_Id); end Needs_Elaboration; ----------------------- @@ -315,7 +345,7 @@ package body Bindo.Units is begin pragma Assert (Present (U_Id)); - return US.Contains (Elaborable_Units, U_Id); + return Unit_Sets.Contains (Elaborable_Units, U_Id); end Needs_Elaboration; ---------- @@ -327,7 +357,7 @@ package body Bindo.Units is 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; -------------------------------- @@ -336,7 +366,7 @@ package body Bindo.Units is 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; --------------------- @@ -355,14 +385,12 @@ package body Bindo.Units is 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; ----------------------------------- @@ -402,7 +430,7 @@ package body Bindo.Units is -- 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; diff --git a/gcc/ada/bindo-units.ads b/gcc/ada/bindo-units.ads index 93caadf..3749393 100644 --- a/gcc/ada/bindo-units.ads +++ b/gcc/ada/bindo-units.ads @@ -33,6 +33,19 @@ with GNAT.Sets; use GNAT.Sets; 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 @@ -54,6 +67,10 @@ package Bindo.Units is 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); @@ -69,9 +86,11 @@ package Bindo.Units is 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); @@ -144,11 +163,6 @@ package Bindo.Units is -- 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; diff --git a/gcc/ada/bindo-validators.adb b/gcc/ada/bindo-validators.adb index 54d2fc6..aed4960 100644 --- a/gcc/ada/bindo-validators.adb +++ b/gcc/ada/bindo-validators.adb @@ -29,22 +29,183 @@ with Types; use Types; 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 @@ -52,7 +213,7 @@ package body Bindo.Validators is -- 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 @@ -61,7 +222,7 @@ package body Bindo.Validators is -- 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. @@ -70,7 +231,9 @@ package body Bindo.Validators is 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. @@ -79,28 +242,22 @@ package body Bindo.Validators is 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; @@ -115,7 +272,7 @@ package body Bindo.Validators is 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)); @@ -129,15 +286,14 @@ package body Bindo.Validators is -- 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; @@ -152,7 +308,7 @@ package body Bindo.Validators is 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)); @@ -167,8 +323,8 @@ package body Bindo.Validators is 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; @@ -185,15 +341,18 @@ package body Bindo.Validators is -- 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. @@ -208,7 +367,7 @@ package body Bindo.Validators is -------------------- 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 @@ -230,21 +389,8 @@ package body Bindo.Validators is -- 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; --------------------------------- @@ -260,10 +406,10 @@ package body Bindo.Validators is ----------------------- 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); @@ -273,9 +419,9 @@ package body Bindo.Validators is 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); @@ -283,11 +429,6 @@ package body Bindo.Validators is -- 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 -- ------------------------------- @@ -296,8 +437,8 @@ package body Bindo.Validators is 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; @@ -316,16 +457,16 @@ package body Bindo.Validators is ------------------------------------ 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; @@ -333,21 +474,21 @@ package body Bindo.Validators is 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; @@ -359,17 +500,17 @@ package body Bindo.Validators is ------------------------------------- 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; @@ -379,15 +520,15 @@ package body Bindo.Validators is 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; @@ -395,22 +536,32 @@ package body Bindo.Validators is 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; @@ -421,32 +572,19 @@ package body Bindo.Validators is ---------------------------------------- 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; ------------------------------ @@ -462,10 +600,10 @@ package body Bindo.Validators is ----------------------- 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); @@ -475,9 +613,9 @@ package body Bindo.Validators is 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); @@ -485,11 +623,6 @@ package body Bindo.Validators is -- 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 -- ---------------------------- @@ -498,8 +631,8 @@ package body Bindo.Validators is 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; @@ -518,16 +651,16 @@ package body Bindo.Validators is --------------------------------- 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; @@ -535,40 +668,40 @@ package body Bindo.Validators is 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; @@ -580,18 +713,17 @@ package body Bindo.Validators is ---------------------------------- 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; @@ -601,15 +733,15 @@ package body Bindo.Validators is 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; @@ -617,25 +749,25 @@ package body Bindo.Validators is 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; @@ -648,32 +780,34 @@ package body Bindo.Validators is 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; diff --git a/gcc/ada/bindo-validators.ads b/gcc/ada/bindo-validators.ads index 39fccc6..d70447b 100644 --- a/gcc/ada/bindo-validators.ads +++ b/gcc/ada/bindo-validators.ads @@ -35,6 +35,26 @@ use Bindo.Graphs.Library_Graphs; 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 -- ---------------------------------- diff --git a/gcc/ada/bindo-writers.adb b/gcc/ada/bindo-writers.adb index 7450c15..067ba1f 100644 --- a/gcc/ada/bindo-writers.adb +++ b/gcc/ada/bindo-writers.adb @@ -28,7 +28,8 @@ with Fname; use Fname; 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; @@ -124,26 +125,27 @@ package body Bindo.Writers is -------------------------------- 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; @@ -152,20 +154,17 @@ package body Bindo.Writers is ------------------------------- 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; @@ -174,16 +173,16 @@ package body Bindo.Writers is 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; @@ -192,39 +191,36 @@ package body Bindo.Writers is -------------------------------- 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; @@ -277,17 +273,8 @@ package body Bindo.Writers is 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; ----------------------- @@ -313,6 +300,131 @@ package body Bindo.Writers is 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 -- ------------------------------- @@ -416,22 +528,23 @@ package body Bindo.Writers is -- 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); @@ -447,14 +560,13 @@ package body Bindo.Writers is ----------- 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); @@ -498,7 +610,6 @@ package body Bindo.Writers is Iter := Iterate_Elaboration_Roots (G); while Has_Next (Iter) loop Next (Iter, Root); - pragma Assert (Present (Root)); Write_Elaboration_Root (G, Root); end loop; @@ -541,24 +652,22 @@ package body Bindo.Writers is --------------------------------- 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; @@ -577,16 +686,16 @@ package body Bindo.Writers is 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: "); @@ -594,12 +703,11 @@ package body Bindo.Writers is 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; @@ -612,29 +720,34 @@ package body Bindo.Writers is 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; ------------------------------------- @@ -642,18 +755,17 @@ package body Bindo.Writers is ------------------------------------- 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; @@ -719,22 +831,22 @@ package body Bindo.Writers is 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); @@ -755,13 +867,13 @@ package body Bindo.Writers is 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); --------------------- @@ -797,7 +909,7 @@ package body Bindo.Writers is Comp : Component_Id) is Iter : Component_Vertex_Iterator; - LGV_Id : Library_Graph_Vertex_Id; + Vertex : Library_Graph_Vertex_Id; begin pragma Assert (Present (G)); @@ -805,13 +917,12 @@ package body Bindo.Writers is 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; @@ -835,7 +946,6 @@ package body Bindo.Writers is Iter := Iterate_Components (G); while Has_Next (Iter) loop Next (Iter, Comp); - pragma Assert (Present (Comp)); Write_Component (G, Comp); end loop; @@ -850,16 +960,16 @@ package body Bindo.Writers is 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: "); @@ -867,12 +977,11 @@ package body Bindo.Writers is 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; @@ -913,26 +1022,23 @@ package body Bindo.Writers is ------------------------------ 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_"); @@ -956,22 +1062,20 @@ package body Bindo.Writers is 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 @@ -986,7 +1090,7 @@ package body Bindo.Writers is 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"); @@ -994,11 +1098,11 @@ package body Bindo.Writers is 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; @@ -1008,7 +1112,7 @@ package body Bindo.Writers is 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; ---------------------------------- @@ -1017,17 +1121,16 @@ package body Bindo.Writers is 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; @@ -1071,11 +1174,11 @@ package body Bindo.Writers is 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 -- diff --git a/gcc/ada/bindo-writers.ads b/gcc/ada/bindo-writers.ads index 9ed598e..b791638 100644 --- a/gcc/ada/bindo-writers.ads +++ b/gcc/ada/bindo-writers.ads @@ -81,6 +81,16 @@ package Bindo.Writers is 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 -- ------------------------------- diff --git a/gcc/ada/bindo.adb b/gcc/ada/bindo.adb index 7d26476..039fd0d 100644 --- a/gcc/ada/bindo.adb +++ b/gcc/ada/bindo.adb @@ -23,8 +23,11 @@ -- -- ------------------------------------------------------------------------------ +with Binde; +with Debug; use Debug; + with Bindo.Elaborators; -use Bindo.Elaborators.Invocation_And_Library_Graph_Elaborators; +use Bindo.Elaborators; package body Bindo is @@ -47,30 +50,44 @@ 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 -- @@ -78,6 +95,8 @@ package body Bindo is -- * 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. -- @@ -162,7 +181,11 @@ package body Bindo is -- | -- +------ | -------------- Diagnostics phase -------------------------+ -- | | | - -- | +--> ??? more on this later | + -- | +--> Find_Cycles | + -- | +--> Validate_Cycles | + -- | +--> Write_Cycles | + -- | | | + -- | +--> Diagnose_Cycle / Diagnose_All_Cycles | -- | | -- +-------------------------------------------------------------------+ @@ -225,7 +248,37 @@ package body Bindo is -- 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 -- @@ -236,6 +289,11 @@ package body Bindo is -- 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 @@ -255,16 +313,20 @@ package body Bindo is -- 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 -- @@ -281,7 +343,20 @@ package body Bindo is 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; diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index d76d93d..fb9ebba 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -378,7 +378,7 @@ package body Debug is -- d_A Output ALI invocation tables -- d_B - -- d_C + -- d_C Diagnose all cycles -- d_D -- d_F -- d_G @@ -390,13 +390,13 @@ package body Debug is -- 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 @@ -1150,22 +1150,27 @@ package body Debug is -- 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 -- diff --git a/gcc/ada/gnatbind.adb b/gcc/ada/gnatbind.adb index 41541c3..40c85b9 100644 --- a/gcc/ada/gnatbind.adb +++ b/gcc/ada/gnatbind.adb @@ -26,7 +26,6 @@ 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; @@ -883,14 +882,7 @@ begin 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 diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index ffd6a90..861d58e 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -59,65 +59,32 @@ with System.WCh_Con; use System.WCh_Con; 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 @@ -161,16 +128,6 @@ package body Lib.Writ is 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 -- ------------------------------ @@ -252,92 +209,6 @@ package body Lib.Writ is 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 -- ------------- @@ -347,40 +218,6 @@ package body Lib.Writ is 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 -- --------------- @@ -441,9 +278,6 @@ package body Lib.Writ is -- 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). @@ -633,175 +467,6 @@ package body Lib.Writ is 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 -- ---------------------------- @@ -2010,6 +1675,179 @@ package body Lib.Writ is 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 -- --------------------- diff --git a/gcc/ada/lib-writ.ads b/gcc/ada/lib-writ.ads index c17233a..7248a61 100644 --- a/gcc/ada/lib-writ.ads +++ b/gcc/ada/lib-writ.ads @@ -880,18 +880,32 @@ package Lib.Writ is -- 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. @@ -925,7 +939,7 @@ package Lib.Writ is -- 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 -- diff --git a/gcc/ada/libgnat/g-lists.adb b/gcc/ada/libgnat/g-lists.adb index f7447a5..817274a 100644 --- a/gcc/ada/libgnat/g-lists.adb +++ b/gcc/ada/libgnat/g-lists.adb @@ -337,6 +337,57 @@ package body GNAT.Lists is 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 -- --------------- diff --git a/gcc/ada/libgnat/g-lists.ads b/gcc/ada/libgnat/g-lists.ads index b64ef08..fdcaed6 100644 --- a/gcc/ada/libgnat/g-lists.ads +++ b/gcc/ada/libgnat/g-lists.ads @@ -117,6 +117,12 @@ package GNAT.Lists is -- 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. diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index ce0950d..2bd38c8 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -11689,6 +11689,11 @@ package body Sem_Elab is -- 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 @@ -11938,40 +11943,32 @@ package body Sem_Elab is (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); @@ -11981,21 +11978,23 @@ package body Sem_Elab is -- 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); @@ -12039,11 +12038,50 @@ package body Sem_Elab is 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 @@ -12059,15 +12097,14 @@ package body Sem_Elab is 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; ------------------------------- @@ -12809,6 +12846,12 @@ package body Sem_Elab is 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. @@ -12824,6 +12867,30 @@ package body Sem_Elab is 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 -- ---------------------------- @@ -12882,6 +12949,10 @@ package body Sem_Elab is (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 @@ -12970,7 +13041,7 @@ package body Sem_Elab is -- 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 @@ -13013,7 +13084,6 @@ package body Sem_Elab is Extra : Entity_Id; Extra_Nam : Name_Id; - IR_Rec : Invocation_Relation_Record; Kind : Invocation_Kind; Rel : Invoker_Target_Relation; @@ -13052,15 +13122,13 @@ package body Sem_Elab is 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; |