a-crbtgo.ads: Commented each subprogram

2006-10-31  Matt Heaney  <heaney@adacore.com>

	* a-crbtgo.ads: Commented each subprogram

	* a-crbtgo.adb: Added reference to book from which algorithms were
	adapted.

        * a-crbtgk.ads, a-crbtgk.adb (Generic_Insert_Post): pass flag to
	indicate which child.
	(Generic_Conditional_Insert): changed parameter name from "Success" to
	"Inserted".
	(Generic_Unconditional_Insert_With_Hint): improved algorithm

	* a-coorse.adb (Replace_Element): changed parameter name in call to
	conditional insert operation.

	* a-convec.adb, a-coinve.adb (Insert): removed obsolete comment

	* a-cohama.adb (Iterate): manipulate busy-bit here, instead of in
	Generic_Iteration

	* a-ciorse.adb (Replace_Element): changed parameter name in call to
	conditional insert operation.

	* a-cihama.adb (Iterate): manipulate busy-bit here, instead of in
	Generic_Iteration.

	* a-cidlli.ads, a-cidlli.adb (Splice): Position param is now mode in
	instead of mode inout.

	* a-chtgop.adb (Adjust): modified comments to reflect current AI-302
	draft
	(Generic_Read): preserve existing buckets array if possible
	(Generic_Write): don't send buckets array length anymore

	* a-cdlili.ads, a-cdlili.adb (Splice): Position param is now mode in
	instead of mode inout.

	* a-cihase.adb (Difference): iterate over smaller of Tgt and Src sets
	(Iterate): manipulate busy-bit here, instead of in Generic_Iteration

	* a-cohase.adb (Difference): iterate over smaller of Tgt and Src sets
	(Iterate): manipulate busy-bit here, instead of in Generic_Iteration
	(Replace_Element): local operation is now an instantiation

	* a-chtgke.ads, a-chtgke.adb (Generic_Conditional_Insert): manually
	check current length.
	(Generic_Replace_Element): new operation

From-SVN: r118324

1 files changed, 104 insertions, 23 deletions

diff --git a/gcc/ada/a-chtgke.adb b/gcc/ada/a-chtgke.adb
index 5203890a594..ba6ae2376f4 100644
--- a/gcc/ada/a-chtgke.adb
+++ b/gcc/ada/a-chtgke.adb
@@ -7,11 +7,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
---                                                                          --
--- This specification is derived from the Ada Reference Manual for use with --
--- GNAT. The copyright notice above, and the license provisions that follow --
--- apply solely to the  contents of the part following the private keyword. --
+--          Copyright (C) 2004-2006, Free Software Foundation, 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- --
@@ -131,23 +127,21 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is
       Indx : constant Hash_Type := Index (HT, Key);
       B    : Node_Access renames HT.Buckets (Indx);
 
-      subtype Length_Subtype is Count_Type range 0 .. Count_Type'Last - 1;
-
    begin
       if B = null then
          if HT.Busy > 0 then
             raise Program_Error;
          end if;
 
-         declare
-            Length : constant Length_Subtype := HT.Length;
-         begin
-            Node := New_Node (Next => null);
-            Inserted := True;
+         if HT.Length = Count_Type'Last then
+            raise Constraint_Error;
+         end if;
 
-            B := Node;
-            HT.Length := Length + 1;
-         end;
+         Node := New_Node (Next => null);
+         Inserted := True;
+
+         B := Node;
+         HT.Length := HT.Length + 1;
 
          return;
       end if;
@@ -168,15 +162,15 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is
          raise Program_Error;
       end if;
 
-      declare
-         Length : constant Length_Subtype := HT.Length;
-      begin
-         Node := New_Node (Next => B);
-         Inserted := True;
+      if HT.Length = Count_Type'Last then
+         raise Constraint_Error;
+      end if;
 
-         B := Node;
-         HT.Length := Length + 1;
-      end;
+      Node := New_Node (Next => B);
+      Inserted := True;
+
+      B := Node;
+      HT.Length := HT.Length + 1;
    end Generic_Conditional_Insert;
 
    -----------
@@ -190,4 +184,91 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is
       return Hash (Key) mod HT.Buckets'Length;
    end Index;
 
+   ---------------------
+   -- Replace_Element --
+   ---------------------
+
+   procedure Generic_Replace_Element
+     (HT   : in out Hash_Table_Type;
+      Node : Node_Access;
+      Key  : Key_Type)
+   is
+   begin
+      pragma Assert (HT.Length > 0);
+
+      if Equivalent_Keys (Key, Node) then
+         pragma Assert (Hash (Key) = Hash (Node));
+
+         if HT.Lock > 0 then
+            raise Program_Error with
+              "attempt to tamper with cursors (container is locked)";
+         end if;
+
+         Assign (Node, Key);
+         return;
+      end if;
+
+      declare
+         J : Hash_Type;
+         K : constant Hash_Type := Index (HT, Key);
+         B : Node_Access renames HT.Buckets (K);
+         N : Node_Access := B;
+         M : Node_Access;
+
+      begin
+         while N /= null loop
+            if Equivalent_Keys (Key, N) then
+               raise Program_Error with
+                 "attempt to replace existing element";
+            end if;
+
+            N := Next (N);
+         end loop;
+
+         J := Hash (Node);
+
+         if J = K then
+            if HT.Lock > 0 then
+               raise Program_Error with
+                 "attempt to tamper with cursors (container is locked)";
+            end if;
+
+            Assign (Node, Key);
+            return;
+         end if;
+
+         if HT.Busy > 0 then
+            raise Program_Error with
+              "attempt to tamper with elements (container is busy)";
+         end if;
+
+         Assign (Node, Key);
+
+         N := HT.Buckets (J);
+         pragma Assert (N /= null);
+
+         if N = Node then
+            HT.Buckets (J) := Next (Node);
+
+         else
+            pragma Assert (HT.Length > 1);
+
+            loop
+               M := Next (N);
+               pragma Assert (M /= null);
+
+               if M = Node then
+                  Set_Next (Node => N, Next => Next (Node));
+                  exit;
+               end if;
+
+               N := M;
+            end loop;
+         end if;
+
+         Set_Next (Node => Node, Next => B);
+         B := Node;
+      end;
+   end Generic_Replace_Element;
+
 end Ada.Containers.Hash_Tables.Generic_Keys;