File : exp_ch7.ads
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- E X P _ C H 7 --
6 -- --
7 -- S p e c --
8 -- --
9 -- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
10 -- --
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. --
20 -- --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
23 -- --
24 ------------------------------------------------------------------------------
25
26 with Namet; use Namet;
27 with Types; use Types;
28
29 package Exp_Ch7 is
30
31 procedure Expand_N_Package_Body (N : Node_Id);
32 procedure Expand_N_Package_Declaration (N : Node_Id);
33
34 -----------------------------
35 -- Finalization Management --
36 -----------------------------
37
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
41 -- current unit.
42
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.
47
48 -- Support of exceptions from user finalization procedures
49
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.
53
54 -- There are 3 subprograms to use this mechanism, and the type
55 -- Finalization_Exception_Data carries internal data between these
56 -- subprograms:
57 --
58 -- 1. Build_Object_Declaration: create the variables for the next two
59 -- subprograms.
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.
64
65 type Finalization_Exception_Data is record
66 Loc : Source_Ptr;
67 -- Sloc for the added nodes
68
69 Abort_Id : Entity_Id;
70 -- Boolean variable set to true if the finalization was triggered by
71 -- an abort.
72
73 E_Id : Entity_Id;
74 -- Variable containing the exception occurrence raised by user code
75
76 Raised_Id : Entity_Id;
77 -- Boolean variable set to true if an exception was raised in user code
78 end record;
79
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:
85 --
86 -- when others =>
87 -- if not Raised_Id then
88 -- Raised_Id := True;
89 -- Save_Occurrence (E_Id, Get_Current_Excep.all.all);
90 -- end if;
91 --
92 -- If flag For_Library is set (and not in restricted profile):
93 --
94 -- when others =>
95 -- if not Raised_Id then
96 -- Raised_Id := True;
97 -- Save_Library_Occurrence (Get_Current_Excep.all);
98 -- end if;
99 --
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.
104
105 procedure Build_Finalization_Master
106 (Typ : Entity_Id;
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.
120
121 procedure Build_Invariant_Procedure_Body
122 (Typ : Entity_Id;
123 Partial_Invariant : Boolean := False);
124 -- Create the body of the procedure which verifies the invariants of type
125 -- Typ at runtime. Flag Partial_Invariant should be set when Typ denotes a
126 -- private type, otherwise it is assumed that Typ denotes the full view of
127 -- a private type.
128
129 procedure Build_Invariant_Procedure_Declaration
130 (Typ : Entity_Id;
131 Partial_Invariant : Boolean := False);
132 -- Create the declaration of the procedure which verifies the invariants of
133 -- type Typ at runtime. Flag Partial_Invariant should be set when building
134 -- the invariant procedure for a private type.
135
136 procedure Build_Late_Proc (Typ : Entity_Id; Nam : Name_Id);
137 -- Build one controlling procedure when a late body overrides one of the
138 -- controlling operations.
139
140 procedure Build_Object_Declarations
141 (Data : out Finalization_Exception_Data;
142 Decls : List_Id;
143 Loc : Source_Ptr;
144 For_Package : Boolean := False);
145 -- Subsidiary to Make_Deep_Array_Body and Make_Deep_Record_Body. Create the
146 -- list List containing the object declarations of boolean flag Abort_Id,
147 -- the exception occurrence E_Id and boolean flag Raised_Id.
148 --
149 -- Abort_Id : constant Boolean :=
150 -- Exception_Identity (Get_Current_Excep.all) =
151 -- Standard'Abort_Signal'Identity;
152 -- <or>
153 -- Abort_Id : constant Boolean := False; -- no abort or For_Package
154 --
155 -- E_Id : Exception_Occurrence;
156 -- Raised_Id : Boolean := False;
157
158 function Build_Raise_Statement
159 (Data : Finalization_Exception_Data) return Node_Id;
160 -- Subsidiary to routines Build_Finalizer, Make_Deep_Array_Body and Make_
161 -- Deep_Record_Body. Generate the following conditional raise statement:
162 --
163 -- if Raised_Id and then not Abort_Id then
164 -- Raise_From_Controlled_Operation (E_Id);
165 -- end if;
166 --
167 -- Abort_Id is a local boolean flag which is set when the finalization was
168 -- triggered by an abort, E_Id denotes the defining identifier of a local
169 -- exception occurrence, Raised_Id is the entity of a local boolean flag.
170
171 function CW_Or_Has_Controlled_Part (T : Entity_Id) return Boolean;
172 -- True if T is a class-wide type, or if it has controlled parts ("part"
173 -- means T or any of its subcomponents). Same as Needs_Finalization, except
174 -- when pragma Restrictions (No_Finalization) applies, in which case we
175 -- know that class-wide objects do not contain controlled parts.
176
177 function Has_New_Controlled_Component (E : Entity_Id) return Boolean;
178 -- E is a type entity. Give the same result as Has_Controlled_Component
179 -- except for tagged extensions where the result is True only if the
180 -- latest extension contains a controlled component.
181
182 function Make_Adjust_Call
183 (Obj_Ref : Node_Id;
184 Typ : Entity_Id;
185 Skip_Self : Boolean := False) return Node_Id;
186 -- Create a call to either Adjust or Deep_Adjust depending on the structure
187 -- of type Typ. Obj_Ref is an expression with no-side effect (not required
188 -- to have been previously analyzed) that references the object to be
189 -- adjusted. Typ is the expected type of Obj_Ref. When Skip_Self is set,
190 -- only the components (if any) are adjusted.
191
192 function Make_Detach_Call (Obj_Ref : Node_Id) return Node_Id;
193 -- Create a call to unhook an object from an arbitrary list. Obj_Ref is the
194 -- object. Generate the following:
195 --
196 -- Ada.Finalization.Heap_Management.Detach
197 -- (System.Finalization_Root.Root_Controlled_Ptr (Obj_Ref));
198
199 function Make_Final_Call
200 (Obj_Ref : Node_Id;
201 Typ : Entity_Id;
202 Skip_Self : Boolean := False) return Node_Id;
203 -- Create a call to either Finalize or Deep_Finalize depending on the
204 -- structure of type Typ. Obj_Ref is an expression (with no-side effect
205 -- and is not required to have been previously analyzed) that references
206 -- the object to be finalized. Typ is the expected type of Obj_Ref. When
207 -- Skip_Self is set, only the components (if any) are finalized.
208
209 procedure Make_Finalize_Address_Body (Typ : Entity_Id);
210 -- Create the body of TSS routine Finalize_Address if Typ is controlled and
211 -- does not have a TSS entry for Finalize_Address. The procedure converts
212 -- an address into a pointer and subsequently calls Deep_Finalize on the
213 -- dereference.
214
215 function Make_Init_Call
216 (Obj_Ref : Node_Id;
217 Typ : Entity_Id) return Node_Id;
218 -- Obj_Ref is an expression with no-side effect (not required to have been
219 -- previously analyzed) that references the object to be initialized. Typ
220 -- is the expected type of Obj_Ref, which is either a controlled type
221 -- (Is_Controlled) or a type with controlled components (Has_Controlled_
222 -- Components).
223
224 function Make_Handler_For_Ctrl_Operation (Loc : Source_Ptr) return Node_Id;
225 -- Generate an implicit exception handler with an 'others' choice,
226 -- converting any occurrence to a raise of Program_Error.
227
228 function Make_Local_Deep_Finalize
229 (Typ : Entity_Id;
230 Nam : Entity_Id) return Node_Id;
231 -- Create a special version of Deep_Finalize with identifier Nam. The
232 -- routine has state information and can perform partial finalization.
233
234 function Make_Set_Finalize_Address_Call
235 (Loc : Source_Ptr;
236 Ptr_Typ : Entity_Id) return Node_Id;
237 -- Associate the Finalize_Address primitive of the designated type with the
238 -- finalization master of access type Ptr_Typ. The returned call is:
239 --
240 -- Set_Finalize_Address
241 -- (<Ptr_Typ>FM, <Desig_Typ>FD'Unrestricted_Access);
242
243 --------------------------------------------
244 -- Task and Protected Object finalization --
245 --------------------------------------------
246
247 function Cleanup_Array
248 (N : Node_Id;
249 Obj : Node_Id;
250 Typ : Entity_Id) return List_Id;
251 -- Generate loops to finalize any tasks or simple protected objects that
252 -- are subcomponents of an array.
253
254 function Cleanup_Protected_Object
255 (N : Node_Id;
256 Ref : Node_Id) return Node_Id;
257 -- Generate code to finalize a protected object without entries
258
259 function Cleanup_Record
260 (N : Node_Id;
261 Obj : Node_Id;
262 Typ : Entity_Id) return List_Id;
263 -- For each subcomponent of a record that contains tasks or simple
264 -- protected objects, generate the appropriate finalization call.
265
266 function Cleanup_Task
267 (N : Node_Id;
268 Ref : Node_Id) return Node_Id;
269 -- Generate code to finalize a task
270
271 function Has_Simple_Protected_Object (T : Entity_Id) return Boolean;
272 -- Check whether composite type contains a simple protected component
273
274 function Is_Simple_Protected_Type (T : Entity_Id) return Boolean;
275 -- Determine whether T denotes a protected type without entries whose
276 -- _object field is of type System.Tasking.Protected_Objects.Protection.
277 -- Something wrong here, implementation was changed to test Lock_Free
278 -- but this spec does not mention that ???
279
280 --------------------------------
281 -- Transient Scope Management --
282 --------------------------------
283
284 procedure Expand_Cleanup_Actions (N : Node_Id);
285 -- Expand the necessary stuff into a scope to enable finalization of local
286 -- objects and deallocation of transient data when exiting the scope. N is
287 -- a "scope node" that is to say one of the following: N_Block_Statement,
288 -- N_Subprogram_Body, N_Task_Body, N_Entry_Body.
289
290 procedure Establish_Transient_Scope (N : Node_Id; Sec_Stack : Boolean);
291 -- Push a new transient scope on the scope stack. N is the node responsible
292 -- for the need of a transient scope. If Sec_Stack is True then the
293 -- secondary stack is brought in, otherwise it isn't.
294
295 function Node_To_Be_Wrapped return Node_Id;
296 -- Return the node to be wrapped if the current scope is transient
297
298 procedure Store_Before_Actions_In_Scope (L : List_Id);
299 -- Append the list L of actions to the end of the before-actions store in
300 -- the top of the scope stack (also analyzes these actions).
301
302 procedure Store_After_Actions_In_Scope (L : List_Id);
303 -- Prepend the list L of actions to the beginning of the after-actions
304 -- stored in the top of the scope stack (also analyzes these actions).
305 --
306 -- Note that we are prepending here rather than appending. This means that
307 -- if several calls are made to this procedure for the same scope, the
308 -- actions will be executed in reverse order of the calls (actions for the
309 -- last call executed first). Within the list L for a single call, the
310 -- actions are executed in the order in which they appear in this list.
311
312 procedure Store_Cleanup_Actions_In_Scope (L : List_Id);
313 -- Prepend the list L of actions to the beginning of the cleanup-actions
314 -- store in the top of the scope stack.
315
316 procedure Wrap_Transient_Declaration (N : Node_Id);
317 -- N is an object declaration. Expand the finalization calls after the
318 -- declaration and make the outer scope being the transient one.
319
320 procedure Wrap_Transient_Expression (N : Node_Id);
321 -- N is a sub-expression. Expand a transient block around an expression
322
323 procedure Wrap_Transient_Statement (N : Node_Id);
324 -- N is a statement. Expand a transient block around an instruction
325
326 end Exp_Ch7;