From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1914) id 7ACAB385043A; Fri, 13 May 2022 08:09:07 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 7ACAB385043A MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Pierre-Marie de Rodat To: gcc-cvs@gcc.gnu.org Subject: [gcc r13-405] [Ada] Simplify helper units for formal hashed sets/maps X-Act-Checkin: gcc X-Git-Author: Yannick Moy X-Git-Refname: refs/heads/master X-Git-Oldrev: f8e12e78628238a9e3cf68ce9376aa2e28e0506f X-Git-Newrev: 4c9a8183b3469f50c9418a2309e56b37cbac9f9f Message-Id: <20220513080907.7ACAB385043A@sourceware.org> Date: Fri, 13 May 2022 08:09:07 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Fri, 13 May 2022 08:09:07 -0000 https://gcc.gnu.org/g:4c9a8183b3469f50c9418a2309e56b37cbac9f9f commit r13-405-g4c9a8183b3469f50c9418a2309e56b37cbac9f9f Author: Yannick Moy Date: Thu Feb 24 17:30:36 2022 +0100 [Ada] Simplify helper units for formal hashed sets/maps As tampering checks do not exist in formal hashed sets and maps, remove the machinery for such checks in the version of generic key and node operations for formal sets/maps. Update comments as well. gcc/ada/ * libgnat/a-chtgfk.adb (Checked_Equivalent_Keys, Checked_Index): Remove useless functions. (Delete_Key_Sans_Free, Find, Generic_Conditional_Insert): Adapt to removal of wrapper functions. * libgnat/a-chtgfk.ads (Checked_Equivalent_Keys, Checked_Index): Remove useless functions. * libgnat/a-chtgfo.adb (Checked_Index): Remove useless function. (Clear): Delete code commented out regarding Busy and Lock management. (Delete_Node_At_Index): Delete unused procedure. (Delete_Node_Sans_Free, Free, Generic_Read, Next): Adapt to removal of wrapper functions. * libgnat/a-chtgfo.ads (Checked_Index): Remove useless function. (Delete_Node_At_Index): Delete unused procedure. Diff: --- gcc/ada/libgnat/a-chtgfk.adb | 58 ++++++++------------------------------- gcc/ada/libgnat/a-chtgfk.ads | 37 ++++++------------------- gcc/ada/libgnat/a-chtgfo.adb | 65 +++----------------------------------------- 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 338eb352d9b..7d355e04c49 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 8a044871909..363eaf05680 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 e35163df67f..d688863d3fb 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 b20ef6961a5..043b73232fa 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;