===================================================================
@@ -711,36 +711,35 @@
-----------------------------
function Build_Exception_Handler
- (Loc : Source_Ptr;
- E_Id : Entity_Id;
- Raised_Id : Entity_Id;
+ (Data : Finalization_Exception_Data;
For_Library : Boolean := False) return Node_Id
is
Actuals : List_Id;
Proc_To_Call : Entity_Id;
begin
- pragma Assert (Present (E_Id));
- pragma Assert (Present (Raised_Id));
+ pragma Assert (Present (Data.E_Id));
+ pragma Assert (Present (Data.Raised_Id));
-- Generate:
-- Get_Current_Excep.all.all
Actuals := New_List (
- Make_Explicit_Dereference (Loc,
+ Make_Explicit_Dereference (Data.Loc,
Prefix =>
- Make_Function_Call (Loc,
+ Make_Function_Call (Data.Loc,
Name =>
- Make_Explicit_Dereference (Loc,
+ Make_Explicit_Dereference (Data.Loc,
Prefix =>
- New_Reference_To (RTE (RE_Get_Current_Excep), Loc)))));
+ New_Reference_To (RTE (RE_Get_Current_Excep),
+ Data.Loc)))));
if For_Library and then not Restricted_Profile then
Proc_To_Call := RTE (RE_Save_Library_Occurrence);
else
Proc_To_Call := RTE (RE_Save_Occurrence);
- Prepend_To (Actuals, New_Reference_To (E_Id, Loc));
+ Prepend_To (Actuals, New_Reference_To (Data.E_Id, Data.Loc));
end if;
-- Generate:
@@ -754,23 +753,23 @@
-- end if;
return
- Make_Exception_Handler (Loc,
+ Make_Exception_Handler (Data.Loc,
Exception_Choices =>
- New_List (Make_Others_Choice (Loc)),
+ New_List (Make_Others_Choice (Data.Loc)),
Statements => New_List (
- Make_If_Statement (Loc,
+ Make_If_Statement (Data.Loc,
Condition =>
- Make_Op_Not (Loc,
- Right_Opnd => New_Reference_To (Raised_Id, Loc)),
+ Make_Op_Not (Data.Loc,
+ Right_Opnd => New_Reference_To (Data.Raised_Id, Data.Loc)),
Then_Statements => New_List (
- Make_Assignment_Statement (Loc,
- Name => New_Reference_To (Raised_Id, Loc),
- Expression => New_Reference_To (Standard_True, Loc)),
+ Make_Assignment_Statement (Data.Loc,
+ Name => New_Reference_To (Data.Raised_Id, Data.Loc),
+ Expression => New_Reference_To (Standard_True, Data.Loc)),
- Make_Procedure_Call_Statement (Loc,
+ Make_Procedure_Call_Statement (Data.Loc,
Name =>
- New_Reference_To (Proc_To_Call, Loc),
+ New_Reference_To (Proc_To_Call, Data.Loc),
Parameter_Associations => Actuals)))));
end Build_Exception_Handler;
@@ -1052,21 +1051,14 @@
-- structures right from the start. Entities and lists are created once
-- it has been established that N has at least one controlled object.
- Abort_Id : Entity_Id := Empty;
- -- Entity of local flag. The flag is set when finalization is triggered
- -- by an abort.
-
Components_Built : Boolean := False;
-- A flag used to avoid double initialization of entities and lists. If
-- the flag is set then the following variables have been initialized:
--
- -- Abort_Id
-- Counter_Id
- -- E_Id
-- Finalizer_Decls
-- Finalizer_Stmts
-- Jump_Alts
- -- Raised_Id
Counter_Id : Entity_Id := Empty;
Counter_Val : Int := 0;
@@ -1076,9 +1068,8 @@
-- Declarative region of N (if available). If N is a package declaration
-- Decls denotes the visible declarations.
- E_Id : Entity_Id := Empty;
- -- Entity of the local exception occurence. The first exception which
- -- occurred during finalization is stored in E_Id and later reraised.
+ Finalizer_Data : Finalization_Exception_Data;
+ -- Data for the exception
Finalizer_Decls : List_Id := No_List;
-- Local variable declarations. This list holds the label declarations
@@ -1140,10 +1131,6 @@
Priv_Decls : List_Id := No_List;
-- The private declarations of N if N is a package declaration
- Raised_Id : Entity_Id := Empty;
- -- Entity for the raised flag. Along with E_Id, the flag is used in the
- -- propagation of exceptions which occur during finalization.
-
Spec_Id : Entity_Id := Empty;
Spec_Decls : List_Id := Top_Decls;
Stmts : List_Id := No_List;
@@ -1217,10 +1204,11 @@
Counter_Id := Make_Temporary (Loc, 'C');
Counter_Typ := Make_Temporary (Loc, 'T');
+ Finalizer_Decls := New_List;
+
if Exceptions_OK then
- Abort_Id := Make_Temporary (Loc, 'A');
- E_Id := Make_Temporary (Loc, 'E');
- Raised_Id := Make_Temporary (Loc, 'R');
+ Build_Object_Declarations
+ (Finalizer_Data, Finalizer_Decls, Loc, For_Package);
end if;
-- Since the total number of controlled objects is always known,
@@ -1280,7 +1268,6 @@
Analyze (Counter_Decl);
end if;
- Finalizer_Decls := New_List;
Jump_Alts := New_List;
end if;
@@ -1442,7 +1429,7 @@
and then Exceptions_OK
then
Append_To (Finalizer_Stmts,
- Build_Raise_Statement (Loc, Abort_Id, E_Id, Raised_Id));
+ Build_Raise_Statement (Finalizer_Data));
end if;
-- Create the jump block which controls the finalization flow
@@ -1533,14 +1520,6 @@
-- Abort_Undefer; -- Added if abort is allowed
-- end Fin_Id;
- if Has_Ctrl_Objs
- and then Exceptions_OK
- then
- Prepend_List_To (Finalizer_Decls,
- Build_Object_Declarations
- (Loc, Abort_Id, E_Id, Raised_Id, For_Package));
- end if;
-
-- Create the body of the finalizer
Body_Id := Make_Defining_Identifier (Loc, Chars (Fin_Id));
@@ -2567,7 +2546,7 @@
Exception_Handlers => New_List (
Build_Exception_Handler
- (Loc, E_Id, Raised_Id, For_Package)))));
+ (Finalizer_Data, For_Package)))));
-- When exception handlers are prohibited, the finalization call
-- appears unprotected. Any exception raised during finalization
@@ -2940,28 +2919,30 @@
-- Build_Object_Declarations --
-------------------------------
- function Build_Object_Declarations
- (Loc : Source_Ptr;
- Abort_Id : Entity_Id;
- E_Id : Entity_Id;
- Raised_Id : Entity_Id;
- For_Package : Boolean := False) return List_Id
+ procedure Build_Object_Declarations
+ (Data : out Finalization_Exception_Data;
+ Decls : List_Id;
+ Loc : Source_Ptr;
+ For_Package : Boolean := False)
is
A_Expr : Node_Id;
E_Decl : Node_Id;
- Result : List_Id;
begin
+ pragma Assert (Decls /= No_List);
+
if Restriction_Active (No_Exception_Propagation) then
- return Empty_List;
+ Data.Abort_Id := Empty;
+ Data.E_Id := Empty;
+ Data.Raised_Id := Empty;
+ return;
end if;
- pragma Assert (Present (Abort_Id));
- pragma Assert (Present (E_Id));
- pragma Assert (Present (Raised_Id));
+ Data.Abort_Id := Make_Temporary (Loc, 'A');
+ Data.E_Id := Make_Temporary (Loc, 'E');
+ Data.Raised_Id := Make_Temporary (Loc, 'R');
+ Data.Loc := Loc;
- Result := New_List;
-
-- In certain scenarios, finalization can be triggered by an abort. If
-- the finalization itself fails and raises an exception, the resulting
-- Program_Error must be supressed and replaced by an abort signal. In
@@ -2990,9 +2971,9 @@
-- Generate:
-- Abort_Id : constant Boolean := <A_Expr>;
- Append_To (Result,
+ Append_To (Decls,
Make_Object_Declaration (Loc,
- Defining_Identifier => Abort_Id,
+ Defining_Identifier => Data.Abort_Id,
Constant_Present => True,
Object_Definition => New_Reference_To (Standard_Boolean, Loc),
Expression => A_Expr));
@@ -3002,23 +2983,21 @@
E_Decl :=
Make_Object_Declaration (Loc,
- Defining_Identifier => E_Id,
+ Defining_Identifier => Data.E_Id,
Object_Definition =>
New_Reference_To (RTE (RE_Exception_Occurrence), Loc));
Set_No_Initialization (E_Decl);
- Append_To (Result, E_Decl);
+ Append_To (Decls, E_Decl);
-- Generate:
-- Raised_Id : Boolean := False;
- Append_To (Result,
+ Append_To (Decls,
Make_Object_Declaration (Loc,
- Defining_Identifier => Raised_Id,
+ Defining_Identifier => Data.Raised_Id,
Object_Definition => New_Reference_To (Standard_Boolean, Loc),
Expression => New_Reference_To (Standard_False, Loc)));
-
- return Result;
end Build_Object_Declarations;
---------------------------
@@ -3026,10 +3005,7 @@
---------------------------
function Build_Raise_Statement
- (Loc : Source_Ptr;
- Abort_Id : Entity_Id;
- E_Id : Entity_Id;
- Raised_Id : Entity_Id) return Node_Id
+ (Data : Finalization_Exception_Data) return Node_Id
is
Stmt : Node_Id;
@@ -3039,12 +3015,12 @@
if RTE_Available (RE_Raise_From_Controlled_Operation) then
Stmt :=
- Make_Procedure_Call_Statement (Loc,
+ Make_Procedure_Call_Statement (Data.Loc,
Name =>
New_Reference_To
- (RTE (RE_Raise_From_Controlled_Operation), Loc),
+ (RTE (RE_Raise_From_Controlled_Operation), Data.Loc),
Parameter_Associations =>
- New_List (New_Reference_To (E_Id, Loc)));
+ New_List (New_Reference_To (Data.E_Id, Data.Loc)));
-- Restricted runtime: exception messages are not supported and hence
-- Raise_From_Controlled_Operation is not supported. Raise Program_Error
@@ -3052,7 +3028,7 @@
else
Stmt :=
- Make_Raise_Program_Error (Loc,
+ Make_Raise_Program_Error (Data.Loc,
Reason => PE_Finalize_Raised_Exception);
end if;
@@ -3064,13 +3040,13 @@
-- end if;
return
- Make_If_Statement (Loc,
+ Make_If_Statement (Data.Loc,
Condition =>
- Make_And_Then (Loc,
- Left_Opnd => New_Reference_To (Raised_Id, Loc),
+ Make_And_Then (Data.Loc,
+ Left_Opnd => New_Reference_To (Data.Raised_Id, Data.Loc),
Right_Opnd =>
- Make_Op_Not (Loc,
- Right_Opnd => New_Reference_To (Abort_Id, Loc))),
+ Make_Op_Not (Data.Loc,
+ Right_Opnd => New_Reference_To (Data.Abort_Id, Data.Loc))),
Then_Statements => New_List (Stmt));
end Build_Raise_Statement;
@@ -4222,18 +4198,17 @@
Last_Object : Node_Id;
Related_Node : Node_Id)
is
- Abort_Id : Entity_Id;
- Built : Boolean := False;
- Desig : Entity_Id;
- E_Id : Entity_Id;
- Fin_Block : Node_Id;
- Last_Fin : Node_Id := Empty;
- Loc : Source_Ptr;
- Obj_Id : Entity_Id;
- Obj_Ref : Node_Id;
- Obj_Typ : Entity_Id;
- Raised_Id : Entity_Id;
- Stmt : Node_Id;
+ Finalizer_Data : Finalization_Exception_Data;
+ Finalizer_Decls : List_Id;
+ Built : Boolean := False;
+ Desig : Entity_Id;
+ Fin_Block : Node_Id;
+ Last_Fin : Node_Id := Empty;
+ Loc : Source_Ptr;
+ Obj_Id : Entity_Id;
+ Obj_Ref : Node_Id;
+ Obj_Typ : Entity_Id;
+ Stmt : Node_Id;
begin
-- Examine all objects in the list First_Object .. Last_Object
@@ -4266,13 +4241,12 @@
-- time around.
if not Built then
- Abort_Id := Make_Temporary (Loc, 'A');
- E_Id := Make_Temporary (Loc, 'E');
- Raised_Id := Make_Temporary (Loc, 'R');
+ Finalizer_Decls := New_List;
+ Build_Object_Declarations
+ (Finalizer_Data, Finalizer_Decls, Loc);
- Insert_List_Before_And_Analyze (First_Object,
- Build_Object_Declarations
- (Loc, Abort_Id, E_Id, Raised_Id));
+ Insert_List_Before_And_Analyze
+ (First_Object, Finalizer_Decls);
Built := True;
end if;
@@ -4306,7 +4280,7 @@
Typ => Desig)),
Exception_Handlers => New_List (
- Build_Exception_Handler (Loc, E_Id, Raised_Id))));
+ Build_Exception_Handler (Finalizer_Data))));
Insert_After_And_Analyze (Last_Object, Fin_Block);
-- The raise statement must be inserted after all the
@@ -4371,7 +4345,7 @@
and then Present (Last_Fin)
then
Insert_After_And_Analyze (Last_Fin,
- Build_Raise_Statement (Loc, Abort_Id, E_Id, Raised_Id));
+ Build_Raise_Statement (Finalizer_Data));
end if;
end Process_Transient_Objects;
@@ -4760,20 +4734,19 @@
function Build_Adjust_Or_Finalize_Statements
(Typ : Entity_Id) return List_Id
is
- Comp_Typ : constant Entity_Id := Component_Type (Typ);
- Index_List : constant List_Id := New_List;
- Loc : constant Source_Ptr := Sloc (Typ);
- Num_Dims : constant Int := Number_Dimensions (Typ);
- Abort_Id : Entity_Id := Empty;
- Call : Node_Id;
- Comp_Ref : Node_Id;
- Core_Loop : Node_Id;
- Dim : Int;
- E_Id : Entity_Id := Empty;
- J : Entity_Id;
- Loop_Id : Entity_Id;
- Raised_Id : Entity_Id := Empty;
- Stmts : List_Id;
+ Comp_Typ : constant Entity_Id := Component_Type (Typ);
+ Index_List : constant List_Id := New_List;
+ Loc : constant Source_Ptr := Sloc (Typ);
+ Num_Dims : constant Int := Number_Dimensions (Typ);
+ Finalizer_Decls : List_Id := No_List;
+ Finalizer_Data : Finalization_Exception_Data;
+ Call : Node_Id;
+ Comp_Ref : Node_Id;
+ Core_Loop : Node_Id;
+ Dim : Int;
+ J : Entity_Id;
+ Loop_Id : Entity_Id;
+ Stmts : List_Id;
Exceptions_OK : constant Boolean :=
not Restriction_Active (No_Exception_Propagation);
@@ -4802,9 +4775,8 @@
Build_Indices;
if Exceptions_OK then
- Abort_Id := Make_Temporary (Loc, 'A');
- E_Id := Make_Temporary (Loc, 'E');
- Raised_Id := Make_Temporary (Loc, 'R');
+ Finalizer_Decls := New_List;
+ Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
end if;
Comp_Ref :=
@@ -4848,7 +4820,7 @@
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (Call),
Exception_Handlers => New_List (
- Build_Exception_Handler (Loc, E_Id, Raised_Id))));
+ Build_Exception_Handler (Finalizer_Data))));
else
Core_Loop := Call;
end if;
@@ -4912,14 +4884,14 @@
if Exceptions_OK then
Append_To (Stmts,
- Build_Raise_Statement (Loc, Abort_Id, E_Id, Raised_Id));
+ Build_Raise_Statement (Finalizer_Data));
end if;
return
New_List (
Make_Block_Statement (Loc,
Declarations =>
- Build_Object_Declarations (Loc, Abort_Id, E_Id, Raised_Id),
+ Finalizer_Decls,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc, Stmts)));
end Build_Adjust_Or_Finalize_Statements;
@@ -4929,24 +4901,23 @@
---------------------------------
function Build_Initialize_Statements (Typ : Entity_Id) return List_Id is
- Comp_Typ : constant Entity_Id := Component_Type (Typ);
- Final_List : constant List_Id := New_List;
- Index_List : constant List_Id := New_List;
- Loc : constant Source_Ptr := Sloc (Typ);
- Num_Dims : constant Int := Number_Dimensions (Typ);
- Abort_Id : Entity_Id;
- Counter_Id : Entity_Id;
- Dim : Int;
- E_Id : Entity_Id := Empty;
- F : Node_Id;
- Fin_Stmt : Node_Id;
- Final_Block : Node_Id;
- Final_Loop : Node_Id;
- Init_Loop : Node_Id;
- J : Node_Id;
- Loop_Id : Node_Id;
- Raised_Id : Entity_Id := Empty;
- Stmts : List_Id;
+ Comp_Typ : constant Entity_Id := Component_Type (Typ);
+ Final_List : constant List_Id := New_List;
+ Index_List : constant List_Id := New_List;
+ Loc : constant Source_Ptr := Sloc (Typ);
+ Num_Dims : constant Int := Number_Dimensions (Typ);
+ Counter_Id : Entity_Id;
+ Dim : Int;
+ F : Node_Id;
+ Fin_Stmt : Node_Id;
+ Final_Block : Node_Id;
+ Final_Loop : Node_Id;
+ Finalizer_Data : Finalization_Exception_Data;
+ Finalizer_Decls : List_Id := No_List;
+ Init_Loop : Node_Id;
+ J : Node_Id;
+ Loop_Id : Node_Id;
+ Stmts : List_Id;
Exceptions_OK : constant Boolean :=
not Restriction_Active (No_Exception_Propagation);
@@ -5081,9 +5052,8 @@
Counter_Id := Make_Temporary (Loc, 'C');
if Exceptions_OK then
- Abort_Id := Make_Temporary (Loc, 'A');
- E_Id := Make_Temporary (Loc, 'E');
- Raised_Id := Make_Temporary (Loc, 'R');
+ Finalizer_Decls := New_List;
+ Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
end if;
-- Generate the block which houses the finalization call, the index
@@ -5112,7 +5082,7 @@
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (Build_Finalization_Call),
Exception_Handlers => New_List (
- Build_Exception_Handler (Loc, E_Id, Raised_Id))));
+ Build_Exception_Handler (Finalizer_Data))));
else
Fin_Stmt := Build_Finalization_Call;
end if;
@@ -5204,14 +5174,14 @@
if Exceptions_OK then
Append_To (Stmts,
- Build_Raise_Statement (Loc, Abort_Id, E_Id, Raised_Id));
+ Build_Raise_Statement (Finalizer_Data));
Append_To (Stmts, Make_Raise_Statement (Loc));
end if;
Final_Block :=
Make_Block_Statement (Loc,
Declarations =>
- Build_Object_Declarations (Loc, Abort_Id, E_Id, Raised_Id),
+ Finalizer_Decls,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc, Statements => Stmts));
@@ -5583,14 +5553,13 @@
-----------------------------
function Build_Adjust_Statements (Typ : Entity_Id) return List_Id is
- Loc : constant Source_Ptr := Sloc (Typ);
- Typ_Def : constant Node_Id := Type_Definition (Parent (Typ));
- Abort_Id : Entity_Id := Empty;
- Bod_Stmts : List_Id;
- E_Id : Entity_Id := Empty;
- Raised_Id : Entity_Id := Empty;
- Rec_Def : Node_Id;
- Var_Case : Node_Id;
+ Loc : constant Source_Ptr := Sloc (Typ);
+ Typ_Def : constant Node_Id := Type_Definition (Parent (Typ));
+ Bod_Stmts : List_Id;
+ Finalizer_Data : Finalization_Exception_Data;
+ Finalizer_Decls : List_Id := No_List;
+ Rec_Def : Node_Id;
+ Var_Case : Node_Id;
Exceptions_OK : constant Boolean :=
not Restriction_Active (No_Exception_Propagation);
@@ -5654,7 +5623,7 @@
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (Adj_Stmt),
Exception_Handlers => New_List (
- Build_Exception_Handler (Loc, E_Id, Raised_Id))));
+ Build_Exception_Handler (Finalizer_Data))));
end if;
Append_To (Stmts, Adj_Stmt);
@@ -5792,9 +5761,8 @@
begin
if Exceptions_OK then
- Abort_Id := Make_Temporary (Loc, 'A');
- E_Id := Make_Temporary (Loc, 'E');
- Raised_Id := Make_Temporary (Loc, 'R');
+ Finalizer_Decls := New_List;
+ Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
end if;
if Nkind (Typ_Def) = N_Derived_Type_Definition then
@@ -5891,7 +5859,7 @@
Statements => New_List (Adj_Stmt),
Exception_Handlers => New_List (
Build_Exception_Handler
- (Loc, E_Id, Raised_Id))));
+ (Finalizer_Data))));
end if;
Prepend_To (Bod_Stmts, Adj_Stmt);
@@ -5942,7 +5910,7 @@
Statements => New_List (Adj_Stmt),
Exception_Handlers => New_List (
Build_Exception_Handler
- (Loc, E_Id, Raised_Id))));
+ (Finalizer_Data))));
end if;
Append_To (Bod_Stmts,
@@ -5981,14 +5949,14 @@
else
if Exceptions_OK then
Append_To (Bod_Stmts,
- Build_Raise_Statement (Loc, Abort_Id, E_Id, Raised_Id));
+ Build_Raise_Statement (Finalizer_Data));
end if;
return
New_List (
Make_Block_Statement (Loc,
Declarations =>
- Build_Object_Declarations (Loc, Abort_Id, E_Id, Raised_Id),
+ Finalizer_Decls,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc, Bod_Stmts)));
end if;
@@ -5999,15 +5967,14 @@
-------------------------------
function Build_Finalize_Statements (Typ : Entity_Id) return List_Id is
- Loc : constant Source_Ptr := Sloc (Typ);
- Typ_Def : constant Node_Id := Type_Definition (Parent (Typ));
- Abort_Id : Entity_Id := Empty;
- Bod_Stmts : List_Id;
- Counter : Int := 0;
- E_Id : Entity_Id := Empty;
- Raised_Id : Entity_Id := Empty;
- Rec_Def : Node_Id;
- Var_Case : Node_Id;
+ Loc : constant Source_Ptr := Sloc (Typ);
+ Typ_Def : constant Node_Id := Type_Definition (Parent (Typ));
+ Bod_Stmts : List_Id;
+ Counter : Int := 0;
+ Finalizer_Data : Finalization_Exception_Data;
+ Finalizer_Decls : List_Id := No_List;
+ Rec_Def : Node_Id;
+ Var_Case : Node_Id;
Exceptions_OK : constant Boolean :=
not Restriction_Active (No_Exception_Propagation);
@@ -6140,7 +6107,7 @@
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (Fin_Stmt),
Exception_Handlers => New_List (
- Build_Exception_Handler (Loc, E_Id, Raised_Id))));
+ Build_Exception_Handler (Finalizer_Data))));
end if;
Append_To (Stmts, Fin_Stmt);
@@ -6372,9 +6339,8 @@
begin
if Exceptions_OK then
- Abort_Id := Make_Temporary (Loc, 'A');
- E_Id := Make_Temporary (Loc, 'E');
- Raised_Id := Make_Temporary (Loc, 'R');
+ Finalizer_Decls := New_List;
+ Build_Object_Declarations (Finalizer_Data, Finalizer_Decls, Loc);
end if;
if Nkind (Typ_Def) = N_Derived_Type_Definition then
@@ -6473,7 +6439,7 @@
Statements => New_List (Fin_Stmt),
Exception_Handlers => New_List (
Build_Exception_Handler
- (Loc, E_Id, Raised_Id))));
+ (Finalizer_Data))));
end if;
Append_To (Bod_Stmts, Fin_Stmt);
@@ -6526,7 +6492,7 @@
Statements => New_List (Fin_Stmt),
Exception_Handlers => New_List (
Build_Exception_Handler
- (Loc, E_Id, Raised_Id))));
+ (Finalizer_Data))));
end if;
Prepend_To (Bod_Stmts,
@@ -6563,14 +6529,14 @@
else
if Exceptions_OK then
Append_To (Bod_Stmts,
- Build_Raise_Statement (Loc, Abort_Id, E_Id, Raised_Id));
+ Build_Raise_Statement (Finalizer_Data));
end if;
return
New_List (
Make_Block_Statement (Loc,
Declarations =>
- Build_Object_Declarations (Loc, Abort_Id, E_Id, Raised_Id),
+ Finalizer_Decls,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc, Bod_Stmts)));
end if;
===================================================================
@@ -40,10 +40,39 @@
-- Create the procedures Deep_Initialize, Deep_Adjust and Deep_Finalize
-- that take care of finalization management at run-time.
- function Build_Exception_Handler
- (Loc : Source_Ptr;
+ -- Support of exceptions from user finalization procedures
+ --
+ -- There is a specific mechanism to handle these exceptions, continue
+ -- finalization and then raise PE.
+ -- This mechanism is used by this package but also by exp_intr for
+ -- Ada.Unchecked_Deallocation.
+ -- There are 3 subprograms to use this mechanism, and the type
+ -- Finalization_Exception_Data carries internal data between these
+ -- subprograms:
+ --
+ -- 1. Build_Object_Declaration: create the variables for the next two
+ -- subprograms.
+ -- 2. Build_Exception_Handler: create the exception handler for a call to
+ -- a user finalization procedure.
+ -- 3. Build_Raise_Stmt: create the code to potentially raise a PE exception
+ -- if am exception was raise in a user finalization procedure.
+ type Finalization_Exception_Data is record
+ Loc : Source_Ptr;
+ -- Sloc for the added nodes
+
+ Abort_Id : Entity_Id;
+ -- Boolean variable set to true if the finalization was triggered by
+ -- an abort.
+
E_Id : Entity_Id;
+ -- Variable containing the exception occurrence raised by user code
+
Raised_Id : Entity_Id;
+ -- Boolean variable set to true if an exception was raised in user code
+ end record;
+
+ function Build_Exception_Handler
+ (Data : Finalization_Exception_Data;
For_Library : Boolean := False) return Node_Id;
-- Subsidiary to Build_Finalizer, Make_Deep_Array_Body and Make_Deep_Record
-- _Body. Create an exception handler of the following form:
@@ -84,15 +113,14 @@
-- Build one controlling procedure when a late body overrides one of
-- the controlling operations.
- function Build_Object_Declarations
- (Loc : Source_Ptr;
- Abort_Id : Entity_Id;
- E_Id : Entity_Id;
- Raised_Id : Entity_Id;
- For_Package : Boolean := False) return List_Id;
- -- Subsidiary to Make_Deep_Array_Body and Make_Deep_Record_Body. Return a
- -- list containing the object declarations of boolean flag Abort_Id, the
- -- exception occurrence E_Id and boolean flag Raised_Id.
+ procedure Build_Object_Declarations
+ (Data : out Finalization_Exception_Data;
+ Decls : List_Id;
+ Loc : Source_Ptr;
+ For_Package : Boolean := False);
+ -- Subsidiary to Make_Deep_Array_Body and Make_Deep_Record_Body. Create the
+ -- list List containing the object declarations of boolean flag Abort_Id,
+ -- the exception occurrence E_Id and boolean flag Raised_Id.
--
-- Abort_Id : constant Boolean :=
-- Exception_Identity (Get_Current_Excep.all) =
@@ -104,10 +132,7 @@
-- Raised_Id : Boolean := False;
function Build_Raise_Statement
- (Loc : Source_Ptr;
- Abort_Id : Entity_Id;
- E_Id : Entity_Id;
- Raised_Id : Entity_Id) return Node_Id;
+ (Data : Finalization_Exception_Data) return Node_Id;
-- Subsidiary to routines Build_Finalizer, Make_Deep_Array_Body and Make_
-- Deep_Record_Body. Generate the following conditional raise statement:
--
===================================================================
@@ -876,23 +876,23 @@
-- structures to find and terminate those components.
procedure Expand_Unc_Deallocation (N : Node_Id) is
- Arg : constant Node_Id := First_Actual (N);
- Loc : constant Source_Ptr := Sloc (N);
- Typ : constant Entity_Id := Etype (Arg);
- Desig_T : constant Entity_Id := Designated_Type (Typ);
- Rtyp : constant Entity_Id := Underlying_Type (Root_Type (Typ));
- Pool : constant Entity_Id := Associated_Storage_Pool (Rtyp);
- Stmts : constant List_Id := New_List;
+ Arg : constant Node_Id := First_Actual (N);
+ Loc : constant Source_Ptr := Sloc (N);
+ Typ : constant Entity_Id := Etype (Arg);
+ Desig_T : constant Entity_Id := Designated_Type (Typ);
+ Rtyp : constant Entity_Id := Underlying_Type (Root_Type (Typ));
+ Pool : constant Entity_Id := Associated_Storage_Pool (Rtyp);
+ Stmts : constant List_Id := New_List;
+ Needs_Fin : constant Boolean := Needs_Finalization (Desig_T);
- Abort_Id : Entity_Id := Empty;
+ Finalizer_Data : Finalization_Exception_Data;
+
Blk : Node_Id := Empty;
Deref : Node_Id;
- E_Id : Entity_Id := Empty;
Final_Code : List_Id;
Free_Arg : Node_Id;
Free_Node : Node_Id;
Gen_Code : Node_Id;
- Raised_Id : Entity_Id := Empty;
Arg_Known_Non_Null : constant Boolean := Known_Non_Null (N);
-- This captures whether we know the argument to be non-null so that
@@ -909,7 +909,7 @@
-- Processing for pointer to controlled type
- if Needs_Finalization (Desig_T) then
+ if Needs_Fin then
Deref :=
Make_Explicit_Dereference (Loc,
Prefix => Duplicate_Subexpr_No_Checks (Arg));
@@ -958,13 +958,8 @@
-- Save_Occurrence (E, Get_Current_Excep.all.all);
-- end;
- Abort_Id := Make_Temporary (Loc, 'A');
- E_Id := Make_Temporary (Loc, 'E');
- Raised_Id := Make_Temporary (Loc, 'R');
+ Build_Object_Declarations (Finalizer_Data, Stmts, Loc);
- Append_List_To (Stmts,
- Build_Object_Declarations (Loc, Abort_Id, E_Id, Raised_Id));
-
Final_Code := New_List (
Make_Block_Statement (Loc,
Handled_Statement_Sequence =>
@@ -974,7 +969,7 @@
Obj_Ref => Deref,
Typ => Desig_T)),
Exception_Handlers => New_List (
- Build_Exception_Handler (Loc, E_Id, Raised_Id)))));
+ Build_Exception_Handler (Finalizer_Data)))));
-- For .NET/JVM, detach the object from the containing finalization
-- collection before finalizing it.
@@ -1216,9 +1211,8 @@
-- Raise_From_Controlled_Operation (E); -- all other cases
-- end if;
- if Present (Raised_Id) then
- Append_To (Stmts,
- Build_Raise_Statement (Loc, Abort_Id, E_Id, Raised_Id));
+ if Needs_Fin then
+ Append_To (Stmts, Build_Raise_Statement (Finalizer_Data));
end if;
-- If we know the argument is non-null, then make a block statement