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;
-- 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
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 --
---------------------------
(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;
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;
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 =>
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
-------------------------------
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;
-------------
-- 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;
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.
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);
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;
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;
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;
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;
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);
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;
projects / gcc.git / commitdiff