Implement -mmemcpy-strategy= and -mmemset-strategy= options
[official-gcc.git] / gcc / ada / g-dynhta.adb
blobf8ac29dbb68f3d95280456b637ef7a7c00098582
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME COMPONENTS --
4 -- --
5 -- G N A T . D Y N A M I C _ H T A B L E S --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2002-2010, 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 ------------------------------------------------------------------------------
32 package body GNAT.Dynamic_HTables is
34 -------------------
35 -- Static_HTable --
36 -------------------
38 package body Static_HTable is
40 type Table_Type is array (Header_Num) of Elmt_Ptr;
42 type Instance_Data is record
43 Table : Table_Type;
44 Iterator_Index : Header_Num;
45 Iterator_Ptr : Elmt_Ptr;
46 Iterator_Started : Boolean := False;
47 end record;
49 function Get_Non_Null (T : Instance) return Elmt_Ptr;
50 -- Returns Null_Ptr if Iterator_Started is False or if the Table is
51 -- empty. Returns Iterator_Ptr if non null, or the next non null
52 -- element in table if any.
54 ---------
55 -- Get --
56 ---------
58 function Get (T : Instance; K : Key) return Elmt_Ptr is
59 Elmt : Elmt_Ptr;
61 begin
62 if T = null then
63 return Null_Ptr;
64 end if;
66 Elmt := T.Table (Hash (K));
68 loop
69 if Elmt = Null_Ptr then
70 return Null_Ptr;
72 elsif Equal (Get_Key (Elmt), K) then
73 return Elmt;
75 else
76 Elmt := Next (Elmt);
77 end if;
78 end loop;
79 end Get;
81 ---------------
82 -- Get_First --
83 ---------------
85 function Get_First (T : Instance) return Elmt_Ptr is
86 begin
87 if T = null then
88 return Null_Ptr;
89 end if;
91 T.Iterator_Started := True;
92 T.Iterator_Index := T.Table'First;
93 T.Iterator_Ptr := T.Table (T.Iterator_Index);
94 return Get_Non_Null (T);
95 end Get_First;
97 --------------
98 -- Get_Next --
99 --------------
101 function Get_Next (T : Instance) return Elmt_Ptr is
102 begin
103 if T = null or else not T.Iterator_Started then
104 return Null_Ptr;
105 end if;
107 T.Iterator_Ptr := Next (T.Iterator_Ptr);
108 return Get_Non_Null (T);
109 end Get_Next;
111 ------------------
112 -- Get_Non_Null --
113 ------------------
115 function Get_Non_Null (T : Instance) return Elmt_Ptr is
116 begin
117 if T = null then
118 return Null_Ptr;
119 end if;
121 while T.Iterator_Ptr = Null_Ptr loop
122 if T.Iterator_Index = T.Table'Last then
123 T.Iterator_Started := False;
124 return Null_Ptr;
125 end if;
127 T.Iterator_Index := T.Iterator_Index + 1;
128 T.Iterator_Ptr := T.Table (T.Iterator_Index);
129 end loop;
131 return T.Iterator_Ptr;
132 end Get_Non_Null;
134 ------------
135 -- Remove --
136 ------------
138 procedure Remove (T : Instance; K : Key) is
139 Index : constant Header_Num := Hash (K);
140 Elmt : Elmt_Ptr;
141 Next_Elmt : Elmt_Ptr;
143 begin
144 if T = null then
145 return;
146 end if;
148 Elmt := T.Table (Index);
150 if Elmt = Null_Ptr then
151 return;
153 elsif Equal (Get_Key (Elmt), K) then
154 T.Table (Index) := Next (Elmt);
156 else
157 loop
158 Next_Elmt := Next (Elmt);
160 if Next_Elmt = Null_Ptr then
161 return;
163 elsif Equal (Get_Key (Next_Elmt), K) then
164 Set_Next (Elmt, Next (Next_Elmt));
165 return;
167 else
168 Elmt := Next_Elmt;
169 end if;
170 end loop;
171 end if;
172 end Remove;
174 -----------
175 -- Reset --
176 -----------
178 procedure Reset (T : in out Instance) is
179 procedure Free is
180 new Ada.Unchecked_Deallocation (Instance_Data, Instance);
182 begin
183 if T = null then
184 return;
185 end if;
187 for J in T.Table'Range loop
188 T.Table (J) := Null_Ptr;
189 end loop;
191 Free (T);
192 end Reset;
194 ---------
195 -- Set --
196 ---------
198 procedure Set (T : in out Instance; E : Elmt_Ptr) is
199 Index : Header_Num;
201 begin
202 if T = null then
203 T := new Instance_Data;
204 end if;
206 Index := Hash (Get_Key (E));
207 Set_Next (E, T.Table (Index));
208 T.Table (Index) := E;
209 end Set;
211 end Static_HTable;
213 -------------------
214 -- Simple_HTable --
215 -------------------
217 package body Simple_HTable is
219 ---------
220 -- Get --
221 ---------
223 function Get (T : Instance; K : Key) return Element is
224 Tmp : Elmt_Ptr;
226 begin
227 if T = Nil then
228 return No_Element;
229 end if;
231 Tmp := Tab.Get (Tab.Instance (T), K);
233 if Tmp = null then
234 return No_Element;
235 else
236 return Tmp.E;
237 end if;
238 end Get;
240 ---------------
241 -- Get_First --
242 ---------------
244 function Get_First (T : Instance) return Element is
245 Tmp : constant Elmt_Ptr := Tab.Get_First (Tab.Instance (T));
247 begin
248 if Tmp = null then
249 return No_Element;
250 else
251 return Tmp.E;
252 end if;
253 end Get_First;
255 -------------
256 -- Get_Key --
257 -------------
259 function Get_Key (E : Elmt_Ptr) return Key is
260 begin
261 return E.K;
262 end Get_Key;
264 --------------
265 -- Get_Next --
266 --------------
268 function Get_Next (T : Instance) return Element is
269 Tmp : constant Elmt_Ptr := Tab.Get_Next (Tab.Instance (T));
270 begin
271 if Tmp = null then
272 return No_Element;
273 else
274 return Tmp.E;
275 end if;
276 end Get_Next;
278 ----------
279 -- Next --
280 ----------
282 function Next (E : Elmt_Ptr) return Elmt_Ptr is
283 begin
284 return E.Next;
285 end Next;
287 ------------
288 -- Remove --
289 ------------
291 procedure Remove (T : Instance; K : Key) is
292 Tmp : Elmt_Ptr;
294 begin
295 Tmp := Tab.Get (Tab.Instance (T), K);
297 if Tmp /= null then
298 Tab.Remove (Tab.Instance (T), K);
299 Free (Tmp);
300 end if;
301 end Remove;
303 -----------
304 -- Reset --
305 -----------
307 procedure Reset (T : in out Instance) is
308 E1, E2 : Elmt_Ptr;
310 begin
311 E1 := Tab.Get_First (Tab.Instance (T));
312 while E1 /= null loop
313 E2 := Tab.Get_Next (Tab.Instance (T));
314 Free (E1);
315 E1 := E2;
316 end loop;
318 Tab.Reset (Tab.Instance (T));
319 end Reset;
321 ---------
322 -- Set --
323 ---------
325 procedure Set (T : in out Instance; K : Key; E : Element) is
326 Tmp : constant Elmt_Ptr := Tab.Get (Tab.Instance (T), K);
327 begin
328 if Tmp = null then
329 Tab.Set (Tab.Instance (T), new Element_Wrapper'(K, E, null));
330 else
331 Tmp.E := E;
332 end if;
333 end Set;
335 --------------
336 -- Set_Next --
337 --------------
339 procedure Set_Next (E : Elmt_Ptr; Next : Elmt_Ptr) is
340 begin
341 E.Next := Next;
342 end Set_Next;
344 end Simple_HTable;
346 end GNAT.Dynamic_HTables;