public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-405] [Ada] Simplify helper units for formal hashed sets/maps
@ 2022-05-13 8:09 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2022-05-13 8:09 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:4c9a8183b3469f50c9418a2309e56b37cbac9f9f
commit r13-405-g4c9a8183b3469f50c9418a2309e56b37cbac9f9f
Author: Yannick Moy <moy@adacore.com>
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;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-05-13 8:09 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:09 [gcc r13-405] [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).