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
|
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . F I N A L I Z A T I O N _ M A S T E R S --
-- --
-- S p e c --
-- --
-- Copyright (C) 2011, 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 Ada.Finalization;
with Ada.Unchecked_Conversion;
with System.Storage_Elements;
with System.Storage_Pools;
package System.Finalization_Masters is
pragma Preelaborate (System.Finalization_Masters);
-- A reference to primitive Finalize_Address. The expander generates an
-- implementation of this procedure for each controlled and class-wide
-- type. Since controlled objects are simply viewed as addresses once
-- allocated through a master, Finalize_Address provides a backward
-- indirection from an address to a type-specific context.
type Finalize_Address_Ptr is access procedure (Obj : System.Address);
-- Heterogeneous collection type structure. The implementation allows for
-- finalizable objects of different base types to be serviced by the same
-- master.
type FM_Node;
type FM_Node_Ptr is access all FM_Node;
type FM_Node is record
Prev : FM_Node_Ptr := null;
Next : FM_Node_Ptr := null;
Finalize_Address : Finalize_Address_Ptr := null;
end record;
-- A reference to any derivation from Root_Storage_Pool. Since this type
-- may not be used to allocate objects, its storage size is zero.
type Any_Storage_Pool_Ptr is
access System.Storage_Pools.Root_Storage_Pool'Class;
for Any_Storage_Pool_Ptr'Storage_Size use 0;
-- Finalization master type structure. A unique master is associated with
-- each access-to-controlled or access-to-class-wide type. Masters also act
-- as components of subpools.
type Finalization_Master is
new Ada.Finalization.Limited_Controlled with
record
Base_Pool : Any_Storage_Pool_Ptr := null;
-- A reference to the pool which this finalization master services. This
-- field is used in conjunction with the build-in-place machinery.
Objects : aliased FM_Node;
-- A doubly linked list which contains the headers of all controlled
-- objects allocated in a [sub]pool.
Finalization_Started : Boolean := False;
pragma Atomic (Finalization_Started);
-- A flag used to detect allocations which occur during the finalization
-- of a master. The allocations must raise Program_Error. This scenario
-- may arise in a multitask environment. The flag is atomic because it
-- is accessed without Lock_Task / Unlock_Task.
end record;
type Finalization_Master_Ptr is access all Finalization_Master;
for Finalization_Master_Ptr'Storage_Size use 0;
-- Since RTSfind cannot contain names of the form RE_"+", the following
-- routine serves as a wrapper around System.Storage_Elements."+".
function Add_Offset_To_Address
(Addr : System.Address;
Offset : System.Storage_Elements.Storage_Offset) return System.Address;
function Address_To_FM_Node_Ptr is
new Ada.Unchecked_Conversion (Address, FM_Node_Ptr);
procedure Attach (N : not null FM_Node_Ptr; L : not null FM_Node_Ptr);
-- Prepend a node to a specific finalization master
function Base_Pool
(Master : Finalization_Master) return Any_Storage_Pool_Ptr;
-- Return a reference to the underlying storage pool on which the master
-- operates.
procedure Detach (N : not null FM_Node_Ptr);
-- Remove a node from an arbitrary finalization master
overriding procedure Finalize (Master : in out Finalization_Master);
-- Lock the master to prevent allocations during finalization. Iterate over
-- the list of allocated controlled objects, finalizing each one by calling
-- its specific Finalize_Address. In the end, deallocate the dummy head.
function Header_Size return System.Storage_Elements.Storage_Count;
-- Return the size of type FM_Node as Storage_Count
function Header_Offset return System.Storage_Elements.Storage_Offset;
-- Return the size of type FM_Node as Storage_Offset
overriding procedure Initialize (Master : in out Finalization_Master);
-- Initialize the dummy head of a finalization master
procedure Set_Base_Pool
(Master : in out Finalization_Master;
Pool_Ptr : Any_Storage_Pool_Ptr);
-- Set the underlying pool of a finalization master
end System.Finalization_Masters;
|
