X-Git-Url: https://oss.titaniummirror.com/gitweb?a=blobdiff_plain;f=gcc%2Fada%2Fg-htable.adb;fp=gcc%2Fada%2Fg-htable.adb;h=0000000000000000000000000000000000000000;hb=6fed43773c9b0ce596dca5686f37ac3fc0fa11c0;hp=25d9c9e4ebc6e7dc9e555c02621d3526364d1042;hpb=27b11d56b743098deb193d510b337ba22dc52e5c;p=msp430-gcc.git diff --git a/gcc/ada/g-htable.adb b/gcc/ada/g-htable.adb deleted file mode 100644 index 25d9c9e4..00000000 --- a/gcc/ada/g-htable.adb +++ /dev/null @@ -1,362 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUNTIME COMPONENTS -- --- -- --- G N A T . H T A B L E -- --- -- --- B o d y -- --- -- --- $Revision: 1.1 $ --- -- --- Copyright (C) 1995-1999 Ada Core Technologies, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 2, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING. If not, write -- --- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- --- MA 02111-1307, USA. -- --- -- --- As a special exception, if other files instantiate generics from this -- --- unit, or you link this unit with other files to produce an executable, -- --- this unit does not by itself cause the resulting executable to be -- --- covered by the GNU General Public License. This exception does not -- --- however invalidate any other reasons why the executable file might be -- --- covered by the GNU Public License. -- --- -- --- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- --- -- ------------------------------------------------------------------------------- - -with Ada.Unchecked_Deallocation; -package body GNAT.HTable is - - -------------------- - -- Static_HTable -- - -------------------- - - package body Static_HTable is - - Table : array (Header_Num) of Elmt_Ptr; - - Iterator_Index : Header_Num; - Iterator_Ptr : Elmt_Ptr; - Iterator_Started : Boolean := False; - - function Get_Non_Null return Elmt_Ptr; - -- Returns Null_Ptr if Iterator_Started is false of the Table is - -- empty. Returns Iterator_Ptr if non null, or the next non null - -- element in table if any. - - --------- - -- Get -- - --------- - - function Get (K : Key) return Elmt_Ptr is - Elmt : Elmt_Ptr; - - begin - Elmt := Table (Hash (K)); - - loop - if Elmt = Null_Ptr then - return Null_Ptr; - - elsif Equal (Get_Key (Elmt), K) then - return Elmt; - - else - Elmt := Next (Elmt); - end if; - end loop; - end Get; - - --------------- - -- Get_First -- - --------------- - - function Get_First return Elmt_Ptr is - begin - Iterator_Started := True; - Iterator_Index := Table'First; - Iterator_Ptr := Table (Iterator_Index); - return Get_Non_Null; - end Get_First; - - -------------- - -- Get_Next -- - -------------- - - function Get_Next return Elmt_Ptr is - begin - if not Iterator_Started then - return Null_Ptr; - end if; - - Iterator_Ptr := Next (Iterator_Ptr); - return Get_Non_Null; - end Get_Next; - - ------------------ - -- Get_Non_Null -- - ------------------ - - function Get_Non_Null return Elmt_Ptr is - begin - while Iterator_Ptr = Null_Ptr loop - if Iterator_Index = Table'Last then - Iterator_Started := False; - return Null_Ptr; - end if; - - Iterator_Index := Iterator_Index + 1; - Iterator_Ptr := Table (Iterator_Index); - end loop; - - return Iterator_Ptr; - end Get_Non_Null; - - ------------ - -- Remove -- - ------------ - - procedure Remove (K : Key) is - Index : constant Header_Num := Hash (K); - Elmt : Elmt_Ptr; - Next_Elmt : Elmt_Ptr; - - begin - Elmt := Table (Index); - - if Elmt = Null_Ptr then - return; - - elsif Equal (Get_Key (Elmt), K) then - Table (Index) := Next (Elmt); - - else - loop - Next_Elmt := Next (Elmt); - - if Next_Elmt = Null_Ptr then - return; - - elsif Equal (Get_Key (Next_Elmt), K) then - Set_Next (Elmt, Next (Next_Elmt)); - return; - - else - Elmt := Next_Elmt; - end if; - end loop; - end if; - end Remove; - - ----------- - -- Reset -- - ----------- - - procedure Reset is - begin - for J in Table'Range loop - Table (J) := Null_Ptr; - end loop; - end Reset; - - --------- - -- Set -- - --------- - - procedure Set (E : Elmt_Ptr) is - Index : Header_Num; - - begin - Index := Hash (Get_Key (E)); - Set_Next (E, Table (Index)); - Table (Index) := E; - end Set; - - end Static_HTable; - - -------------------- - -- Simple_HTable -- - -------------------- - - package body Simple_HTable is - - type Element_Wrapper; - type Elmt_Ptr is access all Element_Wrapper; - type Element_Wrapper is record - K : Key; - E : Element; - Next : Elmt_Ptr; - end record; - - procedure Free is new - Ada.Unchecked_Deallocation (Element_Wrapper, Elmt_Ptr); - - procedure Set_Next (E : Elmt_Ptr; Next : Elmt_Ptr); - function Next (E : Elmt_Ptr) return Elmt_Ptr; - function Get_Key (E : Elmt_Ptr) return Key; - - package Tab is new Static_HTable ( - Header_Num => Header_Num, - Element => Element_Wrapper, - Elmt_Ptr => Elmt_Ptr, - Null_Ptr => null, - Set_Next => Set_Next, - Next => Next, - Key => Key, - Get_Key => Get_Key, - Hash => Hash, - Equal => Equal); - - --------- - -- Get -- - --------- - - function Get (K : Key) return Element is - Tmp : constant Elmt_Ptr := Tab.Get (K); - - begin - if Tmp = null then - return No_Element; - else - return Tmp.E; - end if; - end Get; - - --------------- - -- Get_First -- - --------------- - - function Get_First return Element is - Tmp : constant Elmt_Ptr := Tab.Get_First; - - begin - if Tmp = null then - return No_Element; - else - return Tmp.E; - end if; - end Get_First; - - ------------- - -- Get_Key -- - ------------- - - function Get_Key (E : Elmt_Ptr) return Key is - begin - return E.K; - end Get_Key; - - -------------- - -- Get_Next -- - -------------- - - function Get_Next return Element is - Tmp : constant Elmt_Ptr := Tab.Get_Next; - - begin - if Tmp = null then - return No_Element; - else - return Tmp.E; - end if; - end Get_Next; - - ---------- - -- Next -- - ---------- - - function Next (E : Elmt_Ptr) return Elmt_Ptr is - begin - return E.Next; - end Next; - - ------------ - -- Remove -- - ------------ - - procedure Remove (K : Key) is - Tmp : Elmt_Ptr; - - begin - Tmp := Tab.Get (K); - - if Tmp /= null then - Tab.Remove (K); - Free (Tmp); - end if; - end Remove; - - ----------- - -- Reset -- - ----------- - - procedure Reset is - E1, E2 : Elmt_Ptr; - - begin - E1 := Tab.Get_First; - while E1 /= null loop - E2 := Tab.Get_Next; - Free (E1); - E1 := E2; - end loop; - - Tab.Reset; - end Reset; - - --------- - -- Set -- - --------- - - procedure Set (K : Key; E : Element) is - Tmp : constant Elmt_Ptr := Tab.Get (K); - - begin - if Tmp = null then - Tab.Set (new Element_Wrapper'(K, E, null)); - else - Tmp.E := E; - end if; - end Set; - - -------------- - -- Set_Next -- - -------------- - - procedure Set_Next (E : Elmt_Ptr; Next : Elmt_Ptr) is - begin - E.Next := Next; - end Set_Next; - end Simple_HTable; - - ---------- - -- Hash -- - ---------- - - function Hash (Key : String) return Header_Num is - - type Uns is mod 2 ** 32; - - function Rotate_Left (Value : Uns; Amount : Natural) return Uns; - pragma Import (Intrinsic, Rotate_Left); - - Tmp : Uns := 0; - - begin - for J in Key'Range loop - Tmp := Rotate_Left (Tmp, 1) + Character'Pos (Key (J)); - end loop; - - return Header_Num'First + - Header_Num'Base (Tmp mod Header_Num'Range_Length); - end Hash; - -end GNAT.HTable;