1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2023, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Namet
; use Namet
;
27 with Types
; use Types
;
31 procedure Expand_N_Package_Body
(N
: Node_Id
);
32 procedure Expand_N_Package_Declaration
(N
: Node_Id
);
34 -----------------------------
35 -- Finalization Management --
36 -----------------------------
38 procedure Build_Anonymous_Master
(Ptr_Typ
: Entity_Id
);
39 -- Build a finalization master for an anonymous access-to-controlled type
40 -- denoted by Ptr_Typ. The master is inserted in the declarations of the
43 procedure Build_Controlling_Procs
(Typ
: Entity_Id
);
44 -- Typ is a record, and array type having controlled components.
45 -- Create the procedures Deep_Initialize, Deep_Adjust and Deep_Finalize
46 -- that take care of finalization management at run-time.
48 -- Support of exceptions from user finalization procedures
50 -- There is a specific mechanism to handle these exceptions, continue
51 -- finalization and then raise PE. This mechanism is used by this package
52 -- but also by exp_intr for Ada.Unchecked_Deallocation.
54 -- There are 3 subprograms to use this mechanism, and the type
55 -- Finalization_Exception_Data carries internal data between these
58 -- 1. Build_Object_Declaration: create the variables for the next two
60 -- 2. Build_Exception_Handler: create the exception handler for a call
61 -- to a user finalization procedure.
62 -- 3. Build_Raise_Stmt: create code to potentially raise a PE exception
63 -- if an exception was raise in a user finalization procedure.
65 type Finalization_Exception_Data
is record
67 -- Sloc for the added nodes
70 -- Boolean variable set to true if the finalization was triggered by
74 -- Variable containing the exception occurrence raised by user code
76 Raised_Id
: Entity_Id
;
77 -- Boolean variable set to true if an exception was raised in user code
80 function Build_Exception_Handler
81 (Data
: Finalization_Exception_Data
;
82 For_Library
: Boolean := False) return Node_Id
;
83 -- Subsidiary to Build_Finalizer, Make_Deep_Array_Body and Make_Deep_Record
84 -- _Body. Create an exception handler of the following form:
87 -- if not Raised_Id then
89 -- Save_Occurrence (E_Id, Get_Current_Excep.all.all);
92 -- If flag For_Library is set (and not in restricted profile):
95 -- if not Raised_Id then
97 -- Save_Library_Occurrence (Get_Current_Excep.all);
100 -- E_Id denotes the defining identifier of a local exception occurrence.
101 -- Raised_Id is the entity of a local boolean flag. Flag For_Library is
102 -- used when operating at the library level, when enabled the current
103 -- exception will be saved to a global location.
105 procedure Build_Finalization_Master
107 For_Lib_Level
: Boolean := False;
108 For_Private
: Boolean := False;
109 Context_Scope
: Entity_Id
:= Empty
;
110 Insertion_Node
: Node_Id
:= Empty
);
111 -- Build a finalization master for an access type. The designated type may
112 -- not necessarily be controlled or need finalization actions depending on
113 -- the context. Flag For_Lib_Level must be set when creating a master for a
114 -- build-in-place function call access result type. Flag For_Private must
115 -- be set when the designated type contains a private component. Parameters
116 -- Context_Scope and Insertion_Node must be used in conjunction with flag
117 -- For_Private. Context_Scope is the scope of the context where the
118 -- finalization master must be analyzed. Insertion_Node is the insertion
119 -- point before which the master is to be inserted.
121 procedure Build_Finalizer
123 Clean_Stmts
: List_Id
;
126 Defer_Abort
: Boolean;
127 Fin_Id
: out Entity_Id
);
128 -- N may denote an accept statement, block, entry body, package body,
129 -- package spec, protected body, subprogram body, or a task body. Create
130 -- a procedure which contains finalization calls for all controlled objects
131 -- declared in the declarative or statement region of N. The calls are
132 -- built in reverse order relative to the original declarations. In the
133 -- case of a task body, the routine delays the creation of the finalizer
134 -- until all statements have been moved to the task body procedure.
135 -- Clean_Stmts may contain additional context-dependent code used to abort
136 -- asynchronous calls or complete tasks (see Build_Cleanup_Statements).
137 -- Mark_Id is the secondary stack used in the current context or Empty if
138 -- missing. Top_Decls is the list on which the declaration of the finalizer
139 -- is attached in the non-package case. Defer_Abort indicates that the
140 -- statements passed in perform actions that require abort to be deferred,
141 -- such as for task termination. Fin_Id is the finalizer declaration
144 procedure Build_Late_Proc
(Typ
: Entity_Id
; Nam
: Name_Id
);
145 -- Build one controlling procedure when a late body overrides one of the
146 -- controlling operations.
148 procedure Build_Object_Declarations
149 (Data
: out Finalization_Exception_Data
;
152 For_Package
: Boolean := False);
153 -- Subsidiary to Make_Deep_Array_Body and Make_Deep_Record_Body. Create the
154 -- list List containing the object declarations of boolean flag Abort_Id,
155 -- the exception occurrence E_Id and boolean flag Raised_Id.
157 -- Abort_Id : constant Boolean :=
158 -- Exception_Identity (Get_Current_Excep.all) =
159 -- Standard'Abort_Signal'Identity;
161 -- Abort_Id : constant Boolean := False; -- no abort or For_Package
163 -- E_Id : Exception_Occurrence;
164 -- Raised_Id : Boolean := False;
166 function Build_Raise_Statement
167 (Data
: Finalization_Exception_Data
) return Node_Id
;
168 -- Subsidiary to routines Build_Finalizer, Make_Deep_Array_Body and Make_
169 -- Deep_Record_Body. Generate the following conditional raise statement:
171 -- if Raised_Id and then not Abort_Id then
172 -- Raise_From_Controlled_Operation (E_Id);
175 -- Abort_Id is a local boolean flag which is set when the finalization was
176 -- triggered by an abort, E_Id denotes the defining identifier of a local
177 -- exception occurrence, Raised_Id is the entity of a local boolean flag.
179 function Make_Adjust_Call
182 Skip_Self
: Boolean := False) return Node_Id
;
183 -- Create a call to either Adjust or Deep_Adjust depending on the structure
184 -- of type Typ. Obj_Ref is an expression with no side effects (not required
185 -- to have been previously analyzed) that references the object to be
186 -- adjusted. Typ is the expected type of Obj_Ref. When Skip_Self is set,
187 -- only the components (if any) are adjusted. Return Empty if Adjust or
188 -- Deep_Adjust is not available, possibly due to previous errors.
190 function Make_Final_Call
193 Skip_Self
: Boolean := False) return Node_Id
;
194 -- Create a call to either Finalize or Deep_Finalize, depending on the
195 -- structure of type Typ. Obj_Ref is an expression (with no side effects
196 -- and is not required to have been previously analyzed) that references
197 -- the object to be finalized. Typ is the expected type of Obj_Ref. When
198 -- Skip_Self is set, only the components (if any) are finalized. Return
199 -- Empty if Finalize or Deep_Finalize is not available, possibly due to
202 procedure Make_Finalize_Address_Body
(Typ
: Entity_Id
);
203 -- Create the body of TSS routine Finalize_Address if Typ is controlled and
204 -- does not have a TSS entry for Finalize_Address. The procedure converts
205 -- an address into a pointer and subsequently calls Deep_Finalize on the
208 function Make_Init_Call
210 Typ
: Entity_Id
) return Node_Id
;
211 -- Create a call to either Initialize or Deep_Initialize, depending on the
212 -- structure of type Typ. Obj_Ref is an expression with no side effects
213 -- (not required to have been previously analyzed) that references the
214 -- object to be initialized. Typ is the expected type of Obj_Ref. Return
215 -- Empty if Initialize or Deep_Initialize is not available, possibly due to
218 function Make_Handler_For_Ctrl_Operation
(Loc
: Source_Ptr
) return Node_Id
;
219 -- Generate an implicit exception handler with an 'others' choice,
220 -- converting any occurrence to a raise of Program_Error.
222 function Make_Local_Deep_Finalize
224 Nam
: Entity_Id
) return Node_Id
;
225 -- Create a special version of Deep_Finalize with identifier Nam. The
226 -- routine has state information and can perform partial finalization.
228 function Make_Set_Finalize_Address_Call
230 Ptr_Typ
: Entity_Id
) return Node_Id
;
231 -- Associate the Finalize_Address primitive of the designated type with the
232 -- finalization master of access type Ptr_Typ. The returned call is:
234 -- Set_Finalize_Address
235 -- (<Ptr_Typ>FM, <Desig_Typ>FD'Unrestricted_Access);
237 --------------------------------------------
238 -- Task and Protected Object finalization --
239 --------------------------------------------
241 function Cleanup_Array
244 Typ
: Entity_Id
) return List_Id
;
245 -- Generate loops to finalize any tasks or simple protected objects that
246 -- are subcomponents of an array.
248 function Cleanup_Protected_Object
250 Ref
: Node_Id
) return Node_Id
;
251 -- Generate code to finalize a protected object without entries
253 function Cleanup_Record
256 Typ
: Entity_Id
) return List_Id
;
257 -- For each subcomponent of a record that contains tasks or simple
258 -- protected objects, generate the appropriate finalization call.
260 function Cleanup_Task
262 Ref
: Node_Id
) return Node_Id
;
263 -- Generate code to finalize a task
265 function Has_Simple_Protected_Object
(T
: Entity_Id
) return Boolean;
266 -- Check whether composite type contains a simple protected component
268 function Is_Simple_Protected_Type
(T
: Entity_Id
) return Boolean;
269 -- Determine whether T denotes a protected type without entries whose
270 -- _object field is of type System.Tasking.Protected_Objects.Protection.
271 -- Something wrong here, implementation was changed to test Lock_Free
272 -- but this spec does not mention that ???
274 --------------------------------
275 -- Transient Scope Management --
276 --------------------------------
278 procedure Expand_Cleanup_Actions
(N
: Node_Id
);
279 -- Expand the necessary stuff into a scope to enable finalization of local
280 -- objects and deallocation of transient data when exiting the scope. N is
281 -- one of N_Block_Statement, N_Subprogram_Body, N_Task_Body, N_Entry_Body,
282 -- or N_Extended_Return_Statement.
284 procedure Establish_Transient_Scope
286 Manage_Sec_Stack
: Boolean);
287 -- Push a new transient scope on the scope stack. N is the node which must
288 -- be serviced by the transient scope. Set Manage_Sec_Stack when the scope
289 -- must mark and release the secondary stack.
291 function Node_To_Be_Wrapped
return Node_Id
;
292 -- Return the node to be wrapped if the current scope is transient
294 procedure Store_Before_Actions_In_Scope
(L
: List_Id
);
295 -- Append the list L of actions to the end of the before-actions store in
296 -- the top of the scope stack (also analyzes these actions).
298 procedure Store_After_Actions_In_Scope
(L
: List_Id
);
299 -- Prepend the list L of actions to the beginning of the after-actions
300 -- stored in the top of the scope stack (also analyzes these actions).
302 -- Note that we are prepending here rather than appending. This means that
303 -- if several calls are made to this procedure for the same scope, the
304 -- actions will be executed in reverse order of the calls (actions for the
305 -- last call executed first). Within the list L for a single call, the
306 -- actions are executed in the order in which they appear in this list.
308 procedure Store_Cleanup_Actions_In_Scope
(L
: List_Id
);
309 -- Prepend the list L of actions to the beginning of the cleanup-actions
310 -- store in the top of the scope stack.
312 procedure Wrap_Transient_Declaration
(N
: Node_Id
);
313 -- N is an object declaration. Expand the finalization calls after the
314 -- declaration and make the outer scope being the transient one.
316 procedure Wrap_Transient_Expression
(N
: Node_Id
);
317 -- N is a sub-expression. Expand a transient block around an expression
319 procedure Wrap_Transient_Statement
(N
: Node_Id
);
320 -- N is a statement. Expand a transient block around an instruction