@@ -871,23 +871,6 @@ package Einfo is
-- entity must be delayed, since the insertion of the generic body
-- may affect cleanup generation (see Inline for further details).
---
-
-- Delta_Value
-- Defined in fixed and decimal types. Points to a universal real
-- that holds value of delta for the type, as given in the declaration
@@ -5552,7 +5535,6 @@ package Einfo is
-- Contains_Ignored_Ghost_Code
-- Default_Expressions_Processed
-- Delay_Cleanups
- -- Delay_Subprogram_Descriptors
-- Discard_Names
-- Elaboration_Entity_Required
-- Has_Completion
@@ -5801,7 +5783,6 @@ package Einfo is
-- Body_Needed_For_Inlining
-- Body_Needed_For_SAL
-- Contains_Ignored_Ghost_Code
- -- Delay_Subprogram_Descriptors
-- Discard_Names
-- Elaborate_Body_Desirable (non-generic case only)
-- Elaboration_Entity_Required
@@ -5844,7 +5825,6 @@ package Einfo is
-- SPARK_Pragma
-- SPARK_Aux_Pragma
-- Contains_Ignored_Ghost_Code
- -- Delay_Subprogram_Descriptors
-- Ignore_SPARK_Mode_Pragmas
-- SPARK_Aux_Pragma_Inherited
-- SPARK_Pragma_Inherited
@@ -5918,7 +5898,6 @@ package Einfo is
-- Elaboration_Entity_Required
-- Default_Expressions_Processed
-- Delay_Cleanups
- -- Delay_Subprogram_Descriptors
-- Discard_Names
-- Has_Completion
-- Has_Expanded_Contract (non-generic case only)
@@ -6265,10 +6265,13 @@ package body Exp_Ch6 is
-- body subprogram points to itself.
Proc := Current_Scope;
- while Present (Proc)
- and then Scope (Proc) /= Scop
- loop
+ while Present (Proc) and then Scope (Proc) /= Scop loop
Proc := Scope (Proc);
+ if Is_Subprogram (Proc)
+ and then Present (Protected_Subprogram (Proc))
+ then
+ Proc := Protected_Subprogram (Proc);
+ end if;
end loop;
Corr := Protected_Body_Subprogram (Proc);
@@ -5054,16 +5054,6 @@ package body Exp_Ch7 is
if not Actions_Required then
return;
-
- -- If the current node is a rewritten task body and the descriptors have
- -- not been delayed (due to some nested instantiations), do not generate
- -- redundant cleanup actions.
-
- elsif Is_Task_Body
- and then Nkind (N) = N_Subprogram_Body
- and then not Delay_Subprogram_Descriptors (Corresponding_Spec (N))
- then
- return;
end if;
-- If an extended return statement contains something like
@@ -3398,6 +3398,7 @@ package body Exp_Ch9 is
Loc : constant Source_Ptr := Sloc (N);
+ Block_Id : Entity_Id;
Bod_Id : Entity_Id;
Bod_Spec : Node_Id;
Bod_Stmts : List_Id;
@@ -3456,11 +3457,12 @@ package body Exp_Ch9 is
Analyze_Statements (Bod_Stmts);
- Set_Scope (Entity (Identifier (First (Bod_Stmts))),
- Protected_Body_Subprogram (Ent));
+ Block_Id := Entity (Identifier (First (Bod_Stmts)));
- Reset_Scopes_To
- (First (Bod_Stmts), Entity (Identifier (First (Bod_Stmts))));
+ Set_Scope (Block_Id, Protected_Body_Subprogram (Ent));
+ Set_Uses_Sec_Stack (Block_Id, Uses_Sec_Stack (Corresponding_Spec (N)));
+
+ Reset_Scopes_To (First (Bod_Stmts), Block_Id);
case Corresponding_Runtime_Package (Pid) is
when System_Tasking_Protected_Objects_Entries =>
@@ -8537,19 +8539,10 @@ package body Exp_Ch9 is
New_Op_Spec := Corresponding_Spec (New_Op_Body);
-- When the original subprogram body has nested subprograms,
- -- the new body also has them, so set the flag accordingly
- -- and reset the scopes of the top-level nested subprograms
- -- and other declaration entities so that they now refer to
- -- the new body's entity. (It would preferable to do this
- -- within Build_Protected_Sub_Specification, which is called
- -- from Build_Unprotected_Subprogram_Body, but the needed
- -- subprogram entity isn't available via Corresponding_Spec
- -- until after the above Analyze call.)
+ -- the new body also has them, so set the flag accordingly.
- if Has_Nested_Subprogram (Op_Spec) then
- Set_Has_Nested_Subprogram (New_Op_Spec);
- Reset_Scopes_To (New_Op_Body, New_Op_Spec);
- end if;
+ Set_Has_Nested_Subprogram
+ (New_Op_Spec, Has_Nested_Subprogram (New_Op_Spec));
-- Similarly, when the original subprogram body uses the
-- secondary stack, the new body also does. This is needed
@@ -8558,6 +8551,16 @@ package body Exp_Ch9 is
Set_Uses_Sec_Stack (New_Op_Spec, Uses_Sec_Stack (Op_Spec));
+ -- Now reset the scopes of the top-level nested subprograms
+ -- and other declaration entities so that they now refer to
+ -- the new body's entity (it would preferable to do this
+ -- within Build_Protected_Sub_Specification, which is called
+ -- from Build_Unprotected_Subprogram_Body, but the needed
+ -- subprogram entity isn't available via Corresponding_Spec
+ -- until after the above Analyze call).
+
+ Reset_Scopes_To (New_Op_Body, New_Op_Spec);
+
-- Build the corresponding protected operation. This is
-- needed only if this is a public or private operation of
-- the type.
@@ -490,7 +490,6 @@ package Gen_IL.Fields is
Default_Expressions_Processed,
Default_Value,
Delay_Cleanups,
- Delay_Subprogram_Descriptors,
Delta_Value,
Dependent_Instances,
Depends_On_Private,
@@ -57,7 +57,6 @@ begin -- Gen_IL.Gen.Gen_Entities
Sm (Debug_Info_Off, Flag),
Sm (Default_Expressions_Processed, Flag),
Sm (Delay_Cleanups, Flag),
- Sm (Delay_Subprogram_Descriptors, Flag),
Sm (Depends_On_Private, Flag),
Sm (Disable_Controlled, Flag, Base_Type_Only),
Sm (Discard_Names, Flag),
@@ -1345,7 +1345,8 @@ begin -- Gen_IL.Gen.Gen_Nodes
Sy (Declarations, List_Id, Default_No_List),
Sy (Handled_Statement_Sequence, Node_Id, Default_Empty),
Sy (At_End_Proc, Node_Id, Default_Empty),
- Sm (Activation_Chain_Entity, Node_Id)));
+ Sm (Activation_Chain_Entity, Node_Id),
+ Sm (Corresponding_Spec, Node_Id)));
Cc (N_Entry_Call_Alternative, Node_Kind,
(Sy (Entry_Call_Statement, Node_Id),
@@ -2824,16 +2824,6 @@ package body Inline is
while Present (Elmt) loop
Scop := Node (Elmt);
- if Ekind (Scop) = E_Entry then
- Scop := Protected_Body_Subprogram (Scop);
-
- elsif Is_Subprogram (Scop)
- and then Is_Protected_Type (Underlying_Type (Scope (Scop)))
- and then Present (Protected_Body_Subprogram (Scop))
- then
- Scop := Protected_Body_Subprogram (Scop);
- end if;
-
if Ekind (Scop) = E_Block then
Decl := Parent (Block_Node (Scop));
@@ -4810,16 +4810,7 @@ package body Sem_Ch12 is
Scope_Loop : while Enclosing_Master /= Standard_Standard loop
if Ekind (Enclosing_Master) = E_Package then
if Is_Compilation_Unit (Enclosing_Master) then
- if In_Package_Body (Enclosing_Master) then
- Set_Delay_Subprogram_Descriptors
- (Body_Entity (Enclosing_Master));
- else
- Set_Delay_Subprogram_Descriptors
- (Enclosing_Master);
- end if;
-
exit Scope_Loop;
-
else
Enclosing_Master := Scope (Enclosing_Master);
end if;
@@ -4835,35 +4826,19 @@ package body Sem_Ch12 is
exit Scope_Loop;
else
- if Ekind (Enclosing_Master) = E_Entry
- and then
- Ekind (Scope (Enclosing_Master)) = E_Protected_Type
- then
- if not Expander_Active then
- exit Scope_Loop;
- else
- Enclosing_Master :=
- Protected_Body_Subprogram (Enclosing_Master);
- end if;
- end if;
-
Set_Delay_Cleanups (Enclosing_Master);
while Ekind (Enclosing_Master) = E_Block loop
Enclosing_Master := Scope (Enclosing_Master);
end loop;
- if Is_Subprogram (Enclosing_Master) then
- Set_Delay_Subprogram_Descriptors (Enclosing_Master);
-
- elsif Is_Task_Type (Enclosing_Master) then
+ if Is_Task_Type (Enclosing_Master) then
declare
TBP : constant Node_Id :=
Get_Task_Body_Procedure
(Enclosing_Master);
begin
if Present (TBP) then
- Set_Delay_Subprogram_Descriptors (TBP);
Set_Delay_Cleanups (TBP);
end if;
end;
@@ -1305,6 +1305,7 @@ package body Sem_Ch9 is
Entry_Name := E;
Set_Convention (Id, Convention (E));
Set_Corresponding_Body (Parent (E), Id);
+ Set_Corresponding_Spec (N, E);
Check_Fully_Conformant (Id, E, N);
if Ekind (Id) = E_Entry_Family then
@@ -27268,6 +27268,15 @@ package body Sem_Util is
then
return True;
+ -- The body of a protected operation is within the protected type
+
+ elsif Is_Subprogram (Curr)
+ and then Present (Protected_Subprogram (Curr))
+ and then Is_Protected_Type (Outer)
+ and then Scope (Protected_Subprogram (Curr)) = Outer
+ then
+ return True;
+
-- Outside of its scope, a synchronized type may just be private
elsif Is_Private_Type (Curr)
@@ -27309,6 +27318,13 @@ package body Sem_Util is
then
return True;
+ elsif Is_Subprogram (Curr)
+ and then Present (Protected_Subprogram (Curr))
+ and then Is_Protected_Type (Outer)
+ and then Scope (Protected_Subprogram (Curr)) = Outer
+ then
+ return True;
+
elsif Is_Private_Type (Curr)
and then Present (Full_View (Curr))
then
@@ -1052,8 +1052,8 @@ package Sinfo is
-- and their first named subtypes.
-- Corresponding_Spec
- -- This field is set in subprogram, package, task, and protected body
- -- nodes, where it points to the defining entity in the corresponding
+ -- This field is set in subprogram, package, task, entry and protected
+ -- body nodes where it points to the defining entity in the corresponding
-- spec. The attribute is also set in N_With_Clause nodes where it points
-- to the defining entity for the with'ed spec, and in a subprogram
-- renaming declaration when it is a Renaming_As_Body. The field is Empty
@@ -6206,6 +6206,7 @@ package Sinfo is
-- Declarations
-- Handled_Statement_Sequence
-- Activation_Chain_Entity
+ -- Corresponding_Spec
-- At_End_Proc (set to Empty if no clean up procedure)
-----------------------------------