diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/libgnat/a-chtgfk.adb | 58 | ||||
| -rw-r--r-- | gcc/ada/libgnat/a-chtgfk.ads | 37 | ||||
| -rw-r--r-- | gcc/ada/libgnat/a-chtgfo.adb | 65 | ||||
| -rw-r--r-- | gcc/ada/libgnat/a-chtgfo.ads | 20 |
4 files changed, 24 insertions, 156 deletions
diff --git a/gcc/ada/libgnat/a-chtgfk.adb b/gcc/ada/libgnat/a-chtgfk.adb index 338eb35..7d355e0 100644 --- a/gcc/ada/libgnat/a-chtgfk.adb +++ b/gcc/ada/libgnat/a-chtgfk.adb @@ -31,31 +31,6 @@ package body Ada.Containers.Hash_Tables.Generic_Formal_Keys is Checks : constant Boolean := Container_Checks'Enabled; - ----------------------------- - -- Checked_Equivalent_Keys -- - ----------------------------- - - function Checked_Equivalent_Keys - (HT : Hash_Table_Type; - Key : Key_Type; - Node : Count_Type) return Boolean - is - begin - return Equivalent_Keys (Key, HT.Nodes (Node)); - end Checked_Equivalent_Keys; - - ------------------- - -- Checked_Index -- - ------------------- - - function Checked_Index - (HT : Hash_Table_Type; - Key : Key_Type) return Hash_Type - is - begin - return HT.Buckets'First + Hash (Key) mod HT.Buckets'Length; - end Checked_Index; - -------------------------- -- Delete_Key_Sans_Free -- -------------------------- @@ -74,14 +49,14 @@ package body Ada.Containers.Hash_Tables.Generic_Formal_Keys is return; end if; - Indx := Checked_Index (HT, Key); + Indx := Index (HT, Key); X := HT.Buckets (Indx); if X = 0 then return; end if; - if Checked_Equivalent_Keys (HT, Key, X) then + if Equivalent_Keys (Key, HT.Nodes (X)) then HT.Buckets (Indx) := Next (HT.Nodes (X)); HT.Length := HT.Length - 1; return; @@ -95,7 +70,7 @@ package body Ada.Containers.Hash_Tables.Generic_Formal_Keys is return; end if; - if Checked_Equivalent_Keys (HT, Key, X) then + if Equivalent_Keys (Key, HT.Nodes (X)) then Set_Next (HT.Nodes (Prev), Next => Next (HT.Nodes (X))); HT.Length := HT.Length - 1; return; @@ -119,11 +94,11 @@ package body Ada.Containers.Hash_Tables.Generic_Formal_Keys is return 0; end if; - Indx := Checked_Index (HT, Key); + Indx := Index (HT, Key); Node := HT.Buckets (Indx); while Node /= 0 loop - if Checked_Equivalent_Keys (HT, Key, Node) then + if Equivalent_Keys (Key, HT.Nodes (Node)) then return Node; end if; Node := Next (HT.Nodes (Node)); @@ -145,7 +120,7 @@ package body Ada.Containers.Hash_Tables.Generic_Formal_Keys is Indx : Hash_Type; begin - Indx := Checked_Index (HT, Key); + Indx := Index (HT, Key); Node := HT.Buckets (Indx); if Node = 0 then @@ -165,7 +140,7 @@ package body Ada.Containers.Hash_Tables.Generic_Formal_Keys is end if; loop - if Checked_Equivalent_Keys (HT, Key, Node) then + if Equivalent_Keys (Key, HT.Nodes (Node)) then Inserted := False; return; end if; @@ -204,19 +179,12 @@ package body Ada.Containers.Hash_Tables.Generic_Formal_Keys is NN : Nodes_Type renames HT.Nodes; Old_Indx : Hash_Type; - New_Indx : constant Hash_Type := Checked_Index (HT, Key); + New_Indx : constant Hash_Type := Index (HT, Key); New_Bucket : Count_Type renames BB (New_Indx); N, M : Count_Type; begin - -- The following block appears to be vestigial -- this should be done - -- using Checked_Index instead. Also, we might have to move the actual - -- tampering checks to the top of the subprogram, in order to prevent - -- infinite recursion when calling Hash. (This is similar to how Insert - -- and Delete are implemented.) This implies that we will have to defer - -- the computation of New_Index until after the tampering check. ??? - Old_Indx := HT.Buckets'First + Hash (NN (Node)) mod HT.Buckets'Length; -- Replace_Element is allowed to change a node's key to Key @@ -224,7 +192,7 @@ package body Ada.Containers.Hash_Tables.Generic_Formal_Keys is -- only if Key is not already in the hash table. (In a unique-key -- hash table as this one, a key is mapped to exactly one node.) - if Checked_Equivalent_Keys (HT, Key, Node) then + if Equivalent_Keys (Key, NN (Node)) then -- The new Key value is mapped to this same Node, so Node -- stays in the same bucket. @@ -239,7 +207,7 @@ package body Ada.Containers.Hash_Tables.Generic_Formal_Keys is N := New_Bucket; while N /= 0 loop - if Checks and then Checked_Equivalent_Keys (HT, Key, N) then + if Checks and then Equivalent_Keys (Key, NN (N)) then pragma Assert (N /= Node); raise Program_Error with "attempt to replace existing element"; @@ -249,11 +217,7 @@ package body Ada.Containers.Hash_Tables.Generic_Formal_Keys is end loop; -- We have determined that Key is not already in the hash table, so - -- the change is tentatively allowed. We now perform the standard - -- checks to determine whether the hash table is locked (because you - -- cannot change an element while it's in use by Query_Element or - -- Update_Element), or if the container is busy (because moving a - -- node to a different bucket would interfere with iteration). + -- the change is allowed. if Old_Indx = New_Indx then -- The node is already in the bucket implied by Key. In this case diff --git a/gcc/ada/libgnat/a-chtgfk.ads b/gcc/ada/libgnat/a-chtgfk.ads index 8a04487..363eaf0 100644 --- a/gcc/ada/libgnat/a-chtgfk.ads +++ b/gcc/ada/libgnat/a-chtgfk.ads @@ -59,27 +59,11 @@ package Ada.Containers.Hash_Tables.Generic_Formal_Keys is pragma Inline (Index); -- Returns the bucket number (array index value) for the given key - function Checked_Index - (HT : Hash_Table_Type; - Key : Key_Type) return Hash_Type; - pragma Inline (Checked_Index); - -- Calls Index, but also locks and unlocks the container, per AI05-0022, in - -- order to detect element tampering by the generic actual Hash function. - - function Checked_Equivalent_Keys - (HT : Hash_Table_Type; - Key : Key_Type; - Node : Count_Type) return Boolean; - -- Calls Equivalent_Keys, but locks and unlocks the container, per - -- AI05-0022, in order to detect element tampering by that generic actual. - procedure Delete_Key_Sans_Free (HT : in out Hash_Table_Type; Key : Key_Type; X : out Count_Type); - -- Removes the node (if any) with the given key from the hash table, - -- without deallocating it. Program_Error is raised if the hash - -- table is busy. + -- Removes the node (if any) with the given key from the hash table function Find (HT : Hash_Table_Type; @@ -98,8 +82,7 @@ package Ada.Containers.Hash_Tables.Generic_Formal_Keys is -- Attempts to insert a new node with the given key into the hash table. -- If a node with that key already exists in the table, then that node -- is returned and Inserted returns False. Otherwise New_Node is called - -- to allocate a new node, and Inserted returns True. Program_Error is - -- raised if the hash table is busy. + -- to allocate a new node, and Inserted returns True. generic with function Hash (Node : Node_Type) return Hash_Type; @@ -108,15 +91,11 @@ package Ada.Containers.Hash_Tables.Generic_Formal_Keys is (HT : in out Hash_Table_Type; Node : Count_Type; Key : Key_Type); - -- Assigns Key to Node, possibly changing its equivalence class. If Node - -- is in the same equivalence class as Key (that is, it's already in the - -- bucket implied by Key), then if the hash table is locked then - -- Program_Error is raised; otherwise Assign is called to assign Key to - -- Node. If Node is in a different bucket from Key, then Program_Error is - -- raised if the hash table is busy. Otherwise it Assigns Key to Node and - -- moves the Node from its current bucket to the bucket implied by Key. - -- Note that it is never proper to assign to Node a key value already - -- in the map, and so if Key is equivalent to some other node then - -- Program_Error is raised. + -- Assigns Key to Node, possibly changing its equivalence class. Procedure + -- Assign is called to assign Key to Node. If Node is not in the same + -- bucket as Key before the assignment, it is moved from its current bucket + -- to the bucket implied by Key. Note that it is never proper to assign to + -- Node a key value already in the hash table, and so if Key is equivalent + -- to some other node then Program_Error is raised. end Ada.Containers.Hash_Tables.Generic_Formal_Keys; diff --git a/gcc/ada/libgnat/a-chtgfo.adb b/gcc/ada/libgnat/a-chtgfo.adb index e35163d..d688863 100644 --- a/gcc/ada/libgnat/a-chtgfo.adb +++ b/gcc/ada/libgnat/a-chtgfo.adb @@ -33,18 +33,6 @@ package body Ada.Containers.Hash_Tables.Generic_Formal_Operations is Checks : constant Boolean := Container_Checks'Enabled; - ------------------- - -- Checked_Index -- - ------------------- - - function Checked_Index - (Hash_Table : Hash_Table_Type; - Node : Count_Type) return Hash_Type - is - begin - return Index (Hash_Table, Hash_Table.Nodes (Node)); - end Checked_Index; - ----------- -- Clear -- ----------- @@ -52,55 +40,10 @@ package body Ada.Containers.Hash_Tables.Generic_Formal_Operations is procedure Clear (HT : in out Hash_Table_Type) is begin HT.Length := 0; - -- HT.Busy := 0; - -- HT.Lock := 0; HT.Free := -1; HT.Buckets := [others => 0]; -- optimize this somehow ??? end Clear; - -------------------------- - -- Delete_Node_At_Index -- - -------------------------- - - procedure Delete_Node_At_Index - (HT : in out Hash_Table_Type; - Indx : Hash_Type; - X : Count_Type) - is - Prev : Count_Type; - Curr : Count_Type; - - begin - Prev := HT.Buckets (Indx); - - if Checks and then Prev = 0 then - raise Program_Error with - "attempt to delete node from empty hash bucket"; - end if; - - if Prev = X then - HT.Buckets (Indx) := Next (HT.Nodes (Prev)); - HT.Length := HT.Length - 1; - return; - end if; - - if Checks and then HT.Length = 1 then - raise Program_Error with - "attempt to delete node not in its proper hash bucket"; - end if; - - loop - Curr := Next (HT.Nodes (Prev)); - - if Checks and then Curr = 0 then - raise Program_Error with - "attempt to delete node not in its proper hash bucket"; - end if; - - Prev := Curr; - end loop; - end Delete_Node_At_Index; - --------------------------- -- Delete_Node_Sans_Free -- --------------------------- @@ -121,7 +64,7 @@ package body Ada.Containers.Hash_Tables.Generic_Formal_Operations is "attempt to delete node from empty hashed container"; end if; - Indx := Checked_Index (HT, X); + Indx := Index (HT, HT.Nodes (X)); Prev := HT.Buckets (Indx); if Checks and then Prev = 0 then @@ -223,7 +166,7 @@ package body Ada.Containers.Hash_Tables.Generic_Formal_Operations is -- in the "normal" way: Container.Free points to the head of the list -- of free (inactive) nodes, and the value 0 means the free list is -- empty. Each node on the free list has been initialized to point - -- to the next free node (via its Parent component), and the value 0 + -- to the next free node (via its Next component), and the value 0 -- means that this is the last free node. -- -- If Container.Free is negative, then the links on the free store @@ -446,7 +389,7 @@ package body Ada.Containers.Hash_Tables.Generic_Formal_Operations is for J in 1 .. N loop declare Node : constant Count_Type := New_Node (Stream); - Indx : constant Hash_Type := Checked_Index (HT, Node); + Indx : constant Hash_Type := Index (HT, HT.Nodes (Node)); B : Count_Type renames HT.Buckets (Indx); begin Set_Next (HT.Nodes (Node), Next => B); @@ -523,7 +466,7 @@ package body Ada.Containers.Hash_Tables.Generic_Formal_Operations is -- This was the last node in the bucket, so move to the next -- bucket, and start searching for next node from there. - First := Checked_Index (HT, Node) + 1; + First := Index (HT, HT.Nodes (Node)) + 1; for Indx in First .. HT.Buckets'Last loop Result := HT.Buckets (Indx); diff --git a/gcc/ada/libgnat/a-chtgfo.ads b/gcc/ada/libgnat/a-chtgfo.ads index b20ef69..043b732 100644 --- a/gcc/ada/libgnat/a-chtgfo.ads +++ b/gcc/ada/libgnat/a-chtgfo.ads @@ -62,12 +62,6 @@ package Ada.Containers.Hash_Tables.Generic_Formal_Operations is -- Uses the hash value of Node to compute its Hash_Table buckets array -- index. - function Checked_Index - (Hash_Table : Hash_Table_Type; - Node : Count_Type) return Hash_Type; - -- Calls Index, but also locks and unlocks the container, per AI05-0022, in - -- order to detect element tampering by the generic actual Hash function. - generic with function Find (HT : Hash_Table_Type; @@ -80,19 +74,7 @@ package Ada.Containers.Hash_Tables.Generic_Formal_Operations is -- node then Generic_Equal returns True. procedure Clear (HT : in out Hash_Table_Type); - -- Deallocates each node in hash table HT. (Note that it only deallocates - -- the nodes, not the buckets array.) Program_Error is raised if the hash - -- table is busy. - - procedure Delete_Node_At_Index - (HT : in out Hash_Table_Type; - Indx : Hash_Type; - X : Count_Type); - -- Delete a node whose bucket position is known. extracted from following - -- subprogram, but also used directly to remove a node whose element has - -- been modified through a key_preserving reference: in that case we cannot - -- use the value of the element precisely because the current value does - -- not correspond to the hash code that determines its bucket. + -- Empties the hash table HT procedure Delete_Node_Sans_Free (HT : in out Hash_Table_Type; |