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 | ------------------------------------------------------------------------------
-- G N A T C O L L --
-- --
-- Copyright (C) 2015-2018, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify it --
-- under terms of the GNU General Public License as published by the Free --
-- Software Foundation; either version 3, 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 MERCHAN- --
-- TABILITY 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/>. --
-- --
------------------------------------------------------------------------------
-- This package provides storage pools that allocate enough memory for their
-- element and an extra header.
-- This header can be used to store extra information. For instance, it has
-- been used to store a reference counter, or pointers to the next element
-- in a container.
-- The goal is to reduce the number of memory allocations: instead of doing
-- one allocation for the element, and a second one for the counter, we can
-- do a single allocation, which is much faster.
--
-- Usage example:
-- type Header is record
-- Refcount : Natural;
-- end record;
-- package Pools is new Header_Pools (Header);
-- package String_Pools is new Pools.Typed (String);
-- package Integer_Pools is new Pools.Typed (Integer);
--
-- Str : String_Pools.Element_Access;
-- Str := new String'("foo"); -- uses the storage pool
--
-- String_Pools.Header_Of (Str).Refcount := 1;
-- String_Pools.Free (Str); -- reclaim memory
pragma Ada_2012;
with Ada.Unchecked_Deallocation;
with System.Storage_Pools; use System.Storage_Pools;
with System.Storage_Elements; use System.Storage_Elements;
package GNATCOLL.Storage_Pools.Headers is
------------------
-- Header_Pools --
------------------
-- The actual memory layout that we need to allocate is described below. In
-- all cases, we had a "Pad" (padding) which is used to obey the requested
-- alignment for the object.
-- Currently, this pool doesn't support alignment clauses (and the generic
-- Typed package below doesn't declare any), so the padding is always 0
-- bytes.
-- * For a scalar, record, tagged record or constrained array:
-- +--------+------+-----------------------+
-- | Header | Pad | Element |
-- +--------+------+-----------------------+
-- * For an unconstrained array, whether we use a standard access
-- type or a flattened access type (a representation clause gives
-- it a size of a standard pointer)
--
-- +--------+------+-----------------------+
-- | Header | Pad | First+Last+Element |
-- +--------+------+-----------------------+
-- First and Last are the bounds of the array.
-- Our pool should return the address of First, and the compiler
-- automatically deduces the address of Element to return to the
-- user code.
-- * For a controlled type:
--
-- 1 2 3
-- +--------+------+-----------------------+
-- | Header | Pad | Previous+Next+Element |
-- +--------+------+-----------------------+
-- Previous and Next are pointers to other controlled types.
-- In code like:
-- A := new ...;
-- the header pool allocates memory at 1 via malloc, but
-- returns 2 to the compiler
-- then the compiler stores 3 in A.
-- Conversely, when calling Free, the compiler converts A back to
-- 2, and our pool converts this back to 1 before calling free()
-- The trouble is that when we call "Header_Of" on A, we receive
-- the address 3, so it is harder to find 1.
--
-- See System.Storage_Pools.Subpools.Allocate_Any_Controlled.
generic
type Extra_Header is private;
-- The header to allocate for each element. The pool will make sure
-- to pad its size so that the element's data is properly aligned.
type Header_Access is access all Extra_Header;
package Header_Pools is
type Header_Pool is new Root_Storage_Pool with null record;
overriding procedure Allocate
(Self : in out Header_Pool;
Addr : out System.Address;
Size : Storage_Count;
Alignment : Storage_Count);
overriding procedure Deallocate
(Self : in out Header_Pool;
Addr : System.Address;
Size : Storage_Count;
Alignment : Storage_Count);
overriding function Storage_Size
(Self : Header_Pool) return Storage_Count
is (Storage_Count'Last)
with Inline;
Pool : Header_Pool;
-----------
-- Typed --
-----------
generic
type Element_Type (<>) is limited private;
package Typed is
type Element_Access is access all Element_Type;
for Element_Access'Size use Standard'Address_Size;
for Element_Access'Storage_Pool use Pool;
-- Force array bounds to be stored before the array's data, rather
-- than as a separate dope vector.
function Header_Of
(Element : Element_Access) return Header_Access
with Inline;
-- Points to the beginning of the header for Element.
-- Returns null if Element is null
procedure Free is new Ada.Unchecked_Deallocation
(Element_Type, Element_Access);
-- Free the memory used by Element
end Typed;
end Header_Pools;
end GNATCOLL.Storage_Pools.Headers;
|