* [Ada] Simplify helper units for formal hashed sets/maps
@ 2022-05-13 8:07 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2022-05-13 8:07 UTC (permalink / raw)
To: gcc-patches; +Cc: Yannick Moy
[-- Attachment #1: Type: text/plain, Size: 942 bytes --]
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.
Tested on x86_64-pc-linux-gnu, committed on trunk
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.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 14296 bytes --]
diff --git a/gcc/ada/libgnat/a-chtgfk.adb b/gcc/ada/libgnat/a-chtgfk.adb
--- 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
--- 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
--- 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
--- 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;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-05-13 8:07 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-05-13 8:07 [Ada] Simplify helper units for formal hashed sets/maps Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).