From 05e59503c6e57851104649d8781727c4571a8b2c Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 2 Nov 2020 05:02:00 -0500 Subject: [PATCH] [Ada] Abort defer mismatch with SJLJ exceptions 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. --- gcc/ada/exp_ch11.adb | 75 ----------------------------------- gcc/ada/exp_ch9.adb | 15 +------ gcc/ada/exp_sel.adb | 18 +-------- gcc/ada/exp_sel.ads | 9 ++--- gcc/ada/libgnarl/s-tasren.adb | 14 +------ gcc/ada/libgnarl/s-tpobop.adb | 10 ----- gcc/ada/libgnat/a-except.adb | 30 -------------- 7 files changed, 7 insertions(+), 164 deletions(-) diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index ddd69dfce98..3ab2ea25eab 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -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; diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 7b70321c97d..525eee90029 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -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 diff --git a/gcc/ada/exp_sel.adb b/gcc/ada/exp_sel.adb index 0fe9d3b1a6a..ccf62c6d683 100644 --- a/gcc/ada/exp_sel.adb +++ b/gcc/ada/exp_sel.adb @@ -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; ------------- diff --git a/gcc/ada/exp_sel.ads b/gcc/ada/exp_sel.ads index 98ac647bd47..f2f2c5681ed 100644 --- a/gcc/ada/exp_sel.ads +++ b/gcc/ada/exp_sel.ads @@ -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; diff --git a/gcc/ada/libgnarl/s-tasren.adb b/gcc/ada/libgnarl/s-tasren.adb index 567b955dc6b..b7ee8656637 100644 --- a/gcc/ada/libgnarl/s-tasren.adb +++ b/gcc/ada/libgnarl/s-tasren.adb @@ -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. diff --git a/gcc/ada/libgnarl/s-tpobop.adb b/gcc/ada/libgnarl/s-tpobop.adb index 5537c1a4b1f..b123c197661 100644 --- a/gcc/ada/libgnarl/s-tpobop.adb +++ b/gcc/ada/libgnarl/s-tpobop.adb @@ -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); diff --git a/gcc/ada/libgnat/a-except.adb b/gcc/ada/libgnat/a-except.adb index 52e716f2412..f7fd5bb2155 100644 --- a/gcc/ada/libgnat/a-except.adb +++ b/gcc/ada/libgnat/a-except.adb @@ -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; -- 2.30.2