1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
|
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- E X P _ C H 7 --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Namet; use Namet;
with Types; use Types;
package Exp_Ch7 is
procedure Expand_N_Package_Body (N : Node_Id);
procedure Expand_N_Package_Declaration (N : Node_Id);
-----------------------------
-- Finalization Management --
-----------------------------
function In_Finalization_Root (E : Entity_Id) return Boolean;
-- True if current scope is in package System.Finalization_Root. Used
-- to avoid certain expansions that would involve circularity in the
-- Rtsfind mechanism.
procedure Build_Final_List (N : Node_Id; Typ : Entity_Id);
-- Build finalization list for anonymous access types, and for access
-- types that are frozen before their designated types are known to
-- be controlled.
procedure Build_Controlling_Procs (Typ : Entity_Id);
-- Typ is a record, and array type having controlled components.
-- Create the procedures Deep_Initialize, Deep_Adjust and Deep_Finalize
-- that take care of finalization management at run-time.
procedure Build_Late_Proc (Typ : Entity_Id; Nam : Name_Id);
-- Build one controlling procedure when a late body overrides one of
-- the controlling operations.
function Controller_Component (Typ : Entity_Id) return Entity_Id;
-- Returns the entity of the component whose name is 'Name_uController'
function CW_Or_Has_Controlled_Part (T : Entity_Id) return Boolean;
-- True if T is a class-wide type, or if it has controlled parts ("part"
-- means T or any of its subcomponents). This is the same as
-- Needs_Finalization, except when pragma Restrictions (No_Finalization)
-- applies, in which case we know that class-wide objects do not contain
-- controlled parts.
procedure Expand_Ctrl_Function_Call (N : Node_Id);
-- Expand a call to a function returning a controlled value. That is to
-- say attach the result of the call to the current finalization list,
-- which is the one of the transient scope created for such constructs.
function Find_Final_List
(E : Entity_Id;
Ref : Node_Id := Empty) return Node_Id;
-- E is an entity representing a controlled object, a controlled type or a
-- scope. If Ref is not empty, it is a reference to a controlled record,
-- the closest Final list is in the controller component of the record
-- containing Ref, otherwise this function returns a reference to the final
-- list attached to the closest dynamic scope (which can be E itself),
-- creating this final list if necessary.
function Has_New_Controlled_Component (E : Entity_Id) return Boolean;
-- E is a type entity. Give the same result as Has_Controlled_Component
-- except for tagged extensions where the result is True only if the
-- latest extension contains a controlled component.
function Make_Attach_Call
(Obj_Ref : Node_Id;
Flist_Ref : Node_Id;
With_Attach : Node_Id) return Node_Id;
-- Attach the referenced object to the referenced Final Chain 'Flist_Ref'
-- With_Attach is an expression of type Short_Short_Integer which can be
-- either '0' to signify no attachment, '1' for attachment to a simply
-- linked list or '2' for attachment to a doubly linked list.
function Make_Init_Call
(Ref : Node_Id;
Typ : Entity_Id;
Flist_Ref : Node_Id;
With_Attach : Node_Id) return List_Id;
-- Ref is an expression (with no-side effect and is not required to have
-- been previously analyzed) that references the object to be initialized.
-- Typ is the expected type of Ref, which is either a controlled type
-- (Is_Controlled) or a type with controlled components (Has_Controlled).
-- With_Attach is an integer expression which is the attachment level,
-- see System.Finalization_Implementation.Attach_To_Final_List for the
-- documentation of Nb_Link.
--
-- This function will generate the appropriate calls to make sure that the
-- objects referenced by Ref are initialized. The generated code is quite
-- different for an IS_Controlled type or a HAS_Controlled type, but this
-- is not the problem for the caller, the details are in the body.
function Make_Adjust_Call
(Ref : Node_Id;
Typ : Entity_Id;
Flist_Ref : Node_Id;
With_Attach : Node_Id;
Allocator : Boolean := False) return List_Id;
-- Ref is an expression (with no-side effect and is not required to have
-- been previously analyzed) that references the object to be adjusted. Typ
-- is the expected type of Ref, which is a controlled type (Is_Controlled)
-- or a type with controlled components (Has_Controlled). With_Attach is an
-- integer expression giving the attachment level (see documentation of
-- Attach_To_Final_List.Nb_Link param documentation in s-finimp.ads.
-- Note: if Typ is Finalize_Storage_Only and the object is at library
-- level, then With_Attach will be ignored, and a zero link level will be
-- passed to Attach_To_Final_List.
--
-- This function will generate the appropriate calls to make sure that the
-- objects referenced by Ref are adjusted. The generated code is quite
-- different depending on the fact the type IS_Controlled or HAS_Controlled
-- but this is not the problem of the caller, the details are in the body.
-- The objects must be attached when the adjust takes place after an
-- initialization expression but not when it takes place after a regular
-- assignment.
--
-- If Allocator is True, we are adjusting a newly-created object. The
-- existing chaining pointers should not be left unchanged, because they
-- may come from a bit-for-bit copy of those from an initializing object.
-- So, when this flag is True, if the chaining pointers should otherwise
-- be left unset, instead they are reset to null.
function Make_Final_Call
(Ref : Node_Id;
Typ : Entity_Id;
With_Detach : Node_Id) return List_Id;
-- Ref is an expression (with no-side effect and is not required to have
-- been previously analyzed) that references the object to be Finalized.
-- Typ is the expected type of Ref, which is a controlled type
-- (Is_Controlled) or a type with controlled components (Has_Controlled).
-- With_Detach is a boolean expression indicating whether to detach the
-- controlled object from whatever finalization list it is currently
-- attached to.
--
-- This function will generate the appropriate calls to make sure that the
-- objects referenced by Ref are finalized. The generated code is quite
-- different depending on the fact the type IS_Controlled or HAS_Controlled
-- but this is not the problem of the caller, the details are in the body.
-- The objects must be detached when finalizing an unchecked deallocated
-- object but not when finalizing the target of an assignment, it is not
-- necessary either on scope exit.
function Make_Handler_For_Ctrl_Operation (Loc : Source_Ptr) return Node_Id;
-- Generate an implicit exception handler with an 'others' choice,
-- converting any occurrence to a raise of Program_Error.
function Needs_Finalization (T : Entity_Id) return Boolean;
-- True if T potentially needs finalization actions. True if T is
-- controlled, or has subcomponents. Also True if T is a class-wide type,
-- because some type extension might add controlled subcomponents, except
-- that if pragma Restrictions (No_Finalization) applies, this is False for
-- class-wide types.
--------------------------------------------
-- Task and Protected Object finalization --
--------------------------------------------
function Cleanup_Array
(N : Node_Id;
Obj : Node_Id;
Typ : Entity_Id) return List_Id;
-- Generate loops to finalize any tasks or simple protected objects that
-- are subcomponents of an array.
function Cleanup_Protected_Object
(N : Node_Id;
Ref : Node_Id) return Node_Id;
-- Generate code to finalize a protected object without entries
function Cleanup_Record
(N : Node_Id;
Obj : Node_Id;
Typ : Entity_Id) return List_Id;
-- For each subcomponent of a record that contains tasks or simple
-- protected objects, generate the appropriate finalization call.
function Cleanup_Task
(N : Node_Id;
Ref : Node_Id) return Node_Id;
-- Generate code to finalize a task
function Has_Simple_Protected_Object (T : Entity_Id) return Boolean;
-- Check whether composite type contains a simple protected component
function Is_Simple_Protected_Type (T : Entity_Id) return Boolean;
-- Check whether argument is a protected type without entries. Protected
-- types with entries are controlled, and their cleanup is handled by the
-- standard finalization machinery. For simple protected types we generate
-- inline code to release their locks.
--------------------------------
-- Transient Scope Management --
--------------------------------
procedure Expand_Cleanup_Actions (N : Node_Id);
-- Expand the necessary stuff into a scope to enable finalization of local
-- objects and deallocation of transient data when exiting the scope. N is
-- a "scope node" that is to say one of the following: N_Block_Statement,
-- N_Subprogram_Body, N_Task_Body, N_Entry_Body.
procedure Establish_Transient_Scope (N : Node_Id; Sec_Stack : Boolean);
-- Push a new transient scope on the scope stack. N is the node responsible
-- for the need of a transient scope. If Sec_Stack is True then the
-- secondary stack is brought in, otherwise it isn't.
function Node_To_Be_Wrapped return Node_Id;
-- return the node to be wrapped if the current scope is transient
procedure Store_Before_Actions_In_Scope (L : List_Id);
-- Append the list L of actions to the end of the before-actions store in
-- the top of the scope stack.
procedure Store_After_Actions_In_Scope (L : List_Id);
-- Append the list L of actions to the beginning of the after-actions store
-- in the top of the scope stack.
procedure Wrap_Transient_Declaration (N : Node_Id);
-- N is an object declaration. Expand the finalization calls after the
-- declaration and make the outer scope being the transient one.
procedure Wrap_Transient_Expression (N : Node_Id);
-- N is a sub-expression. Expand a transient block around an expression
procedure Wrap_Transient_Statement (N : Node_Id);
-- N is a statement. Expand a transient block around an instruction
end Exp_Ch7;
|
