===================================================================
@@ -273,6 +273,7 @@
-- Entry_Max_Queue_Lengths_Array Node35
-- Import_Pragma Node35
+ -- Nested_Scenarios Elist36
-- Validated_Object Node36
-- Class_Wide_Clone Node38
@@ -2867,6 +2868,14 @@
return Flag22 (Id);
end Needs_No_Actuals;
+ function Nested_Scenarios (Id : E) return L is
+ begin
+ pragma Assert (Ekind_In (Id, E_Function,
+ E_Procedure,
+ E_Subprogram_Body));
+ return Elist36 (Id);
+ end Nested_Scenarios;
+
function Never_Set_In_Source (Id : E) return B is
begin
return Flag115 (Id);
@@ -6071,6 +6080,14 @@
Set_Flag22 (Id, V);
end Set_Needs_No_Actuals;
+ procedure Set_Nested_Scenarios (Id : E; V : L) is
+ begin
+ pragma Assert (Ekind_In (Id, E_Function,
+ E_Procedure,
+ E_Subprogram_Body));
+ Set_Elist36 (Id, V);
+ end Set_Nested_Scenarios;
+
procedure Set_Never_Set_In_Source (Id : E; V : B := True) is
begin
Set_Flag115 (Id, V);
@@ -11118,6 +11135,12 @@
procedure Write_Field36_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
+ when E_Function
+ | E_Procedure
+ | E_Subprogram_Body
+ =>
+ Write_Str ("Nested_Scenarios");
+
when E_Variable =>
Write_Str ("Validated_Object");
===================================================================
@@ -3531,6 +3531,14 @@
-- interpreted as an indexing of the result of the call. It is also
-- used to resolve various cases of entry calls.
+-- Nested_Scenarios (Elist36)
+-- Present in [stand alone] subprogram bodies. The list contains all
+-- nested scenarios (see the terminology in Sem_Elab) which appear within
+-- the declarations, statements, and exception handlers of the subprogram
+-- body. The list improves the performance of the ABE Processing phase by
+-- avoiding a full tree traversal when the same subprogram body is part
+-- of several distinct paths in the elaboration graph.
+
-- Never_Set_In_Source (Flag115)
-- Defined in all entities, but can be set only for variables and
-- parameters. This flag is set if the object is never assigned a value
@@ -6076,6 +6084,7 @@
-- Linker_Section_Pragma (Node33)
-- Contract (Node34)
-- Import_Pragma (Node35) (non-generic case only)
+ -- Nested_Scenarios (Elist36)
-- Class_Wide_Clone (Node38)
-- Protected_Subprogram (Node39) (non-generic case only)
-- SPARK_Pragma (Node40)
@@ -6398,6 +6407,7 @@
-- Linker_Section_Pragma (Node33)
-- Contract (Node34)
-- Import_Pragma (Node35) (non-generic case only)
+ -- Nested_Scenarios (Elist36)
-- Class_Wide_Clone (Node38)
-- Protected_Subprogram (Node39) (non-generic case only)
-- SPARK_Pragma (Node40)
@@ -6592,6 +6602,7 @@
-- Extra_Formals (Node28)
-- Anonymous_Masters (Elist29)
-- Contract (Node34)
+ -- Nested_Scenarios (Elist36)
-- SPARK_Pragma (Node40)
-- Contains_Ignored_Ghost_Code (Flag279)
-- SPARK_Pragma_Inherited (Flag265)
@@ -7308,6 +7319,7 @@
function Must_Have_Preelab_Init (Id : E) return B;
function Needs_Debug_Info (Id : E) return B;
function Needs_No_Actuals (Id : E) return B;
+ function Nested_Scenarios (Id : E) return L;
function Never_Set_In_Source (Id : E) return B;
function Next_Inlined_Subprogram (Id : E) return E;
function No_Dynamic_Predicate_On_Actual (Id : E) return B;
@@ -8005,6 +8017,7 @@
procedure Set_Must_Have_Preelab_Init (Id : E; V : B := True);
procedure Set_Needs_Debug_Info (Id : E; V : B := True);
procedure Set_Needs_No_Actuals (Id : E; V : B := True);
+ procedure Set_Nested_Scenarios (Id : E; V : L);
procedure Set_Never_Set_In_Source (Id : E; V : B := True);
procedure Set_Next_Inlined_Subprogram (Id : E; V : E);
procedure Set_No_Dynamic_Predicate_On_Actual (Id : E; V : B := True);
@@ -8857,6 +8870,7 @@
pragma Inline (Must_Have_Preelab_Init);
pragma Inline (Needs_Debug_Info);
pragma Inline (Needs_No_Actuals);
+ pragma Inline (Nested_Scenarios);
pragma Inline (Never_Set_In_Source);
pragma Inline (Next_Index);
pragma Inline (Next_Inlined_Subprogram);
@@ -9343,6 +9357,7 @@
pragma Inline (Set_Must_Have_Preelab_Init);
pragma Inline (Set_Needs_Debug_Info);
pragma Inline (Set_Needs_No_Actuals);
+ pragma Inline (Set_Nested_Scenarios);
pragma Inline (Set_Never_Set_In_Source);
pragma Inline (Set_Next_Inlined_Subprogram);
pragma Inline (Set_No_Dynamic_Predicate_On_Actual);
===================================================================
@@ -26,6 +26,7 @@
with Atree; use Atree;
with Debug; use Debug;
with Einfo; use Einfo;
+with Elists; use Elists;
with Errout; use Errout;
with Exp_Ch11; use Exp_Ch11;
with Exp_Tss; use Exp_Tss;
@@ -8502,85 +8503,173 @@
In_Partial_Fin : Boolean;
In_Task_Body : Boolean)
is
- function Is_Potential_Scenario (Nod : Node_Id) return Traverse_Result;
- -- Determine whether arbitrary node Nod denotes a suitable scenario and
- -- if so, process it.
+ procedure Find_And_Process_Nested_Scenarios;
+ pragma Inline (Find_And_Process_Nested_Scenarios);
+ -- Examine the declarations and statements of subprogram body N for
+ -- suitable scenarios. Save each discovered scenario and process it
+ -- accordingly.
- procedure Traverse_Potential_Scenarios is
- new Traverse_Proc (Is_Potential_Scenario);
+ procedure Process_Nested_Scenarios (Nested : Elist_Id);
+ pragma Inline (Process_Nested_Scenarios);
+ -- Invoke Process_Scenario on each individual scenario whith appears in
+ -- list Nested.
- procedure Traverse_List (List : List_Id);
- -- Inspect list List for suitable elaboration scenarios and process them
+ ---------------------------------------
+ -- Find_And_Process_Nested_Scenarios --
+ ---------------------------------------
- ---------------------------
- -- Is_Potential_Scenario --
- ---------------------------
+ procedure Find_And_Process_Nested_Scenarios is
+ Body_Id : constant Entity_Id := Defining_Entity (N);
- function Is_Potential_Scenario (Nod : Node_Id) return Traverse_Result is
- begin
- -- Special cases
+ function Is_Potential_Scenario
+ (Nod : Node_Id) return Traverse_Result;
+ -- Determine whether arbitrary node Nod denotes a suitable scenario.
+ -- If it does, save it in the Nested_Scenarios list of the subprogram
+ -- body, and process it.
- -- Skip constructs which do not have elaboration of their own and
- -- need to be elaborated by other means such as invocation, task
- -- activation, etc.
+ procedure Save_Scenario (Nod : Node_Id);
+ pragma Inline (Save_Scenario);
+ -- Save scenario Nod in the Nested_Scenarios list of the subprogram
+ -- body.
- if Is_Non_Library_Level_Encapsulator (Nod) then
- return Skip;
+ procedure Traverse_List (List : List_Id);
+ pragma Inline (Traverse_List);
+ -- Invoke Traverse_Potential_Scenarios on each node in list List
- -- Terminate the traversal of a task body with an accept statement
- -- when no entry calls in elaboration are allowed because the task
- -- will block at run-time and none of the remaining statements will
- -- be executed.
+ procedure Traverse_Potential_Scenarios is
+ new Traverse_Proc (Is_Potential_Scenario);
- elsif Nkind_In (Original_Node (Nod), N_Accept_Statement,
- N_Selective_Accept)
- and then Restriction_Active (No_Entry_Calls_In_Elaboration_Code)
- then
- return Abandon;
+ ---------------------------
+ -- Is_Potential_Scenario --
+ ---------------------------
- -- Certain nodes carry semantic lists which act as repositories until
- -- expansion transforms the node and relocates the contents. Examine
- -- these lists in case expansion is disabled.
+ function Is_Potential_Scenario
+ (Nod : Node_Id) return Traverse_Result
+ is
+ begin
+ -- Special cases
- elsif Nkind_In (Nod, N_And_Then, N_Or_Else) then
- Traverse_List (Actions (Nod));
+ -- Skip constructs which do not have elaboration of their own and
+ -- need to be elaborated by other means such as invocation, task
+ -- activation, etc.
- elsif Nkind_In (Nod, N_Elsif_Part, N_Iteration_Scheme) then
- Traverse_List (Condition_Actions (Nod));
+ if Is_Non_Library_Level_Encapsulator (Nod) then
+ return Skip;
- elsif Nkind (Nod) = N_If_Expression then
- Traverse_List (Then_Actions (Nod));
- Traverse_List (Else_Actions (Nod));
+ -- Terminate the traversal of a task body with an accept statement
+ -- when no entry calls in elaboration are allowed because the task
+ -- will block at run-time and the remaining statements will not be
+ -- executed.
- elsif Nkind_In (Nod, N_Component_Association,
- N_Iterated_Component_Association)
- then
- Traverse_List (Loop_Actions (Nod));
+ elsif Nkind_In (Original_Node (Nod), N_Accept_Statement,
+ N_Selective_Accept)
+ and then Restriction_Active (No_Entry_Calls_In_Elaboration_Code)
+ then
+ return Abandon;
- -- General case
+ -- Certain nodes carry semantic lists which act as repositories
+ -- until expansion transforms the node and relocates the contents.
+ -- Examine these lists in case expansion is disabled.
- elsif Is_Suitable_Scenario (Nod) then
- Process_Scenario (Nod, In_Partial_Fin, In_Task_Body);
- end if;
+ elsif Nkind_In (Nod, N_And_Then, N_Or_Else) then
+ Traverse_List (Actions (Nod));
- return OK;
- end Is_Potential_Scenario;
+ elsif Nkind_In (Nod, N_Elsif_Part, N_Iteration_Scheme) then
+ Traverse_List (Condition_Actions (Nod));
- -------------------
- -- Traverse_List --
- -------------------
+ elsif Nkind (Nod) = N_If_Expression then
+ Traverse_List (Then_Actions (Nod));
+ Traverse_List (Else_Actions (Nod));
- procedure Traverse_List (List : List_Id) is
- Item : Node_Id;
+ elsif Nkind_In (Nod, N_Component_Association,
+ N_Iterated_Component_Association)
+ then
+ Traverse_List (Loop_Actions (Nod));
+ -- General case
+
+ -- Save a suitable scenario in the Nested_Scenarios list of the
+ -- subprogram body. As a result any subsequent traversals of the
+ -- subprogram body started from a different top level scenario no
+ -- longer need to reexamine the tree.
+
+ elsif Is_Suitable_Scenario (Nod) then
+ Save_Scenario (Nod);
+ Process_Scenario (Nod, In_Partial_Fin, In_Task_Body);
+ end if;
+
+ return OK;
+ end Is_Potential_Scenario;
+
+ -------------------
+ -- Save_Scenario --
+ -------------------
+
+ procedure Save_Scenario (Nod : Node_Id) is
+ Nested : Elist_Id;
+
+ begin
+ Nested := Nested_Scenarios (Body_Id);
+
+ if No (Nested) then
+ Nested := New_Elmt_List;
+ Set_Nested_Scenarios (Body_Id, Nested);
+ end if;
+
+ Append_Elmt (Nod, Nested);
+ end Save_Scenario;
+
+ -------------------
+ -- Traverse_List --
+ -------------------
+
+ procedure Traverse_List (List : List_Id) is
+ Item : Node_Id;
+
+ begin
+ Item := First (List);
+ while Present (Item) loop
+ Traverse_Potential_Scenarios (Item);
+ Next (Item);
+ end loop;
+ end Traverse_List;
+
+ -- Start of processing for Find_And_Process_Nested_Scenarios
+
begin
- Item := First (List);
- while Present (Item) loop
- Traverse_Potential_Scenarios (Item);
- Next (Item);
+ -- Examine the declarations for suitable scenarios
+
+ Traverse_List (Declarations (N));
+
+ -- Examine the handled sequence of statements. This also includes any
+ -- exceptions handlers.
+
+ Traverse_Potential_Scenarios (Handled_Statement_Sequence (N));
+ end Find_And_Process_Nested_Scenarios;
+
+ ------------------------------
+ -- Process_Nested_Scenarios --
+ ------------------------------
+
+ procedure Process_Nested_Scenarios (Nested : Elist_Id) is
+ Nested_Elmt : Elmt_Id;
+
+ begin
+ Nested_Elmt := First_Elmt (Nested);
+ while Present (Nested_Elmt) loop
+ Process_Scenario
+ (N => Node (Nested_Elmt),
+ In_Partial_Fin => In_Partial_Fin,
+ In_Task_Body => In_Task_Body);
+
+ Next_Elmt (Nested_Elmt);
end loop;
- end Traverse_List;
+ end Process_Nested_Scenarios;
+ -- Local variables
+
+ Nested : Elist_Id;
+
-- Start of processing for Traverse_Body
begin
@@ -8605,14 +8694,23 @@
Visited_Bodies.Set (N, True);
end if;
- -- Examine the declarations for suitable scenarios
+ Nested := Nested_Scenarios (Defining_Entity (N));
- Traverse_List (Declarations (N));
+ -- The subprogram body was already examined as part of the elaboration
+ -- graph starting from a different top level scenario. There is no need
+ -- to traverse the declarations and statements again because this will
+ -- yield the exact same scenarios. Use the nested scenarios collected
+ -- during the first inspection of the body.
- -- Examine the handled sequence of statements. This also includes any
- -- exceptions handlers.
+ if Present (Nested) then
+ Process_Nested_Scenarios (Nested);
- Traverse_Potential_Scenarios (Handled_Statement_Sequence (N));
+ -- Otherwise examine the declarations and statements of the subprogram
+ -- body for suitable scenarios, save and process them accordingly.
+
+ else
+ Find_And_Process_Nested_Scenarios;
+ end if;
end Traverse_Body;
---------------------------------