diff options
Diffstat (limited to 'gcc/ada/a-chtgop.adb')
| -rw-r--r-- | gcc/ada/a-chtgop.adb | 294 |
1 files changed, 176 insertions, 118 deletions
diff --git a/gcc/ada/a-chtgop.adb b/gcc/ada/a-chtgop.adb index aa27f42..39879b6 100644 --- a/gcc/ada/a-chtgop.adb +++ b/gcc/ada/a-chtgop.adb @@ -2,11 +2,12 @@ -- -- -- GNAT LIBRARY COMPONENTS -- -- -- --- ADA.CONTAINERS.HASH_TABLES.GENERIC_OPERATIONS -- +-- A D A . C O N T A I N E R S . -- +-- H A S H _ T A B L E S . G E N E R I C _ O P E R A T I O N S -- -- -- -- B o d y -- -- -- --- Copyright (C) 2004 Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2005 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- -- @@ -68,7 +69,9 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is end if; HT.Buckets := new Buckets_Type (Src_Buckets'Range); + -- TODO: allocate minimum size req'd. (See note below.) + -- NOTE: see note below about these comments. -- Probably we have to duplicate the Size (Src), too, in order -- to guarantee that @@ -80,11 +83,30 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is -- If we relax the requirement that the hash value must be the -- same, then of course we can't guarantee that following -- assignment that Dst = Src is true ??? + -- + -- NOTE: 17 Apr 2005 + -- What I said above is no longer true. The semantics of (map) equality + -- changed, such that we use key in the left map to look up the + -- equivalent key in the right map, and then compare the elements (using + -- normal equality) of the equivalent keys. So it doesn't matter that + -- the maps have different capacities (i.e. the hash tables have + -- different lengths), since we just look up the key, irrespective of + -- its map's hash table length. All the RM says we're required to do + -- it arrange for the target map to "=" the source map following an + -- assignment (that is, following an Adjust), so it doesn't matter + -- what the capacity of the target map is. What I'll probably do is + -- allocate a new hash table that has the minimum size necessary, + -- instead of allocating a new hash table whose size exactly matches + -- that of the source. (See the assignment that immediately precedes + -- these comments.) What we really need is a special Assign operation + -- (not unlike what we have already for Vector) that allows the user to + -- choose the capacity of the target. + -- END NOTE. for Src_Index in Src_Buckets'Range loop Src_Node := Src_Buckets (Src_Index); - if Src_Node /= Null_Node then + if Src_Node /= null then declare Dst_Node : constant Node_Access := Copy_Node (Src_Node); @@ -100,7 +122,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is end; Src_Node := Next (Src_Node); - while Src_Node /= Null_Node loop + while Src_Node /= null loop declare Dst_Node : constant Node_Access := Copy_Node (Src_Node); @@ -145,8 +167,12 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is Node : Node_Access; begin + if HT.Busy > 0 then + raise Program_Error; + end if; + while HT.Length > 0 loop - while HT.Buckets (Index) = Null_Node loop + while HT.Buckets (Index) = null loop Index := Index + 1; end loop; @@ -158,7 +184,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is Bucket := Next (Bucket); HT.Length := HT.Length - 1; Free (Node); - exit when Bucket = Null_Node; + exit when Bucket = null; end loop; end; end loop; @@ -172,7 +198,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is (HT : in out Hash_Table_Type; X : Node_Access) is - pragma Assert (X /= Null_Node); + pragma Assert (X /= null); Indx : Hash_Type; Prev : Node_Access; @@ -186,7 +212,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is Indx := Index (HT, X); Prev := HT.Buckets (Indx); - if Prev = Null_Node then + if Prev = null then raise Program_Error; end if; @@ -203,7 +229,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is loop Curr := Next (Prev); - if Curr = Null_Node then + if Curr = null then raise Program_Error; end if; @@ -217,75 +243,6 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is end loop; end Delete_Node_Sans_Free; - --------------------- - -- Ensure_Capacity -- - --------------------- - - procedure Ensure_Capacity - (HT : in out Hash_Table_Type; - N : Count_Type) - is - NN : Hash_Type; - - begin - if N = 0 then - if HT.Length = 0 then - Free (HT.Buckets); - - elsif HT.Length < HT.Buckets'Length then - NN := Prime_Numbers.To_Prime (HT.Length); - - -- ASSERT: NN >= HT.Length - - if NN < HT.Buckets'Length then - Rehash (HT, Size => NN); - end if; - end if; - - return; - end if; - - if HT.Buckets = null then - NN := Prime_Numbers.To_Prime (N); - - -- ASSERT: NN >= N - - Rehash (HT, Size => NN); - return; - end if; - - if N <= HT.Length then - if HT.Length >= HT.Buckets'Length then - return; - end if; - - NN := Prime_Numbers.To_Prime (HT.Length); - - -- ASSERT: NN >= HT.Length - - if NN < HT.Buckets'Length then - Rehash (HT, Size => NN); - end if; - - return; - end if; - - -- ASSERT: N > HT.Length - - if N = HT.Buckets'Length then - return; - end if; - - NN := Prime_Numbers.To_Prime (N); - - -- ASSERT: NN >= N - -- ASSERT: NN > HT.Length - - if NN /= HT.Buckets'Length then - Rehash (HT, Size => NN); - end if; - end Ensure_Capacity; - -------------- -- Finalize -- -------------- @@ -305,12 +262,12 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is begin if HT.Length = 0 then - return Null_Node; + return null; end if; Indx := HT.Buckets'First; loop - if HT.Buckets (Indx) /= Null_Node then + if HT.Buckets (Indx) /= null then return HT.Buckets (Indx); end if; @@ -331,7 +288,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is end if; for J in Buckets'Range loop - while Buckets (J) /= Null_Node loop + while Buckets (J) /= null loop Node := Buckets (J); Buckets (J) := Next (Node); Free (Node); @@ -370,7 +327,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is loop L_Node := L.Buckets (L_Index); - exit when L_Node /= Null_Node; + exit when L_Node /= null; L_Index := L_Index + 1; end loop; @@ -385,7 +342,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is L_Node := Next (L_Node); - if L_Node = Null_Node then + if L_Node = null then if N = 0 then return True; end if; @@ -393,7 +350,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is loop L_Index := L_Index + 1; L_Node := L.Buckets (L_Index); - exit when L_Node /= Null_Node; + exit when L_Node /= null; end loop; end if; end loop; @@ -404,22 +361,32 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is ----------------------- procedure Generic_Iteration (HT : Hash_Table_Type) is - Node : Node_Access; + Busy : Natural renames HT'Unrestricted_Access.all.Busy; begin - if HT.Buckets = null - or else HT.Length = 0 - then + if HT.Length = 0 then return; end if; - for Indx in HT.Buckets'Range loop - Node := HT.Buckets (Indx); - while Node /= Null_Node loop - Process (Node); - Node := Next (Node); + Busy := Busy + 1; + + declare + Node : Node_Access; + begin + for Indx in HT.Buckets'Range loop + Node := HT.Buckets (Indx); + while Node /= null loop + Process (Node); + Node := Next (Node); + end loop; end loop; - end loop; + exception + when others => + Busy := Busy - 1; + raise; + end; + + Busy := Busy - 1; end Generic_Iteration; ------------------ @@ -436,10 +403,6 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is N, M : Count_Type'Base; begin - -- As with the sorted set, it's not clear whether read is allowed to - -- have side effect if it fails. For now, we assume side effects are - -- allowed since it simplifies the algorithm ??? - -- Clear (HT); declare @@ -452,6 +415,10 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is Hash_Type'Read (Stream, Last); + -- TODO: don't immediately deallocate the buckets array we + -- already have. Instead, allocate a new buckets array only + -- if it needs to expanded because of the value of Last. + if Last /= 0 then HT.Buckets := new Buckets_Type (0 .. Last); end if; @@ -461,15 +428,15 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is while N > 0 loop Hash_Type'Read (Stream, I); pragma Assert (I in HT.Buckets'Range); - pragma Assert (HT.Buckets (I) = Null_Node); + pragma Assert (HT.Buckets (I) = null); Count_Type'Base'Read (Stream, M); pragma Assert (M >= 1); pragma Assert (M <= N); HT.Buckets (I) := New_Node (Stream); - pragma Assert (HT.Buckets (I) /= Null_Node); - pragma Assert (Next (HT.Buckets (I)) = Null_Node); + pragma Assert (HT.Buckets (I) /= null); + pragma Assert (Next (HT.Buckets (I)) = null); Y := HT.Buckets (I); @@ -477,8 +444,8 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is for J in Count_Type range 2 .. M loop X := New_Node (Stream); - pragma Assert (X /= Null_Node); - pragma Assert (Next (X) = Null_Node); + pragma Assert (X /= null); + pragma Assert (Next (X) = null); Set_Next (Node => Y, Next => X); Y := X; @@ -517,11 +484,11 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is for Indx in HT.Buckets'Range loop X := HT.Buckets (Indx); - if X /= Null_Node then + if X /= null then M := 1; loop X := Next (X); - exit when X = Null_Node; + exit when X = null; M := M + 1; end loop; @@ -534,7 +501,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is X := Next (X); end loop; - pragma Assert (X = Null_Node); + pragma Assert (X = null); end if; end loop; end Generic_Write; @@ -567,14 +534,18 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is return; end if; - if Target.Length > 0 then - raise Constraint_Error; + if Source.Busy > 0 then + raise Program_Error; end if; - Free (Target.Buckets); + Clear (Target); - Target.Buckets := Source.Buckets; - Source.Buckets := null; + declare + Buckets : constant Buckets_Access := Target.Buckets; + begin + Target.Buckets := Source.Buckets; + Source.Buckets := Buckets; + end; Target.Length := Source.Length; Source.Length := 0; @@ -591,19 +562,19 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is Result : Node_Access := Next (Node); begin - if Result /= Null_Node then + if Result /= null then return Result; end if; for Indx in Index (HT, Node) + 1 .. HT.Buckets'Last loop Result := HT.Buckets (Indx); - if Result /= Null_Node then + if Result /= null then return Result; end if; end loop; - return Null_Node; + return null; end Next; ------------ @@ -642,7 +613,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is declare Src_Bucket : Node_Access renames Src_Buckets (Src_Index); begin - while Src_Bucket /= Null_Node loop + while Src_Bucket /= null loop declare Src_Node : constant Node_Access := Src_Bucket; Dst_Index : constant Hash_Type := @@ -662,6 +633,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is exception when others => + -- NOTE: see todo below. -- Not clear that we can deallocate the nodes, -- because they may be designated by outstanding -- iterators. Which means they're now lost... ??? @@ -671,7 +643,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is -- Dst : Node_Access renames NB (J); -- X : Node_Access; -- begin - -- while Dst /= Null_Node loop + -- while Dst /= null loop -- X := Dst; -- Dst := Succ (Dst); -- Free (X); @@ -679,9 +651,15 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is -- end; -- end loop; + -- TODO: 17 Apr 2005 + -- What I should do instead is go ahead and deallocate the + -- nodes, since when assertions are enabled, we vet the + -- cursors, and we modify the state of a node enough when + -- it is deallocated in order to detect mischief. + -- END TODO. Free (Dst_Buckets); - raise; + raise; -- TODO: raise Program_Error instead end; -- exit when L = 0; @@ -697,5 +675,85 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is Free (Src_Buckets); end Rehash; -end Ada.Containers.Hash_Tables.Generic_Operations; + ---------------------- + -- Reserve_Capacity -- + ---------------------- + + procedure Reserve_Capacity + (HT : in out Hash_Table_Type; + N : Count_Type) + is + NN : Hash_Type; + + begin + if N = 0 then + if HT.Length = 0 then + Free (HT.Buckets); + + elsif HT.Length < HT.Buckets'Length then + NN := Prime_Numbers.To_Prime (HT.Length); + + -- ASSERT: NN >= HT.Length + + if NN < HT.Buckets'Length then + if HT.Busy > 0 then + raise Program_Error; + end if; + + Rehash (HT, Size => NN); + end if; + end if; + + return; + end if; + + if HT.Buckets = null then + NN := Prime_Numbers.To_Prime (N); + + -- ASSERT: NN >= N + + Rehash (HT, Size => NN); + return; + end if; + + if N <= HT.Length then + if HT.Length >= HT.Buckets'Length then + return; + end if; + + NN := Prime_Numbers.To_Prime (HT.Length); + + -- ASSERT: NN >= HT.Length + + if NN < HT.Buckets'Length then + if HT.Busy > 0 then + raise Program_Error; + end if; + + Rehash (HT, Size => NN); + end if; + + return; + end if; + -- ASSERT: N > HT.Length + + if N = HT.Buckets'Length then + return; + end if; + + NN := Prime_Numbers.To_Prime (N); + + -- ASSERT: NN >= N + -- ASSERT: NN > HT.Length + + if NN /= HT.Buckets'Length then + if HT.Busy > 0 then + raise Program_Error; + end if; + + Rehash (HT, Size => NN); + end if; + end Reserve_Capacity; + +end Ada.Containers.Hash_Tables.Generic_Operations; |