OpenCores
URL https://opencores.org/ocsvn/scarts/scarts/trunk

Subversion Repositories scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [ada/] [a-chtgke.adb] - Blame information for rev 16

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 12 jlechner 
------------------------------------------------------------------------------
2 
--                                                                          --
3 
--                         GNAT LIBRARY COMPONENTS                          --
4 
--                                                                          --
5 
--                      A D A . C O N T A I N E R S .                       --
6 
--             H A S H _ T A B L E S . G E N E R I C _ K E Y S              --
7 
--                                                                          --
8 
--                                 B o d y                                  --
9 
--                                                                          --
10 
--          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
11 
--                                                                          --
12 
-- This specification is derived from the Ada Reference Manual for use with --
13 
-- GNAT. The copyright notice above, and the license provisions that follow --
14 
-- apply solely to the  contents of the part following the private keyword. --
15 
--                                                                          --
16 
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
17 
-- terms of the  GNU General Public License as published  by the Free Soft- --
18 
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
19 
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
20 
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
21 
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
22 
-- for  more details.  You should have  received  a copy of the GNU General --
23 
-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
24 
-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
25 
-- Boston, MA 02110-1301, USA.                                              --
26 
--                                                                          --
27 
-- As a special exception,  if other files  instantiate  generics from this --
28 
-- unit, or you link  this unit with other files  to produce an executable, --
29 
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
30 
-- covered  by the  GNU  General  Public  License.  This exception does not --
31 
-- however invalidate  any other reasons why  the executable file  might be --
32 
-- covered by the  GNU Public License.                                      --
33 
--                                                                          --
34 
-- This unit was originally developed by Matthew J Heaney.                  --
35 
------------------------------------------------------------------------------
36 
 
37 
package body Ada.Containers.Hash_Tables.Generic_Keys is
38 
 
39 
   --------------------------
40 
   -- Delete_Key_Sans_Free --
41 
   --------------------------
42 
 
43 
   procedure Delete_Key_Sans_Free
44 
     (HT   : in out Hash_Table_Type;
45 
      Key  : Key_Type;
46 
      X    : out Node_Access)
47 
   is
48 
      Indx : Hash_Type;
49 
      Prev : Node_Access;
50 
 
51 
   begin
52 
      if HT.Length = 0 then
53 
         X := null;
54 
         return;
55 
      end if;
56 
 
57 
      Indx := Index (HT, Key);
58 
      X := HT.Buckets (Indx);
59 
 
60 
      if X = null then
61 
         return;
62 
      end if;
63 
 
64 
      if Equivalent_Keys (Key, X) then
65 
         if HT.Busy > 0 then
66 
            raise Program_Error;
67 
         end if;
68 
         HT.Buckets (Indx) := Next (X);
69 
         HT.Length := HT.Length - 1;
70 
         return;
71 
      end if;
72 
 
73 
      loop
74 
         Prev := X;
75 
         X := Next (Prev);
76 
 
77 
         if X = null then
78 
            return;
79 
         end if;
80 
 
81 
         if Equivalent_Keys (Key, X) then
82 
            if HT.Busy > 0 then
83 
               raise Program_Error;
84 
            end if;
85 
            Set_Next (Node => Prev, Next => Next (X));
86 
            HT.Length := HT.Length - 1;
87 
            return;
88 
         end if;
89 
      end loop;
90 
   end Delete_Key_Sans_Free;
91 
 
92 
   ----------
93 
   -- Find --
94 
   ----------
95 
 
96 
   function Find
97 
     (HT  : Hash_Table_Type;
98 
      Key : Key_Type) return Node_Access is
99 
 
100 
      Indx : Hash_Type;
101 
      Node : Node_Access;
102 
 
103 
   begin
104 
      if HT.Length = 0 then
105 
         return null;
106 
      end if;
107 
 
108 
      Indx := Index (HT, Key);
109 
 
110 
      Node := HT.Buckets (Indx);
111 
      while Node /= null loop
112 
         if Equivalent_Keys (Key, Node) then
113 
            return Node;
114 
         end if;
115 
         Node := Next (Node);
116 
      end loop;
117 
 
118 
      return null;
119 
   end Find;
120 
 
121 
   --------------------------------
122 
   -- Generic_Conditional_Insert --
123 
   --------------------------------
124 
 
125 
   procedure Generic_Conditional_Insert
126 
     (HT       : in out Hash_Table_Type;
127 
      Key      : Key_Type;
128 
      Node     : out Node_Access;
129 
      Inserted : out Boolean)
130 
   is
131 
      Indx : constant Hash_Type := Index (HT, Key);
132 
      B    : Node_Access renames HT.Buckets (Indx);
133 
 
134 
      subtype Length_Subtype is Count_Type range 0 .. Count_Type'Last - 1;
135 
 
136 
   begin
137 
      if B = null then
138 
         if HT.Busy > 0 then
139 
            raise Program_Error;
140 
         end if;
141 
 
142 
         declare
143 
            Length : constant Length_Subtype := HT.Length;
144 
         begin
145 
            Node := New_Node (Next => null);
146 
            Inserted := True;
147 
 
148 
            B := Node;
149 
            HT.Length := Length + 1;
150 
         end;
151 
 
152 
         return;
153 
      end if;
154 
 
155 
      Node := B;
156 
      loop
157 
         if Equivalent_Keys (Key, Node) then
158 
            Inserted := False;
159 
            return;
160 
         end if;
161 
 
162 
         Node := Next (Node);
163 
 
164 
         exit when Node = null;
165 
      end loop;
166 
 
167 
      if HT.Busy > 0 then
168 
         raise Program_Error;
169 
      end if;
170 
 
171 
      declare
172 
         Length : constant Length_Subtype := HT.Length;
173 
      begin
174 
         Node := New_Node (Next => B);
175 
         Inserted := True;
176 
 
177 
         B := Node;
178 
         HT.Length := Length + 1;
179 
      end;
180 
   end Generic_Conditional_Insert;
181 
 
182 
   -----------
183 
   -- Index --
184 
   -----------
185 
 
186 
   function Index
187 
     (HT  : Hash_Table_Type;
188 
      Key : Key_Type) return Hash_Type is
189 
   begin
190 
      return Hash (Key) mod HT.Buckets'Length;
191 
   end Index;
192 
 
193 
end Ada.Containers.Hash_Tables.Generic_Keys;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.