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 207 additions and 276 deletions
gcc/ada/exp_ch3.adb
...@@ -5197,8 +5197,8 @@ package body Exp_Ch3 is ...@@ -5197,8 +5197,8 @@ package body Exp_Ch3 is
if Ekind (Comp) = E_Component if Ekind (Comp) = E_Component
and then Chars (Comp) = Chars (Old_Comp) and then Chars (Comp) = Chars (Old_Comp)
then then
Set_Discriminant_Checking_Func (Comp, Set_Discriminant_Checking_Func
Discriminant_Checking_Func (Old_Comp)); (Comp, Discriminant_Checking_Func (Old_Comp));
end if; end if;
Next_Component (Old_Comp); Next_Component (Old_Comp);
...@@ -6083,21 +6083,20 @@ package body Exp_Ch3 is ...@@ -6083,21 +6083,20 @@ package body Exp_Ch3 is
-- Local variables -- Local variables
Exceptions_OK : constant Boolean :=
not Restriction_Active (No_Exception_Propagation);
Abrt_Blk : Node_Id; Abrt_Blk : Node_Id;
Abrt_Blk_Id : Entity_Id;
Abrt_HSS : Node_Id; Abrt_HSS : Node_Id;
Abrt_Id : Entity_Id;
Abrt_Stmts : List_Id;
Aggr_Init : Node_Id; Aggr_Init : Node_Id;
AUD : Entity_Id;
Comp_Init : List_Id := No_List; Comp_Init : List_Id := No_List;
Fin_Call : Node_Id; Fin_Call : Node_Id;
Fin_Stmts : List_Id := No_List; Init_Stmts : List_Id := No_List;
Obj_Init : Node_Id := Empty; Obj_Init : Node_Id := Empty;
Obj_Ref : Node_Id; Obj_Ref : Node_Id;
Dummy : Entity_Id;
-- This variable captures a dummy internal entity, see the comment
-- associated with its use.
-- Start of processing for Default_Initialize_Object -- Start of processing for Default_Initialize_Object
begin begin
...@@ -6112,19 +6111,25 @@ package body Exp_Ch3 is ...@@ -6112,19 +6111,25 @@ package body Exp_Ch3 is
return; return;
end if; end if;
-- Step 1: Initialize the object -- The expansion performed by this routine is as follows:
if Needs_Finalization (Typ) and then not No_Initialization (N) then -- begin
Obj_Init := -- Abort_Defer;
Make_Init_Call -- Type_Init_Proc (Obj);
(Obj_Ref => New_Occurrence_Of (Def_Id, Loc),
Typ => Typ);
end if;
-- Step 2: Initialize the components of the object -- begin
-- [Deep_]Initialize (Obj);
-- Do not initialize the components if their initialization is -- exception
-- prohibited. -- when others =>
-- [Deep_]Finalize (Obj, Self => False);
-- raise;
-- end;
-- at end
-- Abort_Undefer_Direct;
-- end;
-- Initialize the components of the object
if Has_Non_Null_Base_Init_Proc (Typ) if Has_Non_Null_Base_Init_Proc (Typ)
and then not No_Initialization (N) and then not No_Initialization (N)
...@@ -6154,7 +6159,8 @@ package body Exp_Ch3 is ...@@ -6154,7 +6159,8 @@ package body Exp_Ch3 is
elsif Build_Equivalent_Aggregate then elsif Build_Equivalent_Aggregate then
null; null;
-- Otherwise invoke the type init proc -- Otherwise invoke the type init proc, generate:
-- Type_Init_Proc (Obj);
else else
Obj_Ref := New_Object_Reference; Obj_Ref := New_Object_Reference;
...@@ -6182,41 +6188,35 @@ package body Exp_Ch3 is ...@@ -6182,41 +6188,35 @@ package body Exp_Ch3 is
Analyze_And_Resolve (Expression (N), Typ); Analyze_And_Resolve (Expression (N), Typ);
end if; end if;
-- Step 3: Add partial finalization and abort actions, generate: -- Initialize the object, generate:
-- [Deep_]Initialize (Obj);
if Needs_Finalization (Typ) and then not No_Initialization (N) then
Obj_Init :=
Make_Init_Call
(Obj_Ref => New_Occurrence_Of (Def_Id, Loc),
Typ => Typ);
end if;
-- Build a special finalization block when both the object and its
-- controlled components are to be initialized. The block finalizes
-- the components if the object initialization fails. Generate:
-- Type_Init_Proc (Obj);
-- begin -- begin
-- Deep_Initialize (Obj); -- <Obj_Init>
-- exception -- exception
-- when others => -- when others =>
-- Deep_Finalize (Obj, Self => False); -- <Fin_Call>
-- raise; -- raise;
-- end; -- end;
-- Step 3a: Build the finalization block (if applicable)
-- The finalization block is required when both the object and its
-- controlled components are to be initialized. The block finalizes
-- the components if the object initialization fails.
if Has_Controlled_Component (Typ) if Has_Controlled_Component (Typ)
and then Present (Comp_Init) and then Present (Comp_Init)
and then Present (Obj_Init) and then Present (Obj_Init)
and then not Restriction_Active (No_Exception_Propagation) and then Exceptions_OK
then then
-- Generate: Init_Stmts := Comp_Init;
-- Type_Init_Proc (Obj);
Fin_Stmts := Comp_Init;
-- Generate:
-- begin
-- Deep_Initialize (Obj);
-- exception
-- when others =>
-- Deep_Finalize (Obj, Self => False);
-- raise;
-- end;
Fin_Call := Fin_Call :=
Make_Final_Call Make_Final_Call
...@@ -6232,7 +6232,7 @@ package body Exp_Ch3 is ...@@ -6232,7 +6232,7 @@ package body Exp_Ch3 is
Set_No_Elaboration_Check (Fin_Call); Set_No_Elaboration_Check (Fin_Call);
Append_To (Fin_Stmts, Append_To (Init_Stmts,
Make_Block_Statement (Loc, Make_Block_Statement (Loc,
Declarations => No_List, Declarations => No_List,
...@@ -6250,100 +6250,93 @@ package body Exp_Ch3 is ...@@ -6250,100 +6250,93 @@ package body Exp_Ch3 is
Make_Raise_Statement (Loc))))))); Make_Raise_Statement (Loc)))))));
end if; end if;
-- Finalization is not required, the initialization calls are passed -- Otherwise finalization is not required, the initialization calls
-- to the abort block building circuitry, generate: -- are passed to the abort block building circuitry, generate:
-- Type_Init_Proc (Obj); -- Type_Init_Proc (Obj);
-- Deep_Initialize (Obj); -- [Deep_]Initialize (Obj);
else else
if Present (Comp_Init) then if Present (Comp_Init) then
Fin_Stmts := Comp_Init; Init_Stmts := Comp_Init;
end if; end if;
if Present (Obj_Init) then if Present (Obj_Init) then
if No (Fin_Stmts) then if No (Init_Stmts) then
Fin_Stmts := New_List; Init_Stmts := New_List;
end if; end if;
Append_To (Fin_Stmts, Obj_Init); Append_To (Init_Stmts, Obj_Init);
end if; end if;
end if; end if;
-- Step 3b: Build the abort block (if applicable) -- Build an abort block to protect the initialization calls
-- The abort block is required when aborts are allowed in order to
-- protect both initialization calls.
if Present (Comp_Init) and then Present (Obj_Init) then
if Abort_Allowed then
if Abort_Allowed
and then Present (Comp_Init)
and then Present (Obj_Init)
then
-- Generate: -- Generate:
-- Abort_Defer; -- Abort_Defer;
Prepend_To Prepend_To (Init_Stmts, Build_Runtime_Call (Loc, RE_Abort_Defer));
(Fin_Stmts, Build_Runtime_Call (Loc, RE_Abort_Defer));
-- When exceptions are propagated, abort deferral must take place
-- in the presence of initialization or finalization exceptions.
-- Generate: -- Generate:
-- begin -- begin
-- Abort_Defer; -- Abort_Defer;
-- <finalization statements> -- <Init_Stmts>
-- at end -- at end
-- Abort_Undefer_Direct; -- Abort_Undefer_Direct;
-- end; -- end;
declare if Exceptions_OK then
AUD : constant Entity_Id := RTE (RE_Abort_Undefer_Direct); AUD := RTE (RE_Abort_Undefer_Direct);
begin
Abrt_HSS := Abrt_HSS :=
Make_Handled_Sequence_Of_Statements (Loc, Make_Handled_Sequence_Of_Statements (Loc,
Statements => Fin_Stmts, Statements => Init_Stmts,
At_End_Proc => New_Occurrence_Of (AUD, Loc)); At_End_Proc => New_Occurrence_Of (AUD, Loc));
-- Present the Abort_Undefer_Direct function to the backend
-- so that it can inline the call to the function.
Add_Inlined_Body (AUD, N);
end;
Abrt_Blk := Abrt_Blk :=
Make_Block_Statement (Loc, Make_Block_Statement (Loc,
Declarations => No_List,
Handled_Statement_Sequence => Abrt_HSS); Handled_Statement_Sequence => Abrt_HSS);
Add_Block_Identifier (Abrt_Blk, Abrt_Id); Add_Block_Identifier (Abrt_Blk, Abrt_Blk_Id);
Expand_At_End_Handler (Abrt_HSS, Abrt_Id); Expand_At_End_Handler (Abrt_HSS, Abrt_Blk_Id);
Abrt_Stmts := New_List (Abrt_Blk); -- Present the Abort_Undefer_Direct function to the backend so
-- that it can inline the call to the function.
-- Abort is not required Add_Inlined_Body (AUD, N);
else Init_Stmts := New_List (Abrt_Blk);
-- Generate a dummy entity to ensure that the internal symbols
-- are in sync when a unit is compiled with and without aborts.
-- The entity is a block with proper scope and type.
Dummy := New_Internal_Entity (E_Block, Current_Scope, Loc, 'B'); -- Otherwise exceptions are not propagated. Generate:
Set_Etype (Dummy, Standard_Void_Type);
Abrt_Stmts := Fin_Stmts;
end if;
-- No initialization calls present -- Abort_Defer;
-- <Init_Stmts>
-- Abort_Undefer;
else else
Abrt_Stmts := Fin_Stmts; Append_To (Init_Stmts,
Build_Runtime_Call (Loc, RE_Abort_Undefer));
end if;
end if; end if;
-- Step 4: Insert the whole initialization sequence into the tree -- Insert the whole initialization sequence into the tree. If the
-- If the object has a delayed freeze, as will be the case when -- object has a delayed freeze, as will be the case when it has
-- it has aspect specifications, the initialization sequence is -- aspect specifications, the initialization sequence is part of
-- part of the freeze actions. -- the freeze actions.
if Present (Init_Stmts) then
if Has_Delayed_Freeze (Def_Id) then if Has_Delayed_Freeze (Def_Id) then
Append_Freeze_Actions (Def_Id, Abrt_Stmts); Append_Freeze_Actions (Def_Id, Init_Stmts);
else else
Insert_Actions_After (After, Abrt_Stmts); Insert_Actions_After (After, Init_Stmts);
end if;
end if; end if;
end Default_Initialize_Object; end Default_Initialize_Object;
......
gcc/ada/exp_ch7.adb
...@@ -1323,13 +1323,6 @@ package body Exp_Ch7 is ...@@ -1323,13 +1323,6 @@ package body Exp_Ch7 is
---------------------- ----------------------
procedure Create_Finalizer is procedure Create_Finalizer is
Body_Id : Entity_Id;
Fin_Body : Node_Id;
Fin_Spec : Node_Id;
Jump_Block : Node_Id;
Label : Node_Id;
Label_Id : Entity_Id;
function New_Finalizer_Name return Name_Id; function New_Finalizer_Name return Name_Id;
-- Create a fully qualified name of a package spec or body finalizer. -- Create a fully qualified name of a package spec or body finalizer.
-- The generated name is of the form: xx__yy__finalize_[spec|body]. -- The generated name is of the form: xx__yy__finalize_[spec|body].
...@@ -1380,6 +1373,15 @@ package body Exp_Ch7 is ...@@ -1380,6 +1373,15 @@ package body Exp_Ch7 is
return Name_Find; return Name_Find;
end New_Finalizer_Name; end New_Finalizer_Name;
-- Local variables
Body_Id : Entity_Id;
Fin_Body : Node_Id;
Fin_Spec : Node_Id;
Jump_Block : Node_Id;
Label : Node_Id;
Label_Id : Entity_Id;
-- Start of processing for Create_Finalizer -- Start of processing for Create_Finalizer
begin begin
...@@ -1532,16 +1534,17 @@ package body Exp_Ch7 is ...@@ -1532,16 +1534,17 @@ package body Exp_Ch7 is
-- Protect the statements with abort defer/undefer. This is only when -- Protect the statements with abort defer/undefer. This is only when
-- aborts are allowed and the clean up statements require deferral or -- aborts are allowed and the clean up statements require deferral or
-- there are controlled objects to be finalized. -- there are controlled objects to be finalized. Note that the abort
-- defer/undefer pair does not require an extra block because each
-- finalization exception is caught in its corresponding finalization
-- block. As a result, the call to Abort_Defer always takes place.
if Abort_Allowed and then (Defer_Abort or Has_Ctrl_Objs) then if Abort_Allowed and then (Defer_Abort or Has_Ctrl_Objs) then
Prepend_To (Finalizer_Stmts, Prepend_To (Finalizer_Stmts,
Make_Procedure_Call_Statement (Loc, Build_Runtime_Call (Loc, RE_Abort_Defer));
Name => New_Occurrence_Of (RTE (RE_Abort_Defer), Loc)));
Append_To (Finalizer_Stmts, Append_To (Finalizer_Stmts,
Make_Procedure_Call_Statement (Loc, Build_Runtime_Call (Loc, RE_Abort_Undefer));
Name => New_Occurrence_Of (RTE (RE_Abort_Undefer), Loc)));
end if; end if;
-- The local exception does not need to be reraised for library-level -- The local exception does not need to be reraised for library-level
...@@ -1596,7 +1599,8 @@ package body Exp_Ch7 is ...@@ -1596,7 +1599,8 @@ package body Exp_Ch7 is
Defining_Unit_Name => Body_Id), Defining_Unit_Name => Body_Id),
Declarations => Finalizer_Decls, Declarations => Finalizer_Decls,
Handled_Statement_Sequence => Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc, Finalizer_Stmts)); Make_Handled_Sequence_Of_Statements (Loc,
Statements => Finalizer_Stmts));
-- Step 4: Spec and body insertion, analysis -- Step 4: Spec and body insertion, analysis
...@@ -2806,9 +2810,7 @@ package body Exp_Ch7 is ...@@ -2806,9 +2810,7 @@ package body Exp_Ch7 is
else else
-- Generate: -- Generate:
-- [Deep_]Finalize (Obj); -- No_Exception_Propagation -- begin
-- begin -- Exception handlers allowed
-- [Deep_]Finalize (Obj); -- [Deep_]Finalize (Obj);
-- exception -- exception
...@@ -4727,6 +4729,8 @@ package body Exp_Ch7 is ...@@ -4727,6 +4729,8 @@ package body Exp_Ch7 is
-- Raised : Boolean := False; -- Raised : Boolean := False;
-- begin -- begin
-- Abort_Defer;
-- begin -- begin
-- Hook_N := null; -- Hook_N := null;
-- [Deep_]Finalize (Ctrl_Trans_Obj_N); -- [Deep_]Finalize (Ctrl_Trans_Obj_N);
...@@ -4752,26 +4756,8 @@ package body Exp_Ch7 is ...@@ -4752,26 +4756,8 @@ package body Exp_Ch7 is
-- if Raised and not Abrt then -- if Raised and not Abrt then
-- Raise_From_Controlled_Operation (Ex); -- Raise_From_Controlled_Operation (Ex);
-- end if; -- end if;
-- end;
-- When restriction No_Exception_Propagation is active, the expansion
-- is as follows:
-- type Ptr_Typ_1 is access all Ctrl_Trans_Obj_1_Typ; -- Abort_Undefer_Direct;
-- Hook_1 : Ptr_Typ_1 := null;
-- Ctrl_Trans_Obj_1 : ...;
-- Hook_1 := Ctrl_Trans_Obj_1'Unrestricted_Access;
-- . . .
-- type Ptr_Typ_N is access all Ctrl_Trans_Obj_N_Typ;
-- Hook_N : Ptr_Typ_N := null;
-- Ctrl_Trans_Obj_N : ...;
-- Hook_N := Ctrl_Trans_Obj_N'Unrestricted_Access;
-- begin
-- Hook_N := null;
-- [Deep_]Finalize (Ctrl_Trans_Obj_N);
-- Hook_1 := null;
-- [Deep_]Finalize (Ctrl_Trans_Obj_1);
-- end; -- end;
-- Recognize a scenario where the transient context is an object -- Recognize a scenario where the transient context is an object
...@@ -4983,6 +4969,7 @@ package body Exp_Ch7 is ...@@ -4983,6 +4969,7 @@ package body Exp_Ch7 is
-- When exception propagation is enabled wrap the hook clear -- When exception propagation is enabled wrap the hook clear
-- statement and the finalization call into a block to catch -- statement and the finalization call into a block to catch
-- potential exceptions raised during finalization. Generate: -- potential exceptions raised during finalization. Generate:
-- begin -- begin
-- [Temp := null;] -- [Temp := null;]
-- [Deep_]Finalize (Obj_Ref); -- [Deep_]Finalize (Obj_Ref);
...@@ -5037,6 +5024,20 @@ package body Exp_Ch7 is ...@@ -5037,6 +5024,20 @@ package body Exp_Ch7 is
end loop; end loop;
if Present (Blk_Decl) then if Present (Blk_Decl) then
-- Note that the abort defer / undefer pair does not require an
-- extra block because each finalization exception is caught in
-- its corresponding finalization block. As a result, the call to
-- Abort_Defer always takes place.
if Abort_Allowed then
Prepend_To (Blk_Stmts,
Build_Runtime_Call (Loc, RE_Abort_Defer));
Append_To (Blk_Stmts,
Build_Runtime_Call (Loc, RE_Abort_Undefer));
end if;
Insert_After_And_Analyze (Blk_Ins, Blk_Decl); Insert_After_And_Analyze (Blk_Ins, Blk_Decl);
end if; end if;
end Process_Transient_Objects; end Process_Transient_Objects;
...@@ -5429,9 +5430,12 @@ package body Exp_Ch7 is ...@@ -5429,9 +5430,12 @@ package body Exp_Ch7 is
(Typ : Entity_Id) return List_Id (Typ : Entity_Id) return List_Id
is is
Comp_Typ : constant Entity_Id := Component_Type (Typ); Comp_Typ : constant Entity_Id := Component_Type (Typ);
Exceptions_OK : constant Boolean :=
not Restriction_Active (No_Exception_Propagation);
Index_List : constant List_Id := New_List; Index_List : constant List_Id := New_List;
Loc : constant Source_Ptr := Sloc (Typ); Loc : constant Source_Ptr := Sloc (Typ);
Num_Dims : constant Int := Number_Dimensions (Typ); Num_Dims : constant Int := Number_Dimensions (Typ);
Finalizer_Decls : List_Id := No_List; Finalizer_Decls : List_Id := No_List;
Finalizer_Data : Finalization_Exception_Data; Finalizer_Data : Finalization_Exception_Data;
Call : Node_Id; Call : Node_Id;
...@@ -5442,9 +5446,6 @@ package body Exp_Ch7 is ...@@ -5442,9 +5446,6 @@ package body Exp_Ch7 is
Loop_Id : Entity_Id; Loop_Id : Entity_Id;
Stmts : List_Id; Stmts : List_Id;
Exceptions_OK : constant Boolean :=
not Restriction_Active (No_Exception_Propagation);
procedure Build_Indexes; procedure Build_Indexes;
-- Generate the indexes used in the dimension loops -- Generate the indexes used in the dimension loops
...@@ -5492,9 +5493,7 @@ package body Exp_Ch7 is ...@@ -5492,9 +5493,7 @@ package body Exp_Ch7 is
-- Generate the block which houses the adjust or finalize call: -- Generate the block which houses the adjust or finalize call:
-- <adjust or finalize call>; -- No_Exception_Propagation -- begin
-- begin -- Exception handlers allowed
-- <adjust or finalize call> -- <adjust or finalize call>
-- exception -- exception
...@@ -5567,7 +5566,7 @@ package body Exp_Ch7 is ...@@ -5567,7 +5566,7 @@ package body Exp_Ch7 is
-- begin -- begin
-- <core loop> -- <core loop>
-- if Raised and then not Abort then -- Expection handlers OK -- if Raised and then not Abort then
-- Raise_From_Controlled_Operation (E); -- Raise_From_Controlled_Operation (E);
-- end if; -- end if;
-- end; -- end;
...@@ -5575,8 +5574,7 @@ package body Exp_Ch7 is ...@@ -5575,8 +5574,7 @@ package body Exp_Ch7 is
Stmts := New_List (Core_Loop); Stmts := New_List (Core_Loop);
if Exceptions_OK then if Exceptions_OK then
Append_To (Stmts, Append_To (Stmts, Build_Raise_Statement (Finalizer_Data));
Build_Raise_Statement (Finalizer_Data));
end if; end if;
return return
...@@ -5594,10 +5592,13 @@ package body Exp_Ch7 is ...@@ -5594,10 +5592,13 @@ package body Exp_Ch7 is
function Build_Initialize_Statements (Typ : Entity_Id) return List_Id is function Build_Initialize_Statements (Typ : Entity_Id) return List_Id is
Comp_Typ : constant Entity_Id := Component_Type (Typ); Comp_Typ : constant Entity_Id := Component_Type (Typ);
Exceptions_OK : constant Boolean :=
not Restriction_Active (No_Exception_Propagation);
Final_List : constant List_Id := New_List; Final_List : constant List_Id := New_List;
Index_List : constant List_Id := New_List; Index_List : constant List_Id := New_List;
Loc : constant Source_Ptr := Sloc (Typ); Loc : constant Source_Ptr := Sloc (Typ);
Num_Dims : constant Int := Number_Dimensions (Typ); Num_Dims : constant Int := Number_Dimensions (Typ);
Counter_Id : Entity_Id; Counter_Id : Entity_Id;
Dim : Int; Dim : Int;
F : Node_Id; F : Node_Id;
...@@ -5611,9 +5612,6 @@ package body Exp_Ch7 is ...@@ -5611,9 +5612,6 @@ package body Exp_Ch7 is
Loop_Id : Node_Id; Loop_Id : Node_Id;
Stmts : List_Id; Stmts : List_Id;
Exceptions_OK : constant Boolean :=
not Restriction_Active (No_Exception_Propagation);
function Build_Counter_Assignment return Node_Id; function Build_Counter_Assignment return Node_Id;
-- Generate the following assignment: -- Generate the following assignment:
-- Counter := V'Length (1) * -- Counter := V'Length (1) *
...@@ -5751,9 +5749,7 @@ package body Exp_Ch7 is ...@@ -5751,9 +5749,7 @@ package body Exp_Ch7 is
-- if Counter > 0 then -- if Counter > 0 then
-- Counter := Counter - 1; -- Counter := Counter - 1;
-- else -- else
-- [Deep_]Finalize (V (F1, ..., FN)); -- No_Except_Propagation -- begin
-- begin -- Exceptions allowed
-- [Deep_]Finalize (V (F1, ..., FN)); -- [Deep_]Finalize (V (F1, ..., FN));
-- exception -- exception
-- when others => -- when others =>
...@@ -5852,18 +5848,17 @@ package body Exp_Ch7 is ...@@ -5852,18 +5848,17 @@ package body Exp_Ch7 is
-- <final loop> -- <final loop>
-- if Raised and then not Abort then -- Exception handlers OK -- if Raised and then not Abort then
-- Raise_From_Controlled_Operation (E); -- Raise_From_Controlled_Operation (E);
-- end if; -- end if;
-- raise; -- Exception handlers OK -- raise;
-- end; -- end;
Stmts := New_List (Build_Counter_Assignment, Final_Loop); Stmts := New_List (Build_Counter_Assignment, Final_Loop);
if Exceptions_OK then if Exceptions_OK then
Append_To (Stmts, Append_To (Stmts, Build_Raise_Statement (Finalizer_Data));
Build_Raise_Statement (Finalizer_Data));
Append_To (Stmts, Make_Raise_Statement (Loc)); Append_To (Stmts, Make_Raise_Statement (Loc));
end if; end if;
...@@ -6243,17 +6238,17 @@ package body Exp_Ch7 is ...@@ -6243,17 +6238,17 @@ package body Exp_Ch7 is
----------------------------- -----------------------------
function Build_Adjust_Statements (Typ : Entity_Id) return List_Id is function Build_Adjust_Statements (Typ : Entity_Id) return List_Id is
Exceptions_OK : constant Boolean :=
not Restriction_Active (No_Exception_Propagation);
Loc : constant Source_Ptr := Sloc (Typ); Loc : constant Source_Ptr := Sloc (Typ);
Typ_Def : constant Node_Id := Type_Definition (Parent (Typ)); Typ_Def : constant Node_Id := Type_Definition (Parent (Typ));
Bod_Stmts : List_Id; Bod_Stmts : List_Id;
Finalizer_Data : Finalization_Exception_Data; Finalizer_Data : Finalization_Exception_Data;
Finalizer_Decls : List_Id := No_List; Finalizer_Decls : List_Id := No_List;
Rec_Def : Node_Id; Rec_Def : Node_Id;
Var_Case : Node_Id; Var_Case : Node_Id;
Exceptions_OK : constant Boolean :=
not Restriction_Active (No_Exception_Propagation);
function Process_Component_List_For_Adjust function Process_Component_List_For_Adjust
(Comps : Node_Id) return List_Id; (Comps : Node_Id) return List_Id;
-- Build all necessary adjust statements for a single component list -- Build all necessary adjust statements for a single component list
...@@ -6285,11 +6280,9 @@ package body Exp_Ch7 is ...@@ -6285,11 +6280,9 @@ package body Exp_Ch7 is
Adj_Stmt : Node_Id; Adj_Stmt : Node_Id;
begin begin
-- Generate: -- begin
-- [Deep_]Adjust (V.Id); -- No_Exception_Propagation
-- begin -- Exception handlers allowed
-- [Deep_]Adjust (V.Id); -- [Deep_]Adjust (V.Id);
-- exception -- exception
-- when others => -- when others =>
-- if not Raised then -- if not Raised then
...@@ -6523,10 +6516,9 @@ package body Exp_Ch7 is ...@@ -6523,10 +6516,9 @@ package body Exp_Ch7 is
Skip_Self => True); Skip_Self => True);
-- Generate: -- Generate:
-- Deep_Adjust (V._parent, False); -- No_Except_Propagat -- begin
-- begin -- Exceptions OK
-- Deep_Adjust (V._parent, False); -- Deep_Adjust (V._parent, False);
-- exception -- exception
-- when Id : others => -- when Id : others =>
-- if not Raised then -- if not Raised then
...@@ -6568,10 +6560,9 @@ package body Exp_Ch7 is ...@@ -6568,10 +6560,9 @@ package body Exp_Ch7 is
-- Generate: -- Generate:
-- if F then -- if F then
-- Adjust (V); -- No_Exception_Propagation -- begin
-- begin -- Exception handlers allowed
-- Adjust (V); -- Adjust (V);
-- exception -- exception
-- when others => -- when others =>
-- if not Raised then -- if not Raised then
...@@ -6635,8 +6626,7 @@ package body Exp_Ch7 is ...@@ -6635,8 +6626,7 @@ package body Exp_Ch7 is
else else
if Exceptions_OK then if Exceptions_OK then
Append_To (Bod_Stmts, Append_To (Bod_Stmts, Build_Raise_Statement (Finalizer_Data));
Build_Raise_Statement (Finalizer_Data));
end if; end if;
return return
...@@ -6654,8 +6644,11 @@ package body Exp_Ch7 is ...@@ -6654,8 +6644,11 @@ package body Exp_Ch7 is
------------------------------- -------------------------------
function Build_Finalize_Statements (Typ : Entity_Id) return List_Id is function Build_Finalize_Statements (Typ : Entity_Id) return List_Id is
Exceptions_OK : constant Boolean :=
not Restriction_Active (No_Exception_Propagation);
Loc : constant Source_Ptr := Sloc (Typ); Loc : constant Source_Ptr := Sloc (Typ);
Typ_Def : constant Node_Id := Type_Definition (Parent (Typ)); Typ_Def : constant Node_Id := Type_Definition (Parent (Typ));
Bod_Stmts : List_Id; Bod_Stmts : List_Id;
Counter : Int := 0; Counter : Int := 0;
Finalizer_Data : Finalization_Exception_Data; Finalizer_Data : Finalization_Exception_Data;
...@@ -6663,9 +6656,6 @@ package body Exp_Ch7 is ...@@ -6663,9 +6656,6 @@ package body Exp_Ch7 is
Rec_Def : Node_Id; Rec_Def : Node_Id;
Var_Case : Node_Id; Var_Case : Node_Id;
Exceptions_OK : constant Boolean :=
not Restriction_Active (No_Exception_Propagation);
function Process_Component_List_For_Finalize function Process_Component_List_For_Finalize
(Comps : Node_Id) return List_Id; (Comps : Node_Id) return List_Id;
-- Build all necessary finalization statements for a single component -- Build all necessary finalization statements for a single component
...@@ -7096,10 +7086,9 @@ package body Exp_Ch7 is ...@@ -7096,10 +7086,9 @@ package body Exp_Ch7 is
Skip_Self => True); Skip_Self => True);
-- Generate: -- Generate:
-- Deep_Finalize (V._parent, False); -- No_Except_Propag -- begin
-- begin -- Exceptions OK
-- Deep_Finalize (V._parent, False); -- Deep_Finalize (V._parent, False);
-- exception -- exception
-- when Id : others => -- when Id : others =>
-- if not Raised then -- if not Raised then
...@@ -7142,10 +7131,9 @@ package body Exp_Ch7 is ...@@ -7142,10 +7131,9 @@ package body Exp_Ch7 is
-- Generate: -- Generate:
-- if F then -- if F then
-- Finalize (V); -- No_Exception_Propagation
-- begin -- begin
-- Finalize (V); -- Finalize (V);
-- exception -- exception
-- when others => -- when others =>
-- if not Raised then -- if not Raised then
...@@ -7207,8 +7195,7 @@ package body Exp_Ch7 is ...@@ -7207,8 +7195,7 @@ package body Exp_Ch7 is
else else
if Exceptions_OK then if Exceptions_OK then
Append_To (Bod_Stmts, Append_To (Bod_Stmts, Build_Raise_Statement (Finalizer_Data));
Build_Raise_Statement (Finalizer_Data));
end if; end if;
return return
......
gcc/ada/exp_ch9.adb
...@@ -4315,14 +4315,17 @@ package body Exp_Ch9 is ...@@ -4315,14 +4315,17 @@ package body Exp_Ch9 is
if Nkind (Op_Spec) = N_Function_Specification then if Nkind (Op_Spec) = N_Function_Specification then
if Exc_Safe then if Exc_Safe then
R := Make_Temporary (Loc, 'R'); R := Make_Temporary (Loc, 'R');
Unprot_Call := Unprot_Call :=
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
Defining_Identifier => R, Defining_Identifier => R,
Constant_Present => True, Constant_Present => True,
Object_Definition => New_Copy (Result_Definition (N_Op_Spec)), Object_Definition =>
New_Copy (Result_Definition (N_Op_Spec)),
Expression => Expression =>
Make_Function_Call (Loc, Make_Function_Call (Loc,
Name => Make_Identifier (Loc, Name =>
Make_Identifier (Loc,
Chars => Chars (Defining_Unit_Name (N_Op_Spec))), Chars => Chars (Defining_Unit_Name (N_Op_Spec))),
Parameter_Associations => Uactuals)); Parameter_Associations => Uactuals));
...@@ -4331,8 +4334,10 @@ package body Exp_Ch9 is ...@@ -4331,8 +4334,10 @@ package body Exp_Ch9 is
Expression => New_Occurrence_Of (R, Loc)); Expression => New_Occurrence_Of (R, Loc));
else else
Unprot_Call := Make_Simple_Return_Statement (Loc, Unprot_Call :=
Expression => Make_Function_Call (Loc, Make_Simple_Return_Statement (Loc,
Expression =>
Make_Function_Call (Loc,
Name => Name =>
Make_Identifier (Loc, Make_Identifier (Loc,
Chars => Chars (Defining_Unit_Name (N_Op_Spec))), Chars => Chars (Defining_Unit_Name (N_Op_Spec))),
...@@ -4354,7 +4359,8 @@ package body Exp_Ch9 is ...@@ -4354,7 +4359,8 @@ package body Exp_Ch9 is
-- Wrap call in block that will be covered by an at_end handler -- Wrap call in block that will be covered by an at_end handler
if not Exc_Safe then if not Exc_Safe then
Unprot_Call := Make_Block_Statement (Loc, Unprot_Call :=
Make_Block_Statement (Loc,
Handled_Statement_Sequence => Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc, Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (Unprot_Call))); Statements => New_List (Unprot_Call)));
...@@ -4385,15 +4391,14 @@ package body Exp_Ch9 is ...@@ -4385,15 +4391,14 @@ package body Exp_Ch9 is
Selector_Name => Make_Identifier (Loc, Name_uObject)), Selector_Name => Make_Identifier (Loc, Name_uObject)),
Attribute_Name => Name_Unchecked_Access); Attribute_Name => Name_Unchecked_Access);
Lock_Stmt := Make_Procedure_Call_Statement (Loc, Lock_Stmt :=
Make_Procedure_Call_Statement (Loc,
Name => Lock_Name, Name => Lock_Name,
Parameter_Associations => New_List (Object_Parm)); Parameter_Associations => New_List (Object_Parm));
if Abort_Allowed then if Abort_Allowed then
Stmts := New_List ( Stmts := New_List (
Make_Procedure_Call_Statement (Loc, Build_Runtime_Call (Loc, RE_Abort_Defer),
Name => New_Occurrence_Of (RTE (RE_Abort_Defer), Loc),
Parameter_Associations => Empty_List),
Lock_Stmt); Lock_Stmt);
else else
...@@ -4417,12 +4422,13 @@ package body Exp_Ch9 is ...@@ -4417,12 +4422,13 @@ package body Exp_Ch9 is
Build_Protected_Subprogram_Call_Cleanup (Op_Spec, Pid, Loc, Stmts); Build_Protected_Subprogram_Call_Cleanup (Op_Spec, Pid, Loc, Stmts);
if Nkind (Op_Spec) = N_Function_Specification then if Nkind (Op_Spec) = N_Function_Specification then
Append (Return_Stmt, Stmts); Append_To (Stmts, Return_Stmt);
Append (Make_Block_Statement (Loc, Append_To (Pre_Stmts,
Make_Block_Statement (Loc,
Declarations => New_List (Unprot_Call), Declarations => New_List (Unprot_Call),
Handled_Statement_Sequence => Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc, Make_Handled_Sequence_Of_Statements (Loc,
Statements => Stmts)), Pre_Stmts); Statements => Stmts)));
Stmts := Pre_Stmts; Stmts := Pre_Stmts;
end if; end if;
end if; end if;
...@@ -4594,11 +4600,7 @@ package body Exp_Ch9 is ...@@ -4594,11 +4600,7 @@ package body Exp_Ch9 is
-- Abort_Undefer; -- Abort_Undefer;
if Abort_Allowed then if Abort_Allowed then
Append_To (Stmts, Append_To (Stmts, Build_Runtime_Call (Loc, RE_Abort_Undefer));
Make_Procedure_Call_Statement (Loc,
Name =>
New_Occurrence_Of (RTE (RE_Abort_Undefer), Loc),
Parameter_Associations => Empty_List));
end if; end if;
end Build_Protected_Subprogram_Call_Cleanup; end Build_Protected_Subprogram_Call_Cleanup;
...@@ -7169,6 +7171,8 @@ package body Exp_Ch9 is ...@@ -7169,6 +7171,8 @@ package body Exp_Ch9 is
Name => New_Occurrence_Of (Proc, Loc))); Name => New_Occurrence_Of (Proc, Loc)));
end Rewrite_Abortable_Part; end Rewrite_Abortable_Part;
-- Start of processing for Expand_N_Asynchronous_Select
begin begin
Process_Statements_For_Controlled_Objects (Trig); Process_Statements_For_Controlled_Objects (Trig);
Process_Statements_For_Controlled_Objects (Abrt); Process_Statements_For_Controlled_Objects (Abrt);
...@@ -7426,8 +7430,7 @@ package body Exp_Ch9 is ...@@ -7426,8 +7430,7 @@ package body Exp_Ch9 is
Name_uDisp_Asynchronous_Select), Name_uDisp_Asynchronous_Select),
Loc), Loc),
Parameter_Associations => Parameter_Associations => New_List (
New_List (
New_Copy_Tree (Obj), -- <object> New_Copy_Tree (Obj), -- <object>
New_Occurrence_Of (S, Loc), -- S New_Occurrence_Of (S, Loc), -- S
Make_Attribute_Reference (Loc, -- P'Address Make_Attribute_Reference (Loc, -- P'Address
...@@ -7439,10 +7442,7 @@ package body Exp_Ch9 is ...@@ -7439,10 +7442,7 @@ package body Exp_Ch9 is
-- Generate: -- Generate:
-- Abort_Defer; -- Abort_Defer;
Prepend_To (TaskE_Stmts, Prepend_To (TaskE_Stmts, Build_Runtime_Call (Loc, RE_Abort_Defer));
Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (RTE (RE_Abort_Defer), Loc),
Parameter_Associations => No_List));
-- Generate: -- Generate:
-- Abort_Undefer; -- Abort_Undefer;
...@@ -7450,10 +7450,8 @@ package body Exp_Ch9 is ...@@ -7450,10 +7450,8 @@ package body Exp_Ch9 is
Cleanup_Stmts := New_Copy_List_Tree (Astats); Cleanup_Stmts := New_Copy_List_Tree (Astats);
Prepend_To (Cleanup_Stmts, Prepend_To
Make_Procedure_Call_Statement (Loc, (Cleanup_Stmts, Build_Runtime_Call (Loc, RE_Abort_Undefer));
Name => New_Occurrence_Of (RTE (RE_Abort_Undefer), Loc),
Parameter_Associations => No_List));
-- Wrap the statements in a block. Exp_Ch7.Expand_Cleanup_Actions -- Wrap the statements in a block. Exp_Ch7.Expand_Cleanup_Actions
-- will generate a _clean for the additional status flag. -- will generate a _clean for the additional status flag.
...@@ -7640,9 +7638,7 @@ package body Exp_Ch9 is ...@@ -7640,9 +7638,7 @@ package body Exp_Ch9 is
Hdle := New_List (Build_Abort_Block_Handler (Loc)); Hdle := New_List (Build_Abort_Block_Handler (Loc));
Prepend_To (Astats, Prepend_To (Astats, Build_Runtime_Call (Loc, RE_Abort_Undefer));
Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (RTE (RE_Abort_Undefer), Loc)));
Abortable_Block := Abortable_Block :=
Make_Block_Statement (Loc, Make_Block_Statement (Loc,
...@@ -7788,17 +7784,14 @@ package body Exp_Ch9 is ...@@ -7788,17 +7784,14 @@ package body Exp_Ch9 is
Has_Created_Identifier => True, Has_Created_Identifier => True,
Is_Asynchronous_Call_Block => True); Is_Asynchronous_Call_Block => True);
if Exception_Mechanism = Back_End_Exceptions then -- Aborts are not deferred at beginning of exception handlers in
-- ZCX.
-- Aborts are not deferred at beginning of exception handlers
-- in ZCX.
if Exception_Mechanism = Back_End_Exceptions then
Handler_Stmt := Make_Null_Statement (Loc); Handler_Stmt := Make_Null_Statement (Loc);
else else
Handler_Stmt := Make_Procedure_Call_Statement (Loc, Handler_Stmt := Build_Runtime_Call (Loc, RE_Abort_Undefer);
Name => New_Occurrence_Of (RTE (RE_Abort_Undefer), Loc),
Parameter_Associations => No_List);
end if; end if;
Stmts := New_List ( Stmts := New_List (
...@@ -7881,9 +7874,7 @@ package body Exp_Ch9 is ...@@ -7881,9 +7874,7 @@ package body Exp_Ch9 is
Hdle := New_List (Build_Abort_Block_Handler (Loc)); Hdle := New_List (Build_Abort_Block_Handler (Loc));
Prepend_To (Astats, Prepend_To (Astats, Build_Runtime_Call (Loc, RE_Abort_Undefer));
Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (RTE (RE_Abort_Undefer), Loc)));
Abortable_Block := Abortable_Block :=
Make_Block_Statement (Loc, Make_Block_Statement (Loc,
...@@ -7927,10 +7918,7 @@ package body Exp_Ch9 is ...@@ -7927,10 +7918,7 @@ package body Exp_Ch9 is
-- Protected the call against abort -- Protected the call against abort
Prepend_To (Stmts, Prepend_To (Stmts, Build_Runtime_Call (Loc, RE_Abort_Defer));
Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (RTE (RE_Abort_Defer), Loc),
Parameter_Associations => Empty_List));
end if; end if;
Set_Entry_Cancel_Parameter (Blk_Ent, Cancel_Param); Set_Entry_Cancel_Parameter (Blk_Ent, Cancel_Param);
...@@ -10762,9 +10750,7 @@ package body Exp_Ch9 is ...@@ -10762,9 +10750,7 @@ package body Exp_Ch9 is
-- analysis with unknown calls, so don't do it. -- analysis with unknown calls, so don't do it.
if not CodePeer_Mode then if not CodePeer_Mode then
Call := Call := Build_Runtime_Call (Loc, RE_Abort_Undefer);
Make_Procedure_Call_Statement (Eloc,
Name => New_Occurrence_Of (RTE (RE_Abort_Undefer), Eloc));
Insert_Before Insert_Before
(First (Statements (Handled_Statement_Sequence (First (Statements (Handled_Statement_Sequence
(Accept_Statement (Alt)))), (Accept_Statement (Alt)))),
......
gcc/ada/exp_intr.adb
...@@ -1022,6 +1022,7 @@ package body Exp_Intr is ...@@ -1022,6 +1022,7 @@ package body Exp_Intr is
Abrt_Blk : Node_Id := Empty; Abrt_Blk : Node_Id := Empty;
Abrt_Blk_Id : Entity_Id; Abrt_Blk_Id : Entity_Id;
Abrt_HSS : Node_Id;
AUD : Entity_Id; AUD : Entity_Id;
Fin_Blk : Node_Id; Fin_Blk : Node_Id;
Fin_Call : Node_Id; Fin_Call : Node_Id;
...@@ -1031,10 +1032,6 @@ package body Exp_Intr is ...@@ -1031,10 +1032,6 @@ package body Exp_Intr is
Gen_Code : Node_Id; Gen_Code : Node_Id;
Obj_Ref : 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 begin
-- Nothing to do if we know the argument is null -- Nothing to do if we know the argument is null
...@@ -1048,10 +1045,10 @@ package body Exp_Intr is ...@@ -1048,10 +1045,10 @@ package body Exp_Intr is
-- Ex : Exception_Occurrence; -- Ex : Exception_Occurrence;
-- Raised : Boolean := False; -- Raised : Boolean := False;
-- begin -- aborts allowed -- begin
-- Abort_Defer; -- Abort_Defer;
-- begin -- exception propagation allowed -- begin
-- [Deep_]Finalize (Obj_Ref); -- [Deep_]Finalize (Obj_Ref);
-- exception -- exception
...@@ -1121,7 +1118,13 @@ package body Exp_Intr is ...@@ -1121,7 +1118,13 @@ package body Exp_Intr is
Exception_Handlers => New_List ( Exception_Handlers => New_List (
Build_Exception_Handler (Fin_Data)))); Build_Exception_Handler (Fin_Data))));
-- The finalization action must be protected by an abort defer -- Otherwise exception propagation is not allowed
else
Fin_Blk := Fin_Call;
end if;
-- The finalization action must be protected by an abort defer and
-- undefer pair when aborts are allowed. Generate: -- undefer pair when aborts are allowed. Generate:
-- begin -- begin
...@@ -1134,37 +1137,32 @@ package body Exp_Intr is ...@@ -1134,37 +1137,32 @@ package body Exp_Intr is
if Abort_Allowed then if Abort_Allowed then
AUD := RTE (RE_Abort_Undefer_Direct); AUD := RTE (RE_Abort_Undefer_Direct);
Abrt_Blk := Abrt_HSS :=
Make_Block_Statement (Loc,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc, Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List ( Statements => New_List (
Build_Runtime_Call (Loc, RE_Abort_Defer), Build_Runtime_Call (Loc, RE_Abort_Defer),
Fin_Blk), Fin_Blk),
At_End_Proc => New_Occurrence_Of (AUD, Loc))); At_End_Proc => New_Occurrence_Of (AUD, Loc));
Abrt_Blk :=
Make_Block_Statement (Loc,
Handled_Statement_Sequence => Abrt_HSS);
Add_Block_Identifier (Abrt_Blk, Abrt_Blk_Id); Add_Block_Identifier (Abrt_Blk, Abrt_Blk_Id);
Expand_At_End_Handler (Abrt_HSS, Abrt_Blk_Id);
-- Present the Abort_Undefer_Direct function to the backend so -- Present the Abort_Undefer_Direct function to the backend so
-- that it can inline the call to the function. -- that it can inline the call to the function.
Add_Inlined_Body (AUD, N); Add_Inlined_Body (AUD, N);
Append_To (Stmts, Abrt_Blk);
-- Otherwise aborts are not allowed. Generate a dummy entity to -- Otherwise aborts are not allowed
-- ensure that the internal symbols are in sync when a unit is
-- compiled with and without aborts.
else else
Dummy := New_Internal_Entity (E_Block, Current_Scope, Loc, 'B'); Abrt_Blk := Fin_Blk;
Append_To (Stmts, Fin_Blk);
end if; end if;
-- Otherwise exception propagation is not allowed Append_To (Stmts, Abrt_Blk);
else
Append_To (Stmts, Fin_Call);
end if;
end if; end if;
-- For a task type, call Free_Task before freeing the ATCB. We used to -- For a task type, call Free_Task before freeing the ATCB. We used to
...@@ -1174,8 +1172,8 @@ package body Exp_Intr is ...@@ -1174,8 +1172,8 @@ package body Exp_Intr is
-- (the task will be freed once it terminates). -- (the task will be freed once it terminates).
if Is_Task_Type (Desig_Typ) then if Is_Task_Type (Desig_Typ) then
Append_To Append_To (Stmts,
(Stmts, Cleanup_Task (N, Duplicate_Subexpr_No_Checks (Arg))); Cleanup_Task (N, Duplicate_Subexpr_No_Checks (Arg)));
-- For composite types that contain tasks, recurse over the structure -- For composite types that contain tasks, recurse over the structure
-- to build the selectors for the task subcomponents. -- to build the selectors for the task subcomponents.
...@@ -1411,15 +1409,6 @@ package body Exp_Intr is ...@@ -1411,15 +1409,6 @@ package body Exp_Intr is
Rewrite (N, Gen_Code); Rewrite (N, Gen_Code);
Analyze (N); 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; end Expand_Unc_Deallocation;
----------------------- -----------------------
......
gcc/ada/exp_util.adb
...@@ -9453,19 +9453,4 @@ package body Exp_Util is ...@@ -9453,19 +9453,4 @@ package body Exp_Util is
and then not Is_Predicate_Function_M (S); and then not Is_Predicate_Function_M (S);
end Within_Internal_Subprogram; 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; end Exp_Util;
gcc/ada/exp_util.ads
...@@ -1020,15 +1020,6 @@ package Exp_Util is ...@@ -1020,15 +1020,6 @@ package Exp_Util is
-- predefined primitive operation. Some expansion activity (e.g. predicate -- predefined primitive operation. Some expansion activity (e.g. predicate
-- checks) is disabled in such. -- 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 private
pragma Inline (Duplicate_Subexpr); pragma Inline (Duplicate_Subexpr);
pragma Inline (Force_Evaluation); 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