1--  Copyright 1994 Grady Booch
2--  Copyright 1999 Pat Rogers
3--  Copyright 1999-2014 Simon Wright <simon@pushface.org>
4
5--  This package is free software; you can redistribute it and/or
6--  modify it under terms of the GNU General Public License as
7--  published by the Free Software Foundation; either version 2, or
8--  (at your option) any later version. This package is distributed in
9--  the hope that it will be useful, but WITHOUT ANY WARRANTY; without
10--  even the implied warranty of MERCHANTABILITY or FITNESS FOR A
11--  PARTICULAR PURPOSE. See the GNU General Public License for more
12--  details. You should have received a copy of the GNU General Public
13--  License distributed with this package; see file COPYING.  If not,
14--  write to the Free Software Foundation, 59 Temple Place - Suite
15--  330, Boston, MA 02111-1307, USA.
16
17--  As a special exception, if other files instantiate generics from
18--  this unit, or you link this unit with other files to produce an
19--  executable, this unit does not by itself cause the resulting
20--  executable to be covered by the GNU General Public License.  This
21--  exception does not however invalidate any other reasons why the
22--  executable file might be covered by the GNU Public License.
23
24with System.Storage_Pools;
25with System.Storage_Elements;
26
27package BC.Support.Managed_Storage is
28
29   pragma Preelaborate;
30
31   package SSE renames System.Storage_Elements;
32
33   type Pool (Chunk_Size : SSE.Storage_Count) is
34     new System.Storage_Pools.Root_Storage_Pool with private;
35   --  This pool can allocate objects of type Your_Type that are no
36   --  larger than Chunk_Size (including any extra space for the
37   --  constraints of objects of indefinite types). BC.Storage_Error
38   --  will be raised for attempts to allocate larger objects.
39
40   --  At any time, each chunk that is in use may contain objects of a
41   --  specific size and alignment. There may be more than one chunk
42   --  containing objects of the same size and alignment. A used chunk
43   --  may currently contain no objects.
44
45   procedure Allocate (The_Pool : in out Pool;
46                       Storage_Address : out System.Address;
47                       Size_In_Storage_Elements : SSE.Storage_Count;
48                       Alignment : SSE.Storage_Count);
49
50   procedure Deallocate (The_Pool : in out Pool;
51                         Storage_Address : System.Address;
52                         Size_In_Storage_Elements : SSE.Storage_Count;
53                         Alignment : SSE.Storage_Count);
54
55   function Storage_Size (This : Pool) return SSE.Storage_Count;
56
57   --  Create Count empty chunks, place on the Unused list.
58   procedure Preallocate_Chunks (This : in out Pool;  Count : Positive);
59
60   --  Place any in-use chunks without current allocations back on the
61   --  Unused list.
62   procedure Reclaim_Unused_Chunks (This : in out Pool);
63
64   --  Release any chunks on the Unused list.
65   procedure Purge_Unused_Chunks (This : in out Pool);
66
67   function Total_Chunks (This : Pool) return Natural;
68
69   --  Count of in-use chunks (which may not contain any current
70   --  allocations).
71   function Dirty_Chunks (This : Pool) return Natural;
72
73   --  Count of chunks on the Unused list.
74   function Unused_Chunks (This : Pool) return Natural;
75
76private
77
78   --  Chunks are organised in a doubly-linked list, where each member
79   --  is the head of a list of chunks all of the same aligned element
80   --  size and alignment.
81   --
82   --  The doubly-linked list is organised by decreasing aligned
83   --  element size and then (for the same aligned element size) by
84   --  decreasing alignment.
85   type Chunk_List;
86   type Chunk_List_Pointer is access all Chunk_List;
87
88   --  The user data is organised as an array of System.Address, large
89   --  enough to hold at least the number of bytes required.
90   type Address_Array is array (Positive range <>) of System.Address;
91
92   type Chunk (Address_Array_Size : Natural);
93   type Chunk_Pointer is access all Chunk;
94
95   type Chunk_List is record
96
97         --  Chain of heads
98         Next_List : Chunk_List_Pointer;
99
100         --  Chain of chunks all of the same element size & alignment
101         --  (as below).
102         Head : Chunk_Pointer;
103
104         --  Size of elements held in this chunk.
105         Element_Size : SSE.Storage_Count;
106
107         --  Alignment of elements held in this chunk.
108         Alignment : SSE.Storage_Count;
109
110   end record;
111
112   type Chunk (Address_Array_Size : Natural) is record
113
114      --  Owning list of chunks all of the same element size & alignment.
115      Parent : Chunk_List_Pointer;
116
117      --  Chain of chunks all of the same element size & alignment.
118      Next_Chunk : Chunk_Pointer;
119
120      --  Usable size, depending on current alignment.
121      Usable_Chunk_Size : SSE.Storage_Count;
122
123      --  Number of free (or used, depending on context) elements
124      --  in this chunk.
125      Number_Elements : SSE.Storage_Count;
126
127      --  Address of next free element in this chunk.
128      Next_Element : System.Address;
129
130      Payload : Address_Array (1 .. Address_Array_Size);
131
132   end record;
133
134   type Pool (Chunk_Size : SSE.Storage_Count)
135      is new System.Storage_Pools.Root_Storage_Pool with record
136         Head : Chunk_List_Pointer;
137         Unused : Chunk_Pointer;
138         Address_Array_Size : Natural;
139   end record;
140
141   procedure Initialize (This : in out Pool);
142   procedure Finalize (This : in out Pool);
143
144end BC.Support.Managed_Storage;
145