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-2005, 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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 with Ada
.Unchecked_Deallocation
;
36 package body GNAT
.Dynamic_HTables
is
42 package body Static_HTable
is
44 type Table_Type
is array (Header_Num
) of Elmt_Ptr
;
46 type Instance_Data
is record
48 Iterator_Index
: Header_Num
;
49 Iterator_Ptr
: Elmt_Ptr
;
50 Iterator_Started
: Boolean := False;
53 function Get_Non_Null
(T
: Instance
) return Elmt_Ptr
;
54 -- Returns Null_Ptr if Iterator_Started is False or if the Table is
55 -- empty. Returns Iterator_Ptr if non null, or the next non null
56 -- element in table if any.
62 function Get
(T
: Instance
; K
: Key
) return Elmt_Ptr
is
70 Elmt
:= T
.Table
(Hash
(K
));
73 if Elmt
= Null_Ptr
then
76 elsif Equal
(Get_Key
(Elmt
), K
) then
89 function Get_First
(T
: Instance
) return Elmt_Ptr
is
95 T
.Iterator_Started
:= True;
96 T
.Iterator_Index
:= T
.Table
'First;
97 T
.Iterator_Ptr
:= T
.Table
(T
.Iterator_Index
);
98 return Get_Non_Null
(T
);
105 function Get_Next
(T
: Instance
) return Elmt_Ptr
is
107 if T
= null or else not T
.Iterator_Started
then
111 T
.Iterator_Ptr
:= Next
(T
.Iterator_Ptr
);
112 return Get_Non_Null
(T
);
119 function Get_Non_Null
(T
: Instance
) return Elmt_Ptr
is
125 while T
.Iterator_Ptr
= Null_Ptr
loop
126 if T
.Iterator_Index
= T
.Table
'Last then
127 T
.Iterator_Started
:= False;
131 T
.Iterator_Index
:= T
.Iterator_Index
+ 1;
132 T
.Iterator_Ptr
:= T
.Table
(T
.Iterator_Index
);
135 return T
.Iterator_Ptr
;
142 procedure Remove
(T
: Instance
; K
: Key
) is
143 Index
: constant Header_Num
:= Hash
(K
);
145 Next_Elmt
: Elmt_Ptr
;
152 Elmt
:= T
.Table
(Index
);
154 if Elmt
= Null_Ptr
then
157 elsif Equal
(Get_Key
(Elmt
), K
) then
158 T
.Table
(Index
) := Next
(Elmt
);
162 Next_Elmt
:= Next
(Elmt
);
164 if Next_Elmt
= Null_Ptr
then
167 elsif Equal
(Get_Key
(Next_Elmt
), K
) then
168 Set_Next
(Elmt
, Next
(Next_Elmt
));
182 procedure Reset
(T
: in out Instance
) is
184 new Ada
.Unchecked_Deallocation
(Instance_Data
, Instance
);
191 for J
in T
.Table
'Range loop
192 T
.Table
(J
) := Null_Ptr
;
202 procedure Set
(T
: in out Instance
; E
: Elmt_Ptr
) is
207 T
:= new Instance_Data
;
210 Index
:= Hash
(Get_Key
(E
));
211 Set_Next
(E
, T
.Table
(Index
));
212 T
.Table
(Index
) := E
;
221 package body Simple_HTable
is
227 function Get
(T
: Instance
; K
: Key
) return Element
is
235 Tmp
:= Tab
.Get
(Tab
.Instance
(T
), K
);
248 function Get_First
(T
: Instance
) return Element
is
249 Tmp
: constant Elmt_Ptr
:= Tab
.Get_First
(Tab
.Instance
(T
));
263 function Get_Key
(E
: Elmt_Ptr
) return Key
is
272 function Get_Next
(T
: Instance
) return Element
is
273 Tmp
: constant Elmt_Ptr
:= Tab
.Get_Next
(Tab
.Instance
(T
));
286 function Next
(E
: Elmt_Ptr
) return Elmt_Ptr
is
295 procedure Remove
(T
: Instance
; K
: Key
) is
299 Tmp
:= Tab
.Get
(Tab
.Instance
(T
), K
);
302 Tab
.Remove
(Tab
.Instance
(T
), K
);
311 procedure Reset
(T
: in out Instance
) is
315 E1
:= Tab
.Get_First
(Tab
.Instance
(T
));
316 while E1
/= null loop
317 E2
:= Tab
.Get_Next
(Tab
.Instance
(T
));
322 Tab
.Reset
(Tab
.Instance
(T
));
329 procedure Set
(T
: in out Instance
; K
: Key
; E
: Element
) is
330 Tmp
: constant Elmt_Ptr
:= Tab
.Get
(Tab
.Instance
(T
), K
);
333 Tab
.Set
(Tab
.Instance
(T
), new Element_Wrapper
'(K, E, null));
343 procedure Set_Next (E : Elmt_Ptr; Next : Elmt_Ptr) is
350 end GNAT.Dynamic_HTables;