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