Mercurial > hg > CbC > CbC_gcc
comparison gcc/ada/libgnat/g-dyntab.ads @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 |
parents | |
children | 84e7813d76e9 |
comparison
equal
deleted
inserted
replaced
68:561a7518be6b | 111:04ced10e8804 |
---|---|
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; |