+2019-07-05 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * ali.adb (For_Each_Invocation_Construct,
+ For_Each_Invocation_Relation): New version.
+ (Scan_ALI): Initialize field Invocation_Graph_Encoding.
+ (Set_Invocation_Graph_Encoding): Update the setting of the
+ invocation graph encoding.
+ * ali.ads: Move field Invocation_Graph_Encoding from Unit_Record
+ to ALI_Record because the encoding applies to the whole ALI,
+ rather than one of the units (spec or body) for which the ALI
+ file was created.
+ (For_Each_Invocation_Construct, For_Each_Invocation_Relation):
+ New version.
+ * bindo.adb: Update the section on switches. Complete the
+ section of debugging elaboration order issues.
+ (Find_Elaboration_Order): Prepare the routine for the switch
+ from the old to the new elaboration order mechanism.
+ * bindo-diagnostics.adb (Find_And_Output_Invocation_Paths):
+ Manage a visited set used by Visit_Vertex.
+ (Output_All_Cycles_Suggestions,
+ Output_Dynamic_Model_Suggestions): Clarify the nature of the
+ suggested switch.
+ (Output_Elaborate_Body_Transition): Update the diagnostic to
+ emit a better message.
+ (Output_Forced_Suggestions, Output_Full_Encoding_Suggestions):
+ Clarify the nature of the suggested switch.
+ (Visit_Vertex): Update the parameter profile to add a set of
+ invokers visited during the transition. This set prevents
+ infinite exploration of the graph in case the invocations are
+ recursive.
+ * bindo-elaborators.adb: Add a use clause for
+ Bindo.Writers.Dependency_Writers.
+ (Elaborate_Units_Common): Output the library graph after it has
+ been augmented with invocation edges. Output just the components
+ instead of outputting the whole library graph again.
+ (Elaborate_Units_Dynamic, Elaborate_Units_Static): Output the
+ dependencies as expressed in the library graph.
+ * bindo-units.adb (Invocation_Graph_Encoding): Update the
+ extraction of the invocation graph encoding.
+ * bindo-writers.adb: Add with and use clauses for Binderr and
+ Butil.
+ (palgc, plgc): New debug routine.
+ (Write_Components): Moved to the spec. Add a header for the
+ output.
+ (Write_Dependencies, Write_Dependencies_Of_Vertex,
+ Write_Dependency_Edge): New routine.
+ (Write_Elaboration_Order): Update the logic to follow the format
+ of Binde's order output.
+ (Write_Library_Graph): Do not output the components every time
+ the graph is written.
+ (Write_Unit): Output the invocation graph encoding of the unit.
+ Output the invocation constructs and relations for the unit
+ only.
+ * bindo-writers.ads (Write_Components): Moved from the body.
+ (Write_Dependencies): New routine.
+ * bindusg.adb: Prepare the routine for the switch from the old
+ to the new elaboration order mechanism.
+ * debug.adb: Binder switch -d_O is now not associated with any
+ functionality.
+ * einfo.adb (Is_Elaboration_Target): The attribute applies to
+ packages, as specified by the comment on the attribute usage.
+ * opt.ads: Add a global flag which controls the choice between
+ the new and the legacy elaboration order mechanism.
+ * sem_elab.adb: Add Package_Target to type Target_Kind.
+ (Build_Elaborate_Body_Procedure, Build_Elaborate_Procedure,
+ Build_Elaborate_Spec_Procedure, Check_Elaboration_Scenarios,
+ Check_SPARK_Model_In_Effect): Use Main_Unit_Entity to obtain the
+ entity of the main unit.
+ (Create_Package_Rep): New routine.
+ (Create_Target_Rep): Add processing for packages.
+ (Declaration_Placement_Of_Node, Has_Prior_Elaboration): Use
+ Main_Unit_Entity to obtain the entity of the main
+ unit.
+ (Invocation_Graph_Recording_OK): Prepare the routine for the
+ switch from the old to the new elaboration order mechanism.
+ (Main_Unit_Entity): New routine.
+ (Meet_Elaboration_Requirement,
+ Process_Conditional_ABE_Variable_Reference): Use
+ Main_Unit_Entity to obtain the entity of the main unit.
+ (Process_Invocation_Instantiation): New routine.
+ (Process_Invocation_Scenario): Add processing for
+ instantiations.
+ * switch-b.adb (Scan_Binder_Switches): Prepare the routine for
+ the switch from the old to the new elaboration order mechanism.
+
2019-07-05 Joffrey Huguet <huguet@adacore.com>
* libgnat/a-textio.adb: Add abstract state refinment.
end loop;
end For_Each_Invocation_Construct;
+ -----------------------------------
+ -- For_Each_Invocation_Construct --
+ -----------------------------------
+
+ procedure For_Each_Invocation_Construct
+ (U_Id : Unit_Id;
+ Processor : Invocation_Construct_Processor_Ptr)
+ is
+ pragma Assert (Present (U_Id));
+ pragma Assert (Processor /= null);
+
+ U_Rec : Unit_Record renames Units.Table (U_Id);
+
+ begin
+ for IC_Id in U_Rec.First_Invocation_Construct ..
+ U_Rec.Last_Invocation_Construct
+ loop
+ Processor.all (IC_Id);
+ end loop;
+ end For_Each_Invocation_Construct;
+
----------------------------------
-- For_Each_Invocation_Relation --
----------------------------------
end loop;
end For_Each_Invocation_Relation;
+ ----------------------------------
+ -- For_Each_Invocation_Relation --
+ ----------------------------------
+
+ procedure For_Each_Invocation_Relation
+ (U_Id : Unit_Id;
+ Processor : Invocation_Relation_Processor_Ptr)
+ is
+ pragma Assert (Present (U_Id));
+ pragma Assert (Processor /= null);
+
+ U_Rec : Unit_Record renames Units.Table (U_Id);
+
+ begin
+ for IR_Id in U_Rec.First_Invocation_Relation ..
+ U_Rec.Last_Invocation_Relation
+ loop
+ Processor.all (IR_Id);
+ end loop;
+ end For_Each_Invocation_Relation;
+
----------
-- Hash --
----------
First_Specific_Dispatching => Specific_Dispatching.Last + 1,
First_Unit => No_Unit_Id,
GNATprove_Mode => False,
+ Invocation_Graph_Encoding => No_Encoding,
Last_Interrupt_State => Interrupt_States.Last,
Last_Sdep => No_Sdep_Id,
Last_Specific_Dispatching => Specific_Dispatching.Last,
if Update_Units then
declare
Curr_Unit : Unit_Record renames Units.Table (Units.Last);
+ Curr_ALI : ALIs_Record renames ALIs.Table (Curr_Unit.My_ALI);
begin
- Curr_Unit.Invocation_Graph_Encoding := Kind;
+ Curr_ALI.Invocation_Graph_Encoding := Kind;
end;
end if;
end Set_Invocation_Graph_Encoding;
-- Last_Specific_Dispatching = First_Specific_Dispatching - 1. That
-- is why the 'Base reference is there, it can be one less than the
-- lower bound of the subtype. Not set if 'S' appears in Ignore_Lines.
+
+ 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.
end record;
No_Main_Priority : constant Int := -1;
Last_Arg : Arg_Id;
-- Id of last args table entry for this file
- Invocation_Graph_Encoding : Invocation_Graph_Encoding_Kind;
- -- The encoding format used to capture information about the invocation
- -- constructs and relations within the corresponding ALI file of this
- -- unit.
-
First_Invocation_Construct : Invocation_Construct_Id;
-- Id of the first invocation construct for this unit
pragma Inline (For_Each_Invocation_Construct);
-- Invoke Processor on each invocation construct
+ procedure For_Each_Invocation_Construct
+ (U_Id : Unit_Id;
+ Processor : Invocation_Construct_Processor_Ptr);
+ pragma Inline (For_Each_Invocation_Construct);
+ -- Invoke Processor on each invocation construct of unit U_Id
+
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
+ -- Invoke Processor on each invocation relation
+
+ procedure For_Each_Invocation_Relation
+ (U_Id : Unit_Id;
+ Processor : Invocation_Relation_Processor_Ptr);
+ pragma Inline (For_Each_Invocation_Relation);
+ -- Invoke Processor on each invocation relation of unit U_Id
function Invocation_Construct_Kind_To_Code
(Kind : Invocation_Construct_Kind) return Character;
Last_Vertex : Library_Graph_Vertex_Id;
Elaborated_Vertex : Library_Graph_Vertex_Id;
End_Vertex : Library_Graph_Vertex_Id;
+ Visited_Invokers : IGV_Sets.Membership_Set;
Path : IGE_Lists.Doubly_Linked_List;
Path_Id : in out Nat);
pragma Inline (Visit_Vertex);
-- 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.
+ -- terminates the traversal. Visited_Invoker is the set of all invokers
+ -- visited so far. All edges along the path are recorded in Path. Path_Id
+ -- is the id of the path.
-------------------------
-- Diagnose_All_Cycles --
is
Path : IGE_Lists.Doubly_Linked_List;
Path_Id : Nat;
+ Visited : IGV_Sets.Membership_Set;
begin
pragma Assert (Present (Inv_Graph));
Path := IGE_Lists.Create;
Path_Id := 1;
+ Visited := IGV_Sets.Create (Number_Of_Vertices (Inv_Graph));
-- Start a DFS traversal over the invocation graph, in an attempt to
-- reach Destination from Source. The actual start of the path is the
Last_Vertex => Source,
Elaborated_Vertex => Source,
End_Vertex => Destination,
+ Visited_Invokers => Visited,
Path => Path,
Path_Id => Path_Id);
IGE_Lists.Destroy (Path);
+ IGV_Sets.Destroy (Visited);
end Find_And_Output_Invocation_Paths;
---------------------------
if Number_Of_Cycles (G) > 1 and then not Debug_Flag_Underscore_CC then
Error_Msg_Info
- (" diagnose all circularities (-d_C)");
+ (" diagnose all circularities (binder switch -d_C)");
end if;
end Output_All_Cycles_Suggestions;
and then not Is_Dynamically_Elaborated (G)
then
Error_Msg_Info
- (" use the dynamic elaboration model (-gnatE)");
+ (" use the dynamic elaboration model (compiler switch -gnatE)");
end if;
end Output_Dynamic_Model_Suggestions;
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.
+ -- spec or body 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
+ --
+ -- spec Elaborate_Body
+ --
+ -- Actual_Destination
+ -- Source --> 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
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, Source);
- Error_Msg_Unit_2 := Name (G, Expected_Destination);
+ Error_Msg_Unit_1 := Name (G, Expected_Destination);
Error_Msg_Info
- (" unit $ has with clause for unit $");
+ (" unit $ is in the closure of pragma Elaborate_Body");
end if;
end Output_Elaborate_Body_Transition;
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");
+ (" remove the dependency of unit $ on unit $ from the argument of "
+ & "switch -f");
+ Error_Msg_Info
+ (" remove switch -f");
end Output_Forced_Suggestions;
------------------------------
if Invocation_Graph_Encoding (G, Succ) /= Full_Path_Encoding then
Error_Msg_Info
- (" use detailed invocation information (-gnatd_F)");
+ (" use detailed invocation information (compiler switch "
+ & "-gnatd_F)");
end if;
end if;
end Output_Full_Encoding_Suggestions;
Last_Vertex : Library_Graph_Vertex_Id;
Elaborated_Vertex : Library_Graph_Vertex_Id;
End_Vertex : Library_Graph_Vertex_Id;
+ Visited_Invokers : IGV_Sets.Membership_Set;
Path : IGE_Lists.Doubly_Linked_List;
Path_Id : in out Nat)
is
pragma Assert (Present (Last_Vertex));
pragma Assert (Present (Elaborated_Vertex));
pragma Assert (Present (End_Vertex));
+ pragma Assert (IGV_Sets.Present (Visited_Invokers));
pragma Assert (IGE_Lists.Present (Path));
-- The current invocation vertex resides within the end library vertex.
-- Otherwise extend the search for the end library vertex via all edges
-- to targets.
- else
+ elsif not IGV_Sets.Contains (Visited_Invokers, Invoker) then
+
+ -- Prepare for invoker backtracking
+
+ IGV_Sets.Insert (Visited_Invokers, Invoker);
+
+ -- Extend the search via all edges to targets
+
Iter := Iterate_Edges_To_Targets (Inv_Graph, Invoker);
while Has_Next (Iter) loop
Next (Iter, Edge);
Last_Vertex => Invoker_Vertex,
Elaborated_Vertex => Elaborated_Vertex,
End_Vertex => End_Vertex,
+ Visited_Invokers => Visited_Invokers,
Path => Path,
Path_Id => Path_Id);
IGE_Lists.Delete_Last (Path);
end loop;
+
+ -- Backtrack the invoker
+
+ IGV_Sets.Delete (Visited_Invokers, Invoker);
end if;
end Visit_Vertex;
with Bindo.Writers;
use Bindo.Writers;
use Bindo.Writers.ALI_Writers;
+use Bindo.Writers.Dependency_Writers;
use Bindo.Writers.Elaboration_Order_Writers;
use Bindo.Writers.Invocation_Graph_Writers;
use Bindo.Writers.Library_Graph_Writers;
-- to a unit that result in extra edges within the library graph.
Augment_Library_Graph (Inv_Graph, Lib_Graph);
+ Write_Library_Graph (Lib_Graph);
-- Create and output the component graph by collapsing all library
-- items into library units and traversing the library graph.
- Find_Components (Lib_Graph);
- Write_Library_Graph (Lib_Graph);
+ Find_Components (Lib_Graph);
+ Write_Components (Lib_Graph);
-- Traverse the library graph to determine the elaboration order of
-- units.
if Status = Order_OK then
Order := Mix_Order;
+ -- Output the dependencies of vertices when switch -e (output
+ -- complete list of elaboration order dependencies) is active.
+
+ Write_Dependencies (Mix_Lib_Graph);
+
-- The library graph contains an Elaborate_All circularity. There is
-- no point in re-elaborating the units without the information from
-- the invocation graph because the circularity will persist.
if Status = Order_OK then
Order := Dyn_Order;
+ -- Output the dependencies of vertices when switch -e (output
+ -- complete list of elaboration order dependencies) is active.
+
+ Write_Dependencies (Dyn_Lib_Graph);
+
-- Otherwise the library graph contains a circularity without the
-- extra information provided by the invocation graph. Diagnose
-- the circularity.
Order => Order,
Status => Status);
- -- The augmented library graph contains a circularity
+ -- The elaboration order is satisfactory. Output the dependencies of
+ -- vertices when switch -e (output complete list of elaboration order
+ -- dependencies) is active.
- if Status /= Order_OK then
+ if Status = Order_OK then
+ Write_Dependencies (Lib_Graph);
+
+ -- Otherwise the augmented library graph contains a circularity
+
+ else
Diagnose_Circularities
(Inv_Graph => Inv_Graph,
Lib_Graph => Lib_Graph);
pragma Assert (Present (U_Id));
U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
+ U_ALI : ALIs_Record renames ALI.ALIs.Table (U_Rec.My_ALI);
begin
- return U_Rec.Invocation_Graph_Encoding;
+ return U_ALI.Invocation_Graph_Encoding;
end Invocation_Graph_Encoding;
-------------------------------
-- --
------------------------------------------------------------------------------
-with Debug; use Debug;
-with Fname; use Fname;
-with Opt; use Opt;
-with Output; use Output;
+with Binderr; use Binderr;
+with Butil; use Butil;
+with Debug; use Debug;
+with Fname; use Fname;
+with Opt; use Opt;
+with Output; use Output;
with Bindo.Units;
use Bindo.Units;
Write_Int (Int (U_Rec.Last_Invocation_Relation));
Write_Str (")");
Write_Eol;
+
+ Write_Str (" Invocation_Graph_Encoding = ");
+ Write_Str (Invocation_Graph_Encoding (U_Id)'Img);
+ Write_Eol;
Write_Eol;
- For_Each_Invocation_Construct (Write_Invocation_Construct'Access);
- For_Each_Invocation_Relation (Write_Invocation_Relation'Access);
+ For_Each_Invocation_Construct
+ (U_Id => U_Id,
+ Processor => Write_Invocation_Construct'Access);
+
+ For_Each_Invocation_Relation
+ (U_Id => U_Id,
+ Processor => Write_Invocation_Relation'Access);
end Write_Unit;
-----------------------
pragma Inline (Write_Cyclic_Edge);
-- Write cyclic edge Edge of library graph G to standard
+ -----------
+ -- Debug --
+ -----------
+
+ procedure palgc (G : Library_Graph) renames Write_Cycles;
+ pragma Unreferenced (palgc);
+
+ procedure plgc
+ (G : Library_Graph;
+ Cycle : Library_Graph_Cycle_Id) renames Write_Cycle;
+ pragma Unreferenced (plgc);
+
-----------------
-- Write_Cycle --
-----------------
end Write_Cyclic_Edge;
end Cycle_Writers;
+ ------------------------
+ -- Dependency_Writers --
+ ------------------------
+
+ package body Dependency_Writers is
+
+ -----------------------
+ -- Local subprograms --
+ -----------------------
+
+ procedure Write_Dependencies_Of_Vertex
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id);
+ pragma Inline (Write_Dependencies_Of_Vertex);
+ -- Write the dependencies of vertex Vertex of library graph G to
+ -- standard output.
+
+ procedure Write_Dependency_Edge
+ (G : Library_Graph;
+ Edge : Library_Graph_Edge_Id);
+ pragma Inline (Write_Dependency_Edge);
+ -- Write the dependency described by edge Edge of library graph G to
+ -- standard output.
+
+ ------------------------
+ -- Write_Dependencies --
+ ------------------------
+
+ procedure Write_Dependencies (G : Library_Graph) is
+ Use_Formatting : constant Boolean := not Zero_Formatting;
+
+ Iter : Library_Graphs.All_Vertex_Iterator;
+ Vertex : Library_Graph_Vertex_Id;
+
+ begin
+ pragma Assert (Present (G));
+
+ -- Nothing to do when switch -e (output complete list of elaboration
+ -- order dependencies) is not in effect.
+
+ if not Elab_Dependency_Output then
+ return;
+ end if;
+
+ if Use_Formatting then
+ Write_Eol;
+ Write_Line ("ELABORATION ORDER DEPENDENCIES");
+ Write_Eol;
+ end if;
+
+ Info_Prefix_Suppress := True;
+
+ Iter := Iterate_All_Vertices (G);
+ while Has_Next (Iter) loop
+ Next (Iter, Vertex);
+
+ Write_Dependencies_Of_Vertex (G, Vertex);
+ end loop;
+
+ Info_Prefix_Suppress := False;
+
+ if Use_Formatting then
+ Write_Eol;
+ end if;
+ end Write_Dependencies;
+
+ ----------------------------------
+ -- Write_Dependencies_Of_Vertex --
+ ----------------------------------
+
+ procedure Write_Dependencies_Of_Vertex
+ (G : Library_Graph;
+ Vertex : Library_Graph_Vertex_Id)
+ is
+ Edge : Library_Graph_Edge_Id;
+ Iter : Edges_To_Successors_Iterator;
+
+ begin
+ pragma Assert (Present (G));
+ pragma Assert (Present (Vertex));
+
+ -- Nothing to do for internal and predefined units
+
+ if Is_Internal_Unit (G, Vertex)
+ or else Is_Predefined_Unit (G, Vertex)
+ then
+ return;
+ end if;
+
+ Iter := Iterate_Edges_To_Successors (G, Vertex);
+ while Has_Next (Iter) loop
+ Next (Iter, Edge);
+
+ Write_Dependency_Edge (G, Edge);
+ end loop;
+ end Write_Dependencies_Of_Vertex;
+
+ ---------------------------
+ -- Write_Dependency_Edge --
+ ---------------------------
+
+ procedure Write_Dependency_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
+ -- Nothing to do for internal and predefined units
+
+ if Is_Internal_Unit (G, Succ)
+ or else Is_Predefined_Unit (G, Succ)
+ then
+ return;
+ end if;
+
+ Error_Msg_Unit_1 := Name (G, Pred);
+ Error_Msg_Unit_2 := Name (G, Succ);
+ Error_Msg_Output
+ (Msg => " unit $ must be elaborated before unit $",
+ Info => True);
+
+ Error_Msg_Unit_1 := Name (G, Succ);
+ Error_Msg_Unit_2 := Name (G, Pred);
+
+ if Is_Elaborate_All_Edge (G, Edge) then
+ Error_Msg_Output
+ (Msg =>
+ " reason: unit $ has with clause and pragma "
+ & "Elaborate_All for unit $",
+ Info => True);
+
+ elsif Is_Elaborate_Body_Edge (G, Edge) then
+ Error_Msg_Output
+ (Msg => " reason: unit $ has with clause for unit $",
+ Info => True);
+
+ elsif Is_Elaborate_Edge (G, Edge) then
+ Error_Msg_Output
+ (Msg =>
+ " reason: unit $ has with clause and pragma Elaborate "
+ & "for unit $",
+ Info => True);
+
+ elsif Is_Forced_Edge (G, Edge) then
+ Error_Msg_Output
+ (Msg =>
+ " reason: unit $ has a dependency on unit $ forced by -f "
+ & "switch",
+ Info => True);
+
+ elsif Is_Invocation_Edge (G, Edge) then
+ Error_Msg_Output
+ (Msg =>
+ " reason: unit $ invokes a construct of unit $ at "
+ & "elaboration time",
+ Info => True);
+
+ else
+ pragma Assert (Is_With_Edge (G, Edge));
+
+ Error_Msg_Output
+ (Msg => " reason: unit $ has with clause for unit $",
+ Info => True);
+ end if;
+ end Write_Dependency_Edge;
+ end Dependency_Writers;
+
-------------------------------
-- Elaboration_Order_Writers --
-------------------------------
-----------------------------
procedure Write_Elaboration_Order (Order : Unit_Id_Table) is
+ Use_Formatting : constant Boolean := not Zero_Formatting;
+
begin
- -- Nothing to do when switch -d_O (output elaboration order) is not
- -- in effect.
+ -- Nothing to do when switch -l (output chosen elaboration order) is
+ -- not in effect.
- if not Debug_Flag_Underscore_OO then
+ if not Elab_Order_Output then
return;
end if;
- Write_Str ("Elaboration Order");
- Write_Eol;
- Write_Eol;
+ if Use_Formatting then
+ Write_Eol;
+ Write_Str ("ELABORATION ORDER");
+ Write_Eol;
+ end if;
Write_Units (Order);
- Write_Eol;
- Write_Str ("Elaboration Order end");
- Write_Eol;
-
- Write_Eol;
+ if Use_Formatting then
+ Write_Eol;
+ end if;
end Write_Elaboration_Order;
----------------
----------------
procedure Write_Unit (U_Id : Unit_Id) is
+ Use_Formatting : constant Boolean := not Zero_Formatting;
+
begin
pragma Assert (Present (U_Id));
- Write_Str ("unit (U_Id_");
- Write_Int (Int (U_Id));
- Write_Str (") name = ");
- Write_Name (Name (U_Id));
+ if Use_Formatting then
+ Write_Str (" ");
+ end if;
+
+ Write_Unit_Name (Name (U_Id));
Write_Eol;
end Write_Unit;
-- Write all vertices of component Comp of library graph G to standard
-- output.
- procedure Write_Components (G : Library_Graph);
- pragma Inline (Write_Components);
- -- Write all components of library graph G to standard output
-
procedure Write_Edges_To_Successors
(G : Library_Graph;
Vertex : Library_Graph_Vertex_Id);
Iter : Component_Iterator;
begin
+ -- Nothing to do when switch -d_L (output library item graph) is not
+ -- in effect.
+
+ if not Debug_Flag_Underscore_LL then
+ return;
+ end if;
+
+ Write_Str ("Library Graph components");
+ Write_Eol;
+ Write_Eol;
+
if Num_Of_Comps > 0 then
+ Write_Str ("Components: ");
+ Write_Num (Int (Num_Of_Comps));
+ Write_Eol;
+
Iter := Iterate_Components (G);
while Has_Next (Iter) loop
Next (Iter, Comp);
else
Write_Eol;
end if;
+
+ Write_Str ("Library Graph components end");
+ Write_Eol;
+
+ Write_Eol;
end Write_Components;
-------------------------------
Write_Statistics (G);
Write_Library_Graph_Vertices (G);
- Write_Components (G);
Write_Str ("Library Graph end");
Write_Eol;
---------------------
procedure Write_File_Name (Nam : File_Name_Type) is
+ Use_Formatting : constant Boolean := not Zero_Formatting;
+
begin
pragma Assert (Present (Nam));
- if not Zero_Formatting then
+ if Use_Formatting then
Write_Str (" ");
end if;
------------------------
procedure Write_Unit_Closure (Order : Unit_Id_Table) is
+ Use_Formatting : constant Boolean := not Zero_Formatting;
+
Set : Membership_Set;
begin
return;
end if;
- if not Zero_Formatting then
+ if Use_Formatting then
Write_Eol;
Write_Line ("REFERENCED SOURCES");
end if;
Destroy (Set);
- if not Zero_Formatting then
+ if Use_Formatting then
Write_Eol;
end if;
end Write_Unit_Closure;
end Cycle_Writers;
+ ------------------------
+ -- Dependency_Writers --
+ ------------------------
+
+ package Dependency_Writers is
+ procedure Write_Dependencies (G : Library_Graph);
+ -- Write all elaboration dependencies of the units represented by
+ -- vertices of library graph G.
+
+ end Dependency_Writers;
+
-------------------------------
-- Elaboration_Order_Writers --
-------------------------------
---------------------------
package Library_Graph_Writers is
+ procedure Write_Components (G : Library_Graph);
+ -- Write all components of library graph G to standard output
+
procedure Write_Library_Graph (G : Library_Graph);
-- Write library graph G to standard output
package body Bindo is
---------------------------------
- -- Elaboration order mechanism --
+ -- Elaboration-order mechanism --
---------------------------------
- -- The elaboration order (EO) mechanism implemented in this unit and its
+ -- The elaboration-order (EO) mechanism implemented in this unit and its
-- children has the following objectives:
--
-- * Find an ordering of all library items (historically referred to as
-- whose elaboration cannot be guaranteed.
--
-- - A detailed traceback of the cycle, showcasing the transition
- -- between units, along with any other elaboration order-related
+ -- between units, along with any other elaboration-order-related
-- information.
--
-- - A set of suggestions on how to break the cycle considering the
--
-- GNATbind utilizes the new bindo elaboration order
--
- -- -d_O Output elaboration order
- --
- -- GNATbind outputs the elaboration order in text format to standard
- -- output.
- --
-- -d_P Output cycle paths
--
-- GNATbind output the cycle paths in text format to standard output
--
- -- -d_T Output elaboration order trace information
+ -- -d_T Output elaboration-order trace information
--
- -- GNATbind outputs trace information on elaboration order and cycle
+ -- GNATbind outputs trace information on elaboration-order and cycle-
-- detection activities to standard output.
--
-- -d_V Validate bindo cycles, graphs, and order
-- GNATbind validates the invocation graph, library graph along with
-- its cycles, and elaboration order by detecting inconsistencies and
-- producing error reports.
+ --
+ -- -e Output complete list of elaboration-order dependencies
+ --
+ -- GNATbind outputs the dependencies between units to standard
+ -- output.
+ --
+ -- -f Force elaboration order from given file
+ --
+ -- GNATbind applies an additional set of edges to the library graph.
+ -- The edges are read from a file specified by the argument of the
+ -- flag.
+ --
+ -- -H Legacy elaboration-order model enabled
+ --
+ -- GNATbind uses the library-graph and heuristics-based elaboration-
+ -- order model.
+ --
+ -- -l Output chosen elaboration order
+ --
+ -- GNATbind outputs the elaboration order in text format to standard
+ -- output.
+ --
+ -- -p Pessimistic (worst-case) elaboration order
+ --
+ -- This switch is not used in Bindo and its children.
----------------------------------------
- -- Debugging elaboration order issues --
+ -- Debugging elaboration-order issues --
----------------------------------------
- -- ??? more on this later
+ -- Prior to debugging elaboration-order-related issues, enable all relevant
+ -- debug flags to collect as much information as possible. Depending on the
+ -- number of files in the bind, Bindo may emit anywhere between several MBs
+ -- to several hundred MBs of data to standard output. The switches are:
+ --
+ -- -d_A -d_C -d_I -d_L -d_P -d_T -d_V
+ --
+ -- Bindo offers several debugging routines that can be invoked from gdb.
+ -- Those are defined in the body of Bindo.Writers, in sections denoted by
+ -- header Debug. For quick reference, the routines are:
+ --
+ -- palgc -- print all library-graph cycles
+ -- pau -- print all units
+ -- pc -- print component
+ -- pige -- print invocation-graph edge
+ -- pigv -- print invocation-graph vertex
+ -- plgc -- print library-graph cycle
+ -- plge -- print library-graph edge
+ -- plgv -- print library-graph vertex
+ -- pu -- print units
+ --
+ -- * Invalid elaboration order
+ --
+ -- The elaboration order is invalid when:
+ --
+ -- - A unit that requires elaboration is missing from the order
+ -- - A unit that does not require elaboration is present in the order
+ --
+ -- Examine the output of the elaboration algorithm available via switch
+ -- -d_T to determine how the related units were included in or excluded
+ -- from the order. Determine whether the library graph contains all the
+ -- relevant edges for those units.
+ --
+ -- Units and routines of interest:
+ -- Bindo.Elaborators
+ -- Elaborate_Library_Graph
+ -- Elaborate_Units_Common
+ -- Elaborate_Units_Dynamic
+ -- Elaborate_Units_Static
+ --
+ -- * Invalid invocation graph
+ --
+ -- The invocation graph is invalid when:
+ --
+ -- - An edge lacks an attribute
+ -- - A vertex lacks an attribute
+ --
+ -- Find the malformed edge or vertex and determine which attribute is
+ -- missing. Examine the contents of the invocation-related ALI tables
+ -- available via switch -d_A. If the invocation construct or relation
+ -- is missing, verify the ALI file. If the ALI lacks all the relevant
+ -- information, then Sem_Elab most likely failed to discover a valid
+ -- elaboration path.
+ --
+ -- Units and routines of interest:
+ -- Bindo.Builders
+ -- Bindo.Graphs
+ -- Add_Edge
+ -- Add_Vertex
+ -- Build_Invocation_Graph
+ --
+ -- * Invalid library graph
+ --
+ -- The library graph is invalid when:
+ --
+ -- - An edge lacks an attribute
+ -- - A vertex lacks an attribute
+ --
+ -- Find the malformed edge or vertex and determine which attribute is
+ -- missing.
+ --
+ -- Units and routines of interest:
+ -- Bindo.Builders
+ -- Bindo.Graphs
+ -- Add_Edge
+ -- Add_Vertex
+ -- Build_Library_Graph
+ --
+ -- * Invalid library-graph cycle
+ --
+ -- A library-graph cycle is invalid when:
+ --
+ -- - It lacks enough edges to form a circuit
+ -- - At least one edge in the circuit is repeated
+ --
+ -- Find the malformed cycle and determine which attribute is missing.
+ --
+ -- Units and routines of interest:
+ -- Bindo.Graphs
+ -- Find_Cycles
----------------------------
-- Find_Elaboration_Order --
Main_Lib_File : File_Name_Type)
is
begin
- -- Use the invocation and library graph-based elaboration order when
+ -- ??? Enable the following code when switching from the old to the new
+ -- elaboration-order mechanism.
+
+ -- Use the library graph and heuristic-based elaboration order when
+ -- switch -H (legacy elaboration-order mode enabled).
+
+ -- if Legacy_Elaboration_Order then
+ -- Binde.Find_Elab_Order (Order, Main_Lib_File);
+
+ -- Otherwise use the invocation and library-graph-based elaboration
+ -- order.
+
+ -- else
+ -- Invocation_And_Library_Graph_Elaborators.Elaborate_Units
+ -- (Order => Order,
+ -- Main_Lib_File => Main_Lib_File);
+ -- end if;
+
+ -- ??? Remove the following code when switching from the old to the new
+ -- elaboration-order mechanism.
+
+ -- 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
(Order => Order,
Main_Lib_File => Main_Lib_File);
- -- Otherwise use the library graph and heuristic-based elaboration
+ -- Otherwise use the library-graph and heuristic-based elaboration
-- order.
else
Write_Line
(" -h Output this usage (help) information");
+ -- ??? Enable the following code when switching from the old to the new
+ -- elaboration-order mechanism.
+
+ -- Line for -H switch
+
+ -- Write_Line
+ -- (" -H Legacy elaboration-order model enabled");
+
-- Lines for -I switch
Write_Line
-- d_L Output library graph
-- d_M
-- d_N New bindo order
- -- d_O Output elaboration order
+ -- d_O
-- d_P Output cycle paths
-- d_Q
-- d_R
-- d_N GNATBIND utilizes the elaboration order provided by bindo
- -- d_O GNATBIND outputs the elaboration order of units to standard output
-
-- d_P GNATBIND outputs the cycle paths to standard output
-- d_T GNATBIND outputs trace information of elaboration order and cycle
function Is_Elaboration_Target (Id : Entity_Id) return Boolean is
begin
return
- Ekind_In (Id, E_Constant, E_Variable)
+ Ekind_In (Id, E_Constant, E_Package, E_Variable)
or else Is_Entry (Id)
or else Is_Generic_Unit (Id)
or else Is_Subprogram (Id)
-- Set to True when the pre-18.x access-before-elaboration model is to be
-- used. Modified by use of -gnatH.
+ Legacy_Elaboration_Order : Boolean := False;
+ -- GNATBIND
+ -- Set to True when the pre-20.x elaboration-order model is to be used.
+ -- Modified by use of -H.
+
Link_Only : Boolean := False;
-- GNATMAKE, GPRBUILD
-- Set to True to skip compile and bind steps (except when Bind_Only is
(Generic_Target,
-- A generic unit being instantiated
+ Package_Target,
+ -- The package form of an instantiation
+
Subprogram_Target,
-- An entry, operator, or subprogram being invoked, or aliased through
-- 'Access or 'Unrestricted_Access.
pragma Inline (Is_Same_Unit);
-- Determine whether entities Unit_1 and Unit_2 denote the same unit
+ function Main_Unit_Entity return Entity_Id;
+ pragma Inline (Main_Unit_Entity);
+ -- Return the entity of the main unit
+
function Non_Private_View (Typ : Entity_Id) return Entity_Id;
pragma Inline (Non_Private_View);
-- Return the full view of private type Typ if available, otherwise return
-- Elaboration_Checks which appears on the initial declaration of the
-- main unit.
- Install_Elaboration_Model (Unit_Entity (Cunit_Entity (Main_Unit)));
+ Install_Elaboration_Model (Unit_Entity (Main_Unit_Entity));
-- Examine the context of the main unit and record all units with prior
-- elaboration with respect to it.
-- because diagnostics on reads are relevant only for external
-- variables.
- if Is_Same_Unit (Unit_Id, Cunit_Entity (Main_Unit)) then
+ if Is_Same_Unit (Unit_Id, Main_Unit_Entity) then
null;
-- Nothing to do when the variable is already initialized. Note that
-- body of A elaborated <-- problem
--
-- The generation of an implicit pragma Elaborate_All (B) ensures
- -- that the elaboration order mechanism will not pick the above
+ -- that the elaboration-order mechanism will not pick the above
-- order.
--
-- An implicit Elaborate is NOT generated when the unit is subject
Elab_Body_OK : Boolean := False;
Same_Unit_OK : Boolean := False) return Boolean
is
- EA_Id : constant Elaboration_Attributes_Id :=
- Elaboration_Attributes_Of (Unit_Id);
-
- Main_Id : constant Entity_Id := Cunit_Entity (Main_Unit);
+ EA_Id : constant Elaboration_Attributes_Id :=
+ Elaboration_Attributes_Of (Unit_Id);
+ Main_Id : constant Entity_Id := Main_Unit_Entity;
Unit_Prag : constant Node_Id := Elab_Pragma (EA_Id);
Unit_With : constant Node_Id := With_Clause (EA_Id);
is
pragma Assert (Nam_In (Req_Nam, Name_Elaborate, Name_Elaborate_All));
- Main_Id : constant Entity_Id := Cunit_Entity (Main_Unit);
+ Main_Id : constant Entity_Id := Main_Unit_Entity;
Unit_Id : constant Entity_Id := Find_Top_Unit (Targ_Id);
procedure Elaboration_Requirement_Error;
pragma Inline (Create_Instantiation_Rep);
-- Create the representation of instantiation Inst
+ function Create_Package_Rep
+ (Pack_Id : Entity_Id) return Target_Rep_Record;
+ pragma Inline (Create_Package_Rep);
+ -- Create the representation of package Pack_Id
+
function Create_Protected_Entry_Rep
(PE_Id : Entity_Id) return Target_Rep_Record;
pragma Inline (Create_Protected_Entry_Rep);
return Rec;
end Create_Instantiation_Rep;
+ ------------------------
+ -- Create_Package_Rep --
+ ------------------------
+
+ function Create_Package_Rep
+ (Pack_Id : Entity_Id) return Target_Rep_Record
+ is
+ Rec : Target_Rep_Record;
+
+ begin
+ Rec.Kind := Package_Target;
+
+ Spec_And_Body_From_Entity
+ (Id => Pack_Id,
+ Body_Decl => Rec.Body_Decl,
+ Spec_Decl => Rec.Spec_Decl);
+
+ return Rec;
+ end Create_Package_Rep;
+
--------------------------------
-- Create_Protected_Entry_Rep --
--------------------------------
then
Rec := Create_Subprogram_Rep (Id);
+ elsif Ekind (Id) = E_Package then
+ Rec := Create_Package_Rep (Id);
+
else
pragma Assert (False);
return Rec;
-- Process invocation call scenario Call with representation Call_Rep.
-- In_State is the current state of the Processing phase.
+ procedure Process_Invocation_Instantiation
+ (Inst : Node_Id;
+ Inst_Rep : Scenario_Rep_Id;
+ In_State : Processing_In_State);
+ pragma Inline (Process_Invocation_Instantiation);
+ -- Process invocation instantiation scenario Inst with representation
+ -- Inst_Rep. In_State is the current state of the Processing phase.
+
procedure Process_Invocation_Scenario
(N : Node_Id;
In_State : Processing_In_State);
end if;
Spec_And_Body_From_Entity
- (Id => Cunit_Entity (Main_Unit),
+ (Id => Main_Unit_Entity,
Body_Decl => Body_Decl,
Spec_Decl => Spec_Decl);
Set_Ekind (Proc_Id, E_Procedure);
Set_Etype (Proc_Id, Standard_Void_Type);
- Set_Scope (Proc_Id, Unique_Entity (Cunit_Entity (Main_Unit)));
+ Set_Scope (Proc_Id, Unique_Entity (Main_Unit_Entity));
-- Create a dummy declaration for the elaboration procedure. The
-- declaration does not need to be syntactically legal, but must
end if;
Spec_And_Body_From_Entity
- (Id => Cunit_Entity (Main_Unit),
+ (Id => Main_Unit_Entity,
Body_Decl => Body_Decl,
Spec_Decl => Spec_Decl);
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 := Main_Unit_Entity;
N_Unit_Id : constant Entity_Id := Find_Top_Unit (N);
begin
Main_Cunit : constant Node_Id := Cunit (Main_Unit);
begin
+ -- ??? Remove the following use of the debug flag when switching from
+ -- the old to the new elaboration-order mechanism.
+
-- Nothing to do when switch -gnatd_G (encode invocation graph in ALI
-- files) is not in effect.
end if;
end Process_Invocation_Call;
+ --------------------------------------
+ -- Process_Invocation_Instantiation --
+ --------------------------------------
+
+ procedure Process_Invocation_Instantiation
+ (Inst : Node_Id;
+ Inst_Rep : Scenario_Rep_Id;
+ In_State : Processing_In_State)
+ is
+ pragma Unreferenced (Inst);
+
+ Gen_Id : constant Entity_Id := Target (Inst_Rep);
+
+ begin
+ -- Nothing to do when the generic appears within an internal unit
+
+ if In_Internal_Unit (Gen_Id) then
+ return;
+ end if;
+
+ -- The generic being instantiated resides within an external unit
+ --
+ -- Main unit External unit
+ -- +-----------+ +-------------+
+ -- | | | |
+ -- | Start ------------> Generic |
+ -- | | | |
+ -- +-----------+ +-------------+
+ --
+ -- Record the invocation path which originates from Start and reaches
+ -- the generic.
+
+ if not In_Extended_Main_Code_Unit (Gen_Id) then
+ Record_Invocation_Path (In_State);
+ end if;
+ end Process_Invocation_Instantiation;
+
---------------------------------
-- Process_Invocation_Scenario --
---------------------------------
In_State => In_State);
end if;
end if;
+
+ -- Instantiation
+
+ elsif Is_Suitable_Instantiation (Scen) then
+ Process_Invocation_Instantiation
+ (Inst => Scen,
+ Inst_Rep => Scenario_Representation_Of (Scen, In_State),
+ In_State => In_State);
end if;
-- Remove the current scenario from the stack of active scenarios
end if;
end Kill_Elaboration_Scenario;
+ ----------------------
+ -- Main_Unit_Entity --
+ ----------------------
+
+ function Main_Unit_Entity return Entity_Id is
+ begin
+ -- Note that Cunit_Entity (Main_Unit) is not reliable in the presence of
+ -- generic bodies and may return an outdated entity.
+
+ return Defining_Entity (Unit (Cunit (Main_Unit)));
+ end Main_Unit_Entity;
+
----------------------
-- Non_Private_View --
----------------------
-- emitted multiple times.
procedure Check_SPARK_Model_In_Effect is
- Spec_Id : constant Entity_Id :=
- Unique_Entity (Cunit_Entity (Main_Unit));
+ Spec_Id : constant Entity_Id := Unique_Entity (Main_Unit_Entity);
begin
-- Do not emit the warning multiple times as this creates useless
Ptr := Ptr + 1;
Usage_Requested := True;
+ -- ??? Enable the following code when switching from the old to the
+ -- new elaboration-order mechanism.
+
+ -- Processing for H switch
+
+ -- when 'H' =>
+ -- Ptr := Ptr + 1;
+ -- Legacy_Elaboration_Order := True;
+
-- Processing for i switch
when 'i' =>