From 3837bc7f8694ca43b734a327e3e37030371eeeea Mon Sep 17 00:00:00 2001 From: Matt Heaney Date: Tue, 31 Oct 2006 19:13:22 +0100 Subject: a-crbtgo.ads: Commented each subprogram 2006-10-31 Matt Heaney * 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 --- gcc/ada/a-chtgke.adb | 127 +++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 104 insertions(+), 23 deletions(-) (limited to 'gcc/ada/a-chtgke.adb') 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; -- cgit v1.2.1