1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- G N A T . D Y N A M I C _ H T A B L E S --
9 -- Copyright (C) 2002-2010, AdaCore --
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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 package body GNAT.Dynamic_HTables is
38 package body Static_HTable is
40 type Table_Type is array (Header_Num) of Elmt_Ptr;
42 type Instance_Data is record
44 Iterator_Index : Header_Num;
45 Iterator_Ptr : Elmt_Ptr;
46 Iterator_Started : Boolean := False;
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.
58 function Get (T : Instance; K : Key) return Elmt_Ptr is
66 Elmt := T.Table (Hash (K));
69 if Elmt = Null_Ptr then
72 elsif Equal (Get_Key (Elmt), K) then
85 function Get_First (T : Instance) return Elmt_Ptr is
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);
101 function Get_Next (T : Instance) return Elmt_Ptr is
103 if T = null or else not T.Iterator_Started then
107 T.Iterator_Ptr := Next (T.Iterator_Ptr);
108 return Get_Non_Null (T);
115 function Get_Non_Null (T : Instance) return Elmt_Ptr is
121 while T.Iterator_Ptr = Null_Ptr loop
122 if T.Iterator_Index = T.Table'Last then
123 T.Iterator_Started := False;
127 T.Iterator_Index := T.Iterator_Index + 1;
128 T.Iterator_Ptr := T.Table (T.Iterator_Index);
131 return T.Iterator_Ptr;
138 procedure Remove (T : Instance; K : Key) is
139 Index : constant Header_Num := Hash (K);
141 Next_Elmt : Elmt_Ptr;
148 Elmt := T.Table (Index);
150 if Elmt = Null_Ptr then
153 elsif Equal (Get_Key (Elmt), K) then
154 T.Table (Index) := Next (Elmt);
158 Next_Elmt := Next (Elmt);
160 if Next_Elmt = Null_Ptr then
163 elsif Equal (Get_Key (Next_Elmt), K) then
164 Set_Next (Elmt, Next (Next_Elmt));
178 procedure Reset (T : in out Instance) is
180 new Ada.Unchecked_Deallocation (Instance_Data, Instance);
187 for J in T.Table'Range loop
188 T.Table (J) := Null_Ptr;
198 procedure Set (T : in out Instance; E : Elmt_Ptr) is
203 T := new Instance_Data;
206 Index := Hash (Get_Key (E));
207 Set_Next (E, T.Table (Index));
208 T.Table (Index) := E;
217 package body Simple_HTable is
223 function Get (T : Instance; K : Key) return Element is
231 Tmp := Tab.Get (Tab.Instance (T), K);
244 function Get_First (T : Instance) return Element is
245 Tmp : constant Elmt_Ptr := Tab.Get_First (Tab.Instance (T));
259 function Get_Key (E : Elmt_Ptr) return Key is
268 function Get_Next (T : Instance) return Element is
269 Tmp : constant Elmt_Ptr := Tab.Get_Next (Tab.Instance (T));
282 function Next (E : Elmt_Ptr) return Elmt_Ptr is
291 procedure Remove (T : Instance; K : Key) is
295 Tmp := Tab.Get (Tab.Instance (T), K);
298 Tab.Remove (Tab.Instance (T), K);
307 procedure Reset (T : in out Instance) is
311 E1 := Tab.Get_First (Tab.Instance (T));
312 while E1 /= null loop
313 E2 := Tab.Get_Next (Tab.Instance (T));
318 Tab.Reset (Tab.Instance (T));
325 procedure Set (T : in out Instance; K : Key; E : Element) is
326 Tmp : constant Elmt_Ptr := Tab.Get (Tab.Instance (T), K);
329 Tab.Set (Tab.Instance (T), new Element_Wrapper'(K, E, null));
339 procedure Set_Next (E : Elmt_Ptr; Next : Elmt_Ptr) is
346 end GNAT.Dynamic_HTables;