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
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
|
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . F I N A L I Z A T I O N _ P R I M I T I V E S --
-- --
-- S p e c --
-- --
-- Copyright (C) 2023-2025, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with System.OS_Locks;
with System.Storage_Elements;
-- This package encapsulates the types and operations used by the compiler
-- to support finalization of objects of finalizable types (types derived
-- from standard Ada types Controlled and Limited_Controlled, as well as
-- types declared with the GNAT Finalizable aspect).
package System.Finalization_Primitives with Preelaborate is
use type System.Storage_Elements.Storage_Offset;
type Finalize_Address_Ptr is access procedure (Obj : System.Address);
-- Values of this type denote finalization procedures associated with
-- objects that have controlled parts. For convenience, such objects
-- are simply referred to as controlled objects in the remainder of
-- this package.
type Master_Node is private;
-- Each controlled object associated with a finalization master has an
-- associated master node created by the compiler.
type Master_Node_Ptr is access all Master_Node;
for Master_Node_Ptr'Storage_Size use 0;
-- A reference to a master node. Since this type may not be used to
-- allocate objects, its storage size is zero.
--------------------------------------------------------------------------
-- Types and operations of finalization masters: A finalization master
-- is used to manage a set of controlled objects declared at the library
-- level of the program or associated with the declarative part of a
-- subprogram or other closed scopes (block statements, for example).
type Finalization_Master
(Exceptions_OK : Boolean;
Extra_Info : Boolean;
Library_Level : Boolean) is limited private;
-- Objects of this type encapsulate an ordered list of zero or more master
-- nodes, each of which is associated with a controlled object.
procedure Attach_Object_To_Master
(Object_Address : System.Address;
Finalize_Address : not null Finalize_Address_Ptr;
Node : not null Master_Node_Ptr;
Master : in out Finalization_Master);
-- Associates a controlled object and its master node with a given master.
-- Finalize_Address denotes the operation to be called to finalize the
-- object (which could be a user-declared Finalize procedure or a procedure
-- generated by the compiler). An object can be associated with at most one
-- finalization master.
procedure Attach_Object_To_Node
(Object_Address : System.Address;
Finalize_Address : not null Finalize_Address_Ptr;
Node : in out Master_Node);
-- Associates a controlled object with its master node only. This is used
-- when there is a single object to be finalized in the context, as well as
-- for objects that need special processing (return object in an extended
-- return statement or transient objects).
procedure Chain_Node_To_Master
(Node : not null Master_Node_Ptr;
Master : in out Finalization_Master);
-- Chain a master node to the given master. This is used to chain the node
-- to the master of the enclosing scope for the objects that need special
-- processing mentioned for Attach_Object_To_Node.
procedure Finalize_Master (Master : in out Finalization_Master);
-- Finalizes each of the controlled objects associated with Master, in the
-- reverse of the order in which they were attached. Calls to the procedure
-- with a Master that has already been finalized have no effects.
procedure Finalize_Object
(Node : in out Master_Node;
Finalize_Address : Finalize_Address_Ptr);
-- Finalizes the controlled object attached to Node by generating a call to
-- Finalize_Address on it, which has to be equal to Node.Finalize_Address.
-- The weird redundancy is intended to help the optimizer turn an indirect
-- call to Finalize_Address into a direct one and then inline it if needed,
-- after having inlined Finalize_Object itself. Calls to the procedure with
-- a Node that has already been finalized have no effects.
procedure Suppress_Object_Finalize_At_End (Node : in out Master_Node);
-- Changes the state of Node to effectively suppress a call to Node's
-- associated object's Finalize procedure. This is called at the end
-- of an extended return statement of a function whose result type
-- needs finalization, to ensure that the function's return object is
-- not finalized within the function in the case the return statement
-- is completed normally (it will still be finalized if an exception
-- is raised before the normal completion of the return statement).
--------------------------------------------------------------------------
-- Types and operations of finalization collections: A finalization
-- collection is used to manage a set of controlled objects associated
-- with an access type. Such collections are always associated with a
-- finalization master, either at the library-level or within a subprogram,
-- depending on where the access type is declared, and the collection
-- object itself is managed via a Master_Node attached to its finalization
-- master.
type Finalization_Collection is limited private
with Finalizable => (Initialize => Initialize,
Finalize => Finalize,
Relaxed_Finalization => Standard.False);
-- Objects of this type encapsulate a set of zero or more controlled
-- objects associated with an access type. The compiler ensures that
-- each finalization collection is in turn associated with a finalization
-- master.
type Finalization_Collection_Ptr is access all Finalization_Collection;
for Finalization_Collection_Ptr'Storage_Size use 0;
-- A reference to a collection. Since this type may not be used to
-- allocate objects, its storage size is zero.
procedure Initialize (Collection : in out Finalization_Collection);
-- Initializes the dummy head of a collection
procedure Finalize (Collection : in out Finalization_Collection);
-- Finalizes each object that has been associated with a finalization
-- collection, in some arbitrary order. Calls to this procedure with
-- a collection that has already been finalized have no effect.
procedure Attach_Object_To_Collection
(Object_Address : System.Address;
Finalize_Address : not null Finalize_Address_Ptr;
Collection : in out Finalization_Collection);
-- Associates a controlled object allocated for some access type with a
-- given finalization collection. Finalize_Address denotes the operation
-- to be called to finalize the object (which could be a user-declared
-- Finalize procedure or a procedure generated by the compiler). An object
-- can be associated with at most one finalization collection.
procedure Detach_Object_From_Collection (Object_Address : System.Address);
-- Removes a controlled object from its associated finalization collection.
-- Calls to the procedure with an object that has already been detached
-- have no effects.
function Header_Alignment return System.Storage_Elements.Storage_Count;
-- Return the alignment of the header to be placed immediately in front of
-- a controlled object allocated for some access type, in storage units.
function Header_Size return System.Storage_Elements.Storage_Count;
-- Return the size of the header to be placed immediately in front of a
-- controlled object allocated for some access type, in storage units.
private
-- Finalization masters:
-- Master node type structure. Finalize_Address comes first because it is
-- an access-to-subprogram and, therefore, might be twice as large and as
-- aligned as an access-to-object on some platforms.
type Master_Node is record
Finalize_Address : Finalize_Address_Ptr := null;
Object_Address : System.Address := Null_Address;
Next : Master_Node_Ptr := null;
end record;
-- Finalization master type structure. A unique master is associated
-- with each scope containing controlled objects.
type Finalization_Master
(Exceptions_OK : Boolean;
Extra_Info : Boolean;
Library_Level : Boolean) is limited
record
Head : Master_Node_Ptr := null;
end record;
-- These operations need to be performed in line for maximum performance
pragma Inline (Attach_Object_To_Master);
pragma Inline (Attach_Object_To_Node);
pragma Inline (Chain_Node_To_Master);
pragma Inline (Finalize_Object);
pragma Inline (Suppress_Object_Finalize_At_End);
-- Finalization collections:
type Collection_Node;
-- Each controlled object associated with a finalization collection has
-- an associated object of this type.
type Collection_Node_Ptr is access all Collection_Node;
for Collection_Node_Ptr'Storage_Size use 0;
pragma No_Strict_Aliasing (Collection_Node_Ptr);
-- A reference to a collection node. Since this type may not be used to
-- allocate objects, its storage size is zero.
-- Collection node type structure. Finalize_Address comes first because it
-- is an access-to-subprogram and, therefore, might be twice as large and
-- as aligned as an access-to-object on some platforms.
type Collection_Node is record
Finalize_Address : Finalize_Address_Ptr := null;
-- A pointer to the Finalize_Address procedure of the object
Enclosing_Collection : Finalization_Collection_Ptr := null;
-- A pointer to the collection to which the node is attached
Prev : Collection_Node_Ptr := null;
Next : Collection_Node_Ptr := null;
-- Collection nodes are managed as a circular doubly-linked list
end record;
function Header_Alignment return System.Storage_Elements.Storage_Count is
(Collection_Node'Alignment);
function Header_Size return System.Storage_Elements.Storage_Count is
(Collection_Node'Object_Size / Storage_Unit);
-- Finalization collection type structure
type Finalization_Collection is limited record
Head : aliased Collection_Node;
-- The head of the circular doubly-linked list of collection nodes
Lock : aliased System.OS_Locks.RTS_Lock;
-- A lock to synchronize concurrent accesses to the collection
Finalization_Started : Boolean;
-- A flag used to detect allocations which occur during the finalization
-- of a collection. The allocations must raise Program_Error. This may
-- arise in a multitask environment.
end record;
-- This operation is very simple and thus can be performed in line
pragma Inline (Initialize);
end System.Finalization_Primitives;
|
