1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- T A B L E -- 6-- -- 7-- S p e c -- 8-- -- 9-- Copyright (C) 1992-2020, Free Software Foundation, Inc. -- 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. See the GNU General Public License -- 17-- for more details. You should have received a copy of the GNU General -- 18-- Public License distributed with GNAT; see file COPYING3. If not, go to -- 19-- http://www.gnu.org/licenses for a complete copy of the license. -- 20-- -- 21-- GNAT was originally developed by the GNAT team at New York University. -- 22-- Extensive contributions were provided by Ada Core Technologies Inc. -- 23-- -- 24------------------------------------------------------------------------------ 25 26-- This package provides an implementation of dynamically resizable one 27-- dimensional arrays. The idea is to mimic the normal Ada semantics for 28-- arrays as closely as possible with the one additional capability of 29-- dynamically modifying the value of the Last attribute. 30 31-- This package uses a very efficient memory management scheme and any 32-- change must be carefully evaluated on compilation of real software. 33 34-- Note that this interface should remain synchronized with those in 35-- GNAT.Table and GNAT.Dynamic_Tables to keep coherency between these 36-- three related units. 37 38with Types; use Types; 39 40package Table is 41 pragma Elaborate_Body; 42 43 generic 44 type Table_Component_Type is private; 45 type Table_Index_Type is range <>; 46 47 Table_Low_Bound : Table_Index_Type; 48 Table_Initial : Pos; 49 Table_Increment : Nat; 50 Table_Name : String; 51 Release_Threshold : Nat := 0; 52 53 package Table is 54 55 -- Table_Component_Type and Table_Index_Type specify the type of the 56 -- array, Table_Low_Bound is the lower bound. Table_Index_Type must be 57 -- an integer type. The effect is roughly to declare: 58 59 -- Table : array (Table_Index_Type range Table_Low_Bound .. <>) 60 -- of Table_Component_Type; 61 62 -- Note: since the upper bound can be one less than the lower 63 -- bound for an empty array, the table index type must be able 64 -- to cover this range, e.g. if the lower bound is 1, then the 65 -- Table_Index_Type should be Natural rather than Positive. 66 67 -- Table_Component_Type may be any Ada type, except that controlled 68 -- types are not supported. Note however that default initialization 69 -- will NOT occur for array components. 70 71 -- The Table_Initial values controls the allocation of the table when 72 -- it is first allocated, either by default, or by an explicit Init 73 -- call. The value used is Opt.Table_Factor * Table_Initial. 74 75 -- The Table_Increment value controls the amount of increase, if the 76 -- table has to be increased in size. The value given is a percentage 77 -- value (e.g. 100 = increase table size by 100%, i.e. double it). 78 79 -- The Table_Name parameter is simply use in debug output messages it 80 -- has no other usage, and is not referenced in non-debugging mode. 81 82 -- The Last and Set_Last subprograms provide control over the current 83 -- logical allocation. They are quite efficient, so they can be used 84 -- freely (expensive reallocation occurs only at major granularity 85 -- chunks controlled by the allocation parameters). 86 87 -- Note: We do not make the table components aliased, since this would 88 -- restrict the use of table for discriminated types. If it is necessary 89 -- to take the access of a table element, use Unrestricted_Access. 90 91 -- WARNING: On HPPA, the virtual addressing approach used in this unit 92 -- is incompatible with the indexing instructions on the HPPA. So when 93 -- using this unit, compile your application with -mdisable-indexing. 94 95 -- WARNING: If the table is reallocated, then the address of all its 96 -- components will change. So do not capture the address of an element 97 -- and then use the address later after the table may be reallocated. 98 -- One tricky case of this is passing an element of the table to a 99 -- subprogram by reference where the table gets reallocated during 100 -- the execution of the subprogram. The best rule to follow is never 101 -- to pass a table element as a parameter except for the case of IN 102 -- mode parameters with scalar values. 103 104 type Table_Type is 105 array (Table_Index_Type range <>) of Table_Component_Type; 106 107 subtype Big_Table_Type is 108 Table_Type (Table_Low_Bound .. Table_Index_Type'Last); 109 -- We work with pointers to a bogus array type that is constrained 110 -- with the maximum possible range bound. This means that the pointer 111 -- is a thin pointer, which is more efficient. Since subscript checks 112 -- in any case must be on the logical, rather than physical bounds, 113 -- safety is not compromised by this approach. 114 115 type Table_Ptr is access all Big_Table_Type; 116 for Table_Ptr'Storage_Size use 0; 117 -- The table is actually represented as a pointer to allow reallocation 118 119 Table : aliased Table_Ptr := null; 120 -- The table itself. The lower bound is the value of Low_Bound. 121 -- Logically the upper bound is the current value of Last (although 122 -- the actual size of the allocated table may be larger than this). 123 -- The program may only access and modify Table entries in the range 124 -- First .. Last. 125 126 Locked : Boolean := False; 127 -- Increasing the value of Last is permitted only if this switch is set 128 -- to False. A client may set Locked to True, in which case any attempt 129 -- to increase the value of Last (which might expand the table) will 130 -- cause an assertion failure. Note that while a table is locked, its 131 -- address in memory remains fixed and unchanging. This feature is used 132 -- to control table expansion during Gigi processing. Gigi assumes that 133 -- tables other than the Uint and Ureal tables do not move during 134 -- processing, which means that they cannot be expanded. The Locked 135 -- flag is used to enforce this restriction. 136 137 procedure Init; 138 -- This procedure allocates a new table of size Initial (freeing any 139 -- previously allocated larger table). It is not necessary to call 140 -- Init when a table is first instantiated (since the instantiation does 141 -- the same initialization steps). However, it is harmless to do so, and 142 -- Init is convenient in reestablishing a table for new use. 143 144 function Last return Table_Index_Type; 145 pragma Inline (Last); 146 -- Returns the current value of the last used entry in the table, which 147 -- can then be used as a subscript for Table. Note that the only way to 148 -- modify Last is to call the Set_Last procedure. Last must always be 149 -- used to determine the logically last entry. 150 151 procedure Release; 152 -- Storage is allocated in chunks according to the values given in the 153 -- Initial and Increment parameters. If Release_Threshold is 0 or the 154 -- length of the table does not exceed this threshold then a call to 155 -- Release releases all storage that is allocated, but is not logically 156 -- part of the current array value; otherwise the call to Release leaves 157 -- the current array value plus 0.1% of the current table length free 158 -- elements located at the end of the table (this parameter facilitates 159 -- reopening large tables and adding a few elements without allocating a 160 -- chunk of memory). In both cases current array values are not affected 161 -- by this call. 162 163 procedure Free; 164 -- Free all allocated memory for the table. A call to init is required 165 -- before any use of this table after calling Free. 166 167 First : constant Table_Index_Type := Table_Low_Bound; 168 -- Export First as synonym for Low_Bound (parallel with use of Last) 169 170 procedure Set_Last (New_Val : Table_Index_Type); 171 pragma Inline (Set_Last); 172 -- This procedure sets Last to the indicated value. If necessary the 173 -- table is reallocated to accommodate the new value (i.e. on return 174 -- the allocated table has an upper bound of at least Last). If Set_Last 175 -- reduces the size of the table, then logically entries are removed 176 -- from the table. If Set_Last increases the size of the table, then 177 -- new entries are logically added to the table. 178 179 procedure Increment_Last; 180 pragma Inline (Increment_Last); 181 -- Adds 1 to Last (same as Set_Last (Last + 1) 182 183 procedure Decrement_Last; 184 pragma Inline (Decrement_Last); 185 -- Subtracts 1 from Last (same as Set_Last (Last - 1) 186 187 procedure Append (New_Val : Table_Component_Type); 188 pragma Inline (Append); 189 -- Equivalent to: 190 -- x.Increment_Last; 191 -- x.Table (x.Last) := New_Val; 192 -- i.e. the table size is increased by one, and the given new item 193 -- stored in the newly created table element. 194 195 procedure Append_All (New_Vals : Table_Type); 196 -- Appends all components of New_Vals 197 198 procedure Set_Item 199 (Index : Table_Index_Type; 200 Item : Table_Component_Type); 201 pragma Inline (Set_Item); 202 -- Put Item in the table at position Index. The table is expanded if 203 -- current table length is less than Index and in that case Last is set 204 -- to Index. Item will replace any value already present in the table 205 -- at this position. 206 207 type Saved_Table is private; 208 -- Type used for Save/Restore subprograms 209 210 function Save return Saved_Table; 211 -- Resets table to empty, but saves old contents of table in returned 212 -- value, for possible later restoration by a call to Restore. 213 214 procedure Restore (T : Saved_Table); 215 -- Given a Saved_Table value returned by a prior call to Save, restores 216 -- the table to the state it was in at the time of the Save call. 217 218 private 219 220 Last_Val : Int; 221 -- Current value of Last. Note that we declare this in the private part 222 -- because we don't want the client to modify Last except through one of 223 -- the official interfaces (since a modification to Last may require a 224 -- reallocation of the table). 225 226 Max : Int; 227 -- Subscript of the maximum entry in the currently allocated table 228 229 type Saved_Table is record 230 Last_Val : Int; 231 Max : Int; 232 Table : Table_Ptr; 233 end record; 234 235 end Table; 236end Table; 237