From: Eric Botcazou <[email protected]>
The Add_Shared_Var_Lock_Procs procedure in Exp_Smem contains a very ad-hoc
management of transient scopes, which is probably unavoidable but can be
streamlined by changing the insertion point of the finalizer to be the one
used in the presence of controlled objects.
However, the latter change badly interacts with the special processing of
protected subprogram bodies implemented in Build_Finalizer_Call. Now this
processing is obsolete after the recent overhaul of the expansion of these
protected subprogram bodies and can be entirely removed.
No functional changes.
gcc/ada/ChangeLog:
* exp_ch7.adb (Build_Finalizer_Call): Delete.
(Build_Finalizer): Always insert the finalizer at the end of the
statement list in the non-package case.
(Expand_Cleanup_Actions): Attach the finalizer manually, if any.
* exp_smem.adb (Add_Shared_Var_Lock_Procs): Insert all the actions
directly in the transient scope.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch7.adb | 137 +++++++++----------------------------------
gcc/ada/exp_smem.adb | 81 ++++++++++---------------
2 files changed, 59 insertions(+), 159 deletions(-)
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index e3cde2e3f30..030134394cb 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -428,13 +428,6 @@ package body Exp_Ch7 is
-- does not contain the above constructs, the routine returns an empty
-- list.
- procedure Build_Finalizer_Call (N : Node_Id; Fin_Id : Entity_Id);
- -- N is a construct that contains a handled sequence of statements, Fin_Id
- -- is the entity of a finalizer. Create an At_End handler that covers the
- -- statements of N and calls Fin_Id. If the handled statement sequence has
- -- an exception handler, the statements will be wrapped in a block to avoid
- -- unwanted interaction with the new At_End handler.
-
procedure Build_Record_Deep_Procs (Typ : Entity_Id);
-- Build the deep Initialize/Adjust/Finalize for a record Typ with
-- Has_Controlled_Component set and store them using the TSS mechanism.
@@ -2306,38 +2299,30 @@ package body Exp_Ch7 is
Append_To (Decls, Fin_Spec);
- -- When the finalizer acts solely as a cleanup routine, the body
- -- is inserted right after the spec.
+ -- Manually freeze the spec. This is somewhat of a hack because a
+ -- subprogram is frozen when its body is seen and the freeze node
+ -- appears right before the body. However, in this case, the spec
+ -- must be frozen earlier since the At_End handler must be able to
+ -- call it.
+ --
+ -- declare
+ -- procedure Fin_Id; -- Spec
+ -- [Fin_Id] -- Freeze node
+ -- begin
+ -- ...
+ -- at end
+ -- Fin_Id; -- At_End handler
+ -- end;
- if Acts_As_Clean and not Has_Ctrl_Objs then
- Insert_After (Fin_Spec, Fin_Body);
+ Ensure_Freeze_Node (Fin_Id);
+ Insert_After (Fin_Spec, Freeze_Node (Fin_Id));
+ Mutate_Ekind (Fin_Id, E_Procedure);
+ Freeze_Extra_Formals (Fin_Id);
+ Set_Is_Frozen (Fin_Id);
- -- In other cases the body is inserted after the last statement
+ pragma Assert (Present (Stmts));
- else
- -- Manually freeze the spec. This is somewhat of a hack because
- -- a subprogram is frozen when its body is seen and the freeze
- -- node appears right before the body. However, in this case,
- -- the spec must be frozen earlier since the At_End handler
- -- must be able to call it.
- --
- -- declare
- -- procedure Fin_Id; -- Spec
- -- [Fin_Id] -- Freeze node
- -- begin
- -- ...
- -- at end
- -- Fin_Id; -- At_End handler
- -- end;
-
- Ensure_Freeze_Node (Fin_Id);
- Insert_After (Fin_Spec, Freeze_Node (Fin_Id));
- Mutate_Ekind (Fin_Id, E_Procedure);
- Freeze_Extra_Formals (Fin_Id);
- Set_Is_Frozen (Fin_Id);
-
- Append_To (Stmts, Fin_Body);
- end if;
+ Append_To (Stmts, Fin_Body);
end if;
Analyze (Fin_Spec, Suppress => All_Checks);
@@ -3183,8 +3168,7 @@ package body Exp_Ch7 is
Spec_Id := Defining_Identifier (Spec_Id);
end if;
- -- Accept statement, block, entry body, package body, protected body,
- -- subprogram body or task body.
+ -- Block, entry body, package body, subprogram body or task body
else
Decls := Declarations (N);
@@ -3310,76 +3294,6 @@ package body Exp_Ch7 is
end if;
end Build_Finalizer;
- --------------------------
- -- Build_Finalizer_Call --
- --------------------------
-
- procedure Build_Finalizer_Call (N : Node_Id; Fin_Id : Entity_Id) is
- begin
- -- Do not perform this expansion in SPARK mode because we do not create
- -- finalizers in the first place.
-
- if GNATprove_Mode then
- return;
- end if;
-
- -- If the construct to be cleaned up is a protected subprogram body, the
- -- finalizer call needs to be associated with the block that wraps the
- -- unprotected version of the subprogram. The following illustrates this
- -- scenario:
-
- -- procedure Prot_SubpP is
- -- procedure finalizer is
- -- begin
- -- Service_Entries (Prot_Obj);
- -- Abort_Undefer;
- -- end finalizer;
-
- -- begin
- -- . . .
- -- begin
- -- Prot_SubpN (Prot_Obj);
- -- at end
- -- finalizer;
- -- end;
- -- end Prot_SubpP;
-
- declare
- Loc : constant Source_Ptr := Sloc (N);
-
- Is_Protected_Subp_Body : constant Boolean :=
- Nkind (N) = N_Subprogram_Body
- and then Is_Protected_Subprogram_Body (N);
- -- True if N is the protected version of a subprogram that belongs to
- -- a protected type.
-
- HSS : constant Node_Id :=
- (if Is_Protected_Subp_Body
- then Handled_Statement_Sequence
- (Last (Statements (Handled_Statement_Sequence (N))))
- else Handled_Statement_Sequence (N));
-
- -- We attach the At_End_Proc to the HSS if this is an accept
- -- statement or extended return statement. Also in the case of
- -- a protected subprogram, because if Service_Entries raises an
- -- exception, we do not lock the PO, so we also do not want to
- -- unlock it.
-
- Use_HSS : constant Boolean :=
- Nkind (N) in N_Accept_Statement | N_Extended_Return_Statement
- or else Is_Protected_Subp_Body;
-
- At_End_Proc_Bearer : constant Node_Id := (if Use_HSS then HSS else N);
- begin
- pragma Assert (No (At_End_Proc (At_End_Proc_Bearer)));
- Set_At_End_Proc (At_End_Proc_Bearer, New_Occurrence_Of (Fin_Id, Loc));
- -- Attach reference to finalizer to tree, for LLVM use
- Set_Parent (At_End_Proc (At_End_Proc_Bearer), At_End_Proc_Bearer);
- Analyze (At_End_Proc (At_End_Proc_Bearer));
- Expand_At_End_Handler (At_End_Proc_Bearer, Empty);
- end;
- end Build_Finalizer_Call;
-
---------------------
-- Build_Late_Proc --
---------------------
@@ -4898,7 +4812,12 @@ package body Exp_Ch7 is
Fin_Id => Fin_Id);
if Present (Fin_Id) then
- Build_Finalizer_Call (N, Fin_Id);
+ pragma Assert (No (At_End_Proc (N)));
+ Set_At_End_Proc (N, New_Occurrence_Of (Fin_Id, Sloc (N)));
+ -- Attach reference to finalizer to tree for LLVM
+ Set_Parent (At_End_Proc (N), N);
+ Analyze (At_End_Proc (N));
+ Expand_At_End_Handler (N, Empty);
end if;
end;
end Expand_Cleanup_Actions;
diff --git a/gcc/ada/exp_smem.adb b/gcc/ada/exp_smem.adb
index f9a35e89211..831b7c09f9e 100644
--- a/gcc/ada/exp_smem.adb
+++ b/gcc/ada/exp_smem.adb
@@ -134,31 +134,18 @@ package body Exp_Smem is
-------------------------------
procedure Add_Shared_Var_Lock_Procs (N : Node_Id) is
+ Aft : constant List_Id := New_List;
Loc : constant Source_Ptr := Sloc (N);
Obj : constant Entity_Id := Entity (Expression (First_Actual (N)));
- Vnm : String_Id;
- Vid : Entity_Id;
- Vde : Node_Id;
- Aft : constant List_Id := New_List;
In_Transient : constant Boolean := Scope_Is_Transient;
+ -- Whether we are already in a transient scope
- function Build_Shared_Var_Lock_Call (RE : RE_Id) return Node_Id;
- -- Return a procedure call statement for lock proc RTE
+ function Current_Scope return Int renames Scope_Stack.Last;
+ -- Return the index of the current scope
- --------------------------------
- -- Build_Shared_Var_Lock_Call --
- --------------------------------
-
- function Build_Shared_Var_Lock_Call (RE : RE_Id) return Node_Id is
- begin
- return
- Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE), Loc),
- Parameter_Associations =>
- New_List (New_Occurrence_Of (Vid, Loc)));
- end Build_Shared_Var_Lock_Call;
+ Vid : Entity_Id;
+ Vnm : String_Id;
-- Start of processing for Add_Shared_Var_Lock_Procs
@@ -176,53 +163,42 @@ package body Exp_Smem is
-- If the lock/read/write/unlock actions for this object have already
-- been emitted in the current scope, no need to perform them anew.
- if In_Transient
- and then Contains (Scope_Stack.Table (Scope_Stack.Last)
- .Locked_Shared_Objects,
- Obj)
- then
- return;
+ if In_Transient then
+ if Contains (Scope_Stack.Table (Current_Scope).Locked_Shared_Objects,
+ Obj)
+ then
+ return;
+ end if;
+
+ else
+ Establish_Transient_Scope (N, Manage_Sec_Stack => False);
end if;
Build_Full_Name (Obj, Vnm);
- -- Declare a constant string to hold the name of the shared object.
- -- Note that this must occur outside of the transient scope, as the
- -- scope's finalizer needs to have access to this object. Also, it
- -- appears that GIGI does not support elaborating string literal
- -- subtypes in transient scopes.
+ -- Declare a constant string to hold the name of the shared object
Vid := Make_Temporary (Loc, 'N', Obj);
- Vde :=
+ Insert_Action (N,
Make_Object_Declaration (Loc,
Defining_Identifier => Vid,
Constant_Present => True,
Object_Definition => New_Occurrence_Of (Standard_String, Loc),
- Expression => Make_String_Literal (Loc, Vnm));
-
- -- Already in a transient scope. Make sure that we insert Vde outside
- -- that scope.
-
- if In_Transient then
- Insert_Before_And_Analyze (Node_To_Be_Wrapped, Vde);
-
- -- Not in a transient scope yet: insert Vde as an action on N prior to
- -- establishing one.
-
- else
- Insert_Action (N, Vde);
- Establish_Transient_Scope (N, Manage_Sec_Stack => False);
- end if;
+ Expression => Make_String_Literal (Loc, Vnm)));
-- Mark object as locked in the current (transient) scope
Append_New_Elmt
- (Obj,
- To => Scope_Stack.Table (Scope_Stack.Last).Locked_Shared_Objects);
+ (Obj, Scope_Stack.Table (Current_Scope).Locked_Shared_Objects);
-- First insert the Lock call before
- Insert_Action (N, Build_Shared_Var_Lock_Call (RE_Shared_Var_Lock));
+ Insert_Action (N,
+ Make_Procedure_Call_Statement (Loc,
+ Name =>
+ New_Occurrence_Of (RTE (RE_Shared_Var_Lock), Loc),
+ Parameter_Associations =>
+ New_List (New_Occurrence_Of (Vid, Loc))));
-- Now, right after the Lock, insert a call to read the object
@@ -237,7 +213,12 @@ package body Exp_Smem is
-- Finally insert the Unlock call
- Append_To (Aft, Build_Shared_Var_Lock_Call (RE_Shared_Var_Unlock));
+ Append_To (Aft,
+ Make_Procedure_Call_Statement (Loc,
+ Name =>
+ New_Occurrence_Of (RTE (RE_Shared_Var_Unlock), Loc),
+ Parameter_Associations =>
+ New_List (New_Occurrence_Of (Vid, Loc))));
-- Store cleanup actions in transient scope
--
2.51.0
