Skip to content

R
riscv-gcc-1
Commit 9795b203 by Hristian Kirtchev Committed by Pierre-Marie de Rodat
Options

[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
parent db626148
Showing with 4356 additions and 1641 deletions
gcc/ada/ChangeLog
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> 2019-07-05 Ed Schonberg <schonberg@adacore.com>
* checks.adb (Apply_Predicate_Check): Except within the * checks.adb (Apply_Predicate_Check): Except within the
......
gcc/ada/ali.adb
...@@ -39,10 +39,115 @@ package body ALI is ...@@ -39,10 +39,115 @@ package body ALI is
use ASCII; use ASCII;
-- Make control characters visible -- 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 -- -- 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); procedure Destroy (IS_Id : in out Invocation_Signature_Id);
-- Destroy an invocation signature with id IS_Id -- Destroy an invocation signature with id IS_Id
...@@ -68,14 +173,19 @@ package body ALI is ...@@ -68,14 +173,19 @@ package body ALI is
Sig_To_Sig_Map : constant Sig_Map.Dynamic_Hash_Table := Sig_To_Sig_Map : constant Sig_Map.Dynamic_Hash_Table :=
Sig_Map.Create (500); Sig_Map.Create (500);
-- The folowing table maps body placement kinds to character codes for -- The folowing table maps declaration placement kinds to character codes
-- invocation construct encoding in ALI files. -- for invocation construct encoding in ALI files.
Body_Placement_Codes : Declaration_Placement_Codes :
constant array (Body_Placement_Kind) of Character := constant array (Declaration_Placement_Kind) of Character :=
(In_Body => 'b', (In_Body => 'b',
In_Spec => 's', In_Spec => 's',
No_Body_Placement => 'Z'); 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 -- The following table maps invocation kinds to character codes for
-- invocation relation encoding in ALI files. -- invocation relation encoding in ALI files.
...@@ -112,13 +222,23 @@ package body ALI is ...@@ -112,13 +222,23 @@ package body ALI is
Elaborate_Spec_Procedure => 's', Elaborate_Spec_Procedure => 's',
Regular_Construct => 'Z'); 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. -- used in ALI files.
Invocation_Graph_Line_Codes : Invocation_Graph_Line_Codes :
constant array (Invocation_Graph_Line_Kind) of Character := constant array (Invocation_Graph_Line_Kind) of Character :=
(Invocation_Construct_Line => 'c', (Invocation_Construct_Line => 'c',
Invocation_Relation_Line => 'r'); Invocation_Graph_Attributes_Line => 'a',
Invocation_Relation_Line => 'r');
-- The following variable records which characters currently are used as -- 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 -- line type markers in the ALI file. This is used in Scan_ALI to detect
...@@ -153,18 +273,22 @@ package body ALI is ...@@ -153,18 +273,22 @@ package body ALI is
------------------------------ ------------------------------
procedure Add_Invocation_Construct procedure Add_Invocation_Construct
(IC_Rec : Invocation_Construct_Record; (Body_Placement : Declaration_Placement_Kind;
Update_Units : Boolean := True) Kind : Invocation_Construct_Kind;
Signature : Invocation_Signature_Id;
Spec_Placement : Declaration_Placement_Kind;
Update_Units : Boolean := True)
is is
IC_Id : Invocation_Construct_Id;
begin begin
pragma Assert (Present (IC_Rec.Signature)); pragma Assert (Present (Signature));
-- Create a invocation construct from the scanned attributes -- Create a invocation construct from the scanned attributes
Invocation_Constructs.Append (IC_Rec); Invocation_Constructs.Append
IC_Id := Invocation_Constructs.Last; ((Body_Placement => Body_Placement,
Kind => Kind,
Signature => Signature,
Spec_Placement => Spec_Placement));
-- Update the invocation construct counter of the current unit only when -- Update the invocation construct counter of the current unit only when
-- requested by the caller. -- requested by the caller.
...@@ -174,7 +298,7 @@ package body ALI is ...@@ -174,7 +298,7 @@ package body ALI is
Curr_Unit : Unit_Record renames Units.Table (Units.Last); Curr_Unit : Unit_Record renames Units.Table (Units.Last);
begin begin
Curr_Unit.Last_Invocation_Construct := IC_Id; Curr_Unit.Last_Invocation_Construct := Invocation_Constructs.Last;
end; end;
end if; end if;
end Add_Invocation_Construct; end Add_Invocation_Construct;
...@@ -184,20 +308,24 @@ package body ALI is ...@@ -184,20 +308,24 @@ package body ALI is
----------------------------- -----------------------------
procedure Add_Invocation_Relation 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) Update_Units : Boolean := True)
is is
IR_Id : Invocation_Relation_Id;
begin begin
pragma Assert (Present (IR_Rec.Invoker)); pragma Assert (Present (Invoker));
pragma Assert (Present (IR_Rec.Target)); pragma Assert (Kind /= No_Invocation);
pragma Assert (IR_Rec.Kind /= No_Invocation); pragma Assert (Present (Target));
-- Create an invocation relation from the scanned attributes -- Create an invocation relation from the scanned attributes
Invocation_Relations.Append (IR_Rec); Invocation_Relations.Append
IR_Id := Invocation_Relations.Last; ((Extra => Extra,
Invoker => Invoker,
Kind => Kind,
Target => Target));
-- Update the invocation relation counter of the current unit only when -- Update the invocation relation counter of the current unit only when
-- requested by the caller. -- requested by the caller.
...@@ -207,41 +335,42 @@ package body ALI is ...@@ -207,41 +335,42 @@ package body ALI is
Curr_Unit : Unit_Record renames Units.Table (Units.Last); Curr_Unit : Unit_Record renames Units.Table (Units.Last);
begin begin
Curr_Unit.Last_Invocation_Relation := IR_Id; Curr_Unit.Last_Invocation_Relation := Invocation_Relations.Last;
end; end;
end if; end if;
end Add_Invocation_Relation; end Add_Invocation_Relation;
--------------------------------- --------------------
-- Body_Placement_Kind_To_Code -- -- Body_Placement --
--------------------------------- --------------------
function Body_Placement_Kind_To_Code function Body_Placement
(Kind : Body_Placement_Kind) return Character (IC_Id : Invocation_Construct_Id) return Declaration_Placement_Kind
is is
begin begin
return Body_Placement_Codes (Kind); pragma Assert (Present (IC_Id));
end Body_Placement_Kind_To_Code; 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 function Code_To_Declaration_Placement_Kind
(Code : Character) return Body_Placement_Kind (Code : Character) return Declaration_Placement_Kind
is is
begin begin
-- Determine which body placement kind corresponds to the character code -- Determine which placement kind corresponds to the character code by
-- by traversing the contents of the mapping table. -- traversing the contents of the mapping table.
for Kind in Body_Placement_Kind loop for Kind in Declaration_Placement_Kind loop
if Body_Placement_Codes (Kind) = Code then if Declaration_Placement_Codes (Kind) = Code then
return Kind; return Kind;
end if; end if;
end loop; end loop;
raise Program_Error; raise Program_Error;
end Code_To_Body_Placement_Kind; end Code_To_Declaration_Placement_Kind;
--------------------------------------- ---------------------------------------
-- Code_To_Invocation_Construct_Kind -- -- Code_To_Invocation_Construct_Kind --
...@@ -263,6 +392,26 @@ package body ALI is ...@@ -263,6 +392,26 @@ package body ALI is
raise Program_Error; raise Program_Error;
end Code_To_Invocation_Construct_Kind; end Code_To_Invocation_Construct_Kind;
--------------------------------------------
-- Code_To_Invocation_Graph_Encoding_Kind --
--------------------------------------------
function Code_To_Invocation_Graph_Encoding_Kind
(Code : Character) return Invocation_Graph_Encoding_Kind
is
begin
-- Determine which invocation-graph encoding kind matches the character
-- code by traversing the contents of the mapping table.
for Kind in Invocation_Graph_Encoding_Kind loop
if Invocation_Graph_Encoding_Codes (Kind) = Code then
return Kind;
end if;
end loop;
raise Program_Error;
end Code_To_Invocation_Graph_Encoding_Kind;
----------------------------- -----------------------------
-- Code_To_Invocation_Kind -- -- Code_To_Invocation_Kind --
----------------------------- -----------------------------
...@@ -291,7 +440,7 @@ package body ALI is ...@@ -291,7 +440,7 @@ package body ALI is
(Code : Character) return Invocation_Graph_Line_Kind (Code : Character) return Invocation_Graph_Line_Kind
is is
begin 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. -- code by traversing the contents of the mapping table.
for Kind in Invocation_Graph_Line_Kind loop for Kind in Invocation_Graph_Line_Kind loop
...@@ -303,6 +452,27 @@ package body ALI is ...@@ -303,6 +452,27 @@ package body ALI is
raise Program_Error; raise Program_Error;
end Code_To_Invocation_Graph_Line_Kind; 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 -- -- Destroy --
------------- -------------
...@@ -313,6 +483,50 @@ package body ALI is ...@@ -313,6 +483,50 @@ package body ALI is
null; null;
end Destroy; 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 -- -- Hash --
---------- ----------
...@@ -428,6 +642,26 @@ package body ALI is ...@@ -428,6 +642,26 @@ package body ALI is
return Invocation_Construct_Codes (Kind); return Invocation_Construct_Codes (Kind);
end Invocation_Construct_Kind_To_Code; 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 -- -- Invocation_Graph_Line_Kind_To_Code --
---------------------------------------- ----------------------------------------
...@@ -489,6 +723,70 @@ package body ALI is ...@@ -489,6 +723,70 @@ package body ALI is
end Invocation_Signature_Of; 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 -- -- Present --
------------- -------------
...@@ -638,7 +936,7 @@ package body ALI is ...@@ -638,7 +936,7 @@ package body ALI is
-- --
-- If Ignore_Special is False (normal case), the scan is terminated by -- 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 -- 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. -- by another double quote.
-- --
-- If May_Be_Quoted is True and the first non blank character is '"' -- If May_Be_Quoted is True and the first non blank character is '"'
...@@ -674,7 +972,7 @@ package body ALI is ...@@ -674,7 +972,7 @@ package body ALI is
-- Parse the definition of a typeref (<...>, {...} or (...)) -- Parse the definition of a typeref (<...>, {...} or (...))
procedure Scan_Invocation_Graph_Line; 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; procedure Skip_Eol;
-- Skip past spaces, then skip past end of line (fatal error if not -- Skip past spaces, then skip past end of line (fatal error if not
...@@ -1204,6 +1502,13 @@ package body ALI is ...@@ -1204,6 +1502,13 @@ package body ALI is
-- * Invocation_Constructs -- * Invocation_Constructs
-- * Units -- * 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; procedure Scan_Invocation_Relation_Line;
pragma Inline (Scan_Invocation_Relation_Line); pragma Inline (Scan_Invocation_Relation_Line);
-- Parse an invocation relation line and construct the corresponding -- Parse an invocation relation line and construct the corresponding
...@@ -1225,51 +1530,78 @@ package body ALI is ...@@ -1225,51 +1530,78 @@ package body ALI is
------------------------------------ ------------------------------------
procedure Scan_Invocation_Construct_Line 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 begin
-- construct-kind -- 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 (' '); Checkc (' ');
Skip_Space; Skip_Space;
-- construct-body-placement -- construct-body-placement
IC_Rec.Placement := Code_To_Body_Placement_Kind (Getc); Body_Placement := Code_To_Declaration_Placement_Kind (Getc);
Checkc (' '); Checkc (' ');
Skip_Space; Skip_Space;
-- construct-signature -- construct-signature
IC_Rec.Signature := Scan_Invocation_Signature; Signature := Scan_Invocation_Signature;
pragma Assert (Present (IC_Rec.Signature));
Skip_Eol; 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; 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 -- -- Scan_Invocation_Relation_Line --
----------------------------------- -----------------------------------
procedure Scan_Invocation_Relation_Line is 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 begin
-- relation-kind -- relation-kind
IR_Rec.Kind := Code_To_Invocation_Kind (Getc); Kind := Code_To_Invocation_Kind (Getc);
Checkc (' '); Checkc (' ');
Skip_Space; Skip_Space;
-- (extra-name | "none") -- (extra-name | "none")
IR_Rec.Extra := Get_Name; Extra := Get_Name;
if IR_Rec.Extra = Name_None then if Extra = Name_None then
IR_Rec.Extra := No_Name; Extra := No_Name;
end if; end if;
Checkc (' '); Checkc (' ');
...@@ -1277,20 +1609,20 @@ package body ALI is ...@@ -1277,20 +1609,20 @@ package body ALI is
-- invoker-signature -- invoker-signature
IR_Rec.Invoker := Scan_Invocation_Signature; Invoker := Scan_Invocation_Signature;
pragma Assert (Present (IR_Rec.Invoker));
Checkc (' '); Checkc (' ');
Skip_Space; Skip_Space;
-- target-signature -- target-signature
IR_Rec.Target := Scan_Invocation_Signature; Target := Scan_Invocation_Signature;
pragma Assert (Present (IR_Rec.Target));
Skip_Eol; Skip_Eol;
Add_Invocation_Relation (IR_Rec); Add_Invocation_Relation
(Extra => Extra,
Invoker => Invoker,
Kind => Kind,
Target => Target);
end Scan_Invocation_Relation_Line; end Scan_Invocation_Relation_Line;
------------------------------- -------------------------------
...@@ -1378,13 +1710,16 @@ package body ALI is ...@@ -1378,13 +1710,16 @@ package body ALI is
-- line-attributes -- line-attributes
if Line = Invocation_Construct_Line then case Line is
Scan_Invocation_Construct_Line; when Invocation_Construct_Line =>
Scan_Invocation_Construct_Line;
else when Invocation_Graph_Attributes_Line =>
pragma Assert (Line = Invocation_Relation_Line); Scan_Invocation_Graph_Attributes_Line;
Scan_Invocation_Relation_Line;
end if; when Invocation_Relation_Line =>
Scan_Invocation_Relation_Line;
end case;
end Scan_Invocation_Graph_Line; end Scan_Invocation_Graph_Line;
-------------- --------------
...@@ -3064,7 +3399,7 @@ package body ALI is ...@@ -3064,7 +3399,7 @@ package body ALI is
ALIs.Table (Id).Last_Sdep := Sdep.Last; ALIs.Table (Id).Last_Sdep := Sdep.Last;
-- Loop through invocation graph lines -- Loop through invocation-graph lines
G_Loop : loop G_Loop : loop
Check_Unknown_Line; Check_Unknown_Line;
...@@ -3436,6 +3771,16 @@ package body ALI is ...@@ -3436,6 +3771,16 @@ package body ALI is
return No_ALI_Id; return No_ALI_Id;
end Scan_ALI; 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 -- -- SEq --
--------- ---------
...@@ -3445,6 +3790,30 @@ package body ALI is ...@@ -3445,6 +3790,30 @@ package body ALI is
return F1.all = F2.all; return F1.all = F2.all;
end SEq; 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 -- -- SHash --
----------- -----------
...@@ -3461,4 +3830,40 @@ package body ALI is ...@@ -3461,4 +3830,40 @@ package body ALI is
return Vindex (Vindex'First + Vindex (H mod Vindex'Range_Length)); return Vindex (Vindex'First + Vindex (H mod Vindex'Range_Length));
end SHash; 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; end ALI;
gcc/ada/ali.ads
...@@ -112,6 +112,20 @@ package ALI is ...@@ -112,6 +112,20 @@ package ALI is
First_ALI_Entry : constant ALI_Id := No_ALI_Id + 1; First_ALI_Entry : constant ALI_Id := No_ALI_Id + 1;
-- Id of first actual entry in table -- 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); type Main_Program_Type is (None, Proc, Func);
-- Indicator of whether unit can be used as main program -- Indicator of whether unit can be used as main program
...@@ -368,6 +382,11 @@ package ALI is ...@@ -368,6 +382,11 @@ package ALI is
Last_Arg : Arg_Id; Last_Arg : Arg_Id;
-- Id of last args table entry for this file -- 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; First_Invocation_Construct : Invocation_Construct_Id;
-- Id of the first invocation construct for this unit -- Id of the first invocation construct for this unit
...@@ -1087,6 +1106,20 @@ package ALI is ...@@ -1087,6 +1106,20 @@ package ALI is
-- Invocation Graph Types -- -- 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 -- The following type identifies an invocation signature
No_Invocation_Signature : constant Invocation_Signature_Id := No_Invocation_Signature : constant Invocation_Signature_Id :=
...@@ -1094,59 +1127,20 @@ package ALI is ...@@ -1094,59 +1127,20 @@ package ALI is
First_Invocation_Signature : constant Invocation_Signature_Id := First_Invocation_Signature : constant Invocation_Signature_Id :=
No_Invocation_Signature + 1; 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 -- 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, (In_Body,
-- The body of the invocation construct is within the body of the unit -- The declaration of the invocation construct is within the body of the
-- it is declared in. -- unit it is declared in.
In_Spec, In_Spec,
-- The body of the invocation construct is within the spec of the unit -- The declaration of the invocation construct is within the spec of the
-- it is declared in. -- unit it is declared in.
No_Body_Placement); No_Declaration_Placement);
-- The invocation construct does not have a body -- The invocation construct does not have a declaration
-- The following type enumerates all possible invocation construct kinds -- The following type enumerates all possible invocation construct kinds
...@@ -1162,35 +1156,6 @@ package ALI is ...@@ -1162,35 +1156,6 @@ package ALI is
Regular_Construct); Regular_Construct);
-- The invocation construct is a normal invocation 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 -- The following type enumerates all possible invocation kinds
type Invocation_Kind is type Invocation_Kind is
...@@ -1220,94 +1185,60 @@ package ALI is ...@@ -1220,94 +1185,60 @@ package ALI is
-- Internal_Controlled_Finalization -- Internal_Controlled_Finalization
Internal_Controlled_Initialization; Internal_Controlled_Initialization;
-- The following type represents an invocation relation. It associates an -- The following type enumerates all possible invocation-graph ALI lines
-- 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
type Invocation_Graph_Line_Kind is type Invocation_Graph_Line_Kind is
(Invocation_Construct_Line, (Invocation_Construct_Line,
Invocation_Graph_Attributes_Line,
Invocation_Relation_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 -- -- Invocation Graph Subprograms --
---------------------------------- ----------------------------------
procedure Add_Invocation_Construct procedure Add_Invocation_Construct
(IC_Rec : Invocation_Construct_Record; (Body_Placement : Declaration_Placement_Kind;
Update_Units : Boolean := True); Kind : Invocation_Construct_Kind;
Signature : Invocation_Signature_Id;
Spec_Placement : Declaration_Placement_Kind;
Update_Units : Boolean := True);
pragma Inline (Add_Invocation_Construct); pragma Inline (Add_Invocation_Construct);
-- Add invocation construct attributes IC_Rec to internal data structures. -- Add a new invocation construct described by its attributes. Update_Units
-- Flag Undate_Units should be set when this addition must be reflected in -- should be set when this addition must be reflected in the attributes of
-- the attributes of the current unit. -- the current unit.
procedure Add_Invocation_Relation 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); Update_Units : Boolean := True);
pragma Inline (Add_Invocation_Relation); pragma Inline (Add_Invocation_Relation);
-- Add invocation relation attributes IR_Rec to internal data structures. -- Add a new invocation relation described by its attributes. Update_Units
-- Flag Undate_Units should be set when this addition must be reflected in -- should be set when this addition must be reflected in the attributes of
-- the attributes of the current unit. -- the current unit.
function Body_Placement_Kind_To_Code function Body_Placement
(Kind : Body_Placement_Kind) return Character; (IC_Id : Invocation_Construct_Id) return Declaration_Placement_Kind;
pragma Inline (Body_Placement_Kind_To_Code); pragma Inline (Body_Placement);
-- Obtain the character encoding of body placement kind Kind -- 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 function Code_To_Declaration_Placement_Kind
(Code : Character) return Body_Placement_Kind; (Code : Character) return Declaration_Placement_Kind;
pragma Inline (Code_To_Body_Placement_Kind); pragma Inline (Code_To_Declaration_Placement_Kind);
-- Obtain the body placement kind of character encoding Code -- Obtain the declaration placement kind of character encoding Code
function Code_To_Invocation_Construct_Kind function Code_To_Invocation_Construct_Kind
(Code : Character) return Invocation_Construct_Kind; (Code : Character) return Invocation_Construct_Kind;
pragma Inline (Code_To_Invocation_Construct_Kind); pragma Inline (Code_To_Invocation_Construct_Kind);
-- Obtain the invocation construct kind of character encoding Code -- 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 function Code_To_Invocation_Kind
(Code : Character) return Invocation_Kind; (Code : Character) return Invocation_Kind;
pragma Inline (Code_To_Invocation_Kind); pragma Inline (Code_To_Invocation_Kind);
...@@ -1316,17 +1247,58 @@ package ALI is ...@@ -1316,17 +1247,58 @@ package ALI is
function Code_To_Invocation_Graph_Line_Kind function Code_To_Invocation_Graph_Line_Kind
(Code : Character) return Invocation_Graph_Line_Kind; (Code : Character) return Invocation_Graph_Line_Kind;
pragma Inline (Code_To_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 function Invocation_Construct_Kind_To_Code
(Kind : Invocation_Construct_Kind) return Character; (Kind : Invocation_Construct_Kind) return Character;
pragma Inline (Invocation_Construct_Kind_To_Code); pragma Inline (Invocation_Construct_Kind_To_Code);
-- Obtain the character encoding of invocation kind Kind -- 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 function Invocation_Graph_Line_Kind_To_Code
(Kind : Invocation_Graph_Line_Kind) return Character; (Kind : Invocation_Graph_Line_Kind) return Character;
pragma Inline (Invocation_Graph_Line_Kind_To_Code); 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 function Invocation_Kind_To_Code
(Kind : Invocation_Kind) return Character; (Kind : Invocation_Kind) return Character;
...@@ -1342,6 +1314,63 @@ package ALI is ...@@ -1342,6 +1314,63 @@ package ALI is
pragma Inline (Invocation_Signature_Of); pragma Inline (Invocation_Signature_Of);
-- Obtain the invocation signature that corresponds to the input attributes -- 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 -- -- Subprograms for Reading ALI File --
-------------------------------------- --------------------------------------
......
gcc/ada/bindo-augmentors.adb
...@@ -29,9 +29,6 @@ with Types; use Types; ...@@ -29,9 +29,6 @@ with Types; use Types;
with Bindo.Writers; use Bindo.Writers; with Bindo.Writers; use Bindo.Writers;
with GNAT; use GNAT;
with GNAT.Sets; use GNAT.Sets;
package body Bindo.Augmentors is package body Bindo.Augmentors is
------------------------------ ------------------------------
...@@ -41,22 +38,12 @@ package body Bindo.Augmentors is ...@@ -41,22 +38,12 @@ package body Bindo.Augmentors is
package body Library_Graph_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 -- -- Global data --
----------------- -----------------
Inv_Graph : Invocation_Graph := Invocation_Graphs.Nil; Inv_Graph : Invocation_Graph := Invocation_Graphs.Nil;
Lib_Graph : Library_Graph := Library_Graphs.Nil; Lib_Graph : Library_Graph := Library_Graphs.Nil;
Visited : Membership_Set := VS.Nil; Visited : IGV_Sets.Membership_Set := IGV_Sets.Nil;
---------------- ----------------
-- Statistics -- -- Statistics --
...@@ -75,16 +62,16 @@ package body Bindo.Augmentors is ...@@ -75,16 +62,16 @@ package body Bindo.Augmentors is
----------------------- -----------------------
function Is_Visited function Is_Visited
(IGV_Id : Invocation_Graph_Vertex_Id) return Boolean; (Vertex : Invocation_Graph_Vertex_Id) return Boolean;
pragma Inline (Is_Visited); 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. -- during the traversal.
procedure Set_Is_Visited procedure Set_Is_Visited
(IGV_Id : Invocation_Graph_Vertex_Id; (Vertex : Invocation_Graph_Vertex_Id;
Val : Boolean := True); Val : Boolean := True);
pragma Inline (Set_Is_Visited); 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. -- depending on value Val.
procedure Visit_Elaboration_Root (Root : Invocation_Graph_Vertex_Id); procedure Visit_Elaboration_Root (Root : Invocation_Graph_Vertex_Id);
...@@ -106,26 +93,26 @@ package body Bindo.Augmentors is ...@@ -106,26 +93,26 @@ package body Bindo.Augmentors is
-- successor is the current root. -- successor is the current root.
procedure Visit_Vertex procedure Visit_Vertex
(Curr_IGV_Id : Invocation_Graph_Vertex_Id; (Invoker : Invocation_Graph_Vertex_Id;
Last_LGV_Id : Library_Graph_Vertex_Id; Last_Vertex : Library_Graph_Vertex_Id;
Root_LGV_Id : Library_Graph_Vertex_Id; Root_Vertex : Library_Graph_Vertex_Id;
Internal_Ctrl : Boolean; Internal_Controlled_Action : Boolean;
Path : Natural); Path : Natural);
pragma Inline (Visit_Vertex); 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 -- * 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 -- * Create an invocation edge in library graph Lib_Graph to reflect
-- the transition, where the predecessor is the library graph vertex -- 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 -- Flag Internal_Controlled_Action should be set when the DFS traversal
-- internal controlled invocation edge. Path denotes the length of the -- visited an internal controlled invocation edge. Path is the length of
-- path. -- the path.
procedure Write_Statistics; procedure Write_Statistics;
pragma Inline (Write_Statistics); pragma Inline (Write_Statistics);
...@@ -166,13 +153,13 @@ package body Bindo.Augmentors is ...@@ -166,13 +153,13 @@ package body Bindo.Augmentors is
---------------- ----------------
function Is_Visited function Is_Visited
(IGV_Id : Invocation_Graph_Vertex_Id) return Boolean (Vertex : Invocation_Graph_Vertex_Id) return Boolean
is is
begin begin
pragma Assert (Present (Visited)); pragma Assert (IGV_Sets.Present (Visited));
pragma Assert (Present (IGV_Id)); pragma Assert (Present (Vertex));
return Contains (Visited, IGV_Id); return IGV_Sets.Contains (Visited, Vertex);
end Is_Visited; end Is_Visited;
-------------------- --------------------
...@@ -180,17 +167,17 @@ package body Bindo.Augmentors is ...@@ -180,17 +167,17 @@ package body Bindo.Augmentors is
-------------------- --------------------
procedure Set_Is_Visited procedure Set_Is_Visited
(IGV_Id : Invocation_Graph_Vertex_Id; (Vertex : Invocation_Graph_Vertex_Id;
Val : Boolean := True) Val : Boolean := True)
is is
begin begin
pragma Assert (Present (Visited)); pragma Assert (IGV_Sets.Present (Visited));
pragma Assert (Present (IGV_Id)); pragma Assert (Present (Vertex));
if Val then if Val then
Insert (Visited, IGV_Id); IGV_Sets.Insert (Visited, Vertex);
else else
Delete (Visited, IGV_Id); IGV_Sets.Delete (Visited, Vertex);
end if; end if;
end Set_Is_Visited; end Set_Is_Visited;
...@@ -203,24 +190,24 @@ package body Bindo.Augmentors is ...@@ -203,24 +190,24 @@ package body Bindo.Augmentors is
pragma Assert (Present (Root)); pragma Assert (Present (Root));
pragma Assert (Present (Lib_Graph)); pragma Assert (Present (Lib_Graph));
Root_LGV_Id : constant Library_Graph_Vertex_Id := Root_Vertex : constant Library_Graph_Vertex_Id :=
Lib_Vertex (Inv_Graph, Root); Body_Vertex (Inv_Graph, Root);
pragma Assert (Present (Root_LGV_Id)); pragma Assert (Present (Root_Vertex));
begin begin
-- Prepare the global data -- Prepare the global data
Visited := Create (Number_Of_Vertices (Inv_Graph)); Visited := IGV_Sets.Create (Number_Of_Vertices (Inv_Graph));
Visit_Vertex Visit_Vertex
(Curr_IGV_Id => Root, (Invoker => Root,
Last_LGV_Id => Root_LGV_Id, Last_Vertex => Root_Vertex,
Root_LGV_Id => Root_LGV_Id, Root_Vertex => Root_Vertex,
Internal_Ctrl => False, Internal_Controlled_Action => False,
Path => 0); Path => 0);
Destroy (Visited); IGV_Sets.Destroy (Visited);
end Visit_Elaboration_Root; end Visit_Elaboration_Root;
----------------------------- -----------------------------
...@@ -237,7 +224,6 @@ package body Bindo.Augmentors is ...@@ -237,7 +224,6 @@ package body Bindo.Augmentors is
Iter := Iterate_Elaboration_Roots (Inv_Graph); Iter := Iterate_Elaboration_Roots (Inv_Graph);
while Has_Next (Iter) loop while Has_Next (Iter) loop
Next (Iter, Root); Next (Iter, Root);
pragma Assert (Present (Root));
Visit_Elaboration_Root (Root); Visit_Elaboration_Root (Root);
end loop; end loop;
...@@ -248,34 +234,33 @@ package body Bindo.Augmentors is ...@@ -248,34 +234,33 @@ package body Bindo.Augmentors is
------------------ ------------------
procedure Visit_Vertex procedure Visit_Vertex
(Curr_IGV_Id : Invocation_Graph_Vertex_Id; (Invoker : Invocation_Graph_Vertex_Id;
Last_LGV_Id : Library_Graph_Vertex_Id; Last_Vertex : Library_Graph_Vertex_Id;
Root_LGV_Id : Library_Graph_Vertex_Id; Root_Vertex : Library_Graph_Vertex_Id;
Internal_Ctrl : Boolean; Internal_Controlled_Action : Boolean;
Path : Natural) Path : Natural)
is is
New_Path : constant Natural := Path + 1; New_Path : constant Natural := Path + 1;
Curr_LGV_Id : Library_Graph_Vertex_Id; Edge : Invocation_Graph_Edge_Id;
IGE_Id : Invocation_Graph_Edge_Id; Invoker_Vertex : Library_Graph_Vertex_Id;
Iter : Edges_To_Targets_Iterator; Iter : Edges_To_Targets_Iterator;
Targ : Invocation_Graph_Vertex_Id;
begin begin
pragma Assert (Present (Inv_Graph)); pragma Assert (Present (Inv_Graph));
pragma Assert (Present (Curr_IGV_Id));
pragma Assert (Present (Lib_Graph)); pragma Assert (Present (Lib_Graph));
pragma Assert (Present (Last_LGV_Id)); pragma Assert (Present (Invoker));
pragma Assert (Present (Root_LGV_Id)); pragma Assert (Present (Last_Vertex));
pragma Assert (Present (Root_Vertex));
-- Nothing to do when the current invocation graph vertex has already -- Nothing to do when the current invocation graph vertex has already
-- been visited. -- been visited.
if Is_Visited (Curr_IGV_Id) then if Is_Visited (Invoker) then
return; return;
end if; end if;
Set_Is_Visited (Curr_IGV_Id); Set_Is_Visited (Invoker);
-- Update the statistics -- Update the statistics
...@@ -287,10 +272,10 @@ package body Bindo.Augmentors is ...@@ -287,10 +272,10 @@ package body Bindo.Augmentors is
-- indicates that elaboration is transitioning from one unit to -- indicates that elaboration is transitioning from one unit to
-- another. Add a library graph edge to capture this dependency. -- another. Add a library graph edge to capture this dependency.
Curr_LGV_Id := Lib_Vertex (Inv_Graph, Curr_IGV_Id); Invoker_Vertex := Body_Vertex (Inv_Graph, Invoker);
pragma Assert (Present (Curr_LGV_Id)); 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 -- The path ultimately reaches back into the unit where the root
-- resides, resulting in a self dependency. In most cases this is -- resides, resulting in a self dependency. In most cases this is
...@@ -299,7 +284,9 @@ package body Bindo.Augmentors is ...@@ -299,7 +284,9 @@ package body Bindo.Augmentors is
-- library graph edge because the circularity is the result of -- library graph edge because the circularity is the result of
-- expansion and thus spurious. -- 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; null;
-- Otherwise create the library graph edge, even if this results -- Otherwise create the library graph edge, even if this results
...@@ -308,8 +295,8 @@ package body Bindo.Augmentors is ...@@ -308,8 +295,8 @@ package body Bindo.Augmentors is
else else
Add_Edge Add_Edge
(G => Lib_Graph, (G => Lib_Graph,
Pred => Curr_LGV_Id, Pred => Invoker_Vertex,
Succ => Root_LGV_Id, Succ => Root_Vertex,
Kind => Invocation_Edge); Kind => Invocation_Edge);
end if; end if;
end if; end if;
...@@ -317,23 +304,19 @@ package body Bindo.Augmentors is ...@@ -317,23 +304,19 @@ package body Bindo.Augmentors is
-- Extend the DFS traversal to all targets of the invocation graph -- Extend the DFS traversal to all targets of the invocation graph
-- vertex. -- vertex.
Iter := Iterate_Edges_To_Targets (Inv_Graph, Curr_IGV_Id); Iter := Iterate_Edges_To_Targets (Inv_Graph, Invoker);
while Has_Next (Iter) loop while Has_Next (Iter) loop
Next (Iter, IGE_Id); Next (Iter, Edge);
pragma Assert (Present (IGE_Id));
Targ := Target (Inv_Graph, IGE_Id);
pragma Assert (Present (Targ));
Visit_Vertex Visit_Vertex
(Curr_IGV_Id => Targ, (Invoker => Target (Inv_Graph, Edge),
Last_LGV_Id => Curr_LGV_Id, Last_Vertex => Invoker_Vertex,
Root_LGV_Id => Root_LGV_Id, Root_Vertex => Root_Vertex,
Internal_Ctrl => Internal_Controlled_Action =>
Internal_Ctrl Internal_Controlled_Action
or else Kind (Inv_Graph, IGE_Id) in or else Kind (Inv_Graph, Edge) in
Internal_Controlled_Invocation_Kind, Internal_Controlled_Invocation_Kind,
Path => New_Path); Path => New_Path);
end loop; end loop;
end Visit_Vertex; end Visit_Vertex;
......
gcc/ada/bindo-builders.adb
...@@ -64,10 +64,10 @@ package body Bindo.Builders is ...@@ -64,10 +64,10 @@ package body Bindo.Builders is
procedure Create_Vertex procedure Create_Vertex
(IC_Id : Invocation_Construct_Id; (IC_Id : Invocation_Construct_Id;
LGV_Id : Library_Graph_Vertex_Id); Vertex : Library_Graph_Vertex_Id);
pragma Inline (Create_Vertex); pragma Inline (Create_Vertex);
-- Create a new vertex for invocation construct IC_Id in invocation -- 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. -- graph Lib_Graph.
procedure Create_Vertices (U_Id : Unit_Id); procedure Create_Vertices (U_Id : Unit_Id);
...@@ -75,6 +75,14 @@ package body Bindo.Builders is ...@@ -75,6 +75,14 @@ package body Bindo.Builders is
-- Create new vertices for all invocation constructs of unit U_Id in -- Create new vertices for all invocation constructs of unit U_Id in
-- invocation graph Inv_Graph. -- 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 -- -- Build_Invocation_Graph --
---------------------------- ----------------------------
...@@ -88,8 +96,9 @@ package body Bindo.Builders is ...@@ -88,8 +96,9 @@ package body Bindo.Builders is
-- Prepare the global data -- Prepare the global data
Inv_Graph := Inv_Graph :=
Create (Initial_Vertices => Number_Of_Elaborable_Units, Create
Initial_Edges => Number_Of_Elaborable_Units); (Initial_Vertices => Number_Of_Elaborable_Units,
Initial_Edges => Number_Of_Elaborable_Units);
Lib_Graph := Lib_G; Lib_Graph := Lib_G;
For_Each_Elaborable_Unit (Create_Vertices'Access); For_Each_Elaborable_Unit (Create_Vertices'Access);
...@@ -107,33 +116,24 @@ package body Bindo.Builders is ...@@ -107,33 +116,24 @@ package body Bindo.Builders is
pragma Assert (Present (Lib_Graph)); pragma Assert (Present (Lib_Graph));
pragma Assert (Present (IR_Id)); pragma Assert (Present (IR_Id));
IR_Rec : Invocation_Relation_Record renames Invoker_Sig : constant Invocation_Signature_Id := Invoker (IR_Id);
Invocation_Relations.Table (IR_Id); Target_Sig : constant Invocation_Signature_Id := Target (IR_Id);
pragma Assert (Present (IR_Rec.Invoker));
pragma Assert (Present (IR_Rec.Target));
Invoker : Invocation_Graph_Vertex_Id; pragma Assert (Present (Invoker_Sig));
Target : Invocation_Graph_Vertex_Id; pragma Assert (Present (Target_Sig));
begin begin
-- Nothing to do when the target denotes an invocation construct that -- Nothing to do when the target denotes an invocation construct that
-- resides in a unit which will never be elaborated. -- 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; return;
end if; 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 Add_Edge
(G => Inv_Graph, (G => Inv_Graph,
Source => Invoker, Source => Corresponding_Vertex (Inv_Graph, Invoker_Sig),
Target => Target, Target => Corresponding_Vertex (Inv_Graph, Target_Sig),
IR_Id => IR_Id); IR_Id => IR_Id);
end Create_Edge; end Create_Edge;
...@@ -162,35 +162,25 @@ package body Bindo.Builders is ...@@ -162,35 +162,25 @@ package body Bindo.Builders is
procedure Create_Vertex procedure Create_Vertex
(IC_Id : Invocation_Construct_Id; (IC_Id : Invocation_Construct_Id;
LGV_Id : Library_Graph_Vertex_Id) Vertex : Library_Graph_Vertex_Id)
is is
begin
pragma Assert (Present (Inv_Graph)); pragma Assert (Present (Inv_Graph));
pragma Assert (Present (Lib_Graph)); pragma Assert (Present (Lib_Graph));
pragma Assert (Present (IC_Id)); pragma Assert (Present (IC_Id));
pragma Assert (Present (LGV_Id)); pragma Assert (Present (Vertex));
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));
Add_Vertex Add_Vertex
(G => Inv_Graph, (G => Inv_Graph,
IC_Id => IC_Id, IC_Id => IC_Id,
LGV_Id => Body_LGV_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; end Create_Vertex;
--------------------- ---------------------
...@@ -203,18 +193,37 @@ package body Bindo.Builders is ...@@ -203,18 +193,37 @@ package body Bindo.Builders is
pragma Assert (Present (U_Id)); pragma Assert (Present (U_Id));
U_Rec : Unit_Record renames ALI.Units.Table (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); Corresponding_Vertex (Lib_Graph, U_Id);
pragma Assert (Present (LGV_Id));
begin begin
for IC_Id in U_Rec.First_Invocation_Construct .. for IC_Id in U_Rec.First_Invocation_Construct ..
U_Rec.Last_Invocation_Construct U_Rec.Last_Invocation_Construct
loop loop
Create_Vertex (IC_Id, LGV_Id); Create_Vertex (IC_Id, Vertex);
end loop; end loop;
end Create_Vertices; 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; end Invocation_Graph_Builders;
---------------------------- ----------------------------
...@@ -235,7 +244,7 @@ package body Bindo.Builders is ...@@ -235,7 +244,7 @@ package body Bindo.Builders is
pragma Inline (Hash_Unit); pragma Inline (Hash_Unit);
-- Obtain the hash value of key U_Id -- 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, (Key_Type => Unit_Id,
Value_Type => Logical_Line_Number, Value_Type => Logical_Line_Number,
No_Value => No_Line_Number, No_Value => No_Line_Number,
...@@ -253,9 +262,10 @@ package body Bindo.Builders is ...@@ -253,9 +262,10 @@ package body Bindo.Builders is
Lib_Graph : Library_Graph := Library_Graphs.Nil; 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 -- 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 -- -- Local subprograms --
...@@ -348,20 +358,24 @@ package body Bindo.Builders is ...@@ -348,20 +358,24 @@ package body Bindo.Builders is
begin begin
pragma Assert (Present (U_Id)); 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; end Add_Unit;
------------------------- -------------------------
-- Build_Library_Graph -- -- Build_Library_Graph --
------------------------- -------------------------
function Build_Library_Graph return Library_Graph is function Build_Library_Graph
(Dynamically_Elaborated : Boolean) return Library_Graph
is
begin begin
-- Prepare the global data -- Prepare the global data
Lib_Graph := Lib_Graph :=
Create (Initial_Vertices => Number_Of_Elaborable_Units, Create
Initial_Edges => Number_Of_Elaborable_Units); (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_Vertex'Access);
For_Each_Elaborable_Unit (Create_Spec_And_Body_Edge'Access); For_Each_Elaborable_Unit (Create_Spec_And_Body_Edge'Access);
...@@ -383,14 +397,11 @@ package body Bindo.Builders is ...@@ -383,14 +397,11 @@ package body Bindo.Builders is
pragma Assert (Present (Pred)); pragma Assert (Present (Pred));
pragma Assert (Present (Succ)); pragma Assert (Present (Succ));
Pred_LGV_Id : constant Library_Graph_Vertex_Id := Pred_Vertex : constant Library_Graph_Vertex_Id :=
Corresponding_Vertex (Lib_Graph, Pred); 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); Corresponding_Vertex (Lib_Graph, Succ);
pragma Assert (Present (Pred_LGV_Id));
pragma Assert (Present (Succ_LGV_Id));
begin begin
Write_Unit_Name (Name (Pred)); Write_Unit_Name (Name (Pred));
Write_Str (" <-- "); Write_Str (" <-- ");
...@@ -399,8 +410,8 @@ package body Bindo.Builders is ...@@ -399,8 +410,8 @@ package body Bindo.Builders is
Add_Edge Add_Edge
(G => Lib_Graph, (G => Lib_Graph,
Pred => Pred_LGV_Id, Pred => Pred_Vertex,
Succ => Succ_LGV_Id, Succ => Succ_Vertex,
Kind => Forced_Edge); Kind => Forced_Edge);
end Create_Forced_Edge; end Create_Forced_Edge;
...@@ -409,15 +420,15 @@ package body Bindo.Builders is ...@@ -409,15 +420,15 @@ package body Bindo.Builders is
------------------------- -------------------------
procedure Create_Forced_Edges is procedure Create_Forced_Edges is
Curr_Unit : Unit_Id; Current_Unit : Unit_Id;
Iter : Forced_Units_Iterator; Iter : Forced_Units_Iterator;
Prev_Unit : Unit_Id; Previous_Unit : Unit_Id;
Unit_Line : Logical_Line_Number; Unit_Line : Logical_Line_Number;
Unit_Name : Unit_Name_Type; Unit_Name : Unit_Name_Type;
begin begin
Prev_Unit := No_Unit_Id; Previous_Unit := No_Unit_Id;
Unit_To_Line := UL.Create (20); Unit_To_Line := Unit_Line_Tables.Create (20);
-- Inspect the contents of the forced-elaboration-order file supplied -- Inspect the contents of the forced-elaboration-order file supplied
-- to the binder using switch -f, and diagnose each unit accordingly. -- to the binder using switch -f, and diagnose each unit accordingly.
...@@ -425,36 +436,35 @@ package body Bindo.Builders is ...@@ -425,36 +436,35 @@ package body Bindo.Builders is
Iter := Iterate_Forced_Units; Iter := Iterate_Forced_Units;
while Has_Next (Iter) loop while Has_Next (Iter) loop
Next (Iter, Unit_Name, Unit_Line); 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); Missing_Unit_Info (Unit_Name);
elsif Is_Internal_Unit (Curr_Unit) then elsif Is_Internal_Unit (Current_Unit) then
Internal_Unit_Info (Unit_Name); Internal_Unit_Info (Unit_Name);
elsif Is_Duplicate_Unit (Curr_Unit) then elsif Is_Duplicate_Unit (Current_Unit) then
Duplicate_Unit_Error (Curr_Unit, Unit_Name, Unit_Line); Duplicate_Unit_Error (Current_Unit, Unit_Name, Unit_Line);
-- Otherwise the unit is a valid candidate for a vertex. Create a -- Otherwise the unit is a valid candidate for a vertex. Create a
-- forced edge between each pair of units. -- forced edge between each pair of units.
else 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 Create_Forced_Edge
(Pred => Prev_Unit, (Pred => Previous_Unit,
Succ => Curr_Unit); Succ => Current_Unit);
end if; end if;
Prev_Unit := Curr_Unit; Previous_Unit := Current_Unit;
end if; end if;
end loop; end loop;
UL.Destroy (Unit_To_Line); Unit_Line_Tables.Destroy (Unit_To_Line);
end Create_Forced_Edges; end Create_Forced_Edges;
------------------------------- -------------------------------
...@@ -462,42 +472,37 @@ package body Bindo.Builders is ...@@ -462,42 +472,37 @@ package body Bindo.Builders is
------------------------------- -------------------------------
procedure Create_Spec_And_Body_Edge (U_Id : Unit_Id) is procedure Create_Spec_And_Body_Edge (U_Id : Unit_Id) is
Aux_LGV_Id : Library_Graph_Vertex_Id; Extra_Vertex : Library_Graph_Vertex_Id;
LGV_Id : Library_Graph_Vertex_Id; Vertex : Library_Graph_Vertex_Id;
begin begin
pragma Assert (Present (Lib_Graph)); pragma Assert (Present (Lib_Graph));
pragma Assert (Present (U_Id)); pragma Assert (Present (U_Id));
LGV_Id := Corresponding_Vertex (Lib_Graph, U_Id); Vertex := Corresponding_Vertex (Lib_Graph, U_Id);
pragma Assert (Present (LGV_Id));
-- The unit denotes a body that completes a previous spec. Link the -- The unit denotes a body that completes a previous spec. Link the
-- spec and body. Add an edge between the predecessor spec and the -- spec and body. Add an edge between the predecessor spec and the
-- successor body. -- successor body.
if Is_Body_With_Spec (Lib_Graph, LGV_Id) then if Is_Body_With_Spec (Lib_Graph, Vertex) then
Aux_LGV_Id := Extra_Vertex :=
Corresponding_Vertex (Lib_Graph, Corresponding_Spec (U_Id)); Corresponding_Vertex (Lib_Graph, Corresponding_Spec (U_Id));
pragma Assert (Present (Aux_LGV_Id)); Set_Corresponding_Item (Lib_Graph, Vertex, Extra_Vertex);
Set_Corresponding_Item (Lib_Graph, LGV_Id, Aux_LGV_Id);
Add_Edge Add_Edge
(G => Lib_Graph, (G => Lib_Graph,
Pred => Aux_LGV_Id, Pred => Extra_Vertex,
Succ => LGV_Id, Succ => Vertex,
Kind => Spec_Before_Body_Edge); Kind => Spec_Before_Body_Edge);
-- The unit denotes a spec with a completing body. Link the spec and -- The unit denotes a spec with a completing body. Link the spec and
-- body. -- body.
elsif Is_Spec_With_Body (Lib_Graph, LGV_Id) then elsif Is_Spec_With_Body (Lib_Graph, Vertex) then
Aux_LGV_Id := Extra_Vertex :=
Corresponding_Vertex (Lib_Graph, Corresponding_Body (U_Id)); Corresponding_Vertex (Lib_Graph, Corresponding_Body (U_Id));
pragma Assert (Present (Aux_LGV_Id)); Set_Corresponding_Item (Lib_Graph, Vertex, Extra_Vertex);
Set_Corresponding_Item (Lib_Graph, LGV_Id, Aux_LGV_Id);
end if; end if;
end Create_Spec_And_Body_Edge; end Create_Spec_And_Body_Edge;
...@@ -531,11 +536,8 @@ package body Bindo.Builders is ...@@ -531,11 +536,8 @@ package body Bindo.Builders is
Withed_U_Id : constant Unit_Id := Withed_U_Id : constant Unit_Id :=
Corresponding_Unit (Withed_Rec.Uname); Corresponding_Unit (Withed_Rec.Uname);
pragma Assert (Present (Withed_U_Id));
Aux_LGV_Id : Library_Graph_Vertex_Id;
Kind : Library_Graph_Edge_Kind; Kind : Library_Graph_Edge_Kind;
Withed_LGV_Id : Library_Graph_Vertex_Id; Withed_Vertex : Library_Graph_Vertex_Id;
begin begin
-- Nothing to do when the withed unit does not need to be elaborated. -- Nothing to do when the withed unit does not need to be elaborated.
...@@ -545,8 +547,7 @@ package body Bindo.Builders is ...@@ -545,8 +547,7 @@ package body Bindo.Builders is
return; return;
end if; end if;
Withed_LGV_Id := Corresponding_Vertex (Lib_Graph, Withed_U_Id); Withed_Vertex := Corresponding_Vertex (Lib_Graph, Withed_U_Id);
pragma Assert (Present (Withed_LGV_Id));
-- The with comes with pragma Elaborate -- The with comes with pragma Elaborate
...@@ -557,15 +558,12 @@ package body Bindo.Builders is ...@@ -557,15 +558,12 @@ package body Bindo.Builders is
-- between the body of the withed predecessor and the withing -- between the body of the withed predecessor and the withing
-- successor. -- successor.
if Is_Spec_With_Body (Lib_Graph, Withed_LGV_Id) then if Is_Spec_With_Body (Lib_Graph, Withed_Vertex) then
Aux_LGV_Id :=
Corresponding_Vertex
(Lib_Graph, Corresponding_Body (Withed_U_Id));
pragma Assert (Present (Aux_LGV_Id));
Add_Edge Add_Edge
(G => Lib_Graph, (G => Lib_Graph,
Pred => Aux_LGV_Id, Pred =>
Corresponding_Vertex
(Lib_Graph, Corresponding_Body (Withed_U_Id)),
Succ => Succ, Succ => Succ,
Kind => Kind); Kind => Kind);
end if; end if;
...@@ -586,7 +584,7 @@ package body Bindo.Builders is ...@@ -586,7 +584,7 @@ package body Bindo.Builders is
Add_Edge Add_Edge
(G => Lib_Graph, (G => Lib_Graph,
Pred => Withed_LGV_Id, Pred => Withed_Vertex,
Succ => Succ, Succ => Succ,
Kind => Kind); Kind => Kind);
end Create_With_Edge; end Create_With_Edge;
...@@ -596,18 +594,13 @@ package body Bindo.Builders is ...@@ -596,18 +594,13 @@ package body Bindo.Builders is
----------------------- -----------------------
procedure Create_With_Edges (U_Id : Unit_Id) is procedure Create_With_Edges (U_Id : Unit_Id) is
LGV_Id : Library_Graph_Vertex_Id;
begin begin
pragma Assert (Present (Lib_Graph)); pragma Assert (Present (Lib_Graph));
pragma Assert (Present (U_Id)); pragma Assert (Present (U_Id));
LGV_Id := Corresponding_Vertex (Lib_Graph, U_Id);
pragma Assert (Present (LGV_Id));
Create_With_Edges Create_With_Edges
(U_Id => U_Id, (U_Id => U_Id,
Succ => LGV_Id); Succ => Corresponding_Vertex (Lib_Graph, U_Id));
end Create_With_Edges; end Create_With_Edges;
----------------------- -----------------------
...@@ -655,7 +648,7 @@ package body Bindo.Builders is ...@@ -655,7 +648,7 @@ package body Bindo.Builders is
pragma Assert (Present (Nam)); pragma Assert (Present (Nam));
Prev_Line : constant Logical_Line_Number := Prev_Line : constant Logical_Line_Number :=
UL.Get (Unit_To_Line, U_Id); Unit_Line_Tables.Get (Unit_To_Line, U_Id);
begin begin
Error_Msg_Nat_1 := Nat (Line); Error_Msg_Nat_1 := Nat (Line);
...@@ -698,7 +691,7 @@ package body Bindo.Builders is ...@@ -698,7 +691,7 @@ package body Bindo.Builders is
begin begin
pragma Assert (Present (U_Id)); 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; end Is_Duplicate_Unit;
------------------------- -------------------------
......
gcc/ada/bindo-builders.ads
...@@ -56,9 +56,11 @@ package Bindo.Builders is ...@@ -56,9 +56,11 @@ package Bindo.Builders is
---------------------------- ----------------------------
package Library_Graph_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 -- 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; end Library_Graph_Builders;
......
gcc/ada/bindo-diagnostics.adb
...@@ -23,50 +23,1457 @@ ...@@ -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 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);
----------------------------- begin
-- Has_Elaborate_All_Cycle -- 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 elsif Is_Elaborate_Body_Edge (Lib_Graph, Current_Edge) then
Has_Cycle : Boolean; Output_Elaborate_Body_Transition
Iter : All_Edge_Iterator; (G => Lib_Graph,
LGE_Id : Library_Graph_Edge_Id; Source => Source,
Actual_Destination => Actual_Destination,
Expected_Destination => Expected_Destination);
begin elsif Is_Elaborate_Edge (Lib_Graph, Current_Edge) then
pragma Assert (Present (G)); 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 else
-- represents a with clause for a unit with pragma Elaborate_All, and pragma Assert (Is_With_Edge (Lib_Graph, Current_Edge));
-- both the predecessor and successor reside in the same component.
-- Note that the iteration must run to completion in order to unlock
-- the graph.
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 while Has_Next (Iter) loop
Next (Iter, LGE_Id); Next (Iter, Edge);
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;
return Has_Cycle; -- Prepare for edge backtracking
end Has_Elaborate_All_Cycle;
end Cycle_Diagnostics; 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; end Bindo.Diagnostics;
gcc/ada/bindo-diagnostics.ads
...@@ -30,6 +30,7 @@ ...@@ -30,6 +30,7 @@
with Bindo.Graphs; with Bindo.Graphs;
use Bindo.Graphs; use Bindo.Graphs;
use Bindo.Graphs.Invocation_Graphs;
use Bindo.Graphs.Library_Graphs; use Bindo.Graphs.Library_Graphs;
package Bindo.Diagnostics is package Bindo.Diagnostics is
...@@ -46,16 +47,15 @@ package Bindo.Diagnostics is ...@@ -46,16 +47,15 @@ package Bindo.Diagnostics is
Order_Has_Elaborate_All_Circularity, Order_Has_Elaborate_All_Circularity,
Order_OK); Order_OK);
----------------------- ---------
-- Cycle_Diagnostics -- -- API --
----------------------- ---------
package Cycle_Diagnostics is procedure Diagnose_Circularities
function Has_Elaborate_All_Cycle (G : Library_Graph) return Boolean; (Inv_Graph : Invocation_Graph;
pragma Inline (Has_Elaborate_All_Cycle); Lib_Graph : Library_Graph);
-- Determine whether library graph G contains a cycle where pragma pragma Inline (Diagnose_Circularities);
-- Elaborate_All appears within a component. -- Diagnose all cycles of library graph Lib_Graph with matching invocation
-- graph Inv_Graph.
end Cycle_Diagnostics;
end Bindo.Diagnostics; end Bindo.Diagnostics;
gcc/ada/bindo-elaborators.adb
...@@ -23,11 +23,10 @@ ...@@ -23,11 +23,10 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Binderr; use Binderr; with Butil; use Butil;
with Butil; use Butil; with Debug; use Debug;
with Debug; use Debug; with Output; use Output;
with Output; use Output; with Types; use Types;
with Types; use Types;
with Bindo.Augmentors; with Bindo.Augmentors;
use Bindo.Augmentors; use Bindo.Augmentors;
...@@ -40,7 +39,6 @@ use Bindo.Builders.Library_Graph_Builders; ...@@ -40,7 +39,6 @@ use Bindo.Builders.Library_Graph_Builders;
with Bindo.Diagnostics; with Bindo.Diagnostics;
use Bindo.Diagnostics; use Bindo.Diagnostics;
use Bindo.Diagnostics.Cycle_Diagnostics;
with Bindo.Units; with Bindo.Units;
use Bindo.Units; use Bindo.Units;
...@@ -61,7 +59,6 @@ use Bindo.Writers.Unit_Closure_Writers; ...@@ -61,7 +59,6 @@ use Bindo.Writers.Unit_Closure_Writers;
with GNAT; use GNAT; with GNAT; use GNAT;
with GNAT.Graphs; use GNAT.Graphs; with GNAT.Graphs; use GNAT.Graphs;
with GNAT.Sets; use GNAT.Sets;
package body Bindo.Elaborators is package body Bindo.Elaborators is
...@@ -89,49 +86,39 @@ package body Bindo.Elaborators is ...@@ -89,49 +86,39 @@ package body Bindo.Elaborators is
type String_Ptr is access all String; 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 -- -- Local subprograms --
----------------------- -----------------------
procedure Add_Vertex procedure Add_Vertex
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id; Vertex : Library_Graph_Vertex_Id;
Set : Membership_Set; Set : LGV_Sets.Membership_Set;
Msg : String; Msg : String;
Step : Elaboration_Order_Step; Step : Elaboration_Order_Step;
Indent : Indentation_Level); Indent : Indentation_Level);
pragma Inline (Add_Vertex); 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 -- a message emitted for tracing purposes. Step is the current step in
-- the elaboration order. Indent is the desired indentation level for -- the elaboration order. Indent is the desired indentation level for
-- tracing. -- tracing.
procedure Add_Vertex_If_Elaborable procedure Add_Vertex_If_Elaborable
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id; Vertex : Library_Graph_Vertex_Id;
Set : Membership_Set; Set : LGV_Sets.Membership_Set;
Msg : String; Msg : String;
Step : Elaboration_Order_Step; Step : Elaboration_Order_Step;
Indent : Indentation_Level); Indent : Indentation_Level);
pragma Inline (Add_Vertex_If_Elaborable); 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 -- be elaborated. Msg is a message emitted for tracing purposes. Step is
-- the current step in the elaboration order. Indent is the desired -- the current step in the elaboration order. Indent is the desired
-- indentation level for tracing. -- indentation level for tracing.
function Create_All_Candidates_Set function Create_All_Candidates_Set
(G : Library_Graph; (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); pragma Inline (Create_All_Candidates_Set);
-- Collect all elaborable candidate vertices of library graph G in a -- Collect all elaborable candidate vertices of library graph G in a
-- set. Step is the current step in the elaboration order. -- set. Step is the current step in the elaboration order.
...@@ -139,7 +126,7 @@ package body Bindo.Elaborators is ...@@ -139,7 +126,7 @@ package body Bindo.Elaborators is
function Create_Component_Candidates_Set function Create_Component_Candidates_Set
(G : Library_Graph; (G : Library_Graph;
Comp : Component_Id; 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); pragma Inline (Create_Component_Candidates_Set);
-- Collect all elaborable candidate vertices that appear in component -- Collect all elaborable candidate vertices that appear in component
-- Comp of library graph G in a set. Step is the current step in the -- Comp of library graph G in a set. Step is the current step in the
...@@ -148,7 +135,7 @@ package body Bindo.Elaborators is ...@@ -148,7 +135,7 @@ package body Bindo.Elaborators is
procedure Elaborate_Component procedure Elaborate_Component
(G : Library_Graph; (G : Library_Graph;
Comp : Component_Id; Comp : Component_Id;
All_Candidates : Membership_Set; All_Candidates : LGV_Sets.Membership_Set;
Remaining_Vertices : in out Natural; Remaining_Vertices : in out Natural;
Order : in out Unit_Id_Table; Order : in out Unit_Id_Table;
Step : Elaboration_Order_Step); Step : Elaboration_Order_Step);
...@@ -170,6 +157,7 @@ package body Bindo.Elaborators is ...@@ -170,6 +157,7 @@ package body Bindo.Elaborators is
procedure Elaborate_Units_Common procedure Elaborate_Units_Common
(Use_Inv_Graph : Boolean; (Use_Inv_Graph : Boolean;
Is_Dyn_Elab : Boolean;
Inv_Graph : out Invocation_Graph; Inv_Graph : out Invocation_Graph;
Lib_Graph : out Library_Graph; Lib_Graph : out Library_Graph;
Order : out Unit_Id_Table; Order : out Unit_Id_Table;
...@@ -177,8 +165,10 @@ package body Bindo.Elaborators is ...@@ -177,8 +165,10 @@ package body Bindo.Elaborators is
pragma Inline (Elaborate_Units_Common); pragma Inline (Elaborate_Units_Common);
-- Find the elaboration order of all units in the bind. Use_Inv_Graph -- 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 -- should be set when library graph Lib_Graph is to be augmented with
-- information from invocation graph Inv_Graph. Order is the elaboration -- information from invocation graph Inv_Graph. Is_Dyn_Elab should be
-- order. Status is the condition of the elaboration order. -- 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); procedure Elaborate_Units_Dynamic (Order : out Unit_Id_Table);
pragma Inline (Elaborate_Units_Dynamic); pragma Inline (Elaborate_Units_Dynamic);
...@@ -196,26 +186,26 @@ package body Bindo.Elaborators is ...@@ -196,26 +186,26 @@ package body Bindo.Elaborators is
procedure Elaborate_Vertex procedure Elaborate_Vertex
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id; Vertex : Library_Graph_Vertex_Id;
All_Candidates : Membership_Set; All_Candidates : LGV_Sets.Membership_Set;
Comp_Candidates : Membership_Set; Comp_Candidates : LGV_Sets.Membership_Set;
Remaining_Vertices : in out Natural; Remaining_Vertices : in out Natural;
Order : in out Unit_Id_Table; Order : in out Unit_Id_Table;
Step : Elaboration_Order_Step; Step : Elaboration_Order_Step;
Indent : Indentation_Level); Indent : Indentation_Level);
pragma Inline (Elaborate_Vertex); 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 -- elaboration order Order. The routine updates awaiting successors
-- where applicable. All_Candidates denotes the set of all elaborable -- where applicable. All_Candidates denotes the set of all elaborable
-- vertices across the whole library graph. Comp_Candidates is the set -- 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 -- Remaining_Vertices denotes the number of vertices that remain to
-- be elaborated. Step is the current step in the elaboration order. -- be elaborated. Step is the current step in the elaboration order.
-- Indent is the desired indentation level for tracing. -- Indent is the desired indentation level for tracing.
function Find_Best_Candidate function Find_Best_Candidate
(G : Library_Graph; (G : Library_Graph;
Set : Membership_Set; Set : LGV_Sets.Membership_Set;
Step : Elaboration_Order_Step; Step : Elaboration_Order_Step;
Indent : Indentation_Level) return Library_Graph_Vertex_Id; Indent : Indentation_Level) return Library_Graph_Vertex_Id;
pragma Inline (Find_Best_Candidate); pragma Inline (Find_Best_Candidate);
...@@ -224,17 +214,17 @@ package body Bindo.Elaborators is ...@@ -224,17 +214,17 @@ package body Bindo.Elaborators is
-- order. Indent is the desired indentation level for tracing. -- order. Indent is the desired indentation level for tracing.
function Is_Better_Candidate function Is_Better_Candidate
(G : Library_Graph; (G : Library_Graph;
Best_Candid : Library_Graph_Vertex_Id; Best_Candidate : Library_Graph_Vertex_Id;
New_Candid : Library_Graph_Vertex_Id) return Boolean; New_Candidate : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (Is_Better_Candidate); 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 -- G is a more suitable choice for elaboration compared to the current
-- best candidate Best_Candid. -- best candidate Best_Candidate.
procedure Trace_Candidate_Vertices procedure Trace_Candidate_Vertices
(G : Library_Graph; (G : Library_Graph;
Set : Membership_Set; Set : LGV_Sets.Membership_Set;
Step : Elaboration_Order_Step); Step : Elaboration_Order_Step);
pragma Inline (Trace_Candidate_Vertices); pragma Inline (Trace_Candidate_Vertices);
-- Write the candidate vertices of library graph G present in membership -- Write the candidate vertices of library graph G present in membership
...@@ -266,12 +256,12 @@ package body Bindo.Elaborators is ...@@ -266,12 +256,12 @@ package body Bindo.Elaborators is
procedure Trace_Vertex procedure Trace_Vertex
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id; Vertex : Library_Graph_Vertex_Id;
Msg : String; Msg : String;
Step : Elaboration_Order_Step; Step : Elaboration_Order_Step;
Indent : Indentation_Level); Indent : Indentation_Level);
pragma Inline (Trace_Vertex); 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 -- graph G to standard output, starting with message Msg. Step is the
-- current step in the elaboration order. Indent denotes the desired -- current step in the elaboration order. Indent denotes the desired
-- indentation level for tracing. -- indentation level for tracing.
...@@ -280,8 +270,8 @@ package body Bindo.Elaborators is ...@@ -280,8 +270,8 @@ package body Bindo.Elaborators is
(G : Library_Graph; (G : Library_Graph;
Pred : Library_Graph_Vertex_Id; Pred : Library_Graph_Vertex_Id;
Succ : Library_Graph_Vertex_Id; Succ : Library_Graph_Vertex_Id;
All_Candidates : Membership_Set; All_Candidates : LGV_Sets.Membership_Set;
Comp_Candidates : Membership_Set; Comp_Candidates : LGV_Sets.Membership_Set;
Step : Elaboration_Order_Step; Step : Elaboration_Order_Step;
Indent : Indentation_Level); Indent : Indentation_Level);
pragma Inline (Update_Successor); pragma Inline (Update_Successor);
...@@ -297,8 +287,8 @@ package body Bindo.Elaborators is ...@@ -297,8 +287,8 @@ package body Bindo.Elaborators is
procedure Update_Successors procedure Update_Successors
(G : Library_Graph; (G : Library_Graph;
Pred : Library_Graph_Vertex_Id; Pred : Library_Graph_Vertex_Id;
All_Candidates : Membership_Set; All_Candidates : LGV_Sets.Membership_Set;
Comp_Candidates : Membership_Set; Comp_Candidates : LGV_Sets.Membership_Set;
Step : Elaboration_Order_Step; Step : Elaboration_Order_Step;
Indent : Indentation_Level); Indent : Indentation_Level);
pragma Inline (Update_Successors); pragma Inline (Update_Successors);
...@@ -317,30 +307,30 @@ package body Bindo.Elaborators is ...@@ -317,30 +307,30 @@ package body Bindo.Elaborators is
procedure Add_Vertex procedure Add_Vertex
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id; Vertex : Library_Graph_Vertex_Id;
Set : Membership_Set; Set : LGV_Sets.Membership_Set;
Msg : String; Msg : String;
Step : Elaboration_Order_Step; Step : Elaboration_Order_Step;
Indent : Indentation_Level) Indent : Indentation_Level)
is is
begin begin
pragma Assert (Present (LGV_Id)); pragma Assert (Present (Vertex));
pragma Assert (Needs_Elaboration (G, LGV_Id)); pragma Assert (Needs_Elaboration (G, Vertex));
pragma Assert (Present (Set)); pragma Assert (LGV_Sets.Present (Set));
-- Add vertex only when it is not present in the set. This is not -- Add vertex only when it is not present in the set. This is not
-- strictly necessary because the set implementation handles this -- strictly necessary because the set implementation handles this
-- case, however the check eliminates spurious traces. -- case, however the check eliminates spurious traces.
if not Contains (Set, LGV_Id) then if not LGV_Sets.Contains (Set, Vertex) then
Trace_Vertex Trace_Vertex
(G => G, (G => G,
LGV_Id => LGV_Id, Vertex => Vertex,
Msg => Msg, Msg => Msg,
Step => Step, Step => Step,
Indent => Indent); Indent => Indent);
Insert (Set, LGV_Id); LGV_Sets.Insert (Set, Vertex);
end if; end if;
end Add_Vertex; end Add_Vertex;
...@@ -350,24 +340,24 @@ package body Bindo.Elaborators is ...@@ -350,24 +340,24 @@ package body Bindo.Elaborators is
procedure Add_Vertex_If_Elaborable procedure Add_Vertex_If_Elaborable
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id; Vertex : Library_Graph_Vertex_Id;
Set : Membership_Set; Set : LGV_Sets.Membership_Set;
Msg : String; Msg : String;
Step : Elaboration_Order_Step; Step : Elaboration_Order_Step;
Indent : Indentation_Level) Indent : Indentation_Level)
is is
Aux_LGV_Id : Library_Graph_Vertex_Id; Extra_Vertex : Library_Graph_Vertex_Id;
begin begin
pragma Assert (Present (G)); pragma Assert (Present (G));
pragma Assert (Present (LGV_Id)); pragma Assert (Present (Vertex));
pragma Assert (Needs_Elaboration (G, LGV_Id)); pragma Assert (Needs_Elaboration (G, Vertex));
pragma Assert (Present (Set)); pragma Assert (LGV_Sets.Present (Set));
if Is_Elaborable_Vertex (G, LGV_Id) then if Is_Elaborable_Vertex (G, Vertex) then
Add_Vertex Add_Vertex
(G => G, (G => G,
LGV_Id => LGV_Id, Vertex => Vertex,
Set => Set, Set => Set,
Msg => Msg, Msg => Msg,
Step => Step, Step => Step,
...@@ -375,28 +365,28 @@ package body Bindo.Elaborators is ...@@ -375,28 +365,28 @@ package body Bindo.Elaborators is
-- Assume that there is no extra vertex that needs to be added -- 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 -- A spec-body pair where the spec carries pragma Elaborate_Body
-- must be treated as one vertex for elaboration purposes. If one -- must be treated as one vertex for elaboration purposes. If one
-- of them is elaborable, then the other is also elaborable. This -- of them is elaborable, then the other is also elaborable. This
-- property is guaranteed by predicate Is_Elaborable_Vertex. -- property is guaranteed by predicate Is_Elaborable_Vertex.
if Is_Body_Of_Spec_With_Elaborate_Body (G, LGV_Id) then if Is_Body_Of_Spec_With_Elaborate_Body (G, Vertex) then
Aux_LGV_Id := Proper_Spec (G, LGV_Id); Extra_Vertex := Proper_Spec (G, Vertex);
pragma Assert (Present (Aux_LGV_Id)); pragma Assert (Present (Extra_Vertex));
elsif Is_Spec_With_Elaborate_Body (G, LGV_Id) then elsif Is_Spec_With_Elaborate_Body (G, Vertex) then
Aux_LGV_Id := Proper_Body (G, LGV_Id); Extra_Vertex := Proper_Body (G, Vertex);
pragma Assert (Present (Aux_LGV_Id)); pragma Assert (Present (Extra_Vertex));
end if; end if;
if Present (Aux_LGV_Id) then if Present (Extra_Vertex) then
pragma Assert (Needs_Elaboration (G, Aux_LGV_Id)); pragma Assert (Needs_Elaboration (G, Extra_Vertex));
Add_Vertex Add_Vertex
(G => G, (G => G,
LGV_Id => Aux_LGV_Id, Vertex => Extra_Vertex,
Set => Set, Set => Set,
Msg => Msg, Msg => Msg,
Step => Step, Step => Step,
...@@ -411,24 +401,23 @@ package body Bindo.Elaborators is ...@@ -411,24 +401,23 @@ package body Bindo.Elaborators is
function Create_All_Candidates_Set function Create_All_Candidates_Set
(G : Library_Graph; (G : Library_Graph;
Step : Elaboration_Order_Step) return Membership_Set Step : Elaboration_Order_Step) return LGV_Sets.Membership_Set
is is
Iter : Library_Graphs.All_Vertex_Iterator; Iter : Library_Graphs.All_Vertex_Iterator;
LGV_Id : Library_Graph_Vertex_Id; Set : LGV_Sets.Membership_Set;
Set : Membership_Set; Vertex : Library_Graph_Vertex_Id;
begin begin
pragma Assert (Present (G)); pragma Assert (Present (G));
Set := Create (Number_Of_Vertices (G)); Set := LGV_Sets.Create (Number_Of_Vertices (G));
Iter := Iterate_All_Vertices (G); Iter := Iterate_All_Vertices (G);
while Has_Next (Iter) loop while Has_Next (Iter) loop
Next (Iter, LGV_Id); Next (Iter, Vertex);
pragma Assert (Present (LGV_Id));
Add_Vertex_If_Elaborable Add_Vertex_If_Elaborable
(G => G, (G => G,
LGV_Id => LGV_Id, Vertex => Vertex,
Set => Set, Set => Set,
Msg => Add_To_All_Candidates_Msg, Msg => Add_To_All_Candidates_Msg,
Step => Step, Step => Step,
...@@ -445,25 +434,24 @@ package body Bindo.Elaborators is ...@@ -445,25 +434,24 @@ package body Bindo.Elaborators is
function Create_Component_Candidates_Set function Create_Component_Candidates_Set
(G : Library_Graph; (G : Library_Graph;
Comp : Component_Id; Comp : Component_Id;
Step : Elaboration_Order_Step) return Membership_Set Step : Elaboration_Order_Step) return LGV_Sets.Membership_Set
is is
Iter : Component_Vertex_Iterator; Iter : Component_Vertex_Iterator;
LGV_Id : Library_Graph_Vertex_Id; Set : LGV_Sets.Membership_Set;
Set : Membership_Set; Vertex : Library_Graph_Vertex_Id;
begin begin
pragma Assert (Present (G)); pragma Assert (Present (G));
pragma Assert (Present (Comp)); 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); Iter := Iterate_Component_Vertices (G, Comp);
while Has_Next (Iter) loop while Has_Next (Iter) loop
Next (Iter, LGV_Id); Next (Iter, Vertex);
pragma Assert (Present (LGV_Id));
Add_Vertex_If_Elaborable Add_Vertex_If_Elaborable
(G => G, (G => G,
LGV_Id => LGV_Id, Vertex => Vertex,
Set => Set, Set => Set,
Msg => Add_To_Comp_Candidates_Msg, Msg => Add_To_Comp_Candidates_Msg,
Step => Step, Step => Step,
...@@ -480,18 +468,18 @@ package body Bindo.Elaborators is ...@@ -480,18 +468,18 @@ package body Bindo.Elaborators is
procedure Elaborate_Component procedure Elaborate_Component
(G : Library_Graph; (G : Library_Graph;
Comp : Component_Id; Comp : Component_Id;
All_Candidates : Membership_Set; All_Candidates : LGV_Sets.Membership_Set;
Remaining_Vertices : in out Natural; Remaining_Vertices : in out Natural;
Order : in out Unit_Id_Table; Order : in out Unit_Id_Table;
Step : Elaboration_Order_Step) Step : Elaboration_Order_Step)
is is
Candidate : Library_Graph_Vertex_Id; Candidate : Library_Graph_Vertex_Id;
Comp_Candidates : Membership_Set; Comp_Candidates : LGV_Sets.Membership_Set;
begin begin
pragma Assert (Present (G)); pragma Assert (Present (G));
pragma Assert (Present (Comp)); pragma Assert (Present (Comp));
pragma Assert (Present (All_Candidates)); pragma Assert (LGV_Sets.Present (All_Candidates));
Trace_Component Trace_Component
(G => G, (G => G,
...@@ -518,7 +506,7 @@ package body Bindo.Elaborators is ...@@ -518,7 +506,7 @@ package body Bindo.Elaborators is
Elaborate_Vertex Elaborate_Vertex
(G => G, (G => G,
LGV_Id => Candidate, Vertex => Candidate,
All_Candidates => All_Candidates, All_Candidates => All_Candidates,
Comp_Candidates => Comp_Candidates, Comp_Candidates => Comp_Candidates,
Remaining_Vertices => Remaining_Vertices, Remaining_Vertices => Remaining_Vertices,
...@@ -527,7 +515,7 @@ package body Bindo.Elaborators is ...@@ -527,7 +515,7 @@ package body Bindo.Elaborators is
Indent => Nested_Indentation); Indent => Nested_Indentation);
end loop; end loop;
Destroy (Comp_Candidates); LGV_Sets.Destroy (Comp_Candidates);
end Elaborate_Component; end Elaborate_Component;
----------------------------- -----------------------------
...@@ -539,9 +527,8 @@ package body Bindo.Elaborators is ...@@ -539,9 +527,8 @@ package body Bindo.Elaborators is
Order : out Unit_Id_Table; Order : out Unit_Id_Table;
Status : out Elaboration_Order_Status) Status : out Elaboration_Order_Status)
is is
All_Candidates : Membership_Set; All_Candidates : LGV_Sets.Membership_Set;
Candidate : Library_Graph_Vertex_Id; Candidate : Library_Graph_Vertex_Id;
Comp : Component_Id;
Remaining_Vertices : Natural; Remaining_Vertices : Natural;
Step : Elaboration_Order_Step; Step : Elaboration_Order_Step;
...@@ -585,19 +572,16 @@ package body Bindo.Elaborators is ...@@ -585,19 +572,16 @@ package body Bindo.Elaborators is
-- and their components that they have one less predecessor to -- and their components that they have one less predecessor to
-- wait on. This may add new candidates to set All_Candidates. -- wait on. This may add new candidates to set All_Candidates.
Comp := Component (G, Candidate);
pragma Assert (Present (Comp));
Elaborate_Component Elaborate_Component
(G => G, (G => G,
Comp => Comp, Comp => Component (G, Candidate),
All_Candidates => All_Candidates, All_Candidates => All_Candidates,
Remaining_Vertices => Remaining_Vertices, Remaining_Vertices => Remaining_Vertices,
Order => Order, Order => Order,
Step => Step); Step => Step);
end loop; end loop;
Destroy (All_Candidates); LGV_Sets.Destroy (All_Candidates);
-- The library graph contains an Elaborate_All circularity when -- The library graph contains an Elaborate_All circularity when
-- at least one edge subject to the related pragma appears in a -- at least one edge subject to the related pragma appears in a
...@@ -642,7 +626,7 @@ package body Bindo.Elaborators is ...@@ -642,7 +626,7 @@ package body Bindo.Elaborators is
Write_ALI_Tables; Write_ALI_Tables;
-- Choose the proper elaboration strategy based on whether the main -- 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 if Is_Dynamically_Elaborated (Main_Lib_Unit) then
Elaborate_Units_Dynamic (Order); Elaborate_Units_Dynamic (Order);
...@@ -673,6 +657,7 @@ package body Bindo.Elaborators is ...@@ -673,6 +657,7 @@ package body Bindo.Elaborators is
procedure Elaborate_Units_Common procedure Elaborate_Units_Common
(Use_Inv_Graph : Boolean; (Use_Inv_Graph : Boolean;
Is_Dyn_Elab : Boolean;
Inv_Graph : out Invocation_Graph; Inv_Graph : out Invocation_Graph;
Lib_Graph : out Library_Graph; Lib_Graph : out Library_Graph;
Order : out Unit_Id_Table; Order : out Unit_Id_Table;
...@@ -682,7 +667,7 @@ package body Bindo.Elaborators is ...@@ -682,7 +667,7 @@ package body Bindo.Elaborators is
-- Create, validate, and output the library graph that captures the -- Create, validate, and output the library graph that captures the
-- dependencies between library items. -- dependencies between library items.
Lib_Graph := Build_Library_Graph; Lib_Graph := Build_Library_Graph (Is_Dyn_Elab);
Validate_Library_Graph (Lib_Graph); Validate_Library_Graph (Lib_Graph);
Write_Library_Graph (Lib_Graph); Write_Library_Graph (Lib_Graph);
...@@ -746,6 +731,7 @@ package body Bindo.Elaborators is ...@@ -746,6 +731,7 @@ package body Bindo.Elaborators is
Elaborate_Units_Common Elaborate_Units_Common
(Use_Inv_Graph => True, (Use_Inv_Graph => True,
Is_Dyn_Elab => True,
Inv_Graph => Mix_Inv_Graph, Inv_Graph => Mix_Inv_Graph,
Lib_Graph => Mix_Lib_Graph, Lib_Graph => Mix_Lib_Graph,
Order => Mix_Order, Order => Mix_Order,
...@@ -761,9 +747,9 @@ package body Bindo.Elaborators is ...@@ -761,9 +747,9 @@ package body Bindo.Elaborators is
-- the invocation graph because the circularity will persist. -- the invocation graph because the circularity will persist.
elsif Status = Order_Has_Elaborate_All_Circularity then elsif Status = Order_Has_Elaborate_All_Circularity then
Error_Msg ("elaboration circularity detected"); Diagnose_Circularities
(Inv_Graph => Mix_Inv_Graph,
-- Report error here Lib_Graph => Mix_Lib_Graph);
-- Otherwise the library graph contains a circularity, or the extra -- Otherwise the library graph contains a circularity, or the extra
-- information provided by the invocation graph caused a circularity. -- information provided by the invocation graph caused a circularity.
...@@ -776,6 +762,7 @@ package body Bindo.Elaborators is ...@@ -776,6 +762,7 @@ package body Bindo.Elaborators is
Elaborate_Units_Common Elaborate_Units_Common
(Use_Inv_Graph => False, (Use_Inv_Graph => False,
Is_Dyn_Elab => True,
Inv_Graph => Dyn_Inv_Graph, Inv_Graph => Dyn_Inv_Graph,
Lib_Graph => Dyn_Lib_Graph, Lib_Graph => Dyn_Lib_Graph,
Order => Dyn_Order, Order => Dyn_Order,
...@@ -792,9 +779,9 @@ package body Bindo.Elaborators is ...@@ -792,9 +779,9 @@ package body Bindo.Elaborators is
-- the circularity. -- the circularity.
else else
Error_Msg ("elaboration circularity detected"); Diagnose_Circularities
(Inv_Graph => Dyn_Inv_Graph,
-- Report error here Lib_Graph => Dyn_Lib_Graph);
end if; end if;
Destroy (Dyn_Inv_Graph); Destroy (Dyn_Inv_Graph);
...@@ -827,6 +814,7 @@ package body Bindo.Elaborators is ...@@ -827,6 +814,7 @@ package body Bindo.Elaborators is
Elaborate_Units_Common Elaborate_Units_Common
(Use_Inv_Graph => True, (Use_Inv_Graph => True,
Is_Dyn_Elab => False,
Inv_Graph => Inv_Graph, Inv_Graph => Inv_Graph,
Lib_Graph => Lib_Graph, Lib_Graph => Lib_Graph,
Order => Order, Order => Order,
...@@ -835,9 +823,9 @@ package body Bindo.Elaborators is ...@@ -835,9 +823,9 @@ package body Bindo.Elaborators is
-- The augmented library graph contains a circularity -- The augmented library graph contains a circularity
if Status /= Order_OK then if Status /= Order_OK then
Error_Msg ("elaboration circularity detected"); Diagnose_Circularities
(Inv_Graph => Inv_Graph,
-- Report error here Lib_Graph => Lib_Graph);
end if; end if;
Destroy (Inv_Graph); Destroy (Inv_Graph);
...@@ -856,27 +844,24 @@ package body Bindo.Elaborators is ...@@ -856,27 +844,24 @@ package body Bindo.Elaborators is
procedure Elaborate_Vertex procedure Elaborate_Vertex
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id; Vertex : Library_Graph_Vertex_Id;
All_Candidates : Membership_Set; All_Candidates : LGV_Sets.Membership_Set;
Comp_Candidates : Membership_Set; Comp_Candidates : LGV_Sets.Membership_Set;
Remaining_Vertices : in out Natural; Remaining_Vertices : in out Natural;
Order : in out Unit_Id_Table; Order : in out Unit_Id_Table;
Step : Elaboration_Order_Step; Step : Elaboration_Order_Step;
Indent : Indentation_Level) Indent : Indentation_Level)
is is
Body_LGV_Id : Library_Graph_Vertex_Id;
U_Id : Unit_Id;
begin begin
pragma Assert (Present (G)); pragma Assert (Present (G));
pragma Assert (Present (LGV_Id)); pragma Assert (Present (Vertex));
pragma Assert (Needs_Elaboration (G, LGV_Id)); pragma Assert (Needs_Elaboration (G, Vertex));
pragma Assert (Present (All_Candidates)); pragma Assert (LGV_Sets.Present (All_Candidates));
pragma Assert (Present (Comp_Candidates)); pragma Assert (LGV_Sets.Present (Comp_Candidates));
Trace_Vertex Trace_Vertex
(G => G, (G => G,
LGV_Id => LGV_Id, Vertex => Vertex,
Msg => "elaborating vertex", Msg => "elaborating vertex",
Step => Step, Step => Step,
Indent => Indent); Indent => Indent);
...@@ -887,20 +872,17 @@ package body Bindo.Elaborators is ...@@ -887,20 +872,17 @@ package body Bindo.Elaborators is
-- check that the vertex is present in either set because the set -- check that the vertex is present in either set because the set
-- implementation handles this case. -- implementation handles this case.
Delete (All_Candidates, LGV_Id); LGV_Sets.Delete (All_Candidates, Vertex);
Delete (Comp_Candidates, LGV_Id); LGV_Sets.Delete (Comp_Candidates, Vertex);
-- Mark the vertex as elaborated in order to prevent further attempts -- Mark the vertex as elaborated in order to prevent further attempts
-- to re-elaborate it. -- 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 -- Add the unit represented by the vertex to the elaboration order
U_Id := Unit (G, LGV_Id); Unit_Id_Tables.Append (Order, Unit (G, Vertex));
pragma Assert (Present (U_Id));
Unit_Id_Tables.Append (Order, U_Id);
-- There is now one fewer vertex to elaborate -- There is now one fewer vertex to elaborate
...@@ -912,7 +894,7 @@ package body Bindo.Elaborators is ...@@ -912,7 +894,7 @@ package body Bindo.Elaborators is
Update_Successors Update_Successors
(G => G, (G => G,
Pred => LGV_Id, Pred => Vertex,
All_Candidates => All_Candidates, All_Candidates => All_Candidates,
Comp_Candidates => Comp_Candidates, Comp_Candidates => Comp_Candidates,
Step => Step, Step => Step,
...@@ -922,13 +904,10 @@ package body Bindo.Elaborators is ...@@ -922,13 +904,10 @@ package body Bindo.Elaborators is
-- to pragma Elaborate_Body. Elaborate the body in order to satisfy -- to pragma Elaborate_Body. Elaborate the body in order to satisfy
-- the semantics of the pragma. -- the semantics of the pragma.
if Is_Spec_With_Elaborate_Body (G, LGV_Id) then if Is_Spec_With_Elaborate_Body (G, Vertex) then
Body_LGV_Id := Proper_Body (G, LGV_Id);
pragma Assert (Present (Body_LGV_Id));
Elaborate_Vertex Elaborate_Vertex
(G => G, (G => G,
LGV_Id => Body_LGV_Id, Vertex => Proper_Body (G, Vertex),
All_Candidates => All_Candidates, All_Candidates => All_Candidates,
Comp_Candidates => Comp_Candidates, Comp_Candidates => Comp_Candidates,
Remaining_Vertices => Remaining_Vertices, Remaining_Vertices => Remaining_Vertices,
...@@ -944,17 +923,17 @@ package body Bindo.Elaborators is ...@@ -944,17 +923,17 @@ package body Bindo.Elaborators is
function Find_Best_Candidate function Find_Best_Candidate
(G : Library_Graph; (G : Library_Graph;
Set : Membership_Set; Set : LGV_Sets.Membership_Set;
Step : Elaboration_Order_Step; Step : Elaboration_Order_Step;
Indent : Indentation_Level) return Library_Graph_Vertex_Id Indent : Indentation_Level) return Library_Graph_Vertex_Id
is is
Best : Library_Graph_Vertex_Id; Best : Library_Graph_Vertex_Id;
Curr : Library_Graph_Vertex_Id; Current : Library_Graph_Vertex_Id;
Iter : Iterator; Iter : LGV_Sets.Iterator;
begin begin
pragma Assert (Present (G)); pragma Assert (Present (G));
pragma Assert (Present (Set)); pragma Assert (LGV_Sets.Present (Set));
-- Assume that there is no candidate -- Assume that there is no candidate
...@@ -963,21 +942,19 @@ package body Bindo.Elaborators is ...@@ -963,21 +942,19 @@ package body Bindo.Elaborators is
-- Inspect all vertices in the set, looking for the best candidate to -- Inspect all vertices in the set, looking for the best candidate to
-- elaborate. -- elaborate.
Iter := Iterate (Set); Iter := LGV_Sets.Iterate (Set);
while Has_Next (Iter) loop while LGV_Sets.Has_Next (Iter) loop
Next (Iter, Curr); LGV_Sets.Next (Iter, Current);
pragma Assert (Needs_Elaboration (G, Current));
pragma Assert (Present (Curr));
pragma Assert (Needs_Elaboration (G, Curr));
-- Update the best candidate when there is no such candidate -- Update the best candidate when there is no such candidate
if not Present (Best) then if not Present (Best) then
Best := Curr; Best := Current;
Trace_Vertex Trace_Vertex
(G => G, (G => G,
LGV_Id => Best, Vertex => Best,
Msg => "initial best candidate vertex", Msg => "initial best candidate vertex",
Step => Step, Step => Step,
Indent => Indent); Indent => Indent);
...@@ -987,14 +964,14 @@ package body Bindo.Elaborators is ...@@ -987,14 +964,14 @@ package body Bindo.Elaborators is
elsif Is_Better_Candidate elsif Is_Better_Candidate
(G => G, (G => G,
Best_Candid => Best, Best_Candidate => Best,
New_Candid => Curr) New_Candidate => Current)
then then
Best := Curr; Best := Current;
Trace_Vertex Trace_Vertex
(G => G, (G => G,
LGV_Id => Best, Vertex => Best,
Msg => "best candidate vertex", Msg => "best candidate vertex",
Step => Step, Step => Step,
Indent => Indent); Indent => Indent);
...@@ -1009,48 +986,48 @@ package body Bindo.Elaborators is ...@@ -1009,48 +986,48 @@ package body Bindo.Elaborators is
------------------------- -------------------------
function Is_Better_Candidate function Is_Better_Candidate
(G : Library_Graph; (G : Library_Graph;
Best_Candid : Library_Graph_Vertex_Id; Best_Candidate : Library_Graph_Vertex_Id;
New_Candid : Library_Graph_Vertex_Id) return Boolean New_Candidate : Library_Graph_Vertex_Id) return Boolean
is is
begin begin
pragma Assert (Present (G)); pragma Assert (Present (G));
pragma Assert (Present (Best_Candid)); pragma Assert (Present (Best_Candidate));
pragma Assert (Present (New_Candid)); pragma Assert (Present (New_Candidate));
-- Prefer a predefined unit over a non-predefined unit -- Prefer a predefined unit over a non-predefined unit
if Is_Predefined_Unit (G, Best_Candid) if Is_Predefined_Unit (G, Best_Candidate)
and then not Is_Predefined_Unit (G, New_Candid) and then not Is_Predefined_Unit (G, New_Candidate)
then then
return False; return False;
elsif not Is_Predefined_Unit (G, Best_Candid) elsif not Is_Predefined_Unit (G, Best_Candidate)
and then Is_Predefined_Unit (G, New_Candid) and then Is_Predefined_Unit (G, New_Candidate)
then then
return True; return True;
-- Prefer an internal unit over a non-iternal unit -- Prefer an internal unit over a non-iternal unit
elsif Is_Internal_Unit (G, Best_Candid) elsif Is_Internal_Unit (G, Best_Candidate)
and then not Is_Internal_Unit (G, New_Candid) and then not Is_Internal_Unit (G, New_Candidate)
then then
return False; return False;
elsif not Is_Internal_Unit (G, Best_Candid) elsif not Is_Internal_Unit (G, Best_Candidate)
and then Is_Internal_Unit (G, New_Candid) and then Is_Internal_Unit (G, New_Candidate)
then then
return True; return True;
-- Prefer a preelaborated unit over a non-preelaborated unit -- Prefer a preelaborated unit over a non-preelaborated unit
elsif Is_Preelaborated_Unit (G, Best_Candid) elsif Is_Preelaborated_Unit (G, Best_Candidate)
and then not Is_Preelaborated_Unit (G, New_Candid) and then not Is_Preelaborated_Unit (G, New_Candidate)
then then
return False; return False;
elsif not Is_Preelaborated_Unit (G, Best_Candid) elsif not Is_Preelaborated_Unit (G, Best_Candidate)
and then Is_Preelaborated_Unit (G, New_Candid) and then Is_Preelaborated_Unit (G, New_Candidate)
then then
return True; return True;
...@@ -1058,7 +1035,8 @@ package body Bindo.Elaborators is ...@@ -1058,7 +1035,8 @@ package body Bindo.Elaborators is
-- behavior. -- behavior.
else 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 if;
end Is_Better_Candidate; end Is_Better_Candidate;
...@@ -1068,18 +1046,18 @@ package body Bindo.Elaborators is ...@@ -1068,18 +1046,18 @@ package body Bindo.Elaborators is
procedure Trace_Candidate_Vertices procedure Trace_Candidate_Vertices
(G : Library_Graph; (G : Library_Graph;
Set : Membership_Set; Set : LGV_Sets.Membership_Set;
Step : Elaboration_Order_Step) Step : Elaboration_Order_Step)
is is
Iter : Iterator; Iter : LGV_Sets.Iterator;
LGV_Id : Library_Graph_Vertex_Id; Vertex : Library_Graph_Vertex_Id;
begin begin
pragma Assert (Present (G)); 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 -- Nothing to do when switch -d_T (output elaboration order and cycle
-- information) is not in effect. -- detection trace information) is not in effect.
if not Debug_Flag_Underscore_TT then if not Debug_Flag_Underscore_TT then
return; return;
...@@ -1087,17 +1065,16 @@ package body Bindo.Elaborators is ...@@ -1087,17 +1065,16 @@ package body Bindo.Elaborators is
Trace_Step (Step); Trace_Step (Step);
Write_Str ("candidate vertices: "); Write_Str ("candidate vertices: ");
Write_Int (Int (Size (Set))); Write_Int (Int (LGV_Sets.Size (Set)));
Write_Eol; Write_Eol;
Iter := Iterate (Set); Iter := LGV_Sets.Iterate (Set);
while Has_Next (Iter) loop while LGV_Sets.Has_Next (Iter) loop
Next (Iter, LGV_Id); LGV_Sets.Next (Iter, Vertex);
pragma Assert (Present (LGV_Id));
Trace_Vertex Trace_Vertex
(G => G, (G => G,
LGV_Id => LGV_Id, Vertex => Vertex,
Msg => "candidate vertex", Msg => "candidate vertex",
Step => Step, Step => Step,
Indent => Nested_Indentation); Indent => Nested_Indentation);
...@@ -1118,8 +1095,8 @@ package body Bindo.Elaborators is ...@@ -1118,8 +1095,8 @@ package body Bindo.Elaborators is
pragma Assert (Present (G)); pragma Assert (Present (G));
pragma Assert (Present (Comp)); pragma Assert (Present (Comp));
-- Nothing to do when switch -d_T (output elaboration order trace -- Nothing to do when switch -d_T (output elaboration order and cycle
-- information) is not in effect. -- detection trace information) is not in effect.
if not Debug_Flag_Underscore_TT then if not Debug_Flag_Underscore_TT then
return; return;
...@@ -1145,8 +1122,8 @@ package body Bindo.Elaborators is ...@@ -1145,8 +1122,8 @@ package body Bindo.Elaborators is
procedure Trace_Step (Step : Elaboration_Order_Step) is procedure Trace_Step (Step : Elaboration_Order_Step) is
begin begin
-- Nothing to do when switch -d_T (output elaboration order trace -- Nothing to do when switch -d_T (output elaboration order and cycle
-- information) is not in effect. -- detection trace information) is not in effect.
if not Debug_Flag_Underscore_TT then if not Debug_Flag_Underscore_TT then
return; return;
...@@ -1168,13 +1145,13 @@ package body Bindo.Elaborators is ...@@ -1168,13 +1145,13 @@ package body Bindo.Elaborators is
Step : Elaboration_Order_Step) Step : Elaboration_Order_Step)
is is
Iter : Library_Graphs.All_Vertex_Iterator; Iter : Library_Graphs.All_Vertex_Iterator;
LGV_Id : Library_Graph_Vertex_Id; Vertex : Library_Graph_Vertex_Id;
begin begin
pragma Assert (Present (G)); pragma Assert (Present (G));
-- Nothing to do when switch -d_T (output elaboration order trace -- Nothing to do when switch -d_T (output elaboration order and cycle
-- information) is not in effect. -- detection trace information) is not in effect.
if not Debug_Flag_Underscore_TT then if not Debug_Flag_Underscore_TT then
return; return;
...@@ -1187,15 +1164,14 @@ package body Bindo.Elaborators is ...@@ -1187,15 +1164,14 @@ package body Bindo.Elaborators is
Iter := Iterate_All_Vertices (G); Iter := Iterate_All_Vertices (G);
while Has_Next (Iter) loop while Has_Next (Iter) loop
Next (Iter, LGV_Id); Next (Iter, Vertex);
pragma Assert (Present (LGV_Id));
if Needs_Elaboration (G, LGV_Id) if Needs_Elaboration (G, Vertex)
and then not In_Elaboration_Order (G, LGV_Id) and then not In_Elaboration_Order (G, Vertex)
then then
Trace_Vertex Trace_Vertex
(G => G, (G => G,
LGV_Id => LGV_Id, Vertex => Vertex,
Msg => "remaining vertex", Msg => "remaining vertex",
Step => Step, Step => Step,
Indent => Nested_Indentation); Indent => Nested_Indentation);
...@@ -1209,21 +1185,21 @@ package body Bindo.Elaborators is ...@@ -1209,21 +1185,21 @@ package body Bindo.Elaborators is
procedure Trace_Vertex procedure Trace_Vertex
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id; Vertex : Library_Graph_Vertex_Id;
Msg : String; Msg : String;
Step : Elaboration_Order_Step; Step : Elaboration_Order_Step;
Indent : Indentation_Level) Indent : Indentation_Level)
is is
pragma Assert (Present (G)); pragma Assert (Present (G));
pragma Assert (Present (LGV_Id)); pragma Assert (Present (Vertex));
Comp : constant Component_Id := Component (G, LGV_Id); Attr_Indent : constant Indentation_Level :=
Indent + Nested_Indentation;
pragma Assert (Present (Comp)); Comp : constant Component_Id := Component (G, Vertex);
begin begin
-- Nothing to do when switch -d_T (output elaboration order trace -- Nothing to do when switch -d_T (output elaboration order and cycle
-- information) is not in effect. -- detection trace information) is not in effect.
if not Debug_Flag_Underscore_TT then if not Debug_Flag_Underscore_TT then
return; return;
...@@ -1233,31 +1209,31 @@ package body Bindo.Elaborators is ...@@ -1233,31 +1209,31 @@ package body Bindo.Elaborators is
Indent_By (Indent); Indent_By (Indent);
Write_Str (Msg); Write_Str (Msg);
Write_Str (" (LGV_Id_"); Write_Str (" (LGV_Id_");
Write_Int (Int (LGV_Id)); Write_Int (Int (Vertex));
Write_Str (")"); Write_Str (")");
Write_Eol; Write_Eol;
Trace_Step (Step); Trace_Step (Step);
Indent_By (Indent + Nested_Indentation); Indent_By (Attr_Indent);
Write_Str ("name = "); Write_Str ("name = ");
Write_Name (Name (G, LGV_Id)); Write_Name (Name (G, Vertex));
Write_Eol; Write_Eol;
Trace_Step (Step); Trace_Step (Step);
Indent_By (Indent + Nested_Indentation); Indent_By (Attr_Indent);
Write_Str ("Component (Comp_Id_"); Write_Str ("Component (Comp_Id_");
Write_Int (Int (Comp)); Write_Int (Int (Comp));
Write_Str (")"); Write_Str (")");
Write_Eol; Write_Eol;
Trace_Step (Step); Trace_Step (Step);
Indent_By (Indent + Nested_Indentation); Indent_By (Attr_Indent);
Write_Str ("pending predecessors: "); Write_Str ("pending predecessors: ");
Write_Num (Int (Pending_Predecessors (G, LGV_Id))); Write_Num (Int (Pending_Predecessors (G, Vertex)));
Write_Eol; Write_Eol;
Trace_Step (Step); Trace_Step (Step);
Indent_By (Indent + Nested_Indentation); Indent_By (Attr_Indent);
Write_Str ("pending components : "); Write_Str ("pending components : ");
Write_Num (Int (Pending_Predecessors (G, Comp))); Write_Num (Int (Pending_Predecessors (G, Comp)));
Write_Eol; Write_Eol;
...@@ -1271,8 +1247,8 @@ package body Bindo.Elaborators is ...@@ -1271,8 +1247,8 @@ package body Bindo.Elaborators is
(G : Library_Graph; (G : Library_Graph;
Pred : Library_Graph_Vertex_Id; Pred : Library_Graph_Vertex_Id;
Succ : Library_Graph_Vertex_Id; Succ : Library_Graph_Vertex_Id;
All_Candidates : Membership_Set; All_Candidates : LGV_Sets.Membership_Set;
Comp_Candidates : Membership_Set; Comp_Candidates : LGV_Sets.Membership_Set;
Step : Elaboration_Order_Step; Step : Elaboration_Order_Step;
Indent : Indentation_Level) Indent : Indentation_Level)
is is
...@@ -1281,26 +1257,28 @@ package body Bindo.Elaborators is ...@@ -1281,26 +1257,28 @@ package body Bindo.Elaborators is
pragma Assert (Needs_Elaboration (G, Pred)); pragma Assert (Needs_Elaboration (G, Pred));
pragma Assert (Present (Succ)); pragma Assert (Present (Succ));
pragma Assert (Needs_Elaboration (G, Succ)); pragma Assert (Needs_Elaboration (G, Succ));
pragma Assert (Present (All_Candidates)); pragma Assert (LGV_Sets.Present (All_Candidates));
pragma Assert (Present (Comp_Candidates)); pragma Assert (LGV_Sets.Present (Comp_Candidates));
Pred_Comp : constant Component_Id := Component (G, Pred);
Succ_Comp : constant Component_Id := Component (G, Succ);
pragma Assert (Present (Pred_Comp)); In_Different_Components : constant Boolean :=
pragma Assert (Present (Succ_Comp)); 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; Candidate : Library_Graph_Vertex_Id;
Iter : Component_Vertex_Iterator; Iter : Component_Vertex_Iterator;
Msg : String_Ptr; Msg : String_Ptr;
Set : Membership_Set; Set : LGV_Sets.Membership_Set;
begin begin
Trace_Vertex Trace_Vertex
(G => G, (G => G,
LGV_Id => Succ, Vertex => Succ,
Msg => "updating successor", Msg => "updating successor",
Step => Step, Step => Step,
Indent => Indent); Indent => Indent);
...@@ -1341,11 +1319,11 @@ package body Bindo.Elaborators is ...@@ -1341,11 +1319,11 @@ package body Bindo.Elaborators is
Add_Vertex_If_Elaborable Add_Vertex_If_Elaborable
(G => G, (G => G,
LGV_Id => Succ, Vertex => Succ,
Set => Set, Set => Set,
Msg => Msg.all, Msg => Msg.all,
Step => Step, Step => Step,
Indent => Indent + Nested_Indentation); Indent => Vertex_Indent);
-- At this point the successor component may become elaborable when -- At this point the successor component may become elaborable when
-- its final predecessor component is elaborated. This in turn may -- its final predecessor component is elaborated. This in turn may
...@@ -1357,15 +1335,14 @@ package body Bindo.Elaborators is ...@@ -1357,15 +1335,14 @@ package body Bindo.Elaborators is
Iter := Iterate_Component_Vertices (G, Succ_Comp); Iter := Iterate_Component_Vertices (G, Succ_Comp);
while Has_Next (Iter) loop while Has_Next (Iter) loop
Next (Iter, Candidate); Next (Iter, Candidate);
pragma Assert (Present (Candidate));
Add_Vertex_If_Elaborable Add_Vertex_If_Elaborable
(G => G, (G => G,
LGV_Id => Candidate, Vertex => Candidate,
Set => All_Candidates, Set => All_Candidates,
Msg => Add_To_All_Candidates_Msg, Msg => Add_To_All_Candidates_Msg,
Step => Step, Step => Step,
Indent => Indent + Nested_Indentation); Indent => Vertex_Indent);
end loop; end loop;
end if; end if;
end Update_Successor; end Update_Successor;
...@@ -1377,36 +1354,30 @@ package body Bindo.Elaborators is ...@@ -1377,36 +1354,30 @@ package body Bindo.Elaborators is
procedure Update_Successors procedure Update_Successors
(G : Library_Graph; (G : Library_Graph;
Pred : Library_Graph_Vertex_Id; Pred : Library_Graph_Vertex_Id;
All_Candidates : Membership_Set; All_Candidates : LGV_Sets.Membership_Set;
Comp_Candidates : Membership_Set; Comp_Candidates : LGV_Sets.Membership_Set;
Step : Elaboration_Order_Step; Step : Elaboration_Order_Step;
Indent : Indentation_Level) Indent : Indentation_Level)
is is
Iter : Edges_To_Successors_Iterator; Edge : Library_Graph_Edge_Id;
LGE_Id : Library_Graph_Edge_Id; Iter : Edges_To_Successors_Iterator;
Succ : Library_Graph_Vertex_Id;
begin begin
pragma Assert (Present (G)); pragma Assert (Present (G));
pragma Assert (Present (Pred)); pragma Assert (Present (Pred));
pragma Assert (Needs_Elaboration (G, Pred)); pragma Assert (Needs_Elaboration (G, Pred));
pragma Assert (Present (All_Candidates)); pragma Assert (LGV_Sets.Present (All_Candidates));
pragma Assert (Present (Comp_Candidates)); pragma Assert (LGV_Sets.Present (Comp_Candidates));
Iter := Iterate_Edges_To_Successors (G, Pred); Iter := Iterate_Edges_To_Successors (G, Pred);
while Has_Next (Iter) loop while Has_Next (Iter) loop
Next (Iter, LGE_Id); Next (Iter, Edge);
pragma Assert (Predecessor (G, Edge) = Pred);
pragma Assert (Present (LGE_Id));
pragma Assert (Predecessor (G, LGE_Id) = Pred);
Succ := Successor (G, LGE_Id);
pragma Assert (Present (Succ));
Update_Successor Update_Successor
(G => G, (G => G,
Pred => Pred, Pred => Pred,
Succ => Succ, Succ => Successor (G, Edge),
All_Candidates => All_Candidates, All_Candidates => All_Candidates,
Comp_Candidates => Comp_Candidates, Comp_Candidates => Comp_Candidates,
Step => Step, Step => Step,
......
gcc/ada/bindo-graphs.adb
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/bindo-graphs.ads
...@@ -28,11 +28,14 @@ ...@@ -28,11 +28,14 @@
-- The following unit defines the various graphs used in determining the -- The following unit defines the various graphs used in determining the
-- elaboration order of units. -- elaboration order of units.
with Types; use Types;
with Bindo.Units; use Bindo.Units; with Bindo.Units; use Bindo.Units;
with GNAT; use GNAT; with GNAT; use GNAT;
with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables; with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables;
with GNAT.Graphs; use GNAT.Graphs; with GNAT.Graphs; use GNAT.Graphs;
with GNAT.Lists; use GNAT.Lists;
with GNAT.Sets; use GNAT.Sets; with GNAT.Sets; use GNAT.Sets;
package Bindo.Graphs is package Bindo.Graphs is
...@@ -49,14 +52,24 @@ package Bindo.Graphs is ...@@ -49,14 +52,24 @@ package Bindo.Graphs is
First_Invocation_Graph_Edge : constant Invocation_Graph_Edge_Id := First_Invocation_Graph_Edge : constant Invocation_Graph_Edge_Id :=
No_Invocation_Graph_Edge + 1; 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 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); 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); 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 -- -- Invocation graph vertex --
...@@ -71,13 +84,47 @@ package Bindo.Graphs is ...@@ -71,13 +84,47 @@ package Bindo.Graphs is
No_Invocation_Graph_Vertex + 1; No_Invocation_Graph_Vertex + 1;
function Hash_Invocation_Graph_Vertex 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); 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); 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 -- -- Library graph edge --
...@@ -91,14 +138,29 @@ package Bindo.Graphs is ...@@ -91,14 +138,29 @@ package Bindo.Graphs is
First_Library_Graph_Edge : constant Library_Graph_Edge_Id := First_Library_Graph_Edge : constant Library_Graph_Edge_Id :=
No_Library_Graph_Edge + 1; 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 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); 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); 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 -- -- Library graph vertex --
...@@ -113,13 +175,18 @@ package Bindo.Graphs is ...@@ -113,13 +175,18 @@ package Bindo.Graphs is
No_Library_Graph_Vertex + 1; No_Library_Graph_Vertex + 1;
function Hash_Library_Graph_Vertex 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); 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); 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 -- -- Invocation_Graphs --
...@@ -152,13 +219,16 @@ package Bindo.Graphs is ...@@ -152,13 +219,16 @@ package Bindo.Graphs is
-- describes. -- describes.
procedure Add_Vertex procedure Add_Vertex
(G : Invocation_Graph; (G : Invocation_Graph;
IC_Id : Invocation_Construct_Id; IC_Id : Invocation_Construct_Id;
LGV_Id : Library_Graph_Vertex_Id); Body_Vertex : Library_Graph_Vertex_Id;
Spec_Vertex : Library_Graph_Vertex_Id);
pragma Inline (Add_Vertex); pragma Inline (Add_Vertex);
-- Create a new vertex in invocation graph G. IC_Id is the invocation -- Create a new vertex in invocation graph G. IC_Id is the invocation
-- construct the vertex describes. LGV_Id is the library graph vertex -- construct the vertex describes. Body_Vertex denotes the library graph
-- where the invocation construct appears. -- 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 function Create
(Initial_Vertices : Positive; (Initial_Vertices : Positive;
...@@ -179,11 +249,26 @@ package Bindo.Graphs is ...@@ -179,11 +249,26 @@ package Bindo.Graphs is
-- Vertex attributes -- -- 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 function Construct
(G : Invocation_Graph; (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); 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. -- describes.
function Corresponding_Vertex function Corresponding_Vertex
...@@ -193,41 +278,56 @@ package Bindo.Graphs is ...@@ -193,41 +278,56 @@ package Bindo.Graphs is
-- Obtain the vertex of invocation graph G that corresponds to signature -- Obtain the vertex of invocation graph G that corresponds to signature
-- IS_Id. -- IS_Id.
function Lib_Vertex function Line
(G : Invocation_Graph; (G : Invocation_Graph;
IGV_Id : Invocation_Graph_Vertex_Id) return Library_Graph_Vertex_Id; Vertex : Invocation_Graph_Vertex_Id) return Nat;
pragma Inline (Lib_Vertex); pragma Inline (Line);
-- Obtain the library graph vertex where vertex IGV_Id of invocation -- Obtain the line number where the invocation construct vertex Vertex
-- graph appears. -- of invocation graph G describes.
function Name function Name
(G : Invocation_Graph; (G : Invocation_Graph;
IGV_Id : Invocation_Graph_Vertex_Id) return Name_Id; Vertex : Invocation_Graph_Vertex_Id) return Name_Id;
pragma Inline (Name); 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. -- 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 -- -- 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 function Kind
(G : Invocation_Graph; (G : Invocation_Graph;
IGE_Id : Invocation_Graph_Edge_Id) return Invocation_Kind; Edge : Invocation_Graph_Edge_Id) return Invocation_Kind;
pragma Inline (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 function Relation
(G : Invocation_Graph; (G : Invocation_Graph;
IGE_Id : Invocation_Graph_Edge_Id) return Invocation_Relation_Id; Edge : Invocation_Graph_Edge_Id) return Invocation_Relation_Id;
pragma Inline (Relation); 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 function Target
(G : Invocation_Graph; (G : Invocation_Graph;
IGE_Id : Invocation_Graph_Edge_Id) return Invocation_Graph_Vertex_Id; Edge : Invocation_Graph_Edge_Id) return Invocation_Graph_Vertex_Id;
pragma Inline (Target); 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 -- -- Statistics --
...@@ -245,9 +345,9 @@ package Bindo.Graphs is ...@@ -245,9 +345,9 @@ package Bindo.Graphs is
function Number_Of_Edges_To_Targets function Number_Of_Edges_To_Targets
(G : Invocation_Graph; (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); 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. -- invocation graph G has.
function Number_Of_Elaboration_Roots function Number_Of_Elaboration_Roots
...@@ -278,8 +378,8 @@ package Bindo.Graphs is ...@@ -278,8 +378,8 @@ package Bindo.Graphs is
-- Obtain an iterator over all edges of invocation graph G -- Obtain an iterator over all edges of invocation graph G
procedure Next procedure Next
(Iter : in out All_Edge_Iterator; (Iter : in out All_Edge_Iterator;
IGE_Id : out Invocation_Graph_Edge_Id); Edge : out Invocation_Graph_Edge_Id);
pragma Inline (Next); pragma Inline (Next);
-- Return the current edge referenced by iterator Iter and advance to -- Return the current edge referenced by iterator Iter and advance to
-- the next available edge. -- the next available edge.
...@@ -300,7 +400,7 @@ package Bindo.Graphs is ...@@ -300,7 +400,7 @@ package Bindo.Graphs is
procedure Next procedure Next
(Iter : in out All_Vertex_Iterator; (Iter : in out All_Vertex_Iterator;
IGV_Id : out Invocation_Graph_Vertex_Id); Vertex : out Invocation_Graph_Vertex_Id);
pragma Inline (Next); pragma Inline (Next);
-- Return the current vertex referenced by iterator Iter and advance -- Return the current vertex referenced by iterator Iter and advance
-- to the next available vertex. -- to the next available vertex.
...@@ -316,14 +416,14 @@ package Bindo.Graphs is ...@@ -316,14 +416,14 @@ package Bindo.Graphs is
function Iterate_Edges_To_Targets function Iterate_Edges_To_Targets
(G : Invocation_Graph; (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); pragma Inline (Iterate_Edges_To_Targets);
-- Obtain an iterator over all edges to targets with source vertex -- Obtain an iterator over all edges to targets with source vertex
-- IGV_Id of invocation graph G. -- Vertex of invocation graph G.
procedure Next procedure Next
(Iter : in out Edges_To_Targets_Iterator; (Iter : in out Edges_To_Targets_Iterator;
IGE_Id : out Invocation_Graph_Edge_Id); Edge : out Invocation_Graph_Edge_Id);
pragma Inline (Next); pragma Inline (Next);
-- Return the current edge referenced by iterator Iter and advance to -- Return the current edge referenced by iterator Iter and advance to
-- the next available edge. -- the next available edge.
...@@ -357,32 +457,38 @@ package Bindo.Graphs is ...@@ -357,32 +457,38 @@ package Bindo.Graphs is
-------------- --------------
procedure Destroy_Invocation_Graph_Vertex 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); 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 -- The following type represents the attributes of an invocation graph
-- vertex. -- vertex.
type Invocation_Graph_Vertex_Attributes is record 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; Construct : Invocation_Construct_Id := No_Invocation_Construct;
-- Reference to the invocation construct this vertex represents -- Reference to the invocation construct this vertex represents
Lib_Vertex : Library_Graph_Vertex_Id := No_Library_Graph_Vertex; Spec_Vertex : Library_Graph_Vertex_Id := No_Library_Graph_Vertex;
-- Reference to the library graph vertex where this vertex resides -- Reference to the library graph vertex where the spec of this
-- vertex resides.
end record; end record;
No_Invocation_Graph_Vertex_Attributes : No_Invocation_Graph_Vertex_Attributes :
constant Invocation_Graph_Vertex_Attributes := constant Invocation_Graph_Vertex_Attributes :=
(Construct => No_Invocation_Construct, (Body_Vertex => No_Library_Graph_Vertex,
Lib_Vertex => No_Library_Graph_Vertex); Construct => No_Invocation_Construct,
Spec_Vertex => No_Library_Graph_Vertex);
procedure Destroy_Invocation_Graph_Vertex_Attributes procedure Destroy_Invocation_Graph_Vertex_Attributes
(Attrs : in out Invocation_Graph_Vertex_Attributes); (Attrs : in out Invocation_Graph_Vertex_Attributes);
pragma Inline (Destroy_Invocation_Graph_Vertex_Attributes); pragma Inline (Destroy_Invocation_Graph_Vertex_Attributes);
-- Destroy the contents of attributes Attrs -- 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, (Key_Type => Invocation_Graph_Vertex_Id,
Value_Type => Invocation_Graph_Vertex_Attributes, Value_Type => Invocation_Graph_Vertex_Attributes,
No_Value => No_Invocation_Graph_Vertex_Attributes, No_Value => No_Invocation_Graph_Vertex_Attributes,
...@@ -399,9 +505,9 @@ package Bindo.Graphs is ...@@ -399,9 +505,9 @@ package Bindo.Graphs is
----------- -----------
procedure Destroy_Invocation_Graph_Edge 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); 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 -- The following type represents the attributes of an invocation graph
-- edge. -- edge.
...@@ -420,7 +526,7 @@ package Bindo.Graphs is ...@@ -420,7 +526,7 @@ package Bindo.Graphs is
pragma Inline (Destroy_Invocation_Graph_Edge_Attributes); pragma Inline (Destroy_Invocation_Graph_Edge_Attributes);
-- Destroy the contents of attributes Attrs -- 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, (Key_Type => Invocation_Graph_Edge_Id,
Value_Type => Invocation_Graph_Edge_Attributes, Value_Type => Invocation_Graph_Edge_Attributes,
No_Value => No_Invocation_Graph_Edge_Attributes, No_Value => No_Invocation_Graph_Edge_Attributes,
...@@ -457,7 +563,7 @@ package Bindo.Graphs is ...@@ -457,7 +563,7 @@ package Bindo.Graphs is
pragma Inline (Hash_Source_Target_Relation); pragma Inline (Hash_Source_Target_Relation);
-- Obtain the hash value of key Rel -- 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, (Element_Type => Source_Target_Relation,
"=" => "=", "=" => "=",
Hash => Hash_Source_Target_Relation); Hash => Hash_Source_Target_Relation);
...@@ -477,7 +583,7 @@ package Bindo.Graphs is ...@@ -477,7 +583,7 @@ package Bindo.Graphs is
pragma Inline (Hash_Invocation_Signature); pragma Inline (Hash_Invocation_Signature);
-- Obtain the hash value of key IS_Id -- 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, (Key_Type => Invocation_Signature_Id,
Value_Type => Invocation_Graph_Vertex_Id, Value_Type => Invocation_Graph_Vertex_Id,
No_Value => No_Invocation_Graph_Vertex, No_Value => No_Invocation_Graph_Vertex,
...@@ -493,7 +599,7 @@ package Bindo.Graphs is ...@@ -493,7 +599,7 @@ package Bindo.Graphs is
-- Elaboration roots -- -- Elaboration roots --
----------------------- -----------------------
package ER is new Membership_Sets package IGV_Sets is new Membership_Sets
(Element_Type => Invocation_Graph_Vertex_Id, (Element_Type => Invocation_Graph_Vertex_Id,
"=" => "=", "=" => "=",
Hash => Hash_Invocation_Graph_Vertex); Hash => Hash_Invocation_Graph_Vertex);
...@@ -518,24 +624,25 @@ package Bindo.Graphs is ...@@ -518,24 +624,25 @@ package Bindo.Graphs is
Counts : Invocation_Graph_Edge_Counts := (others => 0); Counts : Invocation_Graph_Edge_Counts := (others => 0);
-- Edge statistics -- 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 -- The map of edge -> edge attributes for all edges in the graph
Graph : DG.Directed_Graph := DG.Nil; Graph : DG.Directed_Graph := DG.Nil;
-- The underlying graph describing the relations between edges and -- The underlying graph describing the relations between edges and
-- vertices. -- 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 -- The set of relations between source and targets, used to prevent
-- duplicate edges in the graph. -- 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 -- 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 -- 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 -- The map of vertex -> vertex attributes for all vertices in the
-- graph. -- graph.
end record; end record;
...@@ -550,7 +657,7 @@ package Bindo.Graphs is ...@@ -550,7 +657,7 @@ package Bindo.Graphs is
type All_Edge_Iterator is new DG.All_Edge_Iterator; type All_Edge_Iterator is new DG.All_Edge_Iterator;
type All_Vertex_Iterator is new DG.All_Vertex_Iterator; type All_Vertex_Iterator is new DG.All_Vertex_Iterator;
type Edges_To_Targets_Iterator is new DG.Outgoing_Edge_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; end Invocation_Graphs;
-------------------- --------------------
...@@ -559,6 +666,32 @@ package Bindo.Graphs is ...@@ -559,6 +666,32 @@ package Bindo.Graphs is
package Library_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 -- The following type represents the various kinds of library edges
type Library_Graph_Edge_Kind is type Library_Graph_Edge_Kind is
...@@ -620,11 +753,13 @@ package Bindo.Graphs is ...@@ -620,11 +753,13 @@ package Bindo.Graphs is
-- describes. -- describes.
function Create function Create
(Initial_Vertices : Positive; (Initial_Vertices : Positive;
Initial_Edges : Positive) return Library_Graph; Initial_Edges : Positive;
Dynamically_Elaborated : Boolean) return Library_Graph;
pragma Inline (Create); pragma Inline (Create);
-- Create a new empty graph with vertex capacity Initial_Vertices and -- 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); procedure Destroy (G : in out Library_Graph);
pragma Inline (Destroy); pragma Inline (Destroy);
...@@ -634,6 +769,16 @@ package Bindo.Graphs is ...@@ -634,6 +769,16 @@ package Bindo.Graphs is
pragma Inline (Find_Components); pragma Inline (Find_Components);
-- Find all components in library graph G -- 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; function Present (G : Library_Graph) return Boolean;
pragma Inline (Present); pragma Inline (Present);
-- Determine whether library graph G exists -- Determine whether library graph G exists
...@@ -644,16 +789,16 @@ package Bindo.Graphs is ...@@ -644,16 +789,16 @@ package Bindo.Graphs is
function Component function Component
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id) return Component_Id; Vertex : Library_Graph_Vertex_Id) return Component_Id;
pragma Inline (Component); 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 function Corresponding_Item
(G : Library_Graph; (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); pragma Inline (Corresponding_Item);
-- Obtain the complementary vertex which represents the corresponding -- 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 function Corresponding_Vertex
(G : Library_Graph; (G : Library_Graph;
...@@ -664,75 +809,91 @@ package Bindo.Graphs is ...@@ -664,75 +809,91 @@ package Bindo.Graphs is
procedure Decrement_Pending_Predecessors procedure Decrement_Pending_Predecessors
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id); Vertex : Library_Graph_Vertex_Id);
pragma Inline (Decrement_Pending_Predecessors); 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. -- 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 function In_Elaboration_Order
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id) return Boolean; Vertex : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (In_Elaboration_Order); 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. -- 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 function Name
(G : Library_Graph; (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); 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. -- represents.
function Pending_Predecessors function Pending_Predecessors
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id) return Natural; Vertex : Library_Graph_Vertex_Id) return Natural;
pragma Inline (Pending_Predecessors); 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. -- graph G must wait on until it can be elaborated.
procedure Set_Corresponding_Item procedure Set_Corresponding_Item
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id; Vertex : Library_Graph_Vertex_Id;
Val : Library_Graph_Vertex_Id); Val : Library_Graph_Vertex_Id);
pragma Inline (Set_Corresponding_Item); pragma Inline (Set_Corresponding_Item);
-- Set the complementary vertex which represents the corresponding -- 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 procedure Set_In_Elaboration_Order
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id; Vertex : Library_Graph_Vertex_Id;
Val : Boolean := True); Val : Boolean := True);
pragma Inline (Set_In_Elaboration_Order); 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. -- order depending on value Val.
function Unit function Unit
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id) return Unit_Id; Vertex : Library_Graph_Vertex_Id) return Unit_Id;
pragma Inline (Unit); 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 -- -- Edge attributes --
--------------------- ---------------------
function Kind function Kind
(G : Library_Graph; (G : Library_Graph;
LGE_Id : Library_Graph_Edge_Id) return Library_Graph_Edge_Kind; Edge : Library_Graph_Edge_Id) return Library_Graph_Edge_Kind;
pragma Inline (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 function Predecessor
(G : Library_Graph; (G : Library_Graph;
LGE_Id : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id; Edge : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id;
pragma Inline (Predecessor); 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 function Successor
(G : Library_Graph; (G : Library_Graph;
LGE_Id : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id; Edge : Library_Graph_Edge_Id) return Library_Graph_Vertex_Id;
pragma Inline (Successor); 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 -- -- Component attributes --
...@@ -752,30 +913,71 @@ package Bindo.Graphs is ...@@ -752,30 +913,71 @@ package Bindo.Graphs is
-- Obtain the number of pending predecessors component Comp of library -- Obtain the number of pending predecessors component Comp of library
-- graph G must wait on until it can be elaborated. -- 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 -- -- 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 function Is_Body
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id) return Boolean; Vertex : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (Is_Body); 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 function Is_Body_Of_Spec_With_Elaborate_Body
(G : Library_Graph; (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); 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. -- with a corresponding spec, and the spec has pragma Elaborate_Body.
function Is_Body_With_Spec function Is_Body_With_Spec
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id) return Boolean; Vertex : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (Is_Body_With_Spec); 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. -- 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 function Is_Elaborable_Component
(G : Library_Graph; (G : Library_Graph;
Comp : Component_Id) return Boolean; Comp : Component_Id) return Boolean;
...@@ -784,76 +986,112 @@ package Bindo.Graphs is ...@@ -784,76 +986,112 @@ package Bindo.Graphs is
function Is_Elaborable_Vertex function Is_Elaborable_Vertex
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id) return Boolean; Vertex : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (Is_Elaborable_Vertex); 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 function Is_Internal_Unit
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id) return Boolean; Vertex : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (Is_Internal_Unit); 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. -- 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 function Is_Predefined_Unit
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id) return Boolean; Vertex : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (Is_Predefined_Unit); 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. -- predefined unit.
function Is_Preelaborated_Unit function Is_Preelaborated_Unit
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id) return Boolean; Vertex : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (Is_Preelaborated_Unit); 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. -- subjec to pragma Pure or Preelaborable.
function Is_Spec function Is_Spec
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id) return Boolean; Vertex : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (Is_Spec); 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 function Is_Spec_With_Body
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id) return Boolean; Vertex : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (Is_Spec_With_Body); 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. -- with a corresponding body.
function Is_Spec_With_Elaborate_Body function Is_Spec_With_Elaborate_Body
(G : Library_Graph; (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); 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. -- with a corresponding body, and is subject to pragma Elaborate_Body.
function Links_Vertices_In_Same_Component function Is_With_Edge
(G : Library_Graph; (G : Library_Graph;
LGE_Id : Library_Graph_Edge_Id) return Boolean; Edge : Library_Graph_Edge_Id) return Boolean;
pragma Inline (Links_Vertices_In_Same_Component); pragma Inline (Is_With_Edge);
-- Determine whether edge LGE_Id of library graph G links a predecessor -- Determine whether edge Edge of library graph G is the result of a
-- and a successor that reside within the same component. -- with dependency between its successor and predecessor.
function Needs_Elaboration function Needs_Elaboration
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id) return Boolean; Vertex : Library_Graph_Vertex_Id) return Boolean;
pragma Inline (Needs_Elaboration); 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. -- that needs to be elaborated.
function Proper_Body function Proper_Body
(G : Library_Graph; (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); 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 function Proper_Spec
(G : Library_Graph; (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); 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 -- -- Statistics --
...@@ -876,15 +1114,19 @@ package Bindo.Graphs is ...@@ -876,15 +1114,19 @@ package Bindo.Graphs is
pragma Inline (Number_Of_Components); pragma Inline (Number_Of_Components);
-- Obtain the total number of components in library graph G -- 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; function Number_Of_Edges (G : Library_Graph) return Natural;
pragma Inline (Number_Of_Edges); pragma Inline (Number_Of_Edges);
-- Obtain the total number of edges in library graph G -- Obtain the total number of edges in library graph G
function Number_Of_Edges_To_Successors function Number_Of_Edges_To_Successors
(G : Library_Graph; (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); 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. -- library graph G has.
function Number_Of_Vertices (G : Library_Graph) return Natural; function Number_Of_Vertices (G : Library_Graph) return Natural;
...@@ -895,6 +1137,27 @@ package Bindo.Graphs is ...@@ -895,6 +1137,27 @@ package Bindo.Graphs is
-- Iterators -- -- 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 -- The following type represents an iterator over all edges of a library
-- graph. -- graph.
...@@ -909,8 +1172,8 @@ package Bindo.Graphs is ...@@ -909,8 +1172,8 @@ package Bindo.Graphs is
-- Obtain an iterator over all edges of library graph G -- Obtain an iterator over all edges of library graph G
procedure Next procedure Next
(Iter : in out All_Edge_Iterator; (Iter : in out All_Edge_Iterator;
LGE_Id : out Library_Graph_Edge_Id); Edge : out Library_Graph_Edge_Id);
pragma Inline (Next); pragma Inline (Next);
-- Return the current edge referenced by iterator Iter and advance to -- Return the current edge referenced by iterator Iter and advance to
-- the next available edge. -- the next available edge.
...@@ -931,7 +1194,7 @@ package Bindo.Graphs is ...@@ -931,7 +1194,7 @@ package Bindo.Graphs is
procedure Next procedure Next
(Iter : in out All_Vertex_Iterator; (Iter : in out All_Vertex_Iterator;
LGV_Id : out Library_Graph_Vertex_Id); Vertex : out Library_Graph_Vertex_Id);
pragma Inline (Next); pragma Inline (Next);
-- Return the current vertex referenced by iterator Iter and advance -- Return the current vertex referenced by iterator Iter and advance
-- to the next available vertex. -- to the next available vertex.
...@@ -975,11 +1238,34 @@ package Bindo.Graphs is ...@@ -975,11 +1238,34 @@ package Bindo.Graphs is
procedure Next procedure Next
(Iter : in out Component_Vertex_Iterator; (Iter : in out Component_Vertex_Iterator;
LGV_Id : out Library_Graph_Vertex_Id); Vertex : out Library_Graph_Vertex_Id);
pragma Inline (Next); pragma Inline (Next);
-- Return the current vertex referenced by iterator Iter and advance -- Return the current vertex referenced by iterator Iter and advance
-- to the next available vertex. -- 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 -- The following type represents an iterator over all edges that reach
-- successors starting from a particular predecessor vertex. -- successors starting from a particular predecessor vertex.
...@@ -991,14 +1277,14 @@ package Bindo.Graphs is ...@@ -991,14 +1277,14 @@ package Bindo.Graphs is
function Iterate_Edges_To_Successors function Iterate_Edges_To_Successors
(G : Library_Graph; (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); pragma Inline (Iterate_Components);
-- Obtain an iterator over all edges to successors with predecessor -- 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 procedure Next
(Iter : in out Edges_To_Successors_Iterator; (Iter : in out Edges_To_Successors_Iterator;
LGE_Id : out Library_Graph_Edge_Id); Edge : out Library_Graph_Edge_Id);
pragma Inline (Next); pragma Inline (Next);
-- Return the current edge referenced by iterator Iter and advance to -- Return the current edge referenced by iterator Iter and advance to
-- the next available edge. -- the next available edge.
...@@ -1010,9 +1296,9 @@ package Bindo.Graphs is ...@@ -1010,9 +1296,9 @@ package Bindo.Graphs is
-------------- --------------
procedure Destroy_Library_Graph_Vertex 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); 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 -- The following type represents the attributes of a library graph
-- vertex. -- vertex.
...@@ -1054,7 +1340,7 @@ package Bindo.Graphs is ...@@ -1054,7 +1340,7 @@ package Bindo.Graphs is
pragma Inline (Destroy_Library_Graph_Vertex_Attributes); pragma Inline (Destroy_Library_Graph_Vertex_Attributes);
-- Destroy the contents of attributes Attrs -- 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, (Key_Type => Library_Graph_Vertex_Id,
Value_Type => Library_Graph_Vertex_Attributes, Value_Type => Library_Graph_Vertex_Attributes,
No_Value => No_Library_Graph_Vertex_Attributes, No_Value => No_Library_Graph_Vertex_Attributes,
...@@ -1070,11 +1356,6 @@ package Bindo.Graphs is ...@@ -1070,11 +1356,6 @@ package Bindo.Graphs is
-- Edges -- -- 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 -- The following type represents the attributes of a library graph edge
type Library_Graph_Edge_Attributes is record type Library_Graph_Edge_Attributes is record
...@@ -1091,7 +1372,7 @@ package Bindo.Graphs is ...@@ -1091,7 +1372,7 @@ package Bindo.Graphs is
pragma Inline (Destroy_Library_Graph_Edge_Attributes); pragma Inline (Destroy_Library_Graph_Edge_Attributes);
-- Destroy the contents of attributes Attrs -- 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, (Key_Type => Library_Graph_Edge_Id,
Value_Type => Library_Graph_Edge_Attributes, Value_Type => Library_Graph_Edge_Attributes,
No_Value => No_Library_Graph_Edge_Attributes, No_Value => No_Library_Graph_Edge_Attributes,
...@@ -1123,7 +1404,7 @@ package Bindo.Graphs is ...@@ -1123,7 +1404,7 @@ package Bindo.Graphs is
pragma Inline (Destroy_Component_Attributes); pragma Inline (Destroy_Component_Attributes);
-- Destroy the contents of attributes Attrs -- 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, (Key_Type => Component_Id,
Value_Type => Component_Attributes, Value_Type => Component_Attributes,
No_Value => No_Component_Attributes, No_Value => No_Component_Attributes,
...@@ -1135,9 +1416,69 @@ package Bindo.Graphs is ...@@ -1135,9 +1416,69 @@ package Bindo.Graphs is
Destroy_Value => Destroy_Component_Attributes, Destroy_Value => Destroy_Component_Attributes,
Hash => Hash_Component); 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 -- The following type represents a relation between a predecessor and
-- successor vertices. -- successor vertices.
...@@ -1160,7 +1501,7 @@ package Bindo.Graphs is ...@@ -1160,7 +1501,7 @@ package Bindo.Graphs is
pragma Inline (Hash_Predecessor_Successor_Relation); pragma Inline (Hash_Predecessor_Successor_Relation);
-- Obtain the hash value of key Rel -- 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, (Element_Type => Predecessor_Successor_Relation,
"=" => "=", "=" => "=",
Hash => Hash_Predecessor_Successor_Relation); Hash => Hash_Predecessor_Successor_Relation);
...@@ -1176,7 +1517,7 @@ package Bindo.Graphs is ...@@ -1176,7 +1517,7 @@ package Bindo.Graphs is
-- Units -- -- Units --
----------- -----------
package UV is new Dynamic_Hash_Tables package Unit_Tables is new Dynamic_Hash_Tables
(Key_Type => Unit_Id, (Key_Type => Unit_Id,
Value_Type => Library_Graph_Vertex_Id, Value_Type => Library_Graph_Vertex_Id,
No_Value => No_Library_Graph_Vertex, No_Value => No_Library_Graph_Vertex,
...@@ -1205,28 +1546,43 @@ package Bindo.Graphs is ...@@ -1205,28 +1546,43 @@ package Bindo.Graphs is
-- The following type represents the attributes of a library graph -- The following type represents the attributes of a library graph
type Library_Graph_Attributes is record 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 map of component -> component attributes for all components in
-- the graph. -- the graph.
Counts : Library_Graph_Edge_Counts := (others => 0); Counts : Library_Graph_Edge_Counts := (others => 0);
-- Edge statistics -- 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 -- The map of edge -> edge attributes for all edges in the graph
Graph : DG.Directed_Graph := DG.Nil; Graph : DG.Directed_Graph := DG.Nil;
-- The underlying graph describing the relations between edges and -- The underlying graph describing the relations between edges and
-- vertices. -- vertices.
Relations : PS.Membership_Set := PS.Nil; Recorded_Cycles : RC_Sets.Membership_Set := RC_Sets.Nil;
-- The set of relations between successors and predecessors, used to -- The set of recorded cycles, used to prevent duplicate cycles in
-- prevent duplicate edges in the graph. -- 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 -- 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 -- The map of vertex -> vertex attributes for all vertices in the
-- graph. -- graph.
end record; end record;
...@@ -1238,10 +1594,12 @@ package Bindo.Graphs is ...@@ -1238,10 +1594,12 @@ package Bindo.Graphs is
-- Iterators -- -- Iterators --
--------------- ---------------
type All_Cycle_Iterator is new LGC_Lists.Iterator;
type All_Edge_Iterator is new DG.All_Edge_Iterator; type All_Edge_Iterator is new DG.All_Edge_Iterator;
type All_Vertex_Iterator is new DG.All_Vertex_Iterator; type All_Vertex_Iterator is new DG.All_Vertex_Iterator;
type Component_Iterator is new DG.Component_Iterator; type Component_Iterator is new DG.Component_Iterator;
type Component_Vertex_Iterator is new DG.Component_Vertex_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; type Edges_To_Successors_Iterator is new DG.Outgoing_Edge_Iterator;
end Library_Graphs; end Library_Graphs;
......
gcc/ada/bindo-units.adb
...@@ -29,7 +29,7 @@ package body Bindo.Units is ...@@ -29,7 +29,7 @@ package body Bindo.Units is
-- Signature set -- -- Signature set --
------------------- -------------------
package SS is new Membership_Sets package Signature_Sets is new Membership_Sets
(Element_Type => Invocation_Signature_Id, (Element_Type => Invocation_Signature_Id,
"=" => "=", "=" => "=",
Hash => Hash_Invocation_Signature); Hash => Hash_Invocation_Signature);
...@@ -41,11 +41,13 @@ package body Bindo.Units is ...@@ -41,11 +41,13 @@ package body Bindo.Units is
-- The following set stores all invocation signatures that appear in -- The following set stores all invocation signatures that appear in
-- elaborable units. -- 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 -- 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 -- -- Local subprograms --
...@@ -139,14 +141,27 @@ package body Bindo.Units is ...@@ -139,14 +141,27 @@ package body Bindo.Units is
return Corresponding_Unit (Name_Id (UNam)); return Corresponding_Unit (Name_Id (UNam));
end Corresponding_Unit; 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 -- -- Finalize_Units --
-------------------- --------------------
procedure Finalize_Units is procedure Finalize_Units is
begin begin
SS.Destroy (Elaborable_Constructs); Signature_Sets.Destroy (Elaborable_Constructs);
US.Destroy (Elaborable_Units); Unit_Sets.Destroy (Elaborable_Units);
end Finalize_Units; end Finalize_Units;
------------------------------ ------------------------------
...@@ -183,7 +198,7 @@ package body Bindo.Units is ...@@ -183,7 +198,7 @@ package body Bindo.Units is
function Has_Next (Iter : Elaborable_Units_Iterator) return Boolean is function Has_Next (Iter : Elaborable_Units_Iterator) return Boolean is
begin begin
return US.Has_Next (US.Iterator (Iter)); return Unit_Sets.Has_Next (Unit_Sets.Iterator (Iter));
end Has_Next; end Has_Next;
------------------------------- -------------------------------
...@@ -216,11 +231,26 @@ package body Bindo.Units is ...@@ -216,11 +231,26 @@ package body Bindo.Units is
procedure Initialize_Units is procedure Initialize_Units is
begin begin
Elaborable_Constructs := SS.Create (Number_Of_Units); Elaborable_Constructs := Signature_Sets.Create (Number_Of_Units);
Elaborable_Units := US.Create (Number_Of_Units); Elaborable_Units := Unit_Sets.Create (Number_Of_Units);
end Initialize_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 -- -- Is_Dynamically_Elaborated --
------------------------------- -------------------------------
...@@ -278,7 +308,7 @@ package body Bindo.Units is ...@@ -278,7 +308,7 @@ package body Bindo.Units is
function Iterate_Elaborable_Units return Elaborable_Units_Iterator is function Iterate_Elaborable_Units return Elaborable_Units_Iterator is
begin begin
return Elaborable_Units_Iterator (US.Iterate (Elaborable_Units)); return Elaborable_Units_Iterator (Unit_Sets.Iterate (Elaborable_Units));
end Iterate_Elaborable_Units; end Iterate_Elaborable_Units;
---------- ----------
...@@ -304,7 +334,7 @@ package body Bindo.Units is ...@@ -304,7 +334,7 @@ package body Bindo.Units is
begin begin
pragma Assert (Present (IS_Id)); pragma Assert (Present (IS_Id));
return SS.Contains (Elaborable_Constructs, IS_Id); return Signature_Sets.Contains (Elaborable_Constructs, IS_Id);
end Needs_Elaboration; end Needs_Elaboration;
----------------------- -----------------------
...@@ -315,7 +345,7 @@ package body Bindo.Units is ...@@ -315,7 +345,7 @@ package body Bindo.Units is
begin begin
pragma Assert (Present (U_Id)); pragma Assert (Present (U_Id));
return US.Contains (Elaborable_Units, U_Id); return Unit_Sets.Contains (Elaborable_Units, U_Id);
end Needs_Elaboration; end Needs_Elaboration;
---------- ----------
...@@ -327,7 +357,7 @@ package body Bindo.Units is ...@@ -327,7 +357,7 @@ package body Bindo.Units is
U_Id : out Unit_Id) U_Id : out Unit_Id)
is is
begin begin
US.Next (US.Iterator (Iter), U_Id); Unit_Sets.Next (Unit_Sets.Iterator (Iter), U_Id);
end Next; end Next;
-------------------------------- --------------------------------
...@@ -336,7 +366,7 @@ package body Bindo.Units is ...@@ -336,7 +366,7 @@ package body Bindo.Units is
function Number_Of_Elaborable_Units return Natural is function Number_Of_Elaborable_Units return Natural is
begin begin
return US.Size (Elaborable_Units); return Unit_Sets.Size (Elaborable_Units);
end Number_Of_Elaborable_Units; end Number_Of_Elaborable_Units;
--------------------- ---------------------
...@@ -355,14 +385,12 @@ package body Bindo.Units is ...@@ -355,14 +385,12 @@ package body Bindo.Units is
procedure Process_Invocation_Construct (IC_Id : Invocation_Construct_Id) is procedure Process_Invocation_Construct (IC_Id : Invocation_Construct_Id) is
pragma Assert (Present (IC_Id)); pragma Assert (Present (IC_Id));
IC_Rec : Invocation_Construct_Record renames IS_Id : constant Invocation_Signature_Id := Signature (IC_Id);
Invocation_Constructs.Table (IC_Id);
IC_Sig : constant Invocation_Signature_Id := IC_Rec.Signature;
pragma Assert (Present (IC_Sig)); pragma Assert (Present (IS_Id));
begin begin
SS.Insert (Elaborable_Constructs, IC_Sig); Signature_Sets.Insert (Elaborable_Constructs, IS_Id);
end Process_Invocation_Construct; end Process_Invocation_Construct;
----------------------------------- -----------------------------------
...@@ -402,7 +430,7 @@ package body Bindo.Units is ...@@ -402,7 +430,7 @@ package body Bindo.Units is
-- signatures of constructs it declares. -- signatures of constructs it declares.
else else
US.Insert (Elaborable_Units, U_Id); Unit_Sets.Insert (Elaborable_Units, U_Id);
Process_Invocation_Constructs (U_Id); Process_Invocation_Constructs (U_Id);
end if; end if;
end Process_Unit; end Process_Unit;
......
gcc/ada/bindo-units.ads
...@@ -33,6 +33,19 @@ with GNAT.Sets; use GNAT.Sets; ...@@ -33,6 +33,19 @@ with GNAT.Sets; use GNAT.Sets;
package Bindo.Units is 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; procedure Collect_Elaborable_Units;
pragma Inline (Collect_Elaborable_Units); pragma Inline (Collect_Elaborable_Units);
-- Gather all units in the bind that require elaboration. The units are -- Gather all units in the bind that require elaboration. The units are
...@@ -54,6 +67,10 @@ package Bindo.Units is ...@@ -54,6 +67,10 @@ package Bindo.Units is
pragma Inline (Corresponding_Unit); pragma Inline (Corresponding_Unit);
-- Obtain the unit which corresponds to name FNam -- 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); type Unit_Processor_Ptr is access procedure (U_Id : Unit_Id);
procedure For_Each_Elaborable_Unit (Processor : Unit_Processor_Ptr); procedure For_Each_Elaborable_Unit (Processor : Unit_Processor_Ptr);
...@@ -69,9 +86,11 @@ package Bindo.Units is ...@@ -69,9 +86,11 @@ package Bindo.Units is
pragma Inline (Hash_Invocation_Signature); pragma Inline (Hash_Invocation_Signature);
-- Obtain the hash value of key IS_Id -- Obtain the hash value of key IS_Id
function Hash_Unit (U_Id : Unit_Id) return Bucket_Range_Type; function Invocation_Graph_Encoding
pragma Inline (Hash_Unit); (U_Id : Unit_Id) return Invocation_Graph_Encoding_Kind;
-- Obtain the hash value of key U_Id 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; function Is_Dynamically_Elaborated (U_Id : Unit_Id) return Boolean;
pragma Inline (Is_Dynamically_Elaborated); pragma Inline (Is_Dynamically_Elaborated);
...@@ -144,11 +163,6 @@ package Bindo.Units is ...@@ -144,11 +163,6 @@ package Bindo.Units is
-- Initialize the internal structures of this unit -- Initialize the internal structures of this unit
private private
package US is new Membership_Sets type Elaborable_Units_Iterator is new Unit_Sets.Iterator;
(Element_Type => Unit_Id,
"=" => "=",
Hash => Hash_Unit);
type Elaborable_Units_Iterator is new US.Iterator;
end Bindo.Units; end Bindo.Units;
gcc/ada/bindo-validators.adb
...@@ -29,22 +29,183 @@ with Types; use Types; ...@@ -29,22 +29,183 @@ with Types; use Types;
with Bindo.Units; use Bindo.Units; with Bindo.Units; use Bindo.Units;
with GNAT; use GNAT;
with GNAT.Sets; use GNAT.Sets;
package body Bindo.Validators is 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 -- -- Elaboration_Order_Validators --
---------------------------------- ----------------------------------
package body Elaboration_Order_Validators is 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; Has_Invalid_Data : Boolean := False;
-- Flag set when the elaboration order contains invalid data -- Flag set when the elaboration order contains invalid data
...@@ -52,7 +213,7 @@ package body Bindo.Validators is ...@@ -52,7 +213,7 @@ package body Bindo.Validators is
-- Local subprograms -- -- 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); pragma Inline (Build_Elaborable_Unit_Set);
-- Create a set from all units that need to be elaborated -- Create a set from all units that need to be elaborated
...@@ -61,7 +222,7 @@ package body Bindo.Validators is ...@@ -61,7 +222,7 @@ package body Bindo.Validators is
-- Emit an error concerning unit U_Id that must be elaborated, but was -- Emit an error concerning unit U_Id that must be elaborated, but was
-- not. -- not.
procedure Report_Missing_Elaborations (Set : Membership_Set); procedure Report_Missing_Elaborations (Set : Unit_Sets.Membership_Set);
pragma Inline (Report_Missing_Elaborations); pragma Inline (Report_Missing_Elaborations);
-- Emit errors on all units in set Set that must be elaborated, but were -- Emit errors on all units in set Set that must be elaborated, but were
-- not. -- not.
...@@ -70,7 +231,9 @@ package body Bindo.Validators is ...@@ -70,7 +231,9 @@ package body Bindo.Validators is
pragma Inline (Report_Spurious_Elaboration); pragma Inline (Report_Spurious_Elaboration);
-- Emit an error concerning unit U_Id that is incorrectly elaborated -- 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); pragma Inline (Validate_Unit);
-- Validate the elaboration status of unit U_Id. Elab_Set is the set of -- Validate the elaboration status of unit U_Id. Elab_Set is the set of
-- all units that need to be elaborated. -- all units that need to be elaborated.
...@@ -79,28 +242,22 @@ package body Bindo.Validators is ...@@ -79,28 +242,22 @@ package body Bindo.Validators is
pragma Inline (Validate_Units); pragma Inline (Validate_Units);
-- Validate all units in elaboration order Order -- 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 -- -- 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; Iter : Elaborable_Units_Iterator;
Set : Membership_Set; Set : Unit_Sets.Membership_Set;
U_Id : Unit_Id; U_Id : Unit_Id;
begin begin
Set := Create (Number_Of_Elaborable_Units); Set := Unit_Sets.Create (Number_Of_Elaborable_Units);
Iter := Iterate_Elaborable_Units; Iter := Iterate_Elaborable_Units;
while Has_Next (Iter) loop while Has_Next (Iter) loop
Next (Iter, U_Id); Next (Iter, U_Id);
pragma Assert (Present (U_Id));
Insert (Set, U_Id); Unit_Sets.Insert (Set, U_Id);
end loop; end loop;
return Set; return Set;
...@@ -115,7 +272,7 @@ package body Bindo.Validators is ...@@ -115,7 +272,7 @@ package body Bindo.Validators is
begin begin
pragma Assert (Present (U_Id)); pragma Assert (Present (U_Id));
Write_Error (Msg); Write_Error (Msg, Has_Invalid_Data);
Write_Str ("unit (U_Id_"); Write_Str ("unit (U_Id_");
Write_Int (Int (U_Id)); Write_Int (Int (U_Id));
...@@ -129,15 +286,14 @@ package body Bindo.Validators is ...@@ -129,15 +286,14 @@ package body Bindo.Validators is
-- Report_Missing_Elaborations -- -- Report_Missing_Elaborations --
--------------------------------- ---------------------------------
procedure Report_Missing_Elaborations (Set : Membership_Set) is procedure Report_Missing_Elaborations (Set : Unit_Sets.Membership_Set) is
Iter : Iterator; Iter : Unit_Sets.Iterator;
U_Id : Unit_Id; U_Id : Unit_Id;
begin begin
Iter := Iterate (Set); Iter := Unit_Sets.Iterate (Set);
while Has_Next (Iter) loop while Unit_Sets.Has_Next (Iter) loop
Next (Iter, U_Id); Unit_Sets.Next (Iter, U_Id);
pragma Assert (Present (U_Id));
Report_Missing_Elaboration (U_Id); Report_Missing_Elaboration (U_Id);
end loop; end loop;
...@@ -152,7 +308,7 @@ package body Bindo.Validators is ...@@ -152,7 +308,7 @@ package body Bindo.Validators is
begin begin
pragma Assert (Present (U_Id)); pragma Assert (Present (U_Id));
Write_Error (Msg); Write_Error (Msg, Has_Invalid_Data);
Write_Str ("unit (U_Id_"); Write_Str ("unit (U_Id_");
Write_Int (Int (U_Id)); Write_Int (Int (U_Id));
...@@ -167,8 +323,8 @@ package body Bindo.Validators is ...@@ -167,8 +323,8 @@ package body Bindo.Validators is
procedure Validate_Elaboration_Order (Order : Unit_Id_Table) is procedure Validate_Elaboration_Order (Order : Unit_Id_Table) is
begin begin
-- Nothing to do when switch -d_V (validate bindo graphs and order) -- Nothing to do when switch -d_V (validate bindo cycles, graphs, and
-- is not in effect. -- order) is not in effect.
if not Debug_Flag_Underscore_VV then if not Debug_Flag_Underscore_VV then
return; return;
...@@ -185,15 +341,18 @@ package body Bindo.Validators is ...@@ -185,15 +341,18 @@ package body Bindo.Validators is
-- Validate_Unit -- -- 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 begin
pragma Assert (Present (U_Id)); pragma Assert (Present (U_Id));
-- The current unit in the elaboration order appears within the set -- The current unit in the elaboration order appears within the set
-- of units that require elaboration. Remove it from the set. -- of units that require elaboration. Remove it from the set.
if Contains (Elab_Set, U_Id) then if Unit_Sets.Contains (Elab_Set, U_Id) then
Delete (Elab_Set, U_Id); Unit_Sets.Delete (Elab_Set, U_Id);
-- Otherwise the current unit in the elaboration order must not be -- Otherwise the current unit in the elaboration order must not be
-- elaborated. -- elaborated.
...@@ -208,7 +367,7 @@ package body Bindo.Validators is ...@@ -208,7 +367,7 @@ package body Bindo.Validators is
-------------------- --------------------
procedure Validate_Units (Order : Unit_Id_Table) is procedure Validate_Units (Order : Unit_Id_Table) is
Elab_Set : Membership_Set; Elab_Set : Unit_Sets.Membership_Set;
begin begin
-- Collect all units in the compilation that need to be elaborated -- Collect all units in the compilation that need to be elaborated
...@@ -230,21 +389,8 @@ package body Bindo.Validators is ...@@ -230,21 +389,8 @@ package body Bindo.Validators is
-- their elaboration. -- their elaboration.
Report_Missing_Elaborations (Elab_Set); Report_Missing_Elaborations (Elab_Set);
Destroy (Elab_Set); Unit_Sets.Destroy (Elab_Set);
end Validate_Units; 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; end Elaboration_Order_Validators;
--------------------------------- ---------------------------------
...@@ -260,10 +406,10 @@ package body Bindo.Validators is ...@@ -260,10 +406,10 @@ package body Bindo.Validators is
----------------------- -----------------------
procedure Validate_Invocation_Graph_Edge procedure Validate_Invocation_Graph_Edge
(G : Invocation_Graph; (G : Invocation_Graph;
IGE_Id : Invocation_Graph_Edge_Id); Edge : Invocation_Graph_Edge_Id);
pragma Inline (Validate_Invocation_Graph_Edge); 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. -- properly set.
procedure Validate_Invocation_Graph_Edges (G : Invocation_Graph); procedure Validate_Invocation_Graph_Edges (G : Invocation_Graph);
...@@ -273,9 +419,9 @@ package body Bindo.Validators is ...@@ -273,9 +419,9 @@ package body Bindo.Validators is
procedure Validate_Invocation_Graph_Vertex procedure Validate_Invocation_Graph_Vertex
(G : Invocation_Graph; (G : Invocation_Graph;
IGV_Id : Invocation_Graph_Vertex_Id); Vertex : Invocation_Graph_Vertex_Id);
pragma Inline (Validate_Invocation_Graph_Vertex); 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. -- properly set.
procedure Validate_Invocation_Graph_Vertices (G : Invocation_Graph); procedure Validate_Invocation_Graph_Vertices (G : Invocation_Graph);
...@@ -283,11 +429,6 @@ package body Bindo.Validators is ...@@ -283,11 +429,6 @@ package body Bindo.Validators is
-- Verify that the attributes of all vertices of invocation graph G are -- Verify that the attributes of all vertices of invocation graph G are
-- properly set. -- 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 -- -- Validate_Invocation_Graph --
------------------------------- -------------------------------
...@@ -296,8 +437,8 @@ package body Bindo.Validators is ...@@ -296,8 +437,8 @@ package body Bindo.Validators is
begin begin
pragma Assert (Present (G)); pragma Assert (Present (G));
-- Nothing to do when switch -d_V (validate bindo graphs and order) -- Nothing to do when switch -d_V (validate bindo cycles, graphs, and
-- is not in effect. -- order) is not in effect.
if not Debug_Flag_Underscore_VV then if not Debug_Flag_Underscore_VV then
return; return;
...@@ -316,16 +457,16 @@ package body Bindo.Validators is ...@@ -316,16 +457,16 @@ package body Bindo.Validators is
------------------------------------ ------------------------------------
procedure Validate_Invocation_Graph_Edge procedure Validate_Invocation_Graph_Edge
(G : Invocation_Graph; (G : Invocation_Graph;
IGE_Id : Invocation_Graph_Edge_Id) Edge : Invocation_Graph_Edge_Id)
is is
Msg : constant String := "Validate_Invocation_Graph_Edge"; Msg : constant String := "Validate_Invocation_Graph_Edge";
begin begin
pragma Assert (Present (G)); pragma Assert (Present (G));
if not Present (IGE_Id) then if not Present (Edge) then
Write_Error (Msg); Write_Error (Msg, Has_Invalid_Data);
Write_Str (" emply invocation graph edge"); Write_Str (" emply invocation graph edge");
Write_Eol; Write_Eol;
...@@ -333,21 +474,21 @@ package body Bindo.Validators is ...@@ -333,21 +474,21 @@ package body Bindo.Validators is
return; return;
end if; end if;
if not Present (Relation (G, IGE_Id)) then if not Present (Relation (G, Edge)) then
Write_Error (Msg); Write_Error (Msg, Has_Invalid_Data);
Write_Str (" invocation graph edge (IGE_Id_"); Write_Str (" invocation graph edge (IGE_Id_");
Write_Int (Int (IGE_Id)); Write_Int (Int (Edge));
Write_Str (") lacks Relation"); Write_Str (") lacks Relation");
Write_Eol; Write_Eol;
Write_Eol; Write_Eol;
end if; end if;
if not Present (Target (G, IGE_Id)) then if not Present (Target (G, Edge)) then
Write_Error (Msg); Write_Error (Msg, Has_Invalid_Data);
Write_Str (" invocation graph edge (IGE_Id_"); Write_Str (" invocation graph edge (IGE_Id_");
Write_Int (Int (IGE_Id)); Write_Int (Int (Edge));
Write_Str (") lacks Target"); Write_Str (") lacks Target");
Write_Eol; Write_Eol;
Write_Eol; Write_Eol;
...@@ -359,17 +500,17 @@ package body Bindo.Validators is ...@@ -359,17 +500,17 @@ package body Bindo.Validators is
------------------------------------- -------------------------------------
procedure Validate_Invocation_Graph_Edges (G : Invocation_Graph) is procedure Validate_Invocation_Graph_Edges (G : Invocation_Graph) is
IGE_Id : Invocation_Graph_Edge_Id; Edge : Invocation_Graph_Edge_Id;
Iter : Invocation_Graphs.All_Edge_Iterator; Iter : Invocation_Graphs.All_Edge_Iterator;
begin begin
pragma Assert (Present (G)); pragma Assert (Present (G));
Iter := Iterate_All_Edges (G); Iter := Iterate_All_Edges (G);
while Has_Next (Iter) loop 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 loop;
end Validate_Invocation_Graph_Edges; end Validate_Invocation_Graph_Edges;
...@@ -379,15 +520,15 @@ package body Bindo.Validators is ...@@ -379,15 +520,15 @@ package body Bindo.Validators is
procedure Validate_Invocation_Graph_Vertex procedure Validate_Invocation_Graph_Vertex
(G : Invocation_Graph; (G : Invocation_Graph;
IGV_Id : Invocation_Graph_Vertex_Id) Vertex : Invocation_Graph_Vertex_Id)
is is
Msg : constant String := "Validate_Invocation_Graph_Vertex"; Msg : constant String := "Validate_Invocation_Graph_Vertex";
begin begin
pragma Assert (Present (G)); pragma Assert (Present (G));
if not Present (IGV_Id) then if not Present (Vertex) then
Write_Error (Msg); Write_Error (Msg, Has_Invalid_Data);
Write_Str (" emply invocation graph vertex"); Write_Str (" emply invocation graph vertex");
Write_Eol; Write_Eol;
...@@ -395,22 +536,32 @@ package body Bindo.Validators is ...@@ -395,22 +536,32 @@ package body Bindo.Validators is
return; return;
end if; end if;
if not Present (Construct (G, IGV_Id)) then if not Present (Body_Vertex (G, Vertex)) then
Write_Error (Msg); Write_Error (Msg, Has_Invalid_Data);
Write_Str (" invocation graph vertex (IGV_Id_"); 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_Str (") lacks Construct");
Write_Eol; Write_Eol;
Write_Eol; Write_Eol;
end if; end if;
if not Present (Lib_Vertex (G, IGV_Id)) then if not Present (Spec_Vertex (G, Vertex)) then
Write_Error (Msg); Write_Error (Msg, Has_Invalid_Data);
Write_Str (" invocation graph vertex (IGV_Id_"); Write_Str (" invocation graph vertex (IGV_Id_");
Write_Int (Int (IGV_Id)); Write_Int (Int (Vertex));
Write_Str (") lacks Lib_Vertex"); Write_Str (") lacks Spec_Vertex");
Write_Eol; Write_Eol;
Write_Eol; Write_Eol;
end if; end if;
...@@ -421,32 +572,19 @@ package body Bindo.Validators is ...@@ -421,32 +572,19 @@ package body Bindo.Validators is
---------------------------------------- ----------------------------------------
procedure Validate_Invocation_Graph_Vertices (G : Invocation_Graph) is procedure Validate_Invocation_Graph_Vertices (G : Invocation_Graph) is
IGV_Id : Invocation_Graph_Vertex_Id;
Iter : Invocation_Graphs.All_Vertex_Iterator; Iter : Invocation_Graphs.All_Vertex_Iterator;
Vertex : Invocation_Graph_Vertex_Id;
begin begin
pragma Assert (Present (G)); pragma Assert (Present (G));
Iter := Iterate_All_Vertices (G); Iter := Iterate_All_Vertices (G);
while Has_Next (Iter) loop 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 loop;
end Validate_Invocation_Graph_Vertices; 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; end Invocation_Graph_Validators;
------------------------------ ------------------------------
...@@ -462,10 +600,10 @@ package body Bindo.Validators is ...@@ -462,10 +600,10 @@ package body Bindo.Validators is
----------------------- -----------------------
procedure Validate_Library_Graph_Edge procedure Validate_Library_Graph_Edge
(G : Library_Graph; (G : Library_Graph;
LGE_Id : Library_Graph_Edge_Id); Edge : Library_Graph_Edge_Id);
pragma Inline (Validate_Library_Graph_Edge); 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. -- properly set.
procedure Validate_Library_Graph_Edges (G : Library_Graph); procedure Validate_Library_Graph_Edges (G : Library_Graph);
...@@ -475,9 +613,9 @@ package body Bindo.Validators is ...@@ -475,9 +613,9 @@ package body Bindo.Validators is
procedure Validate_Library_Graph_Vertex procedure Validate_Library_Graph_Vertex
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id); Vertex : Library_Graph_Vertex_Id);
pragma Inline (Validate_Library_Graph_Vertex); 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. -- properly set.
procedure Validate_Library_Graph_Vertices (G : Library_Graph); procedure Validate_Library_Graph_Vertices (G : Library_Graph);
...@@ -485,11 +623,6 @@ package body Bindo.Validators is ...@@ -485,11 +623,6 @@ package body Bindo.Validators is
-- Verify that the attributes of all vertices of library graph G are -- Verify that the attributes of all vertices of library graph G are
-- properly set. -- 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 -- -- Validate_Library_Graph --
---------------------------- ----------------------------
...@@ -498,8 +631,8 @@ package body Bindo.Validators is ...@@ -498,8 +631,8 @@ package body Bindo.Validators is
begin begin
pragma Assert (Present (G)); pragma Assert (Present (G));
-- Nothing to do when switch -d_V (validate bindo graphs and order) -- Nothing to do when switch -d_V (validate bindo cycles, graphs, and
-- is not in effect. -- order) is not in effect.
if not Debug_Flag_Underscore_VV then if not Debug_Flag_Underscore_VV then
return; return;
...@@ -518,16 +651,16 @@ package body Bindo.Validators is ...@@ -518,16 +651,16 @@ package body Bindo.Validators is
--------------------------------- ---------------------------------
procedure Validate_Library_Graph_Edge procedure Validate_Library_Graph_Edge
(G : Library_Graph; (G : Library_Graph;
LGE_Id : Library_Graph_Edge_Id) Edge : Library_Graph_Edge_Id)
is is
Msg : constant String := "Validate_Library_Graph_Edge"; Msg : constant String := "Validate_Library_Graph_Edge";
begin begin
pragma Assert (Present (G)); pragma Assert (Present (G));
if not Present (LGE_Id) then if not Present (Edge) then
Write_Error (Msg); Write_Error (Msg, Has_Invalid_Data);
Write_Str (" emply library graph edge"); Write_Str (" emply library graph edge");
Write_Eol; Write_Eol;
...@@ -535,40 +668,40 @@ package body Bindo.Validators is ...@@ -535,40 +668,40 @@ package body Bindo.Validators is
return; return;
end if; end if;
if Kind (G, LGE_Id) = No_Edge then if Kind (G, Edge) = No_Edge then
Write_Error (Msg); Write_Error (Msg, Has_Invalid_Data);
Write_Str (" library graph edge (LGE_Id_"); Write_Str (" library graph edge (LGE_Id_");
Write_Int (Int (LGE_Id)); Write_Int (Int (Edge));
Write_Str (") is not a valid edge"); Write_Str (") is not a valid edge");
Write_Eol; Write_Eol;
Write_Eol; Write_Eol;
elsif Kind (G, LGE_Id) = Body_Before_Spec_Edge then elsif Kind (G, Edge) = Body_Before_Spec_Edge then
Write_Error (Msg); Write_Error (Msg, Has_Invalid_Data);
Write_Str (" library graph edge (LGE_Id_"); 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_Str (") is a Body_Before_Spec edge");
Write_Eol; Write_Eol;
Write_Eol; Write_Eol;
end if; end if;
if not Present (Predecessor (G, LGE_Id)) then if not Present (Predecessor (G, Edge)) then
Write_Error (Msg); Write_Error (Msg, Has_Invalid_Data);
Write_Str (" library graph edge (LGE_Id_"); Write_Str (" library graph edge (LGE_Id_");
Write_Int (Int (LGE_Id)); Write_Int (Int (Edge));
Write_Str (") lacks Predecessor"); Write_Str (") lacks Predecessor");
Write_Eol; Write_Eol;
Write_Eol; Write_Eol;
end if; end if;
if not Present (Successor (G, LGE_Id)) then if not Present (Successor (G, Edge)) then
Write_Error (Msg); Write_Error (Msg, Has_Invalid_Data);
Write_Str (" library graph edge (LGE_Id_"); Write_Str (" library graph edge (LGE_Id_");
Write_Int (Int (LGE_Id)); Write_Int (Int (Edge));
Write_Str (") lacks Successor"); Write_Str (") lacks Successor");
Write_Eol; Write_Eol;
Write_Eol; Write_Eol;
...@@ -580,18 +713,17 @@ package body Bindo.Validators is ...@@ -580,18 +713,17 @@ package body Bindo.Validators is
---------------------------------- ----------------------------------
procedure Validate_Library_Graph_Edges (G : Library_Graph) is procedure Validate_Library_Graph_Edges (G : Library_Graph) is
Iter : Library_Graphs.All_Edge_Iterator; Edge : Library_Graph_Edge_Id;
LGE_Id : Library_Graph_Edge_Id; Iter : Library_Graphs.All_Edge_Iterator;
begin begin
pragma Assert (Present (G)); pragma Assert (Present (G));
Iter := Iterate_All_Edges (G); Iter := Iterate_All_Edges (G);
while Has_Next (Iter) loop while Has_Next (Iter) loop
Next (Iter, LGE_Id); Next (Iter, Edge);
pragma Assert (Present (LGE_Id));
Validate_Library_Graph_Edge (G, LGE_Id); Validate_Library_Graph_Edge (G, Edge);
end loop; end loop;
end Validate_Library_Graph_Edges; end Validate_Library_Graph_Edges;
...@@ -601,15 +733,15 @@ package body Bindo.Validators is ...@@ -601,15 +733,15 @@ package body Bindo.Validators is
procedure Validate_Library_Graph_Vertex procedure Validate_Library_Graph_Vertex
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id) Vertex : Library_Graph_Vertex_Id)
is is
Msg : constant String := "Validate_Library_Graph_Vertex"; Msg : constant String := "Validate_Library_Graph_Vertex";
begin begin
pragma Assert (Present (G)); pragma Assert (Present (G));
if not Present (LGV_Id) then if not Present (Vertex) then
Write_Error (Msg); Write_Error (Msg, Has_Invalid_Data);
Write_Str (" empty library graph vertex"); Write_Str (" empty library graph vertex");
Write_Eol; Write_Eol;
...@@ -617,25 +749,25 @@ package body Bindo.Validators is ...@@ -617,25 +749,25 @@ package body Bindo.Validators is
return; return;
end if; end if;
if (Is_Body_With_Spec (G, LGV_Id) if (Is_Body_With_Spec (G, Vertex)
or else or else
Is_Spec_With_Body (G, LGV_Id)) Is_Spec_With_Body (G, Vertex))
and then not Present (Corresponding_Item (G, LGV_Id)) and then not Present (Corresponding_Item (G, Vertex))
then then
Write_Error (Msg); Write_Error (Msg, Has_Invalid_Data);
Write_Str (" library graph vertex (LGV_Id_"); Write_Str (" library graph vertex (LGV_Id_");
Write_Int (Int (LGV_Id)); Write_Int (Int (Vertex));
Write_Str (") lacks Corresponding_Item"); Write_Str (") lacks Corresponding_Item");
Write_Eol; Write_Eol;
Write_Eol; Write_Eol;
end if; end if;
if not Present (Unit (G, LGV_Id)) then if not Present (Unit (G, Vertex)) then
Write_Error (Msg); Write_Error (Msg, Has_Invalid_Data);
Write_Str (" library graph vertex (LGV_Id_"); Write_Str (" library graph vertex (LGV_Id_");
Write_Int (Int (LGV_Id)); Write_Int (Int (Vertex));
Write_Str (") lacks Unit"); Write_Str (") lacks Unit");
Write_Eol; Write_Eol;
Write_Eol; Write_Eol;
...@@ -648,32 +780,34 @@ package body Bindo.Validators is ...@@ -648,32 +780,34 @@ package body Bindo.Validators is
procedure Validate_Library_Graph_Vertices (G : Library_Graph) is procedure Validate_Library_Graph_Vertices (G : Library_Graph) is
Iter : Library_Graphs.All_Vertex_Iterator; Iter : Library_Graphs.All_Vertex_Iterator;
LGV_Id : Library_Graph_Vertex_Id; Vertex : Library_Graph_Vertex_Id;
begin begin
pragma Assert (Present (G)); pragma Assert (Present (G));
Iter := Iterate_All_Vertices (G); Iter := Iterate_All_Vertices (G);
while Has_Next (Iter) loop while Has_Next (Iter) loop
Next (Iter, LGV_Id); Next (Iter, Vertex);
pragma Assert (Present (LGV_Id));
Validate_Library_Graph_Vertex (G, LGV_Id); Validate_Library_Graph_Vertex (G, Vertex);
end loop; end loop;
end Validate_Library_Graph_Vertices; 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; 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; end Bindo.Validators;
gcc/ada/bindo-validators.ads
...@@ -35,6 +35,26 @@ use Bindo.Graphs.Library_Graphs; ...@@ -35,6 +35,26 @@ use Bindo.Graphs.Library_Graphs;
package Bindo.Validators is 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 -- -- Elaboration_Order_Validators --
---------------------------------- ----------------------------------
......
gcc/ada/bindo-writers.adb
...@@ -28,7 +28,8 @@ with Fname; use Fname; ...@@ -28,7 +28,8 @@ with Fname; use Fname;
with Opt; use Opt; with Opt; use Opt;
with Output; use Output; with Output; use Output;
with Bindo.Units; use Bindo.Units; with Bindo.Units;
use Bindo.Units;
with GNAT; use GNAT; with GNAT; use GNAT;
with GNAT.Graphs; use GNAT.Graphs; with GNAT.Graphs; use GNAT.Graphs;
...@@ -124,26 +125,27 @@ package body Bindo.Writers is ...@@ -124,26 +125,27 @@ package body Bindo.Writers is
-------------------------------- --------------------------------
procedure Write_Invocation_Construct (IC_Id : Invocation_Construct_Id) is procedure Write_Invocation_Construct (IC_Id : Invocation_Construct_Id) is
begin
pragma Assert (Present (IC_Id)); pragma Assert (Present (IC_Id));
IC_Rec : Invocation_Construct_Record renames
Invocation_Constructs.Table (IC_Id);
begin
Write_Str (" invocation construct (IC_Id_"); Write_Str (" invocation construct (IC_Id_");
Write_Int (Int (IC_Id)); Write_Int (Int (IC_Id));
Write_Str (")"); Write_Str (")");
Write_Eol; Write_Eol;
Write_Str (" Body_Placement = ");
Write_Str (Body_Placement (IC_Id)'Img);
Write_Eol;
Write_Str (" Kind = "); Write_Str (" Kind = ");
Write_Str (IC_Rec.Kind'Img); Write_Str (Kind (IC_Id)'Img);
Write_Eol; Write_Eol;
Write_Str (" Placement = "); Write_Str (" Spec_Placement = ");
Write_Str (IC_Rec.Placement'Img); Write_Str (Spec_Placement (IC_Id)'Img);
Write_Eol; Write_Eol;
Write_Invocation_Signature (IC_Rec.Signature); Write_Invocation_Signature (Signature (IC_Id));
Write_Eol; Write_Eol;
end Write_Invocation_Construct; end Write_Invocation_Construct;
...@@ -152,20 +154,17 @@ package body Bindo.Writers is ...@@ -152,20 +154,17 @@ package body Bindo.Writers is
------------------------------- -------------------------------
procedure Write_Invocation_Relation (IR_Id : Invocation_Relation_Id) is procedure Write_Invocation_Relation (IR_Id : Invocation_Relation_Id) is
begin
pragma Assert (Present (IR_Id)); pragma Assert (Present (IR_Id));
IR_Rec : Invocation_Relation_Record renames
Invocation_Relations.Table (IR_Id);
begin
Write_Str (" invocation relation (IR_Id_"); Write_Str (" invocation relation (IR_Id_");
Write_Int (Int (IR_Id)); Write_Int (Int (IR_Id));
Write_Str (")"); Write_Str (")");
Write_Eol; Write_Eol;
if Present (IR_Rec.Extra) then if Present (Extra (IR_Id)) then
Write_Str (" Extra = "); Write_Str (" Extra = ");
Write_Name (IR_Rec.Extra); Write_Name (Extra (IR_Id));
else else
Write_Str (" Extra = none"); Write_Str (" Extra = none");
end if; end if;
...@@ -174,16 +173,16 @@ package body Bindo.Writers is ...@@ -174,16 +173,16 @@ package body Bindo.Writers is
Write_Str (" Invoker"); Write_Str (" Invoker");
Write_Eol; Write_Eol;
Write_Invocation_Signature (IR_Rec.Invoker); Write_Invocation_Signature (Invoker (IR_Id));
Write_Str (" Kind = "); Write_Str (" Kind = ");
Write_Str (IR_Rec.Kind'Img); Write_Str (Kind (IR_Id)'Img);
Write_Eol; Write_Eol;
Write_Str (" Target"); Write_Str (" Target");
Write_Eol; Write_Eol;
Write_Invocation_Signature (IR_Rec.Target); Write_Invocation_Signature (Target (IR_Id));
Write_Eol; Write_Eol;
end Write_Invocation_Relation; end Write_Invocation_Relation;
...@@ -192,39 +191,36 @@ package body Bindo.Writers is ...@@ -192,39 +191,36 @@ package body Bindo.Writers is
-------------------------------- --------------------------------
procedure Write_Invocation_Signature (IS_Id : Invocation_Signature_Id) is procedure Write_Invocation_Signature (IS_Id : Invocation_Signature_Id) is
begin
pragma Assert (Present (IS_Id)); pragma Assert (Present (IS_Id));
IS_Rec : Invocation_Signature_Record renames
Invocation_Signatures.Table (IS_Id);
begin
Write_Str (" Signature (IS_Id_"); Write_Str (" Signature (IS_Id_");
Write_Int (Int (IS_Id)); Write_Int (Int (IS_Id));
Write_Str (")"); Write_Str (")");
Write_Eol; Write_Eol;
Write_Str (" Column = "); Write_Str (" Column = ");
Write_Int (Int (IS_Rec.Column)); Write_Int (Int (Column (IS_Id)));
Write_Eol; Write_Eol;
Write_Str (" Line = "); Write_Str (" Line = ");
Write_Int (Int (IS_Rec.Line)); Write_Int (Int (Line (IS_Id)));
Write_Eol; Write_Eol;
if Present (IS_Rec.Locations) then if Present (Locations (IS_Id)) then
Write_Str (" Locations = "); Write_Str (" Locations = ");
Write_Name (IS_Rec.Locations); Write_Name (Locations (IS_Id));
else else
Write_Str (" Locations = none"); Write_Str (" Locations = none");
end if; end if;
Write_Eol; Write_Eol;
Write_Str (" Name = "); Write_Str (" Name = ");
Write_Name (IS_Rec.Name); Write_Name (Name (IS_Id));
Write_Eol; Write_Eol;
Write_Str (" Scope = "); Write_Str (" Scope = ");
Write_Name (IS_Rec.Scope); Write_Name (Scope (IS_Id));
Write_Eol; Write_Eol;
end Write_Invocation_Signature; end Write_Invocation_Signature;
...@@ -277,17 +273,8 @@ package body Bindo.Writers is ...@@ -277,17 +273,8 @@ package body Bindo.Writers is
Write_Eol; Write_Eol;
Write_Eol; Write_Eol;
for IC_Id in U_Rec.First_Invocation_Construct .. For_Each_Invocation_Construct (Write_Invocation_Construct'Access);
U_Rec.Last_Invocation_Construct For_Each_Invocation_Relation (Write_Invocation_Relation'Access);
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;
end Write_Unit; end Write_Unit;
----------------------- -----------------------
...@@ -313,6 +300,131 @@ package body Bindo.Writers is ...@@ -313,6 +300,131 @@ package body Bindo.Writers is
end Write_Unit_Common; end Write_Unit_Common;
end ALI_Writers; 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 -- -- Elaboration_Order_Writers --
------------------------------- -------------------------------
...@@ -416,22 +528,23 @@ package body Bindo.Writers is ...@@ -416,22 +528,23 @@ package body Bindo.Writers is
-- Write all elaboration roots of invocation graph G to standard output -- Write all elaboration roots of invocation graph G to standard output
procedure Write_Invocation_Graph_Edge procedure Write_Invocation_Graph_Edge
(G : Invocation_Graph; (G : Invocation_Graph;
IGE_Id : Invocation_Graph_Edge_Id); Edge : Invocation_Graph_Edge_Id);
pragma Inline (Write_Invocation_Graph_Edge); 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 procedure Write_Invocation_Graph_Edges
(G : Invocation_Graph; (G : Invocation_Graph;
IGV_Id : Invocation_Graph_Vertex_Id); Vertex : Invocation_Graph_Vertex_Id);
pragma Inline (Write_Invocation_Graph_Edges); 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 procedure Write_Invocation_Graph_Vertex
(G : Invocation_Graph; (G : Invocation_Graph;
IGV_Id : Invocation_Graph_Vertex_Id); Vertex : Invocation_Graph_Vertex_Id);
pragma Inline (Write_Invocation_Graph_Vertex); 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); procedure Write_Invocation_Graph_Vertices (G : Invocation_Graph);
pragma Inline (Write_Invocation_Graph_Vertices); pragma Inline (Write_Invocation_Graph_Vertices);
...@@ -447,14 +560,13 @@ package body Bindo.Writers is ...@@ -447,14 +560,13 @@ package body Bindo.Writers is
----------- -----------
procedure pige procedure pige
(G : Invocation_Graph; (G : Invocation_Graph;
IGE_Id : Invocation_Graph_Edge_Id) Edge : Invocation_Graph_Edge_Id) renames Write_Invocation_Graph_Edge;
renames Write_Invocation_Graph_Edge;
pragma Unreferenced (pige); pragma Unreferenced (pige);
procedure pigv procedure pigv
(G : Invocation_Graph; (G : Invocation_Graph;
IGV_Id : Invocation_Graph_Vertex_Id) Vertex : Invocation_Graph_Vertex_Id)
renames Write_Invocation_Graph_Vertex; renames Write_Invocation_Graph_Vertex;
pragma Unreferenced (pigv); pragma Unreferenced (pigv);
...@@ -498,7 +610,6 @@ package body Bindo.Writers is ...@@ -498,7 +610,6 @@ package body Bindo.Writers is
Iter := Iterate_Elaboration_Roots (G); Iter := Iterate_Elaboration_Roots (G);
while Has_Next (Iter) loop while Has_Next (Iter) loop
Next (Iter, Root); Next (Iter, Root);
pragma Assert (Present (Root));
Write_Elaboration_Root (G, Root); Write_Elaboration_Root (G, Root);
end loop; end loop;
...@@ -541,24 +652,22 @@ package body Bindo.Writers is ...@@ -541,24 +652,22 @@ package body Bindo.Writers is
--------------------------------- ---------------------------------
procedure Write_Invocation_Graph_Edge procedure Write_Invocation_Graph_Edge
(G : Invocation_Graph; (G : Invocation_Graph;
IGE_Id : Invocation_Graph_Edge_Id) Edge : Invocation_Graph_Edge_Id)
is is
pragma Assert (Present (G)); pragma Assert (Present (G));
pragma Assert (Present (IGE_Id)); pragma Assert (Present (Edge));
Targ : constant Invocation_Graph_Vertex_Id := Target (G, IGE_Id);
pragma Assert (Present (Targ)); Targ : constant Invocation_Graph_Vertex_Id := Target (G, Edge);
begin begin
Write_Str (" invocation graph edge (IGE_Id_"); Write_Str (" invocation graph edge (IGE_Id_");
Write_Int (Int (IGE_Id)); Write_Int (Int (Edge));
Write_Str (")"); Write_Str (")");
Write_Eol; Write_Eol;
Write_Str (" Relation (IR_Id_"); Write_Str (" Relation (IR_Id_");
Write_Int (Int (Relation (G, IGE_Id))); Write_Int (Int (Relation (G, Edge)));
Write_Str (")"); Write_Str (")");
Write_Eol; Write_Eol;
...@@ -577,16 +686,16 @@ package body Bindo.Writers is ...@@ -577,16 +686,16 @@ package body Bindo.Writers is
procedure Write_Invocation_Graph_Edges procedure Write_Invocation_Graph_Edges
(G : Invocation_Graph; (G : Invocation_Graph;
IGV_Id : Invocation_Graph_Vertex_Id) Vertex : Invocation_Graph_Vertex_Id)
is is
pragma Assert (Present (G)); pragma Assert (Present (G));
pragma Assert (Present (IGV_Id)); pragma Assert (Present (Vertex));
Num_Of_Edges : constant Natural := 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; Edge : Invocation_Graph_Edge_Id;
Iter : Invocation_Graphs.Edges_To_Targets_Iterator; Iter : Invocation_Graphs.Edges_To_Targets_Iterator;
begin begin
Write_Str (" Edges to targets: "); Write_Str (" Edges to targets: ");
...@@ -594,12 +703,11 @@ package body Bindo.Writers is ...@@ -594,12 +703,11 @@ package body Bindo.Writers is
Write_Eol; Write_Eol;
if Num_Of_Edges > 0 then 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 while Has_Next (Iter) loop
Next (Iter, IGE_Id); Next (Iter, Edge);
pragma Assert (Present (IGE_Id));
Write_Invocation_Graph_Edge (G, IGE_Id); Write_Invocation_Graph_Edge (G, Edge);
end loop; end loop;
else else
Write_Eol; Write_Eol;
...@@ -612,29 +720,34 @@ package body Bindo.Writers is ...@@ -612,29 +720,34 @@ package body Bindo.Writers is
procedure Write_Invocation_Graph_Vertex procedure Write_Invocation_Graph_Vertex
(G : Invocation_Graph; (G : Invocation_Graph;
IGV_Id : Invocation_Graph_Vertex_Id) Vertex : Invocation_Graph_Vertex_Id)
is is
begin begin
pragma Assert (Present (G)); pragma Assert (Present (G));
pragma Assert (Present (IGV_Id)); pragma Assert (Present (Vertex));
Write_Str ("invocation graph vertex (IGV_Id_"); Write_Str ("invocation graph vertex (IGV_Id_");
Write_Int (Int (IGV_Id)); Write_Int (Int (Vertex));
Write_Str (") name = "); 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_Eol;
Write_Str (" Construct (IC_Id_"); Write_Str (" Construct (IC_Id_");
Write_Int (Int (Construct (G, IGV_Id))); Write_Int (Int (Construct (G, Vertex)));
Write_Str (")"); Write_Str (")");
Write_Eol; Write_Eol;
Write_Str (" Lib_Vertex (LGV_Id_"); Write_Str (" Spec_Vertex (LGV_Id_");
Write_Int (Int (Lib_Vertex (G, IGV_Id))); Write_Int (Int (Spec_Vertex (G, Vertex)));
Write_Str (")"); Write_Str (")");
Write_Eol; Write_Eol;
Write_Invocation_Graph_Edges (G, IGV_Id); Write_Invocation_Graph_Edges (G, Vertex);
end Write_Invocation_Graph_Vertex; end Write_Invocation_Graph_Vertex;
------------------------------------- -------------------------------------
...@@ -642,18 +755,17 @@ package body Bindo.Writers is ...@@ -642,18 +755,17 @@ package body Bindo.Writers is
------------------------------------- -------------------------------------
procedure Write_Invocation_Graph_Vertices (G : Invocation_Graph) is procedure Write_Invocation_Graph_Vertices (G : Invocation_Graph) is
IGV_Id : Invocation_Graph_Vertex_Id;
Iter : Invocation_Graphs.All_Vertex_Iterator; Iter : Invocation_Graphs.All_Vertex_Iterator;
Vertex : Invocation_Graph_Vertex_Id;
begin begin
pragma Assert (Present (G)); pragma Assert (Present (G));
Iter := Iterate_All_Vertices (G); Iter := Iterate_All_Vertices (G);
while Has_Next (Iter) loop while Has_Next (Iter) loop
Next (Iter, IGV_Id); Next (Iter, Vertex);
pragma Assert (Present (IGV_Id));
Write_Invocation_Graph_Vertex (G, IGV_Id); Write_Invocation_Graph_Vertex (G, Vertex);
end loop; end loop;
end Write_Invocation_Graph_Vertices; end Write_Invocation_Graph_Vertices;
...@@ -719,22 +831,22 @@ package body Bindo.Writers is ...@@ -719,22 +831,22 @@ package body Bindo.Writers is
procedure Write_Edges_To_Successors procedure Write_Edges_To_Successors
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id); Vertex : Library_Graph_Vertex_Id);
pragma Inline (Write_Edges_To_Successors); 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. -- G to standard output.
procedure Write_Library_Graph_Edge procedure Write_Library_Graph_Edge
(G : Library_Graph; (G : Library_Graph;
LGE_Id : Library_Graph_Edge_Id); Edge : Library_Graph_Edge_Id);
pragma Inline (Write_Library_Graph_Edge); 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 procedure Write_Library_Graph_Vertex
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id); Vertex : Library_Graph_Vertex_Id);
pragma Inline (Write_Library_Graph_Vertex); 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); procedure Write_Library_Graph_Vertices (G : Library_Graph);
pragma Inline (Write_Library_Graph_Vertices); pragma Inline (Write_Library_Graph_Vertices);
...@@ -755,13 +867,13 @@ package body Bindo.Writers is ...@@ -755,13 +867,13 @@ package body Bindo.Writers is
pragma Unreferenced (pc); pragma Unreferenced (pc);
procedure plge procedure plge
(G : Library_Graph; (G : Library_Graph;
LGE_Id : Library_Graph_Edge_Id) renames Write_Library_Graph_Edge; Edge : Library_Graph_Edge_Id) renames Write_Library_Graph_Edge;
pragma Unreferenced (plge); pragma Unreferenced (plge);
procedure plgv procedure plgv
(G : Library_Graph; (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); pragma Unreferenced (plgv);
--------------------- ---------------------
...@@ -797,7 +909,7 @@ package body Bindo.Writers is ...@@ -797,7 +909,7 @@ package body Bindo.Writers is
Comp : Component_Id) Comp : Component_Id)
is is
Iter : Component_Vertex_Iterator; Iter : Component_Vertex_Iterator;
LGV_Id : Library_Graph_Vertex_Id; Vertex : Library_Graph_Vertex_Id;
begin begin
pragma Assert (Present (G)); pragma Assert (Present (G));
...@@ -805,13 +917,12 @@ package body Bindo.Writers is ...@@ -805,13 +917,12 @@ package body Bindo.Writers is
Iter := Iterate_Component_Vertices (G, Comp); Iter := Iterate_Component_Vertices (G, Comp);
while Has_Next (Iter) loop while Has_Next (Iter) loop
Next (Iter, LGV_Id); Next (Iter, Vertex);
pragma Assert (Present (LGV_Id));
Write_Str (" library graph vertex (LGV_Id_"); Write_Str (" library graph vertex (LGV_Id_");
Write_Int (Int (LGV_Id)); Write_Int (Int (Vertex));
Write_Str (") name = "); Write_Str (") name = ");
Write_Name (Name (G, LGV_Id)); Write_Name (Name (G, Vertex));
Write_Eol; Write_Eol;
end loop; end loop;
...@@ -835,7 +946,6 @@ package body Bindo.Writers is ...@@ -835,7 +946,6 @@ package body Bindo.Writers is
Iter := Iterate_Components (G); Iter := Iterate_Components (G);
while Has_Next (Iter) loop while Has_Next (Iter) loop
Next (Iter, Comp); Next (Iter, Comp);
pragma Assert (Present (Comp));
Write_Component (G, Comp); Write_Component (G, Comp);
end loop; end loop;
...@@ -850,16 +960,16 @@ package body Bindo.Writers is ...@@ -850,16 +960,16 @@ package body Bindo.Writers is
procedure Write_Edges_To_Successors procedure Write_Edges_To_Successors
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id) Vertex : Library_Graph_Vertex_Id)
is is
pragma Assert (Present (G)); pragma Assert (Present (G));
pragma Assert (Present (LGV_Id)); pragma Assert (Present (Vertex));
Num_Of_Edges : constant Natural := 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; Edge : Library_Graph_Edge_Id;
LGE_Id : Library_Graph_Edge_Id; Iter : Edges_To_Successors_Iterator;
begin begin
Write_Str (" Edges to successors: "); Write_Str (" Edges to successors: ");
...@@ -867,12 +977,11 @@ package body Bindo.Writers is ...@@ -867,12 +977,11 @@ package body Bindo.Writers is
Write_Eol; Write_Eol;
if Num_Of_Edges > 0 then 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 while Has_Next (Iter) loop
Next (Iter, LGE_Id); Next (Iter, Edge);
pragma Assert (Present (LGE_Id));
Write_Library_Graph_Edge (G, LGE_Id); Write_Library_Graph_Edge (G, Edge);
end loop; end loop;
else else
Write_Eol; Write_Eol;
...@@ -913,26 +1022,23 @@ package body Bindo.Writers is ...@@ -913,26 +1022,23 @@ package body Bindo.Writers is
------------------------------ ------------------------------
procedure Write_Library_Graph_Edge procedure Write_Library_Graph_Edge
(G : Library_Graph; (G : Library_Graph;
LGE_Id : Library_Graph_Edge_Id) Edge : Library_Graph_Edge_Id)
is is
pragma Assert (Present (G)); pragma Assert (Present (G));
pragma Assert (Present (LGE_Id)); pragma Assert (Present (Edge));
Pred : constant Library_Graph_Vertex_Id := Predecessor (G, LGE_Id); Pred : constant Library_Graph_Vertex_Id := Predecessor (G, Edge);
Succ : constant Library_Graph_Vertex_Id := Successor (G, LGE_Id); Succ : constant Library_Graph_Vertex_Id := Successor (G, Edge);
pragma Assert (Present (Pred));
pragma Assert (Present (Succ));
begin begin
Write_Str (" library graph edge (LGE_Id_"); Write_Str (" library graph edge (LGE_Id_");
Write_Int (Int (LGE_Id)); Write_Int (Int (Edge));
Write_Str (")"); Write_Str (")");
Write_Eol; Write_Eol;
Write_Str (" Kind = "); Write_Str (" Kind = ");
Write_Str (Kind (G, LGE_Id)'Img); Write_Str (Kind (G, Edge)'Img);
Write_Eol; Write_Eol;
Write_Str (" Predecessor (LGV_Id_"); Write_Str (" Predecessor (LGV_Id_");
...@@ -956,22 +1062,20 @@ package body Bindo.Writers is ...@@ -956,22 +1062,20 @@ package body Bindo.Writers is
procedure Write_Library_Graph_Vertex procedure Write_Library_Graph_Vertex
(G : Library_Graph; (G : Library_Graph;
LGV_Id : Library_Graph_Vertex_Id) Vertex : Library_Graph_Vertex_Id)
is is
pragma Assert (Present (G)); pragma Assert (Present (G));
pragma Assert (Present (LGV_Id)); pragma Assert (Present (Vertex));
Item : constant Library_Graph_Vertex_Id := Item : constant Library_Graph_Vertex_Id :=
Corresponding_Item (G, LGV_Id); Corresponding_Item (G, Vertex);
U_Id : constant Unit_Id := Unit (G, LGV_Id); U_Id : constant Unit_Id := Unit (G, Vertex);
pragma Assert (Present (U_Id));
begin begin
Write_Str ("library graph vertex (LGV_Id_"); Write_Str ("library graph vertex (LGV_Id_");
Write_Int (Int (LGV_Id)); Write_Int (Int (Vertex));
Write_Str (") name = "); Write_Str (") name = ");
Write_Name (Name (G, LGV_Id)); Write_Name (Name (G, Vertex));
Write_Eol; Write_Eol;
if Present (Item) then if Present (Item) then
...@@ -986,7 +1090,7 @@ package body Bindo.Writers is ...@@ -986,7 +1090,7 @@ package body Bindo.Writers is
Write_Eol; Write_Eol;
Write_Str (" In_Elaboration_Order = "); Write_Str (" In_Elaboration_Order = ");
if In_Elaboration_Order (G, LGV_Id) then if In_Elaboration_Order (G, Vertex) then
Write_Str ("True"); Write_Str ("True");
else else
Write_Str ("False"); Write_Str ("False");
...@@ -994,11 +1098,11 @@ package body Bindo.Writers is ...@@ -994,11 +1098,11 @@ package body Bindo.Writers is
Write_Eol; Write_Eol;
Write_Str (" Pending_Predecessors = "); Write_Str (" Pending_Predecessors = ");
Write_Int (Int (Pending_Predecessors (G, LGV_Id))); Write_Int (Int (Pending_Predecessors (G, Vertex)));
Write_Eol; Write_Eol;
Write_Str (" Component (Comp_Id_"); Write_Str (" Component (Comp_Id_");
Write_Int (Int (Component (G, LGV_Id))); Write_Int (Int (Component (G, Vertex)));
Write_Str (")"); Write_Str (")");
Write_Eol; Write_Eol;
...@@ -1008,7 +1112,7 @@ package body Bindo.Writers is ...@@ -1008,7 +1112,7 @@ package body Bindo.Writers is
Write_Name (Name (U_Id)); Write_Name (Name (U_Id));
Write_Eol; Write_Eol;
Write_Edges_To_Successors (G, LGV_Id); Write_Edges_To_Successors (G, Vertex);
end Write_Library_Graph_Vertex; end Write_Library_Graph_Vertex;
---------------------------------- ----------------------------------
...@@ -1017,17 +1121,16 @@ package body Bindo.Writers is ...@@ -1017,17 +1121,16 @@ package body Bindo.Writers is
procedure Write_Library_Graph_Vertices (G : Library_Graph) is procedure Write_Library_Graph_Vertices (G : Library_Graph) is
Iter : Library_Graphs.All_Vertex_Iterator; Iter : Library_Graphs.All_Vertex_Iterator;
LGV_Id : Library_Graph_Vertex_Id; Vertex : Library_Graph_Vertex_Id;
begin begin
pragma Assert (Present (G)); pragma Assert (Present (G));
Iter := Iterate_All_Vertices (G); Iter := Iterate_All_Vertices (G);
while Has_Next (Iter) loop while Has_Next (Iter) loop
Next (Iter, LGV_Id); Next (Iter, Vertex);
pragma Assert (Present (LGV_Id));
Write_Library_Graph_Vertex (G, LGV_Id); Write_Library_Graph_Vertex (G, Vertex);
end loop; end loop;
end Write_Library_Graph_Vertices; end Write_Library_Graph_Vertices;
...@@ -1071,11 +1174,11 @@ package body Bindo.Writers is ...@@ -1071,11 +1174,11 @@ package body Bindo.Writers is
pragma Inline (Hash_File_Name); pragma Inline (Hash_File_Name);
-- Obtain the hash value of key Nam -- 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, (Element_Type => File_Name_Type,
"=" => "=", "=" => "=",
Hash => Hash_File_Name); Hash => Hash_File_Name);
use FS; use File_Name_Tables;
----------------------- -----------------------
-- Local subprograms -- -- Local subprograms --
......
gcc/ada/bindo-writers.ads
...@@ -81,6 +81,16 @@ package Bindo.Writers is ...@@ -81,6 +81,16 @@ package Bindo.Writers is
end ALI_Writers; 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 -- -- Elaboration_Order_Writers --
------------------------------- -------------------------------
......
gcc/ada/bindo.adb
...@@ -23,8 +23,11 @@ ...@@ -23,8 +23,11 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Binde;
with Debug; use Debug;
with Bindo.Elaborators; with Bindo.Elaborators;
use Bindo.Elaborators.Invocation_And_Library_Graph_Elaborators; use Bindo.Elaborators;
package body Bindo is package body Bindo is
...@@ -47,30 +50,44 @@ package body Bindo is ...@@ -47,30 +50,44 @@ package body Bindo is
-- - The flow of execution at elaboration time. -- - The flow of execution at elaboration time.
-- --
-- - Additional dependencies between units supplied to the binder by -- - 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 -- The library graph captures the dependencies between units expressed
-- time. -- 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 -- The strongly connected components of the library graph are computed.
-- between units.
-- --
-- The library graph is further augmented with additional information -- The order is obtained using a topological sort-like algorithm which
-- from the invocation graph by exploring the execution paths from a -- traverses the library graph and its strongly connected components in
-- unit with elaboration code to other external units. All strongly -- an attempt to order available units while enabling other units to be
-- 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
-- ordered. -- ordered.
-- --
-- * Diagnose elaboration circularities between units -- * Diagnose elaboration circularities between units
-- --
-- The library graph may contain at least one cycle, in which case no -- An elaboration circularity arrises when either
-- ordering is possible. --
-- - 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 -- -- Terminology --
...@@ -78,6 +95,8 @@ package body Bindo is ...@@ -78,6 +95,8 @@ package body Bindo is
-- * Component - A strongly connected component of a graph. -- * 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 root - A special invocation construct which denotes the
-- elaboration procedure of a unit. -- elaboration procedure of a unit.
-- --
...@@ -162,7 +181,11 @@ package body Bindo is ...@@ -162,7 +181,11 @@ package body Bindo is
-- | -- |
-- +------ | -------------- Diagnostics phase -------------------------+ -- +------ | -------------- 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 ...@@ -225,7 +248,37 @@ package body Bindo is
-- Diagnostics phase -- -- 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 -- -- Switches --
...@@ -236,6 +289,11 @@ package body Bindo is ...@@ -236,6 +289,11 @@ package body Bindo is
-- GNATbind outputs the contents of ALI table Invocation_Constructs -- GNATbind outputs the contents of ALI table Invocation_Constructs
-- and Invocation_Edges in textual format to standard output. -- 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 -- -d_I Output invocation graph
-- --
-- GNATbind outputs the invocation graph in text format to standard -- GNATbind outputs the invocation graph in text format to standard
...@@ -255,16 +313,20 @@ package body Bindo is ...@@ -255,16 +313,20 @@ package body Bindo is
-- GNATbind outputs the elaboration order in text format to standard -- GNATbind outputs the elaboration order in text format to standard
-- output. -- output.
-- --
-- -d_P Output cycle paths
--
-- GNATbind output the cycle paths in text format to standard output
--
-- -d_T Output elaboration order trace information -- -d_T Output elaboration order trace information
-- --
-- GNATbind outputs trace information on elaboration order activities -- GNATbind outputs trace information on elaboration order and cycle
-- to standard output. -- 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 -- GNATbind validates the invocation graph, library graph along with
-- and elaboration order by detecting inconsistencies and producing -- its cycles, and elaboration order by detecting inconsistencies and
-- error reports. -- producing error reports.
---------------------------------------- ----------------------------------------
-- Debugging elaboration order issues -- -- Debugging elaboration order issues --
...@@ -281,7 +343,20 @@ package body Bindo is ...@@ -281,7 +343,20 @@ package body Bindo is
Main_Lib_File : File_Name_Type) Main_Lib_File : File_Name_Type)
is is
begin 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 Find_Elaboration_Order;
end Bindo; end Bindo;
gcc/ada/debug.adb
...@@ -378,7 +378,7 @@ package body Debug is ...@@ -378,7 +378,7 @@ package body Debug is
-- d_A Output ALI invocation tables -- d_A Output ALI invocation tables
-- d_B -- d_B
-- d_C -- d_C Diagnose all cycles
-- d_D -- d_D
-- d_F -- d_F
-- d_G -- d_G
...@@ -390,13 +390,13 @@ package body Debug is ...@@ -390,13 +390,13 @@ package body Debug is
-- d_M -- d_M
-- d_N New bindo order -- d_N New bindo order
-- d_O Output elaboration order -- d_O Output elaboration order
-- d_P -- d_P Output cycle paths
-- d_Q -- d_Q
-- d_R -- d_R
-- d_S -- d_S
-- d_T Output elaboration order trace information -- d_T Output elaboration order and cycle detection trace information
-- d_U -- d_U
-- d_V Validate bindo graphs and order -- d_V Validate bindo cycles, graphs, and order
-- d_W -- d_W
-- d_X -- d_X
-- d_Y -- d_Y
...@@ -1150,22 +1150,27 @@ package body Debug is ...@@ -1150,22 +1150,27 @@ package body Debug is
-- d_A GNATBIND output the contents of all ALI invocation-related tables -- d_A GNATBIND output the contents of all ALI invocation-related tables
-- in textual format to standard output. -- 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 -- d_I GNATBIND outputs the contents of the invocation graph in textual
-- format to standard output. -- format to standard output.
--
-- d_L GNATBIND outputs the contents of the library graph in textual -- d_L GNATBIND outputs the contents of the library graph in textual
-- format to standard output. -- format to standard output.
--
-- d_N GNATBIND utilizes the elaboration order provided by bindo -- d_N GNATBIND utilizes the elaboration order provided by bindo
--
-- d_O GNATBIND outputs the elaboration order of units to standard output -- d_O GNATBIND outputs the elaboration order of units to standard output
--
-- d_T GNATBIND outputs trace information of elaboration order activities -- d_P GNATBIND outputs the cycle paths to standard output
-- to standard output.
-- -- d_T GNATBIND outputs trace information of elaboration order and cycle
-- d_V GNATBIND validates the invocation graph, library graph, SCC graph -- detection activities to standard output.
-- and elaboration order.
-- d_V GNATBIND validates the invocation graph, library graph along with
-- its cycles, and the elaboration order.
-------------------------------------------- --------------------------------------------
-- Documentation for gnatmake Debug Flags -- -- Documentation for gnatmake Debug Flags --
......
gcc/ada/gnatbind.adb
...@@ -26,7 +26,6 @@ ...@@ -26,7 +26,6 @@
with ALI; use ALI; with ALI; use ALI;
with ALI.Util; use ALI.Util; with ALI.Util; use ALI.Util;
with Bcheck; use Bcheck; with Bcheck; use Bcheck;
with Binde; use Binde;
with Binderr; use Binderr; with Binderr; use Binderr;
with Bindgen; use Bindgen; with Bindgen; use Bindgen;
with Bindo; use Bindo; with Bindo; use Bindo;
...@@ -883,14 +882,7 @@ begin ...@@ -883,14 +882,7 @@ begin
Elab_Order : Unit_Id_Table; Elab_Order : Unit_Id_Table;
begin begin
-- Use the invocation and library graph-based elaboration order Find_Elaboration_Order (Elab_Order, First_Main_Lib_File);
-- 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;
if Errors_Detected = 0 and then not Check_Only then if Errors_Detected = 0 and then not Check_Only then
Gen_Output_File Gen_Output_File
......
gcc/ada/lib-writ.adb
...@@ -59,65 +59,32 @@ with System.WCh_Con; use System.WCh_Con; ...@@ -59,65 +59,32 @@ with System.WCh_Con; use System.WCh_Con;
package body Lib.Writ is 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; function Present (N_Id : Name_Id) return Boolean;
pragma Inline (Present); pragma Inline (Present);
-- Determine whether a name with id N_Id exists -- Determine whether a name with id N_Id exists
function Scope (IS_Id : Invocation_Signature_Id) return Name_Id; procedure Write_Invocation_Construct (IC_Id : Invocation_Construct_Id);
pragma Inline (Scope); pragma Inline (Write_Invocation_Construct);
-- Obtain attribute Scope of an invocation signature with id IS_Id -- 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 procedure Write_Invocation_Graph_Attributes;
(IC_Id : Invocation_Construct_Id) return Invocation_Signature_Id; pragma Inline (Write_Invocation_Graph_Attributes);
pragma Inline (Signature); -- Write out the attributes of the invocation graph
-- Obtain attribute Signature of an invocation construct with id IC_Id
function Target procedure Write_Invocation_Relation (IR_Id : Invocation_Relation_Id);
(IR_Id : Invocation_Relation_Id) return Invocation_Signature_Id; pragma Inline (Write_Invocation_Relation);
pragma Inline (Target); -- Write invocation relation IR_Id to the ALI file
-- Obtain attribute Target of an invocation relation with id IR_Id
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); procedure Write_Unit_Name (N : Node_Id);
-- Used to write out the unit name for R (pragma Restriction) lines -- Used to write out the unit name for R (pragma Restriction) lines
...@@ -161,16 +128,6 @@ package body Lib.Writ is ...@@ -161,16 +128,6 @@ package body Lib.Writ is
OA_Setting => 'O'); OA_Setting => 'O');
end Add_Preprocessing_Dependency; 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 -- -- Ensure_System_Dependency --
------------------------------ ------------------------------
...@@ -252,92 +209,6 @@ package body Lib.Writ is ...@@ -252,92 +209,6 @@ package body Lib.Writ is
end; end;
end Ensure_System_Dependency; 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 -- -- Present --
------------- -------------
...@@ -347,40 +218,6 @@ package body Lib.Writ is ...@@ -347,40 +218,6 @@ package body Lib.Writ is
return N_Id /= No_Name; return N_Id /= No_Name;
end Present; 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 -- -- Write_ALI --
--------------- ---------------
...@@ -441,9 +278,6 @@ package body Lib.Writ is ...@@ -441,9 +278,6 @@ package body Lib.Writ is
-- this file (using Scan_ALI) and returns True. If no file exists, -- this file (using Scan_ALI) and returns True. If no file exists,
-- or the file is not up to date, then False is returned. -- 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); procedure Write_Unit_Information (Unit_Num : Unit_Number_Type);
-- Write out the library information for one unit for which code is -- Write out the library information for one unit for which code is
-- generated (includes unit line and with lines). -- generated (includes unit line and with lines).
...@@ -633,175 +467,6 @@ package body Lib.Writ is ...@@ -633,175 +467,6 @@ package body Lib.Writ is
end Update_Tables_From_ALI_File; 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 -- -- Write_Unit_Information --
---------------------------- ----------------------------
...@@ -2010,6 +1675,179 @@ package body Lib.Writ is ...@@ -2010,6 +1675,179 @@ package body Lib.Writ is
Close_Output_Library_Info; Close_Output_Library_Info;
end Write_ALI; 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 -- -- Write_Unit_Name --
--------------------- ---------------------
......
gcc/ada/lib-writ.ads
...@@ -880,18 +880,32 @@ package Lib.Writ is ...@@ -880,18 +880,32 @@ package Lib.Writ is
-- locations of all instances where the initial declaration of the -- locations of all instances where the initial declaration of the
-- construct appears. -- 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 -- When the line-kind denotes an invocation construct, line-attributes are
-- set as follows: -- 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 -- Attribute construct-kind is a Character which denotes the nature of
-- the construct. Table ALI.Invocation_Construct_Codes lists all legal -- the construct. Table ALI.Invocation_Construct_Codes lists all legal
-- values. -- 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 -- Attribute construct-body-placement is a Character which denotes the
-- placement of the construct's body within the unit. All legal values -- 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 -- Attribute construct-signature is the invocation signature of the
-- construct. -- construct.
...@@ -925,7 +939,7 @@ package Lib.Writ is ...@@ -925,7 +939,7 @@ package Lib.Writ is
-- Postcondition_Verification - related routine -- Postcondition_Verification - related routine
-- Protected_Entry_Call - not present -- Protected_Entry_Call - not present
-- Protected_Subprogram_Call - not present -- Protected_Subprogram_Call - not present
-- Task_Activation - related task object -- Task_Activation - not present
-- Task_Entry_Call - not present -- Task_Entry_Call - not present
-- Type_Initialization - related type -- Type_Initialization - related type
-- --
......
gcc/ada/libgnat/g-lists.adb
...@@ -337,6 +337,57 @@ package body GNAT.Lists is ...@@ -337,6 +337,57 @@ package body GNAT.Lists is
end if; end if;
end Ensure_Unlocked; 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 -- -- Find_Node --
--------------- ---------------
......
gcc/ada/libgnat/g-lists.ads
...@@ -117,6 +117,12 @@ package GNAT.Lists is ...@@ -117,6 +117,12 @@ package GNAT.Lists is
-- end of a list's lifetime. This action will raise Iterated if the -- end of a list's lifetime. This action will raise Iterated if the
-- list has outstanding iterators. -- 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; function First (L : Doubly_Linked_List) return Element_Type;
-- Obtain an element from the start of list L. This action will raise -- Obtain an element from the start of list L. This action will raise
-- List_Empty if the list is empty. -- List_Empty if the list is empty.
......
gcc/ada/sem_elab.adb
...@@ -11689,6 +11689,11 @@ package body Sem_Elab is ...@@ -11689,6 +11689,11 @@ package body Sem_Elab is
-- active scenarios. In_State is the current state of the Processing -- active scenarios. In_State is the current state of the Processing
-- phase. -- 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); procedure Record_Invocation_Path (In_State : Processing_In_State);
pragma Inline (Record_Invocation_Path); pragma Inline (Record_Invocation_Path);
-- Record the invocation relations found within the path represented in -- Record the invocation relations found within the path represented in
...@@ -11938,40 +11943,32 @@ package body Sem_Elab is ...@@ -11938,40 +11943,32 @@ package body Sem_Elab is
(Constr_Id : Entity_Id; (Constr_Id : Entity_Id;
In_State : Processing_In_State) In_State : Processing_In_State)
is 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; function Kind_Of (Id : Entity_Id) return Invocation_Construct_Kind;
pragma Inline (Kind_Of); pragma Inline (Kind_Of);
-- Obtain the invocation construct kind of arbitrary entity Id -- Obtain the invocation construct kind of arbitrary entity Id
function Placement_Of (Id : Entity_Id) return Body_Placement_Kind; function Spec_Placement_Of
pragma Inline (Placement_Of); (Id : Entity_Id) return Declaration_Placement_Kind;
-- Obtain the body placement of arbitrary entity Id pragma Inline (Spec_Placement_Of);
-- Obtain the placement of arbitrary entity Id's spec
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;
------------------ -----------------------
-- 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 := Id_Rep : constant Target_Rep_Id :=
Target_Representation_Of (Id, In_State); Target_Representation_Of (Id, In_State);
Body_Decl : constant Node_Id := Body_Declaration (Id_Rep); Body_Decl : constant Node_Id := Body_Declaration (Id_Rep);
...@@ -11981,21 +11978,23 @@ package body Sem_Elab is ...@@ -11981,21 +11978,23 @@ package body Sem_Elab is
-- The entity has a body -- The entity has a body
if Present (Body_Decl) then 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 -- Otherwise the entity must have a spec
else else
pragma Assert (Present (Spec_Decl)); pragma Assert (Present (Spec_Decl));
return Placement_Of_Node (Spec_Decl); return Declaration_Placement_Of_Node (Spec_Decl);
end if; 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); Main_Unit_Id : constant Entity_Id := Cunit_Entity (Main_Unit);
N_Unit_Id : constant Entity_Id := Find_Top_Unit (N); N_Unit_Id : constant Entity_Id := Find_Top_Unit (N);
...@@ -12039,11 +12038,50 @@ package body Sem_Elab is ...@@ -12039,11 +12038,50 @@ package body Sem_Elab is
else else
return In_Body; return In_Body;
end if; 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 -- Start of processing for Declare_Invocation_Construct
...@@ -12059,15 +12097,14 @@ package body Sem_Elab is ...@@ -12059,15 +12097,14 @@ package body Sem_Elab is
Set_Is_Saved_Construct (Constr_Id); 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 the construct in the ALI file
Add_Invocation_Construct Add_Invocation_Construct
(IC_Rec => IC_Rec, (Body_Placement => Body_Placement_Of (Constr_Id),
Update_Units => False); Kind => Kind_Of (Constr_Id),
Signature => Signature_Of (Constr_Id),
Spec_Placement => Spec_Placement_Of (Constr_Id),
Update_Units => False);
end Declare_Invocation_Construct; end Declare_Invocation_Construct;
------------------------------- -------------------------------
...@@ -12809,6 +12846,12 @@ package body Sem_Elab is ...@@ -12809,6 +12846,12 @@ package body Sem_Elab is
return; return;
end if; 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 -- Examine all library level invocation scenarios and perform DFS
-- traversals from each one. Encode a path in the ALI file of the -- traversals from each one. Encode a path in the ALI file of the
-- main unit if it reaches into an external unit. -- main unit if it reaches into an external unit.
...@@ -12824,6 +12867,30 @@ package body Sem_Elab is ...@@ -12824,6 +12867,30 @@ package body Sem_Elab is
Process_Main_Unit; Process_Main_Unit;
end Record_Invocation_Graph; 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 -- -- Record_Invocation_Path --
---------------------------- ----------------------------
...@@ -12882,6 +12949,10 @@ package body Sem_Elab is ...@@ -12882,6 +12949,10 @@ package body Sem_Elab is
(Extra : out Entity_Id; (Extra : out Entity_Id;
Kind : out Invocation_Kind) Kind : out Invocation_Kind)
is is
Targ_Rep : constant Target_Rep_Id :=
Target_Representation_Of (Targ_Id, In_State);
Spec_Decl : constant Node_Id := Spec_Declaration (Targ_Rep);
begin begin
-- Accept within a task body -- Accept within a task body
...@@ -12970,7 +13041,7 @@ package body Sem_Elab is ...@@ -12970,7 +13041,7 @@ package body Sem_Elab is
-- Postcondition verification -- Postcondition verification
elsif Is_Postconditions_Proc (Targ_Id) then elsif Is_Postconditions_Proc (Targ_Id) then
Extra := Find_Enclosing_Scope (Targ_Id); Extra := Find_Enclosing_Scope (Spec_Decl);
Kind := Postcondition_Verification; Kind := Postcondition_Verification;
-- Protected entry call -- Protected entry call
...@@ -13013,7 +13084,6 @@ package body Sem_Elab is ...@@ -13013,7 +13084,6 @@ package body Sem_Elab is
Extra : Entity_Id; Extra : Entity_Id;
Extra_Nam : Name_Id; Extra_Nam : Name_Id;
IR_Rec : Invocation_Relation_Record;
Kind : Invocation_Kind; Kind : Invocation_Kind;
Rel : Invoker_Target_Relation; Rel : Invoker_Target_Relation;
...@@ -13052,15 +13122,13 @@ package body Sem_Elab is ...@@ -13052,15 +13122,13 @@ package body Sem_Elab is
Extra_Nam := No_Name; Extra_Nam := No_Name;
end if; 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 the relation in the ALI file
Add_Invocation_Relation 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); Update_Units => False);
end Record_Invocation_Relation; end Record_Invocation_Relation;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment