------------------------------------------------------------------------------ -- XML/Ada - An XML suite for Ada95 -- -- -- -- Copyright (C) 2004-2012, AdaCore -- -- -- -- This library is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 3, or (at your option) any later -- -- version. This library is distributed in the hope that it will be useful, -- -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- -- -- -- -- -- -- -- -- -- You should have received a copy of the GNU General Public License and -- -- a copy of the GCC Runtime Library Exception along with this program; -- -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- -- . -- -- -- ------------------------------------------------------------------------------ with Ada.Unchecked_Deallocation; with Interfaces; use Interfaces; package body Sax.HTable is procedure Unchecked_Free is new Ada.Unchecked_Deallocation (htable_item, item_ptr); ----------- -- Reset -- ----------- procedure Reset (Hash_Table : in out htable) is Item, Tmp : item_ptr; begin for Index in Hash_Table.Table'range loop if Hash_Table.Table (Index).Set then Free (Hash_Table.Table (Index).Elem); Item := Hash_Table.Table (Index).Next; while Item /= null loop Free (Item.Elem); Tmp := Item; Item := Item.Next; Unchecked_Free (Tmp); end loop; Hash_Table.Table (Index).Set := False; end if; end loop; end Reset; ------------------- -- Set_With_Hash -- ------------------- procedure Set_With_Hash (Hash_Table : in out htable; E : element; Hashed : Interfaces.Unsigned_32) is Index : constant Unsigned_32 := Hashed mod Hash_Table.Size + 1; Item : item_ptr; begin if Hash_Table.Table (Index).Set then -- Check whether we already have the item if Equal (Get_Key (Hash_Table.Table (Index).Elem), Get_Key (E)) then Free (Hash_Table.Table (Index).Elem); Hash_Table.Table (Index).Elem := E; return; else Item := Hash_Table.Table (Index).Next; while Item /= null loop if Equal (Get_Key (Item.Elem), Get_Key (E)) then Free (Item.Elem); Item.Elem := E; return; end if; Item := Item.Next; end loop; end if; Hash_Table.Table (Index).Next := new htable_item'(Elem => E, Next => Hash_Table.Table (Index).Next); else Hash_Table.Table (Index) := (Elem => E, Next => null, Set => True); end if; end Set_With_Hash; --------- -- Set -- --------- procedure Set (Hash_Table : in out htable; E : element) is begin Set_With_Hash (Hash_Table, E, Hash (Get_Key (E))); end Set; --------- -- Get -- --------- function Get (Hash_Table : htable; K : key) return element is Tmp : constant element_ptr := Get_Ptr (Hash_Table, K); begin if Tmp = null then return Empty_Element; else return Tmp.all; end if; end Get; ------------- -- Get_Ptr -- ------------- function Get_Ptr (Hash_Table : htable; K : key) return element_ptr is begin return Get_Ptr_With_Hash (Hash_Table, K, Hash (K)); end Get_Ptr; ----------------------- -- Get_Ptr_With_Hash -- ----------------------- function Get_Ptr_With_Hash (Hash_Table : htable; K : key; Hashed : Interfaces.Unsigned_32) return element_ptr is H : constant Unsigned_32 := Hashed mod Hash_Table.Size + 1; Elmt : item_ptr; begin if Hash_Table.Table (H).Set then if Equal (Get_Key (Hash_Table.Table (H).Elem), K) then return Hash_Table.Table (H).Elem'unrestricted_access; else Elmt := Hash_Table.Table (H).Next; while Elmt /= null loop if Equal (Get_Key (Elmt.Elem), K) then return Elmt.Elem'access; end if; Elmt := Elmt.Next; end loop; end if; end if; return null; end Get_Ptr_With_Hash; ------------ -- Remove -- ------------ procedure Remove (Hash_Table : in out htable; K : key) is Index : constant Unsigned_32 := Hash (K) mod Hash_Table.Size + 1; Elmt : item_ptr; Next_Elmt : item_ptr; begin if not Hash_Table.Table (Index).Set then return; elsif Equal (Get_Key (Hash_Table.Table (Index).Elem), K) then Free (Hash_Table.Table (Index).Elem); Elmt := Hash_Table.Table (Index).Next; -- second element in list if Elmt = null then Hash_Table.Table (Index).Set := False; else Hash_Table.Table (Index).Elem := Elmt.Elem; Hash_Table.Table (Index).Next := Elmt.Next; -- to third element Unchecked_Free (Elmt); -- no longer needed, was copied to first end if; else Next_Elmt := Hash_Table.Table (Index).Next; loop if Next_Elmt = null then return; elsif Equal (Get_Key (Next_Elmt.Elem), K) then if Elmt = null then Hash_Table.Table (Index).Next := Next_Elmt.Next; else Elmt.Next := Next_Elmt.Next; end if; Free (Next_Elmt.Elem); Unchecked_Free (Next_Elmt); return; end if; Elmt := Next_Elmt; Next_Elmt := Elmt.Next; end loop; end if; end Remove; ---------------- -- Remove_All -- ---------------- procedure Remove_All (Hash_Table : in out htable) is Item, Item2 : item_ptr; Prev : item_ptr; begin for T in Hash_Table.Table'range loop if Hash_Table.Table (T).Set then -- First examine the remaining of the list in that bucket Prev := null; Item := Hash_Table.Table (T).Next; while Item /= null loop if not Preserve (Item.Elem) then if Prev = null then Hash_Table.Table (T).Next := Item.Next; else Prev.Next := Item.Next; end if; Item2 := Item; Item := Item.Next; -- Prev not changed Free (Item2.Elem); Unchecked_Free (Item2); else Prev := Item; Item := Item.Next; end if; end loop; -- Then examine the bucket itself if not Preserve (Hash_Table.Table (T).Elem) then Free (Hash_Table.Table (T).Elem); if Hash_Table.Table (T).Next = null then Hash_Table.Table (T).Set := False; else Item := Hash_Table.Table (T).Next; Hash_Table.Table (T).Elem := Item.Elem; Hash_Table.Table (T).Next := Item.Next; Unchecked_Free (Item); end if; end if; end if; end loop; end Remove_All; ----------- -- First -- ----------- function First (Hash_Table : htable) return iterator is begin for Index in Hash_Table.Table'range loop if Hash_Table.Table (Index).Set then return (Index => Index, Elem => Hash_Table.Table (Index).Elem'unrestricted_access, Item => null); end if; end loop; return No_Iterator; end First; ---------- -- Next -- ---------- procedure Next (Hash_Table : htable; Iter : in out iterator) is begin pragma assert (Iter /= No_Iterator); if Iter.Item = null then Iter.Item := Hash_Table.Table (Iter.Index).Next; else Iter.Item := Iter.Item.Next; end if; if Iter.Item /= null then Iter.Elem := Iter.Item.Elem'unrestricted_access; return; end if; loop Iter.Index := Unsigned_32'succ (Iter.Index); exit when Iter.Index > Hash_Table.Table'last or else Hash_Table.Table (Iter.Index).Set; end loop; if Iter.Index > Hash_Table.Table'last then Iter := No_Iterator; else Iter.Item := null; Iter.Elem := Hash_Table.Table (Iter.Index).Elem'unrestricted_access; end if; end Next; ------------- -- Current -- ------------- function Current (Iter : iterator) return element is begin return Iter.Elem.all; end Current; end Sax.HTable;