Skip to content

R
riscv-gcc-1
Commit 06eab6a7 by Robert Dewar Committed by Arnaud Charlet
Options

exp_ch11.adb (Expand_At_End_Handler): Set From_At_End flag on raise stmt. 

2008-03-26  Robert Dewar  <dewar@adacore.com>
	    Arnaud Charlet  <charlet@adacore.com>

	* exp_ch11.adb (Expand_At_End_Handler): Set From_At_End flag on raise
	stmt.
	(No_Exception_Propagation_Active): New function.
	(Expand_Exception_Handlers): Use No_Exception_Propagation_Active.
	Update comments, and review all uses of No_Exception_Propagation, which
	are now correct and in sync with what gigi expects.

	* restrict.ads, restrict.adb (No_Exception_Propagation_Active): New
	function.
	(Expand_Exception_Handlers): Use No_Exception_Propagation_Active.
	Update comments, and review all uses of No_Exception_Propagation, which
	are now correct and in sync with what gigi expects.

From-SVN: r133560
parent e10dab7f
Showing with 143 additions and 113 deletions
gcc/ada/exp_ch11.adb
...@@ -143,12 +143,21 @@ package body Exp_Ch11 is ...@@ -143,12 +143,21 @@ package body Exp_Ch11 is
Make_Procedure_Call_Statement (Loc, Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (Clean, Loc))); Name => New_Occurrence_Of (Clean, Loc)));
-- Avoid generation of raise stmt if compiling with no exceptions -- Generate reraise statement as last statement of AT-END handler,
-- propagation -- unless we are under control of No_Exception_Propagation, in which
-- case no exception propagation is possible anyway, so we do not need
-- a reraise (the AT END handler in this case is only for normal exits
-- not for exceptional exits). Also, we flag the Reraise statement as
-- being part of an AT END handler to prevent signalling this reraise
-- as a violation of the restriction when it is not set.
if not Restriction_Active (No_Exception_Propagation) then if not Restriction_Active (No_Exception_Propagation) then
Append_To (Stmnts, declare
Make_Raise_Statement (Loc)); Rstm : constant Node_Id := Make_Raise_Statement (Loc);
begin
Set_From_At_End (Rstm);
Append_To (Stmnts, Rstm);
end;
end if; end if;
Set_Exception_Handlers (HSS, New_List ( Set_Exception_Handlers (HSS, New_List (
...@@ -963,7 +972,7 @@ package body Exp_Ch11 is ...@@ -963,7 +972,7 @@ package body Exp_Ch11 is
Handler_Loop : while Present (Handler) loop Handler_Loop : while Present (Handler) loop
Next_Handler := Next_Non_Pragma (Handler); Next_Handler := Next_Non_Pragma (Handler);
-- Remove source handler if gnat debug flag N is set -- Remove source handler if gnat debug flag .x is set
if Debug_Flag_Dot_X and then Comes_From_Source (Handler) then if Debug_Flag_Dot_X and then Comes_From_Source (Handler) then
Remove (Handler); Remove (Handler);
...@@ -971,8 +980,9 @@ package body Exp_Ch11 is ...@@ -971,8 +980,9 @@ package body Exp_Ch11 is
-- Remove handler if no exception propagation, generating a warning -- Remove handler if no exception propagation, generating a warning
-- if a source generated handler was not the target of a local raise. -- if a source generated handler was not the target of a local raise.
elsif Restriction_Active (No_Exception_Propagation) then else
if not Has_Local_Raise (Handler) if Restriction_Active (No_Exception_Propagation)
and then not Has_Local_Raise (Handler)
and then Comes_From_Source (Handler) and then Comes_From_Source (Handler)
and then Warn_On_Non_Local_Exception and then Warn_On_Non_Local_Exception
then then
...@@ -982,118 +992,124 @@ package body Exp_Ch11 is ...@@ -982,118 +992,124 @@ package body Exp_Ch11 is
Handler); Handler);
end if; end if;
Remove (Handler); if No_Exception_Propagation_Active then
Remove (Handler);
-- Exception handler is active and retained and must be processed
else
-- If an exception occurrence is present, then we must declare it
-- and initialize it from the value stored in the TSD
-- declare
-- name : Exception_Occurrence;
-- begin
-- Save_Occurrence (name, Get_Current_Excep.all)
-- ...
-- end;
if Present (Choice_Parameter (Handler)) then
declare
Cparm : constant Entity_Id := Choice_Parameter (Handler);
Clc : constant Source_Ptr := Sloc (Cparm);
Save : Node_Id;
begin
Save :=
Make_Procedure_Call_Statement (Loc,
Name =>
New_Occurrence_Of (RTE (RE_Save_Occurrence), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Cparm, Clc),
Make_Explicit_Dereference (Loc,
Make_Function_Call (Loc,
Name => Make_Explicit_Dereference (Loc,
New_Occurrence_Of
(RTE (RE_Get_Current_Excep), Loc))))));
Mark_Rewrite_Insertion (Save);
Prepend (Save, Statements (Handler));
Obj_Decl :=
Make_Object_Declaration
(Clc,
Defining_Identifier => Cparm,
Object_Definition =>
New_Occurrence_Of
(RTE (RE_Exception_Occurrence), Clc));
Set_No_Initialization (Obj_Decl, True);
Rewrite (Handler,
Make_Implicit_Exception_Handler (Loc,
Exception_Choices => Exception_Choices (Handler),
Statements => New_List (
Make_Block_Statement (Loc,
Declarations => New_List (Obj_Decl),
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => Statements (Handler))))));
Analyze_List (Statements (Handler), Suppress => All_Checks);
end;
end if;
-- The processing at this point is rather different for the JVM
-- case, so we completely separate the processing.
-- For the JVM case, we unconditionally call Update_Exception, -- Exception handler is active and retained and must be processed
-- passing a call to the intrinsic Current_Target_Exception (see
-- JVM version of Ada.Exceptions in 4jexcept.adb for details).
if VM_Target /= No_VM then else
declare -- If an exception occurrence is present, then we must declare
Arg : constant Node_Id := -- it and initialize it from the value stored in the TSD
Make_Function_Call (Loc,
Name =>
New_Occurrence_Of
(RTE (RE_Current_Target_Exception), Loc));
begin
Prepend_Call_To_Handler
(RE_Update_Exception, New_List (Arg));
end;
-- For the normal case, we have to worry about the state of -- declare
-- abort deferral. Generally, we defer abort during runtime -- name : Exception_Occurrence;
-- handling of exceptions. When control is passed to the -- begin
-- handler, then in the normal case we undefer aborts. In any -- Save_Occurrence (name, Get_Current_Excep.all)
-- case this entire handling is relevant only if aborts are -- ...
-- allowed! -- end;
elsif Abort_Allowed then if Present (Choice_Parameter (Handler)) then
declare
Cparm : constant Entity_Id := Choice_Parameter (Handler);
Clc : constant Source_Ptr := Sloc (Cparm);
Save : Node_Id;
-- There are some special cases in which we do not do the begin
-- undefer. In particular a finalization (AT END) handler Save :=
-- wants to operate with aborts still deferred. Make_Procedure_Call_Statement (Loc,
Name =>
New_Occurrence_Of (RTE (RE_Save_Occurrence), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Cparm, Clc),
Make_Explicit_Dereference (Loc,
Make_Function_Call (Loc,
Name => Make_Explicit_Dereference (Loc,
New_Occurrence_Of
(RTE (RE_Get_Current_Excep), Loc))))));
Mark_Rewrite_Insertion (Save);
Prepend (Save, Statements (Handler));
Obj_Decl :=
Make_Object_Declaration
(Clc,
Defining_Identifier => Cparm,
Object_Definition =>
New_Occurrence_Of
(RTE (RE_Exception_Occurrence), Clc));
Set_No_Initialization (Obj_Decl, True);
Rewrite (Handler,
Make_Implicit_Exception_Handler (Loc,
Exception_Choices => Exception_Choices (Handler),
Statements => New_List (
Make_Block_Statement (Loc,
Declarations => New_List (Obj_Decl),
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => Statements (Handler))))));
Analyze_List
(Statements (Handler), Suppress => All_Checks);
end;
end if;
-- We also suppress the call if this is the special handler -- The processing at this point is rather different for the JVM
-- for Abort_Signal, since if we are aborting, we want to keep -- case, so we completely separate the processing.
-- aborts deferred (one abort is enough).
-- If abort really needs to be deferred the expander must add -- For the VM case, we unconditionally call Update_Exception,
-- this call explicitly, see Expand_N_Asynchronous_Select. -- passing a call to the intrinsic Current_Target_Exception
-- (see JVM/.NET versions of Ada.Exceptions for details).
Others_Choice := if VM_Target /= No_VM then
Nkind (First (Exception_Choices (Handler))) = N_Others_Choice; declare
Arg : constant Node_Id :=
Make_Function_Call (Loc,
Name =>
New_Occurrence_Of
(RTE (RE_Current_Target_Exception), Loc));
begin
Prepend_Call_To_Handler
(RE_Update_Exception, New_List (Arg));
end;
if (Others_Choice -- For the normal case, we have to worry about the state of
or else Entity (First (Exception_Choices (Handler))) /= -- abort deferral. Generally, we defer abort during runtime
Stand.Abort_Signal) -- handling of exceptions. When control is passed to the
and then not -- handler, then in the normal case we undefer aborts. In
(Others_Choice -- any case this entire handling is relevant only if aborts
and then All_Others (First (Exception_Choices (Handler)))) -- are allowed!
and then Abort_Allowed
then elsif Abort_Allowed then
Prepend_Call_To_Handler (RE_Abort_Undefer);
-- 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))))
and then Abort_Allowed
then
Prepend_Call_To_Handler (RE_Abort_Undefer);
end if;
end if; end if;
end if; end if;
end if; end if;
...@@ -1248,7 +1264,6 @@ package body Exp_Ch11 is ...@@ -1248,7 +1264,6 @@ package body Exp_Ch11 is
Insert_List_After_And_Analyze (N, L); Insert_List_After_And_Analyze (N, L);
end if; end if;
end if; end if;
end Expand_N_Exception_Declaration; end Expand_N_Exception_Declaration;
--------------------------------------------- ---------------------------------------------
...@@ -1334,8 +1349,6 @@ package body Exp_Ch11 is ...@@ -1334,8 +1349,6 @@ package body Exp_Ch11 is
H : Node_Id; H : Node_Id;
begin begin
-- Debug_Flag_Dot_G := True;
-- Processing for locally handled exception (exclude reraise case) -- Processing for locally handled exception (exclude reraise case)
if Present (Name (N)) and then Nkind (Name (N)) = N_Identifier then if Present (Name (N)) and then Nkind (Name (N)) = N_Identifier then
......
gcc/ada/restrict.adb
...@@ -26,6 +26,7 @@ ...@@ -26,6 +26,7 @@
with Atree; use Atree; with Atree; use Atree;
with Casing; use Casing; with Casing; use Casing;
with Errout; use Errout; with Errout; use Errout;
with Debug; use Debug;
with Fname; use Fname; with Fname; use Fname;
with Fname.UF; use Fname.UF; with Fname.UF; use Fname.UF;
with Lib; use Lib; with Lib; use Lib;
...@@ -430,6 +431,18 @@ package body Restrict is ...@@ -430,6 +431,18 @@ package body Restrict is
Restrictions.Set (No_Exception_Propagation)); Restrictions.Set (No_Exception_Propagation));
end No_Exception_Handlers_Set; end No_Exception_Handlers_Set;
-------------------------------------
-- No_Exception_Propagation_Active --
-------------------------------------
function No_Exception_Propagation_Active return Boolean is
begin
return (No_Run_Time_Mode
or else Configurable_Run_Time_Mode
or else Debug_Flag_Dot_G)
and then Restriction_Active (No_Exception_Propagation);
end No_Exception_Propagation_Active;
---------------------------------- ----------------------------------
-- Process_Restriction_Synonyms -- -- Process_Restriction_Synonyms --
---------------------------------- ----------------------------------
......
gcc/ada/restrict.ads
...@@ -249,6 +249,10 @@ package Restrict is ...@@ -249,6 +249,10 @@ package Restrict is
-- set. In the latter case, the source may contain handlers but they either -- set. In the latter case, the source may contain handlers but they either
-- get converted using the local goto transformation or deleted. -- get converted using the local goto transformation or deleted.
function No_Exception_Propagation_Active return Boolean;
-- Test to see if current restrictions settings specify that no
-- exception propagation is activated.
function Process_Restriction_Synonyms (N : Node_Id) return Name_Id; function Process_Restriction_Synonyms (N : Node_Id) return Name_Id;
-- Id is a node whose Chars field contains the name of a restriction. -- Id is a node whose Chars field contains the name of a restriction.
-- If it is one of synonyms that we allow for historical purposes (for -- If it is one of synonyms that we allow for historical purposes (for
......
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