1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2009, 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 function In_Finalization_Root
(E
: Entity_Id
) return Boolean;
39 -- True if current scope is in package System.Finalization_Root. Used
40 -- to avoid certain expansions that would involve circularity in the
43 procedure Build_Final_List
(N
: Node_Id
; Typ
: Entity_Id
);
44 -- Build finalization list for anonymous access types, and for access
45 -- types that are frozen before their designated types are known to
48 procedure Build_Controlling_Procs
(Typ
: Entity_Id
);
49 -- Typ is a record, and array type having controlled components.
50 -- Create the procedures Deep_Initialize, Deep_Adjust and Deep_Finalize
51 -- that take care of finalization management at run-time.
53 procedure Build_Late_Proc
(Typ
: Entity_Id
; Nam
: Name_Id
);
54 -- Build one controlling procedure when a late body overrides one of
55 -- the controlling operations.
57 function Controller_Component
(Typ
: Entity_Id
) return Entity_Id
;
58 -- Returns the entity of the component whose name is 'Name_uController'
60 function CW_Or_Has_Controlled_Part
(T
: Entity_Id
) return Boolean;
61 -- True if T is a class-wide type, or if it has controlled parts ("part"
62 -- means T or any of its subcomponents). This is the same as
63 -- Needs_Finalization, except when pragma Restrictions (No_Finalization)
64 -- applies, in which case we know that class-wide objects do not contain
67 procedure Expand_Ctrl_Function_Call
(N
: Node_Id
);
68 -- Expand a call to a function returning a controlled value. That is to
69 -- say attach the result of the call to the current finalization list,
70 -- which is the one of the transient scope created for such constructs.
72 function Find_Final_List
74 Ref
: Node_Id
:= Empty
) return Node_Id
;
75 -- E is an entity representing a controlled object, a controlled type or a
76 -- scope. If Ref is not empty, it is a reference to a controlled record,
77 -- the closest Final list is in the controller component of the record
78 -- containing Ref, otherwise this function returns a reference to the final
79 -- list attached to the closest dynamic scope (which can be E itself),
80 -- creating this final list if necessary.
82 function Has_New_Controlled_Component
(E
: Entity_Id
) return Boolean;
83 -- E is a type entity. Give the same result as Has_Controlled_Component
84 -- except for tagged extensions where the result is True only if the
85 -- latest extension contains a controlled component.
87 function Make_Attach_Call
90 With_Attach
: Node_Id
) return Node_Id
;
91 -- Attach the referenced object to the referenced Final Chain 'Flist_Ref'
92 -- With_Attach is an expression of type Short_Short_Integer which can be
93 -- either '0' to signify no attachment, '1' for attachment to a simply
94 -- linked list or '2' for attachment to a doubly linked list.
96 function Make_Init_Call
100 With_Attach
: Node_Id
) return List_Id
;
101 -- Ref is an expression (with no-side effect and is not required to have
102 -- been previously analyzed) that references the object to be initialized.
103 -- Typ is the expected type of Ref, which is either a controlled type
104 -- (Is_Controlled) or a type with controlled components (Has_Controlled).
105 -- With_Attach is an integer expression which is the attachment level,
106 -- see System.Finalization_Implementation.Attach_To_Final_List for the
107 -- documentation of Nb_Link.
109 -- This function will generate the appropriate calls to make sure that the
110 -- objects referenced by Ref are initialized. The generated code is quite
111 -- different for an IS_Controlled type or a HAS_Controlled type, but this
112 -- is not the problem for the caller, the details are in the body.
114 function Make_Adjust_Call
118 With_Attach
: Node_Id
;
119 Allocator
: Boolean := False) return List_Id
;
120 -- Ref is an expression (with no-side effect and is not required to have
121 -- been previously analyzed) that references the object to be adjusted. Typ
122 -- is the expected type of Ref, which is a controlled type (Is_Controlled)
123 -- or a type with controlled components (Has_Controlled). With_Attach is an
124 -- integer expression giving the attachment level (see documentation of
125 -- Attach_To_Final_List.Nb_Link param documentation in s-finimp.ads.
126 -- Note: if Typ is Finalize_Storage_Only and the object is at library
127 -- level, then With_Attach will be ignored, and a zero link level will be
128 -- passed to Attach_To_Final_List.
130 -- This function will generate the appropriate calls to make sure that the
131 -- objects referenced by Ref are adjusted. The generated code is quite
132 -- different depending on the fact the type IS_Controlled or HAS_Controlled
133 -- but this is not the problem of the caller, the details are in the body.
134 -- The objects must be attached when the adjust takes place after an
135 -- initialization expression but not when it takes place after a regular
138 -- If Allocator is True, we are adjusting a newly-created object. The
139 -- existing chaining pointers should not be left unchanged, because they
140 -- may come from a bit-for-bit copy of those from an initializing object.
141 -- So, when this flag is True, if the chaining pointers should otherwise
142 -- be left unset, instead they are reset to null.
144 function Make_Final_Call
147 With_Detach
: Node_Id
) return List_Id
;
148 -- Ref is an expression (with no-side effect and is not required to have
149 -- been previously analyzed) that references the object to be Finalized.
150 -- Typ is the expected type of Ref, which is a controlled type
151 -- (Is_Controlled) or a type with controlled components (Has_Controlled).
152 -- With_Detach is a boolean expression indicating whether to detach the
153 -- controlled object from whatever finalization list it is currently
156 -- This function will generate the appropriate calls to make sure that the
157 -- objects referenced by Ref are finalized. The generated code is quite
158 -- different depending on the fact the type IS_Controlled or HAS_Controlled
159 -- but this is not the problem of the caller, the details are in the body.
160 -- The objects must be detached when finalizing an unchecked deallocated
161 -- object but not when finalizing the target of an assignment, it is not
162 -- necessary either on scope exit.
164 function Make_Handler_For_Ctrl_Operation
(Loc
: Source_Ptr
) return Node_Id
;
165 -- Generate an implicit exception handler with an 'others' choice,
166 -- converting any occurrence to a raise of Program_Error.
168 function Needs_Finalization
(T
: Entity_Id
) return Boolean;
169 -- True if T potentially needs finalization actions. True if T is
170 -- controlled, or has subcomponents. Also True if T is a class-wide type,
171 -- because some type extension might add controlled subcomponents, except
172 -- that if pragma Restrictions (No_Finalization) applies, this is False for
175 --------------------------------------------
176 -- Task and Protected Object finalization --
177 --------------------------------------------
179 function Cleanup_Array
182 Typ
: Entity_Id
) return List_Id
;
183 -- Generate loops to finalize any tasks or simple protected objects that
184 -- are subcomponents of an array.
186 function Cleanup_Protected_Object
188 Ref
: Node_Id
) return Node_Id
;
189 -- Generate code to finalize a protected object without entries
191 function Cleanup_Record
194 Typ
: Entity_Id
) return List_Id
;
195 -- For each subcomponent of a record that contains tasks or simple
196 -- protected objects, generate the appropriate finalization call.
198 function Cleanup_Task
200 Ref
: Node_Id
) return Node_Id
;
201 -- Generate code to finalize a task
203 function Has_Simple_Protected_Object
(T
: Entity_Id
) return Boolean;
204 -- Check whether composite type contains a simple protected component
206 function Is_Simple_Protected_Type
(T
: Entity_Id
) return Boolean;
207 -- Check whether argument is a protected type without entries. Protected
208 -- types with entries are controlled, and their cleanup is handled by the
209 -- standard finalization machinery. For simple protected types we generate
210 -- inline code to release their locks.
212 --------------------------------
213 -- Transient Scope Management --
214 --------------------------------
216 procedure Expand_Cleanup_Actions
(N
: Node_Id
);
217 -- Expand the necessary stuff into a scope to enable finalization of local
218 -- objects and deallocation of transient data when exiting the scope. N is
219 -- a "scope node" that is to say one of the following: N_Block_Statement,
220 -- N_Subprogram_Body, N_Task_Body, N_Entry_Body.
222 procedure Establish_Transient_Scope
(N
: Node_Id
; Sec_Stack
: Boolean);
223 -- Push a new transient scope on the scope stack. N is the node responsible
224 -- for the need of a transient scope. If Sec_Stack is True then the
225 -- secondary stack is brought in, otherwise it isn't.
227 function Node_To_Be_Wrapped
return Node_Id
;
228 -- return the node to be wrapped if the current scope is transient
230 procedure Store_Before_Actions_In_Scope
(L
: List_Id
);
231 -- Append the list L of actions to the end of the before-actions store in
232 -- the top of the scope stack.
234 procedure Store_After_Actions_In_Scope
(L
: List_Id
);
235 -- Append the list L of actions to the beginning of the after-actions store
236 -- in the top of the scope stack.
238 procedure Wrap_Transient_Declaration
(N
: Node_Id
);
239 -- N is an object declaration. Expand the finalization calls after the
240 -- declaration and make the outer scope being the transient one.
242 procedure Wrap_Transient_Expression
(N
: Node_Id
);
243 -- N is a sub-expression. Expand a transient block around an expression
245 procedure Wrap_Transient_Statement
(N
: Node_Id
);
246 -- N is a statement. Expand a transient block around an instruction