OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[Ada] Abort defer mismatch with SJLJ exceptions

Browse Source 
gcc/ada/

	* libgnarl/s-tasren.adb (Local_Complete_Rendezvous): Always call
	Defer_Abort.
	* libgnat/a-except.adb: Abort does not need to be deferred.
	* libgnarl/s-tpobop.adb (Exceptional_Complete_Entry_Body): Abort
	never needs to be undeferred here.
	* exp_ch11.adb (Expand_Exception_Handlers): Remove difference
	between ZCX and SJLJ.
	* exp_ch9.adb (Expand_N_Asynchronous_Select): Remove different
	handling for sjlj.
	* exp_sel.ads, exp_sel.adb (Build_Abort_Block,
	Build_Abort_Block_Handler): Ditto.
This commit is contained in:
Arnaud Charlet 2020-11-02 05:02:00 -05:00 committed by Pierre-Marie de Rodat
parent bf85ff03b3
commit 05e59503c6
7 changed files with 7 additions and 164 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
gcc/ada/exp_ch11.adb
View File

@ -189,7 +189,6 @@ package body Exp_Ch11 is
Handlrs : constant List_Id := Exception_Handlers (HSS);
Loc : constant Source_Ptr := Sloc (HSS);
Handler : Node_Id;
Others_Choice : Boolean;
Obj_Decl : Node_Id;
Next_Handler : Node_Id;
@ -197,12 +196,6 @@ package body Exp_Ch11 is
-- This procedure handles the expansion of exception handlers for the
-- optimization of local raise statements into goto statements.
procedure Prepend_Call_To_Handler
(Proc : RE_Id;
Args : List_Id := No_List);
-- Routine to prepend a call to the procedure referenced by Proc at
-- the start of the handler code for the current Handler.
procedure Replace_Raise_By_Goto (Raise_S : Node_Id; Goto_L1 : Node_Id);
-- Raise_S is a raise statement (possibly expanded, and possibly of the
-- form of a Raise_xxx_Error node with a condition. This procedure is
@ -850,36 +843,6 @@ package body Exp_Ch11 is
end;
end Expand_Local_Exception_Handlers;
-----------------------------
-- Prepend_Call_To_Handler --
-----------------------------
procedure Prepend_Call_To_Handler
(Proc : RE_Id;
Args : List_Id := No_List)
is
Ent : constant Entity_Id := RTE (Proc);
begin
-- If we have no Entity, then we are probably in no run time mode or
-- some weird error has occurred. In either case do nothing. Note use
-- of No_Location to hide this code from the debugger, so single
-- stepping doesn't jump back and forth.
if Present (Ent) then
declare
Call : constant Node_Id :=
Make_Procedure_Call_Statement (No_Location,
Name => New_Occurrence_Of (RTE (Proc), No_Location),
Parameter_Associations => Args);
begin
Prepend_To (Statements (Handler), Call);
Analyze (Call, Suppress => All_Checks);
end;
end if;
end Prepend_Call_To_Handler;
---------------------------
-- Replace_Raise_By_Goto --
---------------------------
@ -1089,44 +1052,6 @@ package body Exp_Ch11 is
(Statements (Handler), Suppress => All_Checks);
end;
end if;
-- For the normal case, we have to worry about the state of
-- abort deferral. Generally, we defer abort during runtime
-- handling of exceptions. When control is passed to the
-- handler, then in the normal case we undefer aborts. In
-- any case this entire handling is relevant only if aborts
-- are allowed.
if Abort_Allowed
and then not ZCX_Exceptions
then
-- There are some special cases in which we do not do the
-- undefer. In particular a finalization (AT END) handler
-- wants to operate with aborts still deferred.
-- We also suppress the call if this is the special handler
-- for Abort_Signal, since if we are aborting, we want to
-- keep aborts deferred (one abort is enough).
-- If abort really needs to be deferred the expander must
-- add this call explicitly, see
-- Expand_N_Asynchronous_Select.
Others_Choice :=
Nkind (First (Exception_Choices (Handler))) =
N_Others_Choice;
if (Others_Choice
or else Entity (First (Exception_Choices (Handler))) /=
Stand.Abort_Signal)
and then not
(Others_Choice
and then
All_Others (First (Exception_Choices (Handler))))
then
Prepend_Call_To_Handler (RE_Abort_Undefer);
end if;
end if;
end if;
end if;

15
gcc/ada/exp_ch9.adb
View File

@ -7061,7 +7061,6 @@ package body Exp_Ch9 is
Enqueue_Call : Node_Id;
Formals : List_Id;
Hdle : List_Id;
Handler_Stmt : Node_Id;
Index : Node_Id;
Lim_Typ_Stmts : List_Id;
N_Orig : Node_Id;
@ -7737,16 +7736,6 @@ package body Exp_Ch9 is
Has_Created_Identifier => True,
Is_Asynchronous_Call_Block => True);
-- Aborts are not deferred at beginning of exception handlers in
-- ZCX mode.
if ZCX_Exceptions then
Handler_Stmt := Make_Null_Statement (Loc);
else
Handler_Stmt := Build_Runtime_Call (Loc, RE_Abort_Undefer);
end if;
Stmts := New_List (
Make_Block_Statement (Loc,
Handled_Statement_Sequence =>
@ -7763,11 +7752,11 @@ package body Exp_Ch9 is
Make_Implicit_Exception_Handler (Loc,
-- when Abort_Signal =>
-- Abort_Undefer.all;
-- null;
Exception_Choices =>
New_List (New_Occurrence_Of (Stand.Abort_Signal, Loc)),
Statements => New_List (Handler_Stmt))))),
Statements => New_List (Make_Null_Statement (Loc)))))),
-- if not Cancelled (Bnn) then
-- triggered statements

18
gcc/ada/exp_sel.adb
View File

@ -70,27 +70,11 @@ package body Exp_Sel is
-------------------------------
function Build_Abort_Block_Handler (Loc : Source_Ptr) return Node_Id is
Stmt : Node_Id;
begin
-- With ZCX exceptions, aborts are not defered in handlers. With SJLJ,
-- they are deferred at the beginning of Abort_Signal handlers.
if ZCX_Exceptions then
Stmt := Make_Null_Statement (Loc);
else
Stmt :=
Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (RTE (RE_Abort_Undefer), Loc),
Parameter_Associations => No_List);
end if;
return Make_Implicit_Exception_Handler (Loc,
Exception_Choices =>
New_List (New_Occurrence_Of (Stand.Abort_Signal, Loc)),
Statements => New_List (Stmt));
Statements => New_List (Make_Null_Statement (Loc)));
end Build_Abort_Block_Handler;
-------------

9
gcc/ada/exp_sel.ads
View File

@ -39,21 +39,18 @@ package Exp_Sel is
-- begin
-- Blk
-- exception
-- when Abort_Signal => Abort_Undefer / null;
-- when Abort_Signal => null;
-- end;
-- Abr_Blk_Ent is the name of the generated block, Cln_Blk_Ent is the name
-- of the encapsulated cleanup block, Blk is the actual block name.
-- The exception handler code is built by Build_Abort_Block_Handler.
function Build_Abort_Block_Handler (Loc : Source_Ptr) return Node_Id;
-- Generate if front-end exception:
-- when others =>
-- Abort_Undefer;
-- or if back-end exception:
-- Generate:
-- when others =>
-- null;
-- This is an exception handler to stop propagation of aborts, without
-- modifying the deferal level.
-- modifying the deferral level.
function Build_B
(Loc : Source_Ptr;

14
gcc/ada/libgnarl/s-tasren.adb
View File

@ -473,19 +473,7 @@ package body System.Tasking.Rendezvous is
pragma Debug
(Debug.Trace (Self_Id, "Local_Complete_Rendezvous", 'R'));
if Ex = Ada.Exceptions.Null_Id then
-- The call came from normal end-of-rendezvous, so abort is not yet
-- deferred.
Initialization.Defer_Abort (Self_Id);
elsif ZCX_By_Default then
-- With ZCX, aborts are not automatically deferred in handlers
Initialization.Defer_Abort (Self_Id);
end if;
Initialization.Defer_Abort (Self_Id);
-- We need to clean up any accepts which Self may have been serving when
-- it was aborted.

10
gcc/ada/libgnarl/s-tpobop.adb
View File

@ -246,17 +246,7 @@ package body System.Tasking.Protected_Objects.Operations is
Entry_Call.Exception_To_Raise := Ex;
if Ex /= Ada.Exceptions.Null_Id then
-- An exception was raised and abort was deferred, so adjust
-- before propagating, otherwise the task will stay with deferral
-- enabled for its remaining life.
Self_Id := STPO.Self;
if not ZCX_By_Default then
Initialization.Undefer_Abort_Nestable (Self_Id);
end if;
Transfer_Occurrence
(Entry_Call.Self.Common.Compiler_Data.Current_Excep'Access,
Self_Id.Common.Compiler_Data.Current_Excep);

30
gcc/ada/libgnat/a-except.adb
View File

@ -957,11 +957,6 @@ package body Ada.Exceptions is
begin
Exception_Data.Set_Exception_Msg (X, E, Message);
if not ZCX_By_Default then
Abort_Defer.all;
end if;
Complete_And_Propagate_Occurrence (X);
end Raise_Exception_Always;
@ -1041,11 +1036,6 @@ package body Ada.Exceptions is
begin
Exception_Data.Set_Exception_C_Msg (X, E, M);
if not ZCX_By_Default then
Abort_Defer.all;
end if;
Complete_Occurrence (X);
return X;
end Create_Occurrence_From_Signal_Handler;
@ -1141,11 +1131,6 @@ package body Ada.Exceptions is
X : constant EOA := Exception_Propagation.Allocate_Occurrence;
begin
Exception_Data.Set_Exception_C_Msg (X, E, F, L, C, M);
if not ZCX_By_Default then
Abort_Defer.all;
end if;
Complete_And_Propagate_Occurrence (X);
end Raise_With_Location_And_Msg;
@ -1168,13 +1153,6 @@ package body Ada.Exceptions is
Excep.Msg_Length := Ex.Msg_Length;
Excep.Msg (1 .. Excep.Msg_Length) := Ex.Msg (1 .. Ex.Msg_Length);
-- The following is a common pattern, should be abstracted
-- into a procedure call ???
if not ZCX_By_Default then
Abort_Defer.all;
end if;
Complete_And_Propagate_Occurrence (Excep);
end Raise_With_Msg;
@ -1507,10 +1485,6 @@ package body Ada.Exceptions is
Saved_MO : constant System.Address := Excep.Machine_Occurrence;
begin
if not ZCX_By_Default then
Abort_Defer.all;
end if;
Save_Occurrence (Excep.all, Get_Current_Excep.all.all);
Excep.Machine_Occurrence := Saved_MO;
Complete_And_Propagate_Occurrence (Excep);
@ -1556,10 +1530,6 @@ package body Ada.Exceptions is
procedure Reraise_Occurrence_Always (X : Exception_Occurrence) is
begin
if not ZCX_By_Default then
Abort_Defer.all;
end if;
Reraise_Occurrence_No_Defer (X);
end Reraise_Occurrence_Always;