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 | -- --
-- package Copyright (c) Dmitry A. Kazakov --
-- Stack_Storage.Mark_And_Release Luebeck --
-- Interface Winter, 2003 --
-- --
-- Last revision : 19:15 09 Jul 2018 --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public License as --
-- published by the Free Software Foundation; either version 2 of --
-- the License, or (at your option) any later version. This library --
-- is distributed in the hope that it will be useful, but WITHOUT --
-- 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 along with --
-- this library; if not, write to the Free Software Foundation, --
-- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from --
-- this unit, or you link this unit with other files to produce an --
-- executable, this unit does not by itself cause the resulting --
-- executable to be covered by the GNU General Public License. This --
-- exception does not however invalidate any other reasons why the --
-- executable file might be covered by the GNU Public License. --
--____________________________________________________________________--
--
-- This package provides a mark and release storage pool. The type Pool
-- is a descendant of a segmented stack pool. The package keeps track
-- on all objects allocated in the pool to allow them being destroyed
-- as the frame they were allocated left. The package has one generic
-- parameter:
--
-- Stack - The stack pool to use (Stack_Storage.Pool)
--
-- The type Pool_Object is used as the base type for all objects
-- allocated on Stack. It is a limited controlled type. The type
-- Pool_Object_Ptr is a pool-specific pointer to Pool_Object'Class.
-- Objects of type Pool_Mark are used for mark-and-release:
--
-- declare
-- Snap : Pool_Mark; -- Mark the pool state
-- Ptr : Pool_Object_Ptr;
-- begin
-- Ptr := new Derived_Pool_Object; -- Allocate
-- Ptr := new Another_Derived_Pool_Object; -- Allocate
-- end; -- Release all allocated objects
--
-- If some of the pool objects are destroyed explicitly using
-- Unchecked_Deallocation, then this should be done in exactly same
-- order as they were created and never under the latest pool mark.
--
with Ada.Finalization;
generic
Stack : in out Pool'Class;
package Stack_Storage.Mark_And_Release is
--
-- Pool_Object -- All the objects allocated on the stack has to be
-- descendants of this type.
--
type Pool_Object is
new Ada.Finalization.Limited_Controlled with private;
--
-- Pool_Object_Ptr -- Pool-specific pointers to the objects. All the
-- descendants of Pool_Object have to be allocated
-- dynamically using the allocator (new). As the target for the
-- allocator Pool_Object_Ptr or its descendant has to be specified. It
-- is also possible to use some other access type but only if its
-- storage pool is Stack.
--
type Pool_Object_Ptr is access Pool_Object'Class;
for Pool_Object_Ptr'Storage_Pool use Stack;
--
-- Pool_Mark -- Pool snap-shot
--
type Pool_Mark is
new Ada.Finalization.Limited_Controlled with private;
--
-- Finalize -- Destructor
--
-- Snap - A pool snap-shot
--
-- All objects allocated in the pool since construction and not yet
-- destroyed are destroyed now.
--
-- Exceptions :
--
-- Storage_Error
--
procedure Finalize (Snap : in out Pool_Mark);
--
-- Finalize -- Destructor
--
-- Object - A pool object
--
-- Exceptions :
--
-- Storage_Error - Finalized out of allocation order
--
procedure Finalize (Object : in out Pool_Object);
--
-- Initialize -- Constructor
--
-- Object - A pool object
--
procedure Initialize (Object : in out Pool_Object);
--
-- Initialize -- Constructor
--
-- Snap - A pool snap-shot
--
procedure Initialize (Snap : in out Pool_Mark);
private
type Pool_Object is
new Ada.Finalization.Limited_Controlled with
record
Previous : Pool_Object_Ptr;
end record;
type Pool_Mark is
new Ada.Finalization.Limited_Controlled with
record
Mark : Pool_Object_Ptr;
end record;
--
-- Last_Allocated -- The last object allocated in the pool
--
Last_Allocated : Pool_Object_Ptr;
end Stack_Storage.Mark_And_Release;
|