1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- G N A T . D Y N A M I C _ T A B L E S -- 6-- -- 7-- S p e c -- 8-- -- 9-- Copyright (C) 2000-2018, AdaCore -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. -- 17-- -- 18-- As a special exception under Section 7 of GPL version 3, you are granted -- 19-- additional permissions described in the GCC Runtime Library Exception, -- 20-- version 3.1, as published by the Free Software Foundation. -- 21-- -- 22-- You should have received a copy of the GNU General Public License and -- 23-- a copy of the GCC Runtime Library Exception along with this program; -- 24-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25-- <http://www.gnu.org/licenses/>. -- 26-- -- 27-- GNAT was originally developed by the GNAT team at New York University. -- 28-- Extensive contributions were provided by Ada Core Technologies Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32-- Resizable one dimensional array support 33 34-- This package provides an implementation of dynamically resizable one 35-- dimensional arrays. The idea is to mimic the normal Ada semantics for 36-- arrays as closely as possible with the one additional capability of 37-- dynamically modifying the value of the Last attribute. 38 39-- This package provides a facility similar to that of Ada.Containers.Vectors. 40 41-- Note that these three interfaces should remain synchronized to keep as much 42-- coherency as possible among these related units: 43-- 44-- GNAT.Dynamic_Tables 45-- GNAT.Table 46-- Table (the compiler unit) 47 48pragma Compiler_Unit_Warning; 49 50with Ada.Unchecked_Conversion; 51 52generic 53 type Table_Component_Type is private; 54 type Table_Index_Type is range <>; 55 56 Table_Low_Bound : Table_Index_Type := Table_Index_Type'First; 57 Table_Initial : Positive := 8; 58 Table_Increment : Natural := 100; 59 Release_Threshold : Natural := 0; -- size in bytes 60 61package GNAT.Dynamic_Tables is 62 63 -- Table_Component_Type and Table_Index_Type specify the type of the array, 64 -- Table_Low_Bound is the lower bound. The effect is roughly to declare: 65 66 -- Table : array (Table_Low_Bound .. <>) of Table_Component_Type; 67 68 -- The lower bound of Table_Index_Type is ignored. 69 70 -- Table_Component_Type must not be a type with controlled parts. 71 72 -- The Table_Initial value controls the allocation of the table when it is 73 -- first allocated. 74 75 -- The Table_Increment value controls the amount of increase, if the table 76 -- has to be increased in size. The value given is a percentage value (e.g. 77 -- 100 = increase table size by 100%, i.e. double it). 78 79 -- The Last and Set_Last subprograms provide control over the current 80 -- logical allocation. They are quite efficient, so they can be used 81 -- freely (expensive reallocation occurs only at major granularity 82 -- chunks controlled by the allocation parameters). 83 84 -- Note: we do not make the table components aliased, since this would 85 -- restrict the use of table for discriminated types. If it is necessary 86 -- to take the access of a table element, use Unrestricted_Access. 87 88 -- WARNING: On HPPA, the virtual addressing approach used in this unit is 89 -- incompatible with the indexing instructions on the HPPA. So when using 90 -- this unit, compile your application with -mdisable-indexing. 91 92 -- WARNING: If the table is reallocated, then the address of all its 93 -- components will change. So do not capture the address of an element 94 -- and then use the address later after the table may be reallocated. One 95 -- tricky case of this is passing an element of the table to a subprogram 96 -- by reference where the table gets reallocated during the execution of 97 -- the subprogram. The best rule to follow is never to pass a table element 98 -- as a parameter except for the case of IN mode parameters with scalar 99 -- values. 100 101 pragma Assert (Table_Low_Bound /= Table_Index_Type'Base'First); 102 103 subtype Valid_Table_Index_Type is Table_Index_Type'Base 104 range Table_Low_Bound .. Table_Index_Type'Base'Last; 105 subtype Table_Last_Type is Table_Index_Type'Base 106 range Table_Low_Bound - 1 .. Table_Index_Type'Base'Last; 107 108 -- Table_Component_Type must not be a type with controlled parts. 109 110 -- The Table_Initial value controls the allocation of the table when it is 111 -- first allocated. 112 113 -- The Table_Increment value controls the amount of increase, if the table 114 -- has to be increased in size. The value given is a percentage value (e.g. 115 -- 100 = increase table size by 100%, i.e. double it). 116 117 -- The Last and Set_Last subprograms provide control over the current 118 -- logical allocation. They are quite efficient, so they can be used 119 -- freely (expensive reallocation occurs only at major granularity 120 -- chunks controlled by the allocation parameters). 121 122 -- Note: we do not make the table components aliased, since this would 123 -- restrict the use of table for discriminated types. If it is necessary 124 -- to take the access of a table element, use Unrestricted_Access. 125 126 type Table_Type is 127 array (Valid_Table_Index_Type range <>) of Table_Component_Type; 128 subtype Big_Table_Type is 129 Table_Type (Table_Low_Bound .. Valid_Table_Index_Type'Last); 130 -- We work with pointers to a bogus array type that is constrained with 131 -- the maximum possible range bound. This means that the pointer is a thin 132 -- pointer, which is more efficient. Since subscript checks in any case 133 -- must be on the logical, rather than physical bounds, safety is not 134 -- compromised by this approach. 135 136 -- To get subscript checking, rename a slice of the Table, like this: 137 138 -- Table : Table_Type renames T.Table (First .. Last (T)); 139 140 -- and then refer to components of Table. 141 142 type Table_Ptr is access all Big_Table_Type; 143 for Table_Ptr'Storage_Size use 0; 144 -- The table is actually represented as a pointer to allow reallocation 145 146 type Table_Private is private; 147 -- Table private data that is not exported in Instance 148 149 -- Private use only: 150 subtype Empty_Table_Array_Type is 151 Table_Type (Table_Low_Bound .. Table_Low_Bound - 1); 152 type Empty_Table_Array_Ptr is access all Empty_Table_Array_Type; 153 Empty_Table_Array : aliased Empty_Table_Array_Type; 154 function Empty_Table_Array_Ptr_To_Table_Ptr is 155 new Ada.Unchecked_Conversion (Empty_Table_Array_Ptr, Table_Ptr); 156 Empty_Table_Ptr : constant Table_Ptr := 157 Empty_Table_Array_Ptr_To_Table_Ptr (Empty_Table_Array'Access); 158 -- End private use only. The above are used to initialize Table to point to 159 -- an empty array. 160 161 type Instance is record 162 Table : Table_Ptr := Empty_Table_Ptr; 163 -- The table itself. The lower bound is the value of First. Logically 164 -- the upper bound is the current value of Last (although the actual 165 -- size of the allocated table may be larger than this). The program may 166 -- only access and modify Table entries in the range First .. Last. 167 -- 168 -- It's a good idea to access this via a renaming of a slice, in order 169 -- to ensure bounds checking, as in: 170 -- 171 -- Tab : Table_Type renames X.Table (First .. X.Last); 172 -- 173 -- Note: The Table component must come first. See declarations of 174 -- SCO_Unit_Table and SCO_Table in scos.h. 175 176 Locked : Boolean := False; 177 -- Table reallocation is permitted only if this is False. A client may 178 -- set Locked to True, in which case any operation that might expand or 179 -- shrink the table will cause an assertion failure. While a table is 180 -- locked, its address in memory remains fixed and unchanging. 181 182 P : Table_Private; 183 end record; 184 185 function Is_Empty (T : Instance) return Boolean; 186 pragma Inline (Is_Empty); 187 188 procedure Init (T : in out Instance); 189 -- Reinitializes the table to empty. There is no need to call this before 190 -- using a table; tables default to empty. 191 192 procedure Free (T : in out Instance) renames Init; 193 194 function First return Table_Index_Type; 195 pragma Inline (First); 196 -- Export First as synonym for Table_Low_Bound (parallel with use of Last) 197 198 function Last (T : Instance) return Table_Last_Type; 199 pragma Inline (Last); 200 -- Returns the current value of the last used entry in the table, which can 201 -- then be used as a subscript for Table. 202 203 procedure Release (T : in out Instance); 204 -- Storage is allocated in chunks according to the values given in the 205 -- Table_Initial and Table_Increment parameters. If Release_Threshold is 206 -- 0 or the length of the table does not exceed this threshold then a call 207 -- to Release releases all storage that is allocated, but is not logically 208 -- part of the current array value; otherwise the call to Release leaves 209 -- the current array value plus 0.1% of the current table length free 210 -- elements located at the end of the table. This parameter facilitates 211 -- reopening large tables and adding a few elements without allocating a 212 -- chunk of memory. In both cases current array values are not affected by 213 -- this call. 214 215 procedure Set_Last (T : in out Instance; New_Val : Table_Last_Type); 216 pragma Inline (Set_Last); 217 -- This procedure sets Last to the indicated value. If necessary the table 218 -- is reallocated to accommodate the new value (i.e. on return the 219 -- allocated table has an upper bound of at least Last). If Set_Last 220 -- reduces the size of the table, then logically entries are removed from 221 -- the table. If Set_Last increases the size of the table, then new entries 222 -- are logically added to the table. 223 224 procedure Increment_Last (T : in out Instance); 225 pragma Inline (Increment_Last); 226 -- Adds 1 to Last (same as Set_Last (Last + 1)) 227 228 procedure Decrement_Last (T : in out Instance); 229 pragma Inline (Decrement_Last); 230 -- Subtracts 1 from Last (same as Set_Last (Last - 1)) 231 232 procedure Append (T : in out Instance; New_Val : Table_Component_Type); 233 pragma Inline (Append); 234 -- Appends New_Val onto the end of the table 235 -- Equivalent to: 236 -- Increment_Last (T); 237 -- T.Table (T.Last) := New_Val; 238 239 procedure Append_All (T : in out Instance; New_Vals : Table_Type); 240 -- Appends all components of New_Vals 241 242 procedure Set_Item 243 (T : in out Instance; 244 Index : Valid_Table_Index_Type; 245 Item : Table_Component_Type); 246 pragma Inline (Set_Item); 247 -- Put Item in the table at position Index. If Index points to an existing 248 -- item (i.e. it is in the range First .. Last (T)), the item is replaced. 249 -- Otherwise (i.e. Index > Last (T)), the table is expanded, and Last is 250 -- set to Index. 251 252 procedure Move (From, To : in out Instance); 253 -- Moves from From to To, and sets From to empty 254 255 procedure Allocate (T : in out Instance; Num : Integer := 1); 256 pragma Inline (Allocate); 257 -- Adds Num to Last 258 259 generic 260 with procedure Action 261 (Index : Valid_Table_Index_Type; 262 Item : Table_Component_Type; 263 Quit : in out Boolean) is <>; 264 procedure For_Each (Table : Instance); 265 -- Calls procedure Action for each component of the table, or until one of 266 -- these calls set Quit to True. 267 268 generic 269 with function Lt (Comp1, Comp2 : Table_Component_Type) return Boolean; 270 procedure Sort_Table (Table : in out Instance); 271 -- This procedure sorts the components of the table into ascending order 272 -- making calls to Lt to do required comparisons, and using assignments 273 -- to move components around. The Lt function returns True if Comp1 is 274 -- less than Comp2 (in the sense of the desired sort), and False if Comp1 275 -- is greater than Comp2. For equal objects it does not matter if True or 276 -- False is returned (it is slightly more efficient to return False). The 277 -- sort is not stable (the order of equal items in the table is not 278 -- preserved). 279 280private 281 282 type Table_Private is record 283 Last_Allocated : Table_Last_Type := Table_Low_Bound - 1; 284 -- Subscript of the maximum entry in the currently allocated table. 285 -- Initial value ensures that we initially allocate the table. 286 287 Last : Table_Last_Type := Table_Low_Bound - 1; 288 -- Current value of Last function 289 290 -- Invariant: Last <= Last_Allocated 291 end record; 292 293end GNAT.Dynamic_Tables; 294