Skip to content

R
riscv-gcc-1
Commit 7bf911b5 by Hristian Kirtchev Committed by Arnaud Charlet
Options

re PR ada/66242 (Front-end error if exception propagation disabled) 

2015-11-18  Hristian Kirtchev  <kirtchev@adacore.com>

	PR ada/66242

	* exp_ch3.adb (Default_Initialize_Object): Reimplemented. Abort
	defer / undefer pairs are now encapsulated in a block with
	an AT END handler. Partial finalization now takes restriction
	No_Exception_Propagation into account when generating blocks.
	* exp_ch7.adb Various reformattings.
	(Create_Finalizer): Change
	the generation of abort defer / undefer pairs and explain the
	lack of an AT END handler.
	(Process_Transient_Objects): Add generation of abort defer/undefer
	pairs.
	* exp_ch9.adb Various reformattings.
	(Build_Protected_Subprogram_Body): Use
	Build_Runtime_Call to construct a call to Abort_Defer.
	(Build_Protected_Subprogram_Call_Cleanup): Use
	Build_Runtime_Call to construct a call to Abort_Undefer.
	(Expand_N_Asynchronous_Select): Use Build_Runtime_Call to
	construct a call to Abort_Defer.
	* exp_intr.adb (Expand_Unc_Deallocation): Abort defer
	/ undefer pairs are now encapsulated in a block with
	an AT END handler. Finalization now takes restriction
	No_Exception_Propagation into account when generating blocks.
	* exp_util.ads, exp_util.adb (Wrap_Cleanup_Procedure): Removed.

From-SVN: r230531
parent 8ebcad86
Showing with 97 additions and 146 deletions
gcc/ada/exp_intr.adb
......@@ -1022,6 +1022,7 @@ package body Exp_Intr is
Abrt_Blk : Node_Id := Empty;
Abrt_Blk_Id : Entity_Id;
Abrt_HSS : Node_Id;
AUD : Entity_Id;
Fin_Blk : Node_Id;
Fin_Call : Node_Id;
......@@ -1031,10 +1032,6 @@ package body Exp_Intr is
Gen_Code : Node_Id;
Obj_Ref : Node_Id;
Dummy : Entity_Id;
-- This variable captures an unused dummy internal entity, see the
-- comment associated with its use.
begin
-- Nothing to do if we know the argument is null
......@@ -1048,10 +1045,10 @@ package body Exp_Intr is
-- Ex : Exception_Occurrence;
-- Raised : Boolean := False;
-- begin -- aborts allowed
-- begin
-- Abort_Defer;
-- begin -- exception propagation allowed
-- begin
-- [Deep_]Finalize (Obj_Ref);
-- exception
......@@ -1121,50 +1118,51 @@ package body Exp_Intr is
Exception_Handlers => New_List (
Build_Exception_Handler (Fin_Data))));
-- The finalization action must be protected by an abort defer
-- undefer pair when aborts are allowed. Generate:
-- Otherwise exception propagation is not allowed
-- begin
-- Abort_Defer;
-- <Fin_Blk>
-- at end
-- Abort_Undefer_Direct;
-- end;
else
Fin_Blk := Fin_Call;
end if;
if Abort_Allowed then
AUD := RTE (RE_Abort_Undefer_Direct);
-- The finalization action must be protected by an abort defer and
-- undefer pair when aborts are allowed. Generate:
Abrt_Blk :=
Make_Block_Statement (Loc,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (
Build_Runtime_Call (Loc, RE_Abort_Defer),
Fin_Blk),
At_End_Proc => New_Occurrence_Of (AUD, Loc)));
-- begin
-- Abort_Defer;
-- <Fin_Blk>
-- at end
-- Abort_Undefer_Direct;
-- end;
Add_Block_Identifier (Abrt_Blk, Abrt_Blk_Id);
if Abort_Allowed then
AUD := RTE (RE_Abort_Undefer_Direct);
-- Present the Abort_Undefer_Direct function to the backend so
-- that it can inline the call to the function.
Abrt_HSS :=
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (
Build_Runtime_Call (Loc, RE_Abort_Defer),
Fin_Blk),
At_End_Proc => New_Occurrence_Of (AUD, Loc));
Add_Inlined_Body (AUD, N);
Append_To (Stmts, Abrt_Blk);
Abrt_Blk :=
Make_Block_Statement (Loc,
Handled_Statement_Sequence => Abrt_HSS);
-- Otherwise aborts are not allowed. Generate a dummy entity to
-- ensure that the internal symbols are in sync when a unit is
-- compiled with and without aborts.
Add_Block_Identifier (Abrt_Blk, Abrt_Blk_Id);
Expand_At_End_Handler (Abrt_HSS, Abrt_Blk_Id);
else
Dummy := New_Internal_Entity (E_Block, Current_Scope, Loc, 'B');
Append_To (Stmts, Fin_Blk);
end if;
-- Present the Abort_Undefer_Direct function to the backend so
-- that it can inline the call to the function.
-- Otherwise exception propagation is not allowed
Add_Inlined_Body (AUD, N);
-- Otherwise aborts are not allowed
else
Append_To (Stmts, Fin_Call);
Abrt_Blk := Fin_Blk;
end if;
Append_To (Stmts, Abrt_Blk);
end if;
-- For a task type, call Free_Task before freeing the ATCB. We used to
......@@ -1174,8 +1172,8 @@ package body Exp_Intr is
-- (the task will be freed once it terminates).
if Is_Task_Type (Desig_Typ) then
Append_To
(Stmts, Cleanup_Task (N, Duplicate_Subexpr_No_Checks (Arg)));
Append_To (Stmts,
Cleanup_Task (N, Duplicate_Subexpr_No_Checks (Arg)));
-- For composite types that contain tasks, recurse over the structure
-- to build the selectors for the task subcomponents.
......@@ -1411,15 +1409,6 @@ package body Exp_Intr is
Rewrite (N, Gen_Code);
Analyze (N);
-- If we generated a block with an At_End_Proc, expand the exception
-- handler. We need to wait until after everything else is analyzed.
if Present (Abrt_Blk) then
Expand_At_End_Handler
(HSS => Handled_Statement_Sequence (Abrt_Blk),
Blk_Id => Entity (Identifier (Abrt_Blk)));
end if;
end Expand_Unc_Deallocation;
-----------------------
......
gcc/ada/exp_util.adb
......@@ -9453,19 +9453,4 @@ package body Exp_Util is
and then not Is_Predicate_Function_M (S);
end Within_Internal_Subprogram;
----------------------------
-- Wrap_Cleanup_Procedure --
----------------------------
procedure Wrap_Cleanup_Procedure (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Stseq : constant Node_Id := Handled_Statement_Sequence (N);
Stmts : constant List_Id := Statements (Stseq);
begin
if Abort_Allowed then
Prepend_To (Stmts, Build_Runtime_Call (Loc, RE_Abort_Defer));
Append_To (Stmts, Build_Runtime_Call (Loc, RE_Abort_Undefer));
end if;
end Wrap_Cleanup_Procedure;
end Exp_Util;
gcc/ada/exp_util.ads
......@@ -1020,15 +1020,6 @@ package Exp_Util is
-- predefined primitive operation. Some expansion activity (e.g. predicate
-- checks) is disabled in such.
procedure Wrap_Cleanup_Procedure (N : Node_Id);
-- Given an N_Subprogram_Body node, this procedure adds an Abort_Defer call
-- at the start of the statement sequence, and an Abort_Undefer call at the
-- end of the statement sequence. All cleanup routines (i.e. those that are
-- called from "at end" handlers) must defer abort on entry and undefer
-- abort on exit. Note that it is assumed that the code for the procedure
-- does not contain any return statements which would allow the flow of
-- control to escape doing the undefer call.
private
pragma Inline (Duplicate_Subexpr);
pragma Inline (Force_Evaluation);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment