|
111
|
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-2017, 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
|
|
|
48 pragma Compiler_Unit_Warning;
|
|
|
49
|
|
|
50 with Ada.Unchecked_Conversion;
|
|
|
51
|
|
|
52 generic
|
|
|
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
|
|
|
61 package 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
|
|
|
280 private
|
|
|
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
|
|
|
293 end GNAT.Dynamic_Tables;
|
