From 75cfda8b4aa2cee4e62bcbc74f08f7628224b860 Mon Sep 17 00:00:00 2001 From: Hristian Kirtchev Date: Tue, 9 Jul 2019 07:55:00 +0000 Subject: [PATCH] [Ada] Task-related circularities in Elaboration order v4.0 This patch adds another suggestion to the elaboration order diagnostics. An elaboration circularity involving a task activation may be resolved through pragma Restrictions (No_Entry_Calls_In_Elaboration_Code). ------------ -- Source -- ------------ -- no_entry_calls.txt pragma Restrictions (No_Entry_Calls_In_Elaboration_Code); -- a.ads package A is task type Task_Typ is entry Start; end Task_Typ; procedure Proc; end A; -- a.adb with B; package body A is task body Task_Typ is begin accept Start; B.Proc; end Task_Typ; Elab : Task_Typ; procedure Proc is null; end A; -- b.ads package B is procedure Proc; end B; -- b.adb with A; package body B is procedure Proc is begin A.Proc; end Proc; end B; -- main.adb with A; -- +--> A spec B spec -- | ^ ^ ^ -- | | with | | -- | sbb | +----------------+ | sbb -- | | | | -- | | | Invocation | -- | A body ------------> B body -- | ^ | | -- | | Invocation | | -- | +------------------+ | -- | | -- | Invocation | -- +---------------------------+ -- -- The cycle is: -- -- A body --> A body procedure Main is begin null; end Main; ---------------------------- -- Compilation and output -- ---------------------------- $ gnatmake -f -q main.adb -gnatd_F $ gnatmake -f -q main.adb -gnatec=no_entry_calls.txt error: Elaboration circularity detected info: info: Reason: info: info: unit "a (body)" depends on its own elaboration info: info: Circularity: info: info: unit "a (body)" invokes a construct of unit "a (body)" at elaboration time info: path 1: info: elaboration of unit "a (body)" info: activation of local task declared at "a.ads":2:14 info: call to subprogram "proc" declared at "b.ads":2:14 info: call to subprogram "proc" declared at "a.ads":6:14 info: info: Suggestions: info: info: use pragma Restrictions (No_Entry_Calls_In_Elaboration_Code) info: use the dynamic elaboration model (compiler switch -gnatE) info: gnatmake: *** bind failed. 2019-07-09 Hristian Kirtchev gcc/ada/ * bindo.ads: Move type Precedence_Kind from the private to the visible part of the unit. * bindo-augmentors.adb: Remove the use of global data as it is bad practice. (Augment_Library_Graph): Update the parameter profile. (Is_Visited, Set_Is_Visited): Remove. (Visit_Elaboration_Root, Visit_Elaboration_Roots): Update the parameter profile and comment on usage. (Visit_Vertex): Likewise. Also keep track of which invocation edge activates a task. * bindo-augmentors.ads (Augment_Library_Graph): Update the parameter profile and comment on usage. * bindo-builders.adb (Create_Forced_Edge, Create_Spec_And_Body_Edge, Create_With_Edge): Update the call to Add_Edge. * bindo-diagnostics.adb: Add with end use clauses for Restrict and Rident. (Output_Dynamic_Model_Suggestions): Remove. (Output_Invocation_Related_Suggestions): New routine. (Output_Suggestions): Output all invocation-related suggestions together. * bindo-elaborators.adb: Remove types Comparator_Ptr and Predicate_Ptr. (Find_Best_Vertex): Update the parameter profile. * bindo-graphs.adb (Activates_Task): New routine. (Add_Body_Before_Spec_Edge): Update the call to Add_Edge_With_Return. (Add_Edge): Update the parameter profile and the call to Add_Edge_With_Return. (Add_Edge_With_Return): Update the parameter profile and comment on usage. (At_Least_One_Edge_Satisfies): New routine. (Contains_Elaborate_All_Edge): Reimplement. (Contains_Static_Successor_Edge, Contains_Task_Activation): New routine. (Contains_Weak_Static_Successor): Remove. (Is_Static_Successor_Edge): New routine. * bindo-graphs.ads: Add types LGE_Predicate_Ptr, LGV_Comparator_Ptr, and LGV_Predicate_Ptr. Update type Library_Graph_Edge_Attributes to capture whether an invocation edge activates a task. Update the value of No_Library_Graph_Edge_Attributes. (Activates_Task): Update the parameter profile and comment on usage. (Contains_Static_Successor_Edge, Contains_Task_Activation): New routines. (Contains_Weak_Static_Successor): Remove. * doc/gnat_ugn/elaboration_order_handling_in_gnat.rst: Update the documentation to reflect the new task-related advice. * gnat_ugn.texi: Regenerate. From-SVN: r273286 --- gcc/ada/ChangeLog | 53 ++++ gcc/ada/bindo-augmentors.adb | 146 +++++------ gcc/ada/bindo-augmentors.ads | 8 +- gcc/ada/bindo-builders.adb | 36 +-- gcc/ada/bindo-diagnostics.adb | 90 ++++--- gcc/ada/bindo-elaborators.adb | 17 +- gcc/ada/bindo-graphs.adb | 230 ++++++++++++------ gcc/ada/bindo-graphs.ads | 52 +++- gcc/ada/bindo.ads | 18 +- .../elaboration_order_handling_in_gnat.rst | 17 ++ gcc/ada/gnat_ugn.texi | 23 ++ 11 files changed, 441 insertions(+), 249 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b89bb8ff3f9..66de5272698 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,56 @@ +2019-07-09 Hristian Kirtchev + + * bindo.ads: Move type Precedence_Kind from the private to the + visible part of the unit. + * bindo-augmentors.adb: Remove the use of global data as it is + bad practice. + (Augment_Library_Graph): Update the parameter profile. + (Is_Visited, Set_Is_Visited): Remove. + (Visit_Elaboration_Root, Visit_Elaboration_Roots): Update the + parameter profile and comment on usage. + (Visit_Vertex): Likewise. Also keep track of which invocation + edge activates a task. + * bindo-augmentors.ads (Augment_Library_Graph): Update the + parameter profile and comment on usage. + * bindo-builders.adb (Create_Forced_Edge, + Create_Spec_And_Body_Edge, Create_With_Edge): Update the call to + Add_Edge. + * bindo-diagnostics.adb: Add with end use clauses for Restrict + and Rident. + (Output_Dynamic_Model_Suggestions): Remove. + (Output_Invocation_Related_Suggestions): New routine. + (Output_Suggestions): Output all invocation-related suggestions + together. + * bindo-elaborators.adb: Remove types Comparator_Ptr and + Predicate_Ptr. + (Find_Best_Vertex): Update the parameter profile. + * bindo-graphs.adb (Activates_Task): New routine. + (Add_Body_Before_Spec_Edge): Update the call to + Add_Edge_With_Return. + (Add_Edge): Update the parameter profile and the call to + Add_Edge_With_Return. + (Add_Edge_With_Return): Update the parameter profile and comment + on usage. + (At_Least_One_Edge_Satisfies): New routine. + (Contains_Elaborate_All_Edge): Reimplement. + (Contains_Static_Successor_Edge, Contains_Task_Activation): New + routine. + (Contains_Weak_Static_Successor): Remove. + (Is_Static_Successor_Edge): New routine. + * bindo-graphs.ads: Add types LGE_Predicate_Ptr, + LGV_Comparator_Ptr, and LGV_Predicate_Ptr. Update type + Library_Graph_Edge_Attributes to capture whether an invocation + edge activates a task. Update the value of + No_Library_Graph_Edge_Attributes. + (Activates_Task): Update the parameter profile and comment on + usage. + (Contains_Static_Successor_Edge, Contains_Task_Activation): New + routines. + (Contains_Weak_Static_Successor): Remove. + * doc/gnat_ugn/elaboration_order_handling_in_gnat.rst: + Update the documentation to reflect the new task-related advice. + * gnat_ugn.texi: Regenerate. + 2019-07-09 Piotr Trojanek * exp_util.adb (Containing_Package_With_Ext_Axioms): Replace diff --git a/gcc/ada/bindo-augmentors.adb b/gcc/ada/bindo-augmentors.adb index af394643287..bb68a2e4ca5 100644 --- a/gcc/ada/bindo-augmentors.adb +++ b/gcc/ada/bindo-augmentors.adb @@ -37,14 +37,6 @@ package body Bindo.Augmentors is package body Library_Graph_Augmentors is - ----------------- - -- Global data -- - ----------------- - - Inv_Graph : Invocation_Graph := Invocation_Graphs.Nil; - Lib_Graph : Library_Graph := Library_Graphs.Nil; - Visited : IGV_Sets.Membership_Set := IGV_Sets.Nil; - ---------------- -- Statistics -- ---------------- @@ -61,20 +53,10 @@ package body Bindo.Augmentors is -- Local subprograms -- ----------------------- - function Is_Visited - (Vertex : Invocation_Graph_Vertex_Id) return Boolean; - pragma Inline (Is_Visited); - -- Determine whether invocation graph vertex Vertex has been visited - -- during the traversal. - - procedure Set_Is_Visited - (Vertex : Invocation_Graph_Vertex_Id; - Val : Boolean := True); - pragma Inline (Set_Is_Visited); - -- Mark invocation graph vertex Vertex as visited during the traversal - -- depending on value Val. - - procedure Visit_Elaboration_Root (Root : Invocation_Graph_Vertex_Id); + procedure Visit_Elaboration_Root + (Inv_Graph : Invocation_Graph; + Lib_Graph : Library_Graph; + Root : Invocation_Graph_Vertex_Id); pragma Inline (Visit_Elaboration_Root); -- Start a DFS traversal from elaboration root Root to: -- @@ -83,7 +65,9 @@ package body Bindo.Augmentors is -- * Create invocation edges for each such transition where the -- successor is Root. - procedure Visit_Elaboration_Roots; + procedure Visit_Elaboration_Roots + (Inv_Graph : Invocation_Graph; + Lib_Graph : Library_Graph); pragma Inline (Visit_Elaboration_Roots); -- Start a DFS traversal from all elaboration roots to: -- @@ -93,9 +77,13 @@ package body Bindo.Augmentors is -- successor is the current root. procedure Visit_Vertex - (Invoker : Invocation_Graph_Vertex_Id; + (Inv_Graph : Invocation_Graph; + Lib_Graph : Library_Graph; + Invoker : Invocation_Graph_Vertex_Id; Last_Vertex : Library_Graph_Vertex_Id; Root_Vertex : Library_Graph_Vertex_Id; + Visited_Invokers : IGV_Sets.Membership_Set; + Activates_Task : Boolean; Internal_Controlled_Action : Boolean; Path : Natural); pragma Inline (Visit_Vertex); @@ -124,86 +112,56 @@ package body Bindo.Augmentors is --------------------------- procedure Augment_Library_Graph - (Inv_G : Invocation_Graph; - Lib_G : Library_Graph) + (Inv_Graph : Invocation_Graph; + Lib_Graph : Library_Graph) is begin - pragma Assert (Present (Lib_G)); + pragma Assert (Present (Lib_Graph)); -- Nothing to do when there is no invocation graph - if not Present (Inv_G) then + if not Present (Inv_Graph) then return; end if; - -- Prepare the global data. Note that Visited is initialized for each - -- elaboration root. + -- Prepare the statistics data - Inv_Graph := Inv_G; - Lib_Graph := Lib_G; Longest_Path := 0; Total_Visited := 0; - Visit_Elaboration_Roots; + Visit_Elaboration_Roots (Inv_Graph, Lib_Graph); Write_Statistics; end Augment_Library_Graph; - ---------------- - -- Is_Visited -- - ---------------- - - function Is_Visited - (Vertex : Invocation_Graph_Vertex_Id) return Boolean - is - begin - pragma Assert (IGV_Sets.Present (Visited)); - pragma Assert (Present (Vertex)); - - return IGV_Sets.Contains (Visited, Vertex); - end Is_Visited; - - -------------------- - -- Set_Is_Visited -- - -------------------- - - procedure Set_Is_Visited - (Vertex : Invocation_Graph_Vertex_Id; - Val : Boolean := True) - is - begin - pragma Assert (IGV_Sets.Present (Visited)); - pragma Assert (Present (Vertex)); - - if Val then - IGV_Sets.Insert (Visited, Vertex); - else - IGV_Sets.Delete (Visited, Vertex); - end if; - end Set_Is_Visited; - ---------------------------- -- Visit_Elaboration_Root -- ---------------------------- - procedure Visit_Elaboration_Root (Root : Invocation_Graph_Vertex_Id) is + procedure Visit_Elaboration_Root + (Inv_Graph : Invocation_Graph; + Lib_Graph : Library_Graph; + Root : Invocation_Graph_Vertex_Id) + is pragma Assert (Present (Inv_Graph)); - pragma Assert (Present (Root)); pragma Assert (Present (Lib_Graph)); + pragma Assert (Present (Root)); Root_Vertex : constant Library_Graph_Vertex_Id := Body_Vertex (Inv_Graph, Root); - pragma Assert (Present (Root_Vertex)); + Visited : IGV_Sets.Membership_Set; begin - -- Prepare the global data - Visited := IGV_Sets.Create (Number_Of_Vertices (Inv_Graph)); Visit_Vertex - (Invoker => Root, + (Inv_Graph => Inv_Graph, + Lib_Graph => Lib_Graph, + Invoker => Root, Last_Vertex => Root_Vertex, Root_Vertex => Root_Vertex, + Visited_Invokers => Visited, + Activates_Task => False, Internal_Controlled_Action => False, Path => 0); @@ -214,18 +172,25 @@ package body Bindo.Augmentors is -- Visit_Elaboration_Roots -- ----------------------------- - procedure Visit_Elaboration_Roots is + procedure Visit_Elaboration_Roots + (Inv_Graph : Invocation_Graph; + Lib_Graph : Library_Graph) + is Iter : Elaboration_Root_Iterator; Root : Invocation_Graph_Vertex_Id; begin pragma Assert (Present (Inv_Graph)); + pragma Assert (Present (Lib_Graph)); Iter := Iterate_Elaboration_Roots (Inv_Graph); while Has_Next (Iter) loop Next (Iter, Root); - Visit_Elaboration_Root (Root); + Visit_Elaboration_Root + (Inv_Graph => Inv_Graph, + Lib_Graph => Lib_Graph, + Root => Root); end loop; end Visit_Elaboration_Roots; @@ -234,15 +199,20 @@ package body Bindo.Augmentors is ------------------ procedure Visit_Vertex - (Invoker : Invocation_Graph_Vertex_Id; + (Inv_Graph : Invocation_Graph; + Lib_Graph : Library_Graph; + Invoker : Invocation_Graph_Vertex_Id; Last_Vertex : Library_Graph_Vertex_Id; Root_Vertex : Library_Graph_Vertex_Id; + Visited_Invokers : IGV_Sets.Membership_Set; + Activates_Task : Boolean; Internal_Controlled_Action : Boolean; Path : Natural) is New_Path : constant Natural := Path + 1; Edge : Invocation_Graph_Edge_Id; + Edge_Kind : Invocation_Kind; Invoker_Vertex : Library_Graph_Vertex_Id; Iter : Edges_To_Targets_Iterator; @@ -252,15 +222,16 @@ package body Bindo.Augmentors is pragma Assert (Present (Invoker)); pragma Assert (Present (Last_Vertex)); pragma Assert (Present (Root_Vertex)); + pragma Assert (IGV_Sets.Present (Visited_Invokers)); -- Nothing to do when the current invocation graph vertex has already -- been visited. - if Is_Visited (Invoker) then + if IGV_Sets.Contains (Visited_Invokers, Invoker) then return; end if; - Set_Is_Visited (Invoker); + IGV_Sets.Insert (Visited_Invokers, Invoker); -- Update the statistics @@ -294,10 +265,11 @@ package body Bindo.Augmentors is else Add_Edge - (G => Lib_Graph, - Pred => Invoker_Vertex, - Succ => Root_Vertex, - Kind => Invocation_Edge); + (G => Lib_Graph, + Pred => Invoker_Vertex, + Succ => Root_Vertex, + Kind => Invocation_Edge, + Activates_Task => Activates_Task); end if; end if; @@ -307,15 +279,21 @@ package body Bindo.Augmentors is Iter := Iterate_Edges_To_Targets (Inv_Graph, Invoker); while Has_Next (Iter) loop Next (Iter, Edge); + Edge_Kind := Kind (Inv_Graph, Edge); Visit_Vertex - (Invoker => Target (Inv_Graph, Edge), + (Inv_Graph => Inv_Graph, + Lib_Graph => Lib_Graph, + Invoker => Target (Inv_Graph, Edge), Last_Vertex => Invoker_Vertex, Root_Vertex => Root_Vertex, + Visited_Invokers => Visited_Invokers, + Activates_Task => + Activates_Task + or else Edge_Kind = Task_Activation, Internal_Controlled_Action => Internal_Controlled_Action - or else Kind (Inv_Graph, Edge) in - Internal_Controlled_Invocation_Kind, + or else Edge_Kind in Internal_Controlled_Invocation_Kind, Path => New_Path); end loop; end Visit_Vertex; diff --git a/gcc/ada/bindo-augmentors.ads b/gcc/ada/bindo-augmentors.ads index de6317cca41..c00d5c0a916 100644 --- a/gcc/ada/bindo-augmentors.ads +++ b/gcc/ada/bindo-augmentors.ads @@ -43,10 +43,10 @@ package Bindo.Augmentors is package Library_Graph_Augmentors is procedure Augment_Library_Graph - (Inv_G : Invocation_Graph; - Lib_G : Library_Graph); - -- Augment library graph Lib_G with information from invocation graph - -- Inv_G as follows: + (Inv_Graph : Invocation_Graph; + Lib_Graph : Library_Graph); + -- Augment library graph Lib_Graph with information from invocation + -- graph Inv_Graph as follows: -- -- 1) Traverse the invocation graph starting from each elaboration -- procedure of unit Root. diff --git a/gcc/ada/bindo-builders.adb b/gcc/ada/bindo-builders.adb index 233891d12e4..351b10d8fc8 100644 --- a/gcc/ada/bindo-builders.adb +++ b/gcc/ada/bindo-builders.adb @@ -415,10 +415,11 @@ package body Bindo.Builders is Write_Eol; Add_Edge - (G => Lib_Graph, - Pred => Pred_Vertex, - Succ => Succ_Vertex, - Kind => Forced_Edge); + (G => Lib_Graph, + Pred => Pred_Vertex, + Succ => Succ_Vertex, + Kind => Forced_Edge, + Activates_Task => False); end Create_Forced_Edge; ------------------------- @@ -497,10 +498,11 @@ package body Bindo.Builders is Set_Corresponding_Item (Lib_Graph, Vertex, Extra_Vertex); Add_Edge - (G => Lib_Graph, - Pred => Extra_Vertex, - Succ => Vertex, - Kind => Spec_Before_Body_Edge); + (G => Lib_Graph, + Pred => Extra_Vertex, + Succ => Vertex, + Kind => Spec_Before_Body_Edge, + Activates_Task => False); -- The unit denotes a spec with a completing body. Link the spec and -- body. @@ -570,12 +572,13 @@ package body Bindo.Builders is if Is_Spec_With_Body (Lib_Graph, Withed_Vertex) then Add_Edge - (G => Lib_Graph, - Pred => + (G => Lib_Graph, + Pred => Corresponding_Vertex (Lib_Graph, Corresponding_Body (Withed_U_Id)), - Succ => Succ, - Kind => Kind); + Succ => Succ, + Kind => Kind, + Activates_Task => False); end if; -- The with comes with pragma Elaborate_All. Treat the edge as a with @@ -597,10 +600,11 @@ package body Bindo.Builders is -- successor. Add_Edge - (G => Lib_Graph, - Pred => Withed_Vertex, - Succ => Succ, - Kind => Kind); + (G => Lib_Graph, + Pred => Withed_Vertex, + Succ => Succ, + Kind => Kind, + Activates_Task => False); end Create_With_Edge; ----------------------- diff --git a/gcc/ada/bindo-diagnostics.adb b/gcc/ada/bindo-diagnostics.adb index 9cd9d68edbe..9dbdfc0c067 100644 --- a/gcc/ada/bindo-diagnostics.adb +++ b/gcc/ada/bindo-diagnostics.adb @@ -23,9 +23,11 @@ -- -- ------------------------------------------------------------------------------ -with Binderr; use Binderr; -with Debug; use Debug; -with Types; use Types; +with Binderr; use Binderr; +with Debug; use Debug; +with Restrict; use Restrict; +with Rident; use Rident; +with Types; use Types; with Bindo.Validators; use Bindo.Validators; @@ -77,13 +79,6 @@ package body Bindo.Diagnostics is -- 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; @@ -192,6 +187,13 @@ package body Bindo.Diagnostics is -- 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_Related_Suggestions + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id); + pragma Inline (Output_Invocation_Related_Suggestions); + -- Suggest ways to break cycle Cycle of library graph G that involves at + -- least one invocation edge. + procedure Output_Invocation_Transition (Inv_Graph : Invocation_Graph; Lib_Graph : Library_Graph; @@ -522,30 +524,6 @@ package body Bindo.Diagnostics is 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 where the successor - -- was statically elaborated. Using the dynamic model may eliminate an - -- invocation edge, and thus the cycle. - - if Invocation_Edge_Count (G, Cycle) > 0 - and then Contains_Weak_Static_Successor (G, Cycle) - then - Error_Msg_Info - (" use the dynamic elaboration model (compiler switch -gnatE)"); - end if; - end Output_Dynamic_Model_Suggestions; - -------------------------------------- -- Output_Elaborate_All_Suggestions -- -------------------------------------- @@ -1155,6 +1133,48 @@ package body Bindo.Diagnostics is end case; end Output_Invocation_Path_Transition; + ------------------------------------------- + -- Output_Invocation_Related_Suggestions -- + ------------------------------------------- + + procedure Output_Invocation_Related_Suggestions + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Cycle)); + + -- Nothing to do when the cycle does not contain an invocation edge + + if Invocation_Edge_Count (G, Cycle) = 0 then + return; + end if; + + -- The cycle contains at least one invocation edge, where at least + -- one of the paths the edge represents activates a task. The use of + -- restriction No_Entry_Calls_In_Elaboration_Code may halt the flow + -- within the task body on a select or accept statement, eliminating + -- subsequent invocation edges, thus breaking the cycle. + + if not Restriction_Active (No_Entry_Calls_In_Elaboration_Code) + and then Contains_Task_Activation (G, Cycle) + then + Error_Msg_Info + (" use pragma Restrictions " + & "(No_Entry_Calls_In_Elaboration_Code)"); + end if; + + -- The cycle contains at least one invocation edge where the successor + -- was statically elaborated. The use of the dynamic model may remove + -- one of the invocation edges in the cycle, thus breaking the cycle. + + if Contains_Static_Successor_Edge (G, Cycle) then + Error_Msg_Info + (" use the dynamic elaboration model (compiler switch -gnatE)"); + end if; + end Output_Invocation_Related_Suggestions; + ---------------------------------- -- Output_Invocation_Transition -- ---------------------------------- @@ -1257,7 +1277,7 @@ package body Bindo.Diagnostics is -- Output general purpose suggestions - Output_Dynamic_Model_Suggestions + Output_Invocation_Related_Suggestions (G => G, Cycle => Cycle); diff --git a/gcc/ada/bindo-elaborators.adb b/gcc/ada/bindo-elaborators.adb index 192e4a228ed..6d3a1e242cd 100644 --- a/gcc/ada/bindo-elaborators.adb +++ b/gcc/ada/bindo-elaborators.adb @@ -180,20 +180,11 @@ package body Bindo.Elaborators is -- can be elaborated. Step is the current step in the elaboration order. -- Indent is the desired indentation level for tracing. - type Comparator_Ptr is access function - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id; - Compared_To : Library_Graph_Vertex_Id) return Precedence_Kind; - - type Predicate_Ptr is access function - (G : Library_Graph; - Vertex : Library_Graph_Vertex_Id) return Boolean; - function Find_Best_Vertex (G : Library_Graph; Set : LGV_Sets.Membership_Set; - Is_Suitable_Vertex : Predicate_Ptr; - Compare_Vertices : Comparator_Ptr; + Is_Suitable_Vertex : LGV_Predicate_Ptr; + Compare_Vertices : LGV_Comparator_Ptr; Initial_Best_Msg : String; Subsequent_Best_Msg : String; Step : Elaboration_Order_Step; @@ -917,8 +908,8 @@ package body Bindo.Elaborators is function Find_Best_Vertex (G : Library_Graph; Set : LGV_Sets.Membership_Set; - Is_Suitable_Vertex : Predicate_Ptr; - Compare_Vertices : Comparator_Ptr; + Is_Suitable_Vertex : LGV_Predicate_Ptr; + Compare_Vertices : LGV_Comparator_Ptr; Initial_Best_Msg : String; Subsequent_Best_Msg : String; Step : Elaboration_Order_Step; diff --git a/gcc/ada/bindo-graphs.adb b/gcc/ada/bindo-graphs.adb index 5443b790e37..840f01adeb2 100644 --- a/gcc/ada/bindo-graphs.adb +++ b/gcc/ada/bindo-graphs.adb @@ -1058,15 +1058,17 @@ package body Bindo.Graphs is -- for tracing. function Add_Edge_With_Return - (G : Library_Graph; - Pred : Library_Graph_Vertex_Id; - Succ : Library_Graph_Vertex_Id; - Kind : Library_Graph_Edge_Kind) return Library_Graph_Edge_Id; + (G : Library_Graph; + Pred : Library_Graph_Vertex_Id; + Succ : Library_Graph_Vertex_Id; + Kind : Library_Graph_Edge_Kind; + Activates_Task : Boolean) return Library_Graph_Edge_Id; pragma Inline (Add_Edge_With_Return); -- Create a new edge in library graph G with source vertex Pred and -- destination vertex Succ, and return its handle. Kind denotes the - -- nature of the edge. If Pred and Succ are already related, no edge - -- is created and No_Library_Graph_Edge is returned. + -- nature of the edge. Activates_Task should be set when the edge + -- involves a task activation. If Pred and Succ are already related, + -- no edge is created and No_Library_Graph_Edge is returned. procedure Add_Vertex_And_Complement (G : Library_Graph; @@ -1078,6 +1080,14 @@ package body Bindo.Graphs is -- part of an Elaborate_Body pair, or flag Do_Complement is set, add -- the complementary vertex to the set. + function At_Least_One_Edge_Satisfies + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id; + Predicate : LGE_Predicate_Ptr) return Boolean; + pragma Inline (At_Least_One_Edge_Satisfies); + -- Determine whether at least one edge of cycle Cycle of library graph G + -- satisfies predicate Predicate. + function Copy_Cycle_Path (Cycle_Path : LGE_Lists.Doubly_Linked_List) return LGE_Lists.Doubly_Linked_List; @@ -1306,6 +1316,13 @@ package body Bindo.Graphs is -- Determine whether a predecessor vertex and a successor vertex -- described by relation Rel are already linked in library graph G. + function Is_Static_Successor_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean; + pragma Inline (Is_Static_Successor_Edge); + -- Determine whether the successor of invocation edge Edge represents a + -- unit that was compile with the static model. + function Links_Vertices_In_Same_Component (G : Library_Graph; Edge : Library_Graph_Edge_Id) return Boolean; @@ -1491,6 +1508,23 @@ package body Bindo.Graphs is -- LGE_Is's successor vertex of library graph G must wait on before -- it can be elaborated. + -------------------- + -- Activates_Task -- + -------------------- + + function Activates_Task + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); + + return + Kind (G, Edge) = Invocation_Edge + and then Get_LGE_Attributes (G, Edge).Activates_Task; + end Activates_Task; + ------------------------------- -- Add_Body_Before_Spec_Edge -- ------------------------------- @@ -1533,20 +1567,22 @@ package body Bindo.Graphs is if Is_Body_With_Spec (G, Vertex) then Edge := Add_Edge_With_Return - (G => G, - Pred => Vertex, -- body - Succ => Corresponding_Item (G, Vertex), -- spec - Kind => Body_Before_Spec_Edge); + (G => G, + Pred => Vertex, + Succ => Corresponding_Item (G, Vertex), + Kind => Body_Before_Spec_Edge, + Activates_Task => False); -- A spec with a completing body elsif Is_Spec_With_Body (G, Vertex) then Edge := Add_Edge_With_Return - (G => G, - Pred => Corresponding_Item (G, Vertex), -- body - Succ => Vertex, -- spec - Kind => Body_Before_Spec_Edge); + (G => G, + Pred => Corresponding_Item (G, Vertex), + Succ => Vertex, + Kind => Body_Before_Spec_Edge, + Activates_Task => False); end if; if Present (Edge) then @@ -1623,10 +1659,11 @@ package body Bindo.Graphs is -------------- procedure Add_Edge - (G : Library_Graph; - Pred : Library_Graph_Vertex_Id; - Succ : Library_Graph_Vertex_Id; - Kind : Library_Graph_Edge_Kind) + (G : Library_Graph; + Pred : Library_Graph_Vertex_Id; + Succ : Library_Graph_Vertex_Id; + Kind : Library_Graph_Edge_Kind; + Activates_Task : Boolean) is Edge : Library_Graph_Edge_Id; pragma Unreferenced (Edge); @@ -1636,13 +1673,15 @@ package body Bindo.Graphs is pragma Assert (Present (Pred)); pragma Assert (Present (Succ)); pragma Assert (Kind /= No_Edge); + pragma Assert (not Activates_Task or else Kind = Invocation_Edge); Edge := Add_Edge_With_Return - (G => G, - Pred => Pred, - Succ => Succ, - Kind => Kind); + (G => G, + Pred => Pred, + Succ => Succ, + Kind => Kind, + Activates_Task => Activates_Task); end Add_Edge; -------------------------- @@ -1650,10 +1689,11 @@ package body Bindo.Graphs is -------------------------- function Add_Edge_With_Return - (G : Library_Graph; - Pred : Library_Graph_Vertex_Id; - Succ : Library_Graph_Vertex_Id; - Kind : Library_Graph_Edge_Kind) return Library_Graph_Edge_Id + (G : Library_Graph; + Pred : Library_Graph_Vertex_Id; + Succ : Library_Graph_Vertex_Id; + Kind : Library_Graph_Edge_Kind; + Activates_Task : Boolean) return Library_Graph_Edge_Id is pragma Assert (Present (G)); pragma Assert (Present (Pred)); @@ -1691,7 +1731,9 @@ package body Bindo.Graphs is Set_LGE_Attributes (G => G, Edge => Edge, - Val => (Kind => Kind)); + Val => + (Activates_Task => Activates_Task, + Kind => Kind)); -- Mark the predecessor and successor as related by the new edge. -- This prevents all further attempts to link the same predecessor @@ -1785,6 +1827,43 @@ package body Bindo.Graphs is end if; end Add_Vertex_And_Complement; + --------------------------------- + -- At_Least_One_Edge_Satisfies -- + --------------------------------- + + function At_Least_One_Edge_Satisfies + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id; + Predicate : LGE_Predicate_Ptr) return Boolean + is + Edge : Library_Graph_Edge_Id; + Iter : Edges_Of_Cycle_Iterator; + Satisfied : Boolean; + + begin + pragma Assert (Present (G)); + pragma Assert (Present (Cycle)); + pragma Assert (Predicate /= null); + + -- Assume that the predicate cannot be satisfied + + Satisfied := False; + + -- IMPORTANT: + -- + -- * The iteration must run to completion in order to unlock the + -- edges of the cycle. + + Iter := Iterate_Edges_Of_Cycle (G, Cycle); + while Has_Next (Iter) loop + Next (Iter, Edge); + + Satisfied := Satisfied or else Predicate.all (G, Edge); + end loop; + + return Satisfied; + end At_Least_One_Edge_Satisfies; + -------------------------- -- Complementary_Vertex -- -------------------------- @@ -1848,76 +1927,54 @@ package body Bindo.Graphs is (G : Library_Graph; Cycle : Library_Graph_Cycle_Id) return Boolean is - Edge : Library_Graph_Edge_Id; - Iter : Edges_Of_Cycle_Iterator; - Seen : Boolean; - begin pragma Assert (Present (G)); pragma Assert (Present (Cycle)); - -- Assume that no Elaborate_All edge has been seen - - Seen := False; - - -- IMPORTANT: - -- - -- * The iteration must run to completion in order to unlock the - -- edges of the cycle. - - Iter := Iterate_Edges_Of_Cycle (G, Cycle); - while Has_Next (Iter) loop - Next (Iter, Edge); - - if not Seen - and then Is_Elaborate_All_Edge (G, Edge) - then - Seen := True; - end if; - end loop; - - return Seen; + return + At_Least_One_Edge_Satisfies + (G => G, + Cycle => Cycle, + Predicate => Is_Elaborate_All_Edge'Access); end Contains_Elaborate_All_Edge; ------------------------------------ - -- Contains_Weak_Static_Successor -- + -- Contains_Static_Successor_Edge -- ------------------------------------ - function Contains_Weak_Static_Successor + function Contains_Static_Successor_Edge (G : Library_Graph; Cycle : Library_Graph_Cycle_Id) return Boolean is - Edge : Library_Graph_Edge_Id; - Iter : Edges_Of_Cycle_Iterator; - Seen : Boolean; - begin pragma Assert (Present (G)); pragma Assert (Present (Cycle)); - -- Assume that no weak static successor has been seen - - Seen := False; - - -- IMPORTANT: - -- - -- * The iteration must run to completion in order to unlock the - -- edges of the cycle. + return + At_Least_One_Edge_Satisfies + (G => G, + Cycle => Cycle, + Predicate => Is_Static_Successor_Edge'Access); + end Contains_Static_Successor_Edge; - Iter := Iterate_Edges_Of_Cycle (G, Cycle); - while Has_Next (Iter) loop - Next (Iter, Edge); + ------------------------------ + -- Contains_Task_Activation -- + ------------------------------ - if not Seen - and then Is_Invocation_Edge (G, Edge) - and then not Is_Dynamically_Elaborated (G, Successor (G, Edge)) - then - Seen := True; - end if; - end loop; + function Contains_Task_Activation + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Cycle)); - return Seen; - end Contains_Weak_Static_Successor; + return + At_Least_One_Edge_Satisfies + (G => G, + Cycle => Cycle, + Predicate => Activates_Task'Access); + end Contains_Task_Activation; --------------------- -- Copy_Cycle_Path -- @@ -3632,6 +3689,23 @@ package body Bindo.Graphs is and then Has_Elaborate_Body (G, Vertex); end Is_Spec_With_Elaborate_Body; + ------------------------------ + -- Is_Static_Successor_Edge -- + ------------------------------ + + function Is_Static_Successor_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean + is + begin + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); + + return + Is_Invocation_Edge (G, Edge) + and then not Is_Dynamically_Elaborated (G, Successor (G, Edge)); + end Is_Static_Successor_Edge; + --------------------------------- -- Is_Weakly_Elaborable_Vertex -- ---------------------------------- diff --git a/gcc/ada/bindo-graphs.ads b/gcc/ada/bindo-graphs.ads index 84e83b9d673..53bc4eebe62 100644 --- a/gcc/ada/bindo-graphs.ads +++ b/gcc/ada/bindo-graphs.ads @@ -732,18 +732,33 @@ package Bindo.Graphs is type Library_Graph is private; Nil : constant Library_Graph; + type LGE_Predicate_Ptr is access function + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean; + + type LGV_Comparator_Ptr is access function + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id; + Compared_To : Library_Graph_Vertex_Id) return Precedence_Kind; + + type LGV_Predicate_Ptr is access function + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) return Boolean; + ---------------------- -- Graph operations -- ---------------------- procedure Add_Edge - (G : Library_Graph; - Pred : Library_Graph_Vertex_Id; - Succ : Library_Graph_Vertex_Id; - Kind : Library_Graph_Edge_Kind); + (G : Library_Graph; + Pred : Library_Graph_Vertex_Id; + Succ : Library_Graph_Vertex_Id; + Kind : Library_Graph_Edge_Kind; + Activates_Task : Boolean); pragma Inline (Add_Edge); -- Create a new edge in library graph G with source vertex Pred and - -- destination vertex Succ. Kind denotes the nature of the edge. + -- destination vertex Succ. Kind denotes the nature of the edge. Flag + -- Activates_Task should be set when the edge involves task activation. procedure Add_Vertex (G : Library_Graph; @@ -895,6 +910,12 @@ package Bindo.Graphs is -- Edge attributes -- --------------------- + function Activates_Task + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) return Boolean; + pragma Inline (Activates_Task); + -- Determine whether edge Edge of library graph G activates a task + function Kind (G : Library_Graph; Edge : Library_Graph_Edge_Id) return Library_Graph_Edge_Kind; @@ -987,13 +1008,21 @@ package Bindo.Graphs is -- Determine whether cycle Cycle of library graph G contains an -- Elaborate_All edge. - function Contains_Weak_Static_Successor + function Contains_Static_Successor_Edge (G : Library_Graph; Cycle : Library_Graph_Cycle_Id) return Boolean; - pragma Inline (Contains_Weak_Static_Successor); - -- Determine whether cycle Cycle of library graph G contains a weak edge + pragma Inline (Contains_Static_Successor_Edge); + -- Determine whether cycle Cycle of library graph G contains an edge -- where the successor was compiled using the static model. + function Contains_Task_Activation + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) return Boolean; + pragma Inline (Contains_Task_Activation); + -- Determine whether cycle Cycle of library graph G contains an + -- invocation edge where the path it represents involves a task + -- activation. + 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 @@ -1439,13 +1468,18 @@ package Bindo.Graphs is -- The following type represents the attributes of a library graph edge type Library_Graph_Edge_Attributes is record + Activates_Task : Boolean := False; + -- Set for an invocation edge, where at least one of the paths the + -- edge represents activates a task. + Kind : Library_Graph_Edge_Kind := No_Edge; -- The nature of the library graph edge end record; No_Library_Graph_Edge_Attributes : constant Library_Graph_Edge_Attributes := - (Kind => No_Edge); + (Activates_Task => False, + Kind => No_Edge); procedure Destroy_Library_Graph_Edge_Attributes (Attrs : in out Library_Graph_Edge_Attributes); diff --git a/gcc/ada/bindo.ads b/gcc/ada/bindo.ads index 940b752e484..b0ebe628bd7 100644 --- a/gcc/ada/bindo.ads +++ b/gcc/ada/bindo.ads @@ -31,6 +31,14 @@ with Namet; use Namet; package Bindo is + -- The following type represents the various kinds of precedence between + -- two items. + + type Precedence_Kind is + (Lower_Precedence, + Equal_Precedence, + Higher_Precedence); + procedure Find_Elaboration_Order (Order : out Unit_Id_Table; Main_Lib_File : File_Name_Type); @@ -41,14 +49,4 @@ package Bindo is -- exists, it is returned in Order, otherwise Unrecoverable_Error is -- raised. -private - - -- The following type represents the various kinds of precedence between - -- two items. - - type Precedence_Kind is - (Lower_Precedence, - Equal_Precedence, - Higher_Precedence); - end Bindo; diff --git a/gcc/ada/doc/gnat_ugn/elaboration_order_handling_in_gnat.rst b/gcc/ada/doc/gnat_ugn/elaboration_order_handling_in_gnat.rst index 160dbdf5ebf..b27aa739c48 100644 --- a/gcc/ada/doc/gnat_ugn/elaboration_order_handling_in_gnat.rst +++ b/gcc/ada/doc/gnat_ugn/elaboration_order_handling_in_gnat.rst @@ -1014,6 +1014,23 @@ following tactics to eliminate the circularity: The programmer should remove the pragma as advised, and rebuild the program. +* Use of pragma Restrictions + + :: + + use pragma Restrictions (No_Entry_Calls_In_Elaboration_Code) + + This tactic is suggested when the binder has determined that a task + activation at elaboration time + + - Prevents a set of units from being elaborated. + + Note that the binder cannot determine with certainty whether the task will + block at elaboration time. + + The programmer should create a configuration file, place the pragma within, + update the general compilation arguments, and rebuild the program. + * Use of dynamic elaboration model :: diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index b0b3bdd1518..2d565cc5844 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -28457,6 +28457,29 @@ declared in the spec by elaboration code in the body. The programmer should remove the pragma as advised, and rebuild the program. +@item +Use of pragma Restrictions + +@example +use pragma Restrictions (No_Entry_Calls_In_Elaboration_Code) +@end example + +This tactic is suggested when the binder has determined that a task +activation at elaboration time + + +@itemize - + +@item +Prevents a set of units from being elaborated. +@end itemize + +Note that the binder cannot determine with certainty whether the task will +block at elaboration time. + +The programmer should create a configuration file, place the pragma within, +update the general compilation arguments, and rebuild the program. + @item Use of dynamic elaboration model -- 2.30.2