diff options
| -rw-r--r-- | gcc/ada/Makefile.rtl | 2 | ||||
| -rw-r--r-- | gcc/ada/libgnat/a-chtgfk.adb | 278 | ||||
| -rw-r--r-- | gcc/ada/libgnat/a-chtgfk.ads | 101 | ||||
| -rw-r--r-- | gcc/ada/libgnat/a-chtgfo.adb | 413 | ||||
| -rw-r--r-- | gcc/ada/libgnat/a-chtgfo.ads | 114 | ||||
| -rw-r--r-- | gcc/ada/libgnat/a-cohata.ads | 19 |
6 files changed, 0 insertions, 927 deletions
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index a36f601..8656e71 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -120,8 +120,6 @@ GNATRTL_NONTASKING_OBJS= \ a-chlat9$(objext) \ a-chtgbk$(objext) \ a-chtgbo$(objext) \ - a-chtgfk$(objext) \ - a-chtgfo$(objext) \ a-chtgke$(objext) \ a-chtgop$(objext) \ a-chzla1$(objext) \ diff --git a/gcc/ada/libgnat/a-chtgfk.adb b/gcc/ada/libgnat/a-chtgfk.adb deleted file mode 100644 index 1e0dd8a..0000000 --- a/gcc/ada/libgnat/a-chtgfk.adb +++ /dev/null @@ -1,278 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT LIBRARY COMPONENTS -- --- -- --- ADA.CONTAINERS.HASH_TABLES.GENERIC_FORMAL_KEYS -- --- -- --- B o d y -- --- -- --- Copyright (C) 2004-2024, 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- This unit was originally developed by Matthew J Heaney. -- ------------------------------------------------------------------------------- - -package body Ada.Containers.Hash_Tables.Generic_Formal_Keys is - - Checks : constant Boolean := Container_Checks'Enabled; - - -------------------------- - -- Delete_Key_Sans_Free -- - -------------------------- - - procedure Delete_Key_Sans_Free - (HT : in out Hash_Table_Type; - Key : Key_Type; - X : out Count_Type) - is - Indx : Hash_Type; - Prev : Count_Type; - - begin - if HT.Length = 0 then - X := 0; - return; - end if; - - Indx := Index (HT, Key); - X := HT.Buckets (Indx); - - if X = 0 then - return; - end if; - - if Equivalent_Keys (Key, HT.Nodes (X)) then - HT.Buckets (Indx) := Next (HT.Nodes (X)); - HT.Length := HT.Length - 1; - return; - end if; - - loop - Prev := X; - X := Next (HT.Nodes (Prev)); - - if X = 0 then - return; - end if; - - if Equivalent_Keys (Key, HT.Nodes (X)) then - Set_Next (HT.Nodes (Prev), Next => Next (HT.Nodes (X))); - HT.Length := HT.Length - 1; - return; - end if; - end loop; - end Delete_Key_Sans_Free; - - ---------- - -- Find -- - ---------- - - function Find - (HT : Hash_Table_Type; - Key : Key_Type) return Count_Type - is - Indx : Hash_Type; - Node : Count_Type; - - begin - if HT.Length = 0 then - return 0; - end if; - - Indx := Index (HT, Key); - - Node := HT.Buckets (Indx); - while Node /= 0 loop - if Equivalent_Keys (Key, HT.Nodes (Node)) then - return Node; - end if; - Node := Next (HT.Nodes (Node)); - end loop; - - return 0; - end Find; - - -------------------------------- - -- Generic_Conditional_Insert -- - -------------------------------- - - procedure Generic_Conditional_Insert - (HT : in out Hash_Table_Type; - Key : Key_Type; - Node : out Count_Type; - Inserted : out Boolean) - is - Indx : Hash_Type; - - begin - Indx := Index (HT, Key); - Node := HT.Buckets (Indx); - - if Node = 0 then - if Checks and then HT.Length = HT.Capacity then - raise Capacity_Error with "no more capacity for insertion"; - end if; - - New_Node (HT, Node); - Set_Next (HT.Nodes (Node), Next => 0); - - Inserted := True; - - HT.Buckets (Indx) := Node; - HT.Length := HT.Length + 1; - - return; - end if; - - loop - if Equivalent_Keys (Key, HT.Nodes (Node)) then - Inserted := False; - return; - end if; - - Node := Next (HT.Nodes (Node)); - - exit when Node = 0; - end loop; - - if Checks and then HT.Length = HT.Capacity then - raise Capacity_Error with "no more capacity for insertion"; - end if; - - New_Node (HT, Node); - Set_Next (HT.Nodes (Node), Next => HT.Buckets (Indx)); - - Inserted := True; - - HT.Buckets (Indx) := Node; - HT.Length := HT.Length + 1; - end Generic_Conditional_Insert; - - ----------------------------- - -- Generic_Replace_Element -- - ----------------------------- - - procedure Generic_Replace_Element - (HT : in out Hash_Table_Type; - Node : Count_Type; - Key : Key_Type) - is - pragma Assert (HT.Length > 0); - pragma Assert (Node /= 0); - - BB : Buckets_Type renames HT.Buckets; - NN : Nodes_Type renames HT.Nodes; - - Old_Indx : Hash_Type; - New_Indx : constant Hash_Type := Index (HT, Key); - - New_Bucket : Count_Type renames BB (New_Indx); - N, M : Count_Type; - - begin - Old_Indx := HT.Buckets'First + Hash (NN (Node)) mod HT.Buckets'Length; - - -- Replace_Element is allowed to change a node's key to Key - -- (generic formal operation Assign provides the mechanism), but - -- 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 Equivalent_Keys (Key, NN (Node)) then - -- The new Key value is mapped to this same Node, so Node - -- stays in the same bucket. - - Assign (NN (Node), Key); - return; - end if; - - -- Key is not equivalent to Node, so we now have to determine if it's - -- equivalent to some other node in the hash table. This is the case - -- irrespective of whether Key is in the same or a different bucket from - -- Node. - - N := New_Bucket; - while N /= 0 loop - if Checks and then Equivalent_Keys (Key, NN (N)) then - pragma Assert (N /= Node); - raise Program_Error with - "attempt to replace existing element"; - end if; - - N := Next (NN (N)); - end loop; - - -- We have determined that Key is not already in the hash table, so - -- the change is allowed. - - if Old_Indx = New_Indx then - -- The node is already in the bucket implied by Key. In this case - -- we merely change its value without moving it. - - Assign (NN (Node), Key); - return; - end if; - - -- The node is in a bucket different from the bucket implied by Key. - -- Do the assignment first, before moving the node, so that if Assign - -- propagates an exception, then the hash table will not have been - -- modified (except for any possible side-effect Assign had on Node). - - Assign (NN (Node), Key); - - -- Now we can safely remove the node from its current bucket - - N := BB (Old_Indx); -- get value of first node in old bucket - pragma Assert (N /= 0); - - if N = Node then -- node is first node in its bucket - BB (Old_Indx) := Next (NN (Node)); - - else - pragma Assert (HT.Length > 1); - - loop - M := Next (NN (N)); - pragma Assert (M /= 0); - - if M = Node then - Set_Next (NN (N), Next => Next (NN (Node))); - exit; - end if; - - N := M; - end loop; - end if; - - -- Now we link the node into its new bucket (corresponding to Key) - - Set_Next (NN (Node), Next => New_Bucket); - New_Bucket := Node; - end Generic_Replace_Element; - - ----------- - -- Index -- - ----------- - - function Index - (HT : Hash_Table_Type; - Key : Key_Type) return Hash_Type is - begin - return HT.Buckets'First + Hash (Key) mod HT.Buckets'Length; - end Index; - -end Ada.Containers.Hash_Tables.Generic_Formal_Keys; diff --git a/gcc/ada/libgnat/a-chtgfk.ads b/gcc/ada/libgnat/a-chtgfk.ads deleted file mode 100644 index a2ce37c..0000000 --- a/gcc/ada/libgnat/a-chtgfk.ads +++ /dev/null @@ -1,101 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT LIBRARY COMPONENTS -- --- -- --- ADA.CONTAINERS.HASH_TABLES.GENERIC_FORMAL_KEYS -- --- -- --- S p e c -- --- -- --- Copyright (C) 2004-2024, 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- This unit was originally developed by Matthew J Heaney. -- ------------------------------------------------------------------------------- - --- Hash_Table_Type is used to implement hashed containers. This package --- declares hash-table operations that depend on keys. - -generic - with package HT_Types is - new Generic_Formal_Hash_Table_Types (<>); - - use HT_Types; - - with function Next (Node : Node_Type) return Count_Type; - - with procedure Set_Next - (Node : in out Node_Type; - Next : Count_Type); - - type Key_Type (<>) is limited private; - - with function Hash (Key : Key_Type) return Hash_Type; - - with function Equivalent_Keys - (Key : Key_Type; - Node : Node_Type) return Boolean; - -package Ada.Containers.Hash_Tables.Generic_Formal_Keys is - pragma Pure; - - function Index - (HT : Hash_Table_Type; - Key : Key_Type) return Hash_Type; - pragma Inline (Index); - -- Returns the bucket number (array index value) for the given key - - 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 - - function Find - (HT : Hash_Table_Type; - Key : Key_Type) return Count_Type; - -- Returns the node (if any) corresponding to the given key - - generic - with procedure New_Node - (HT : in out Hash_Table_Type; - Node : out Count_Type); - procedure Generic_Conditional_Insert - (HT : in out Hash_Table_Type; - Key : Key_Type; - Node : out Count_Type; - Inserted : out Boolean); - -- 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. - - generic - with function Hash (Node : Node_Type) return Hash_Type; - with procedure Assign (Node : in out Node_Type; Key : Key_Type); - procedure Generic_Replace_Element - (HT : in out Hash_Table_Type; - Node : Count_Type; - Key : Key_Type); - -- 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 deleted file mode 100644 index df7b554..0000000 --- a/gcc/ada/libgnat/a-chtgfo.adb +++ /dev/null @@ -1,413 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT LIBRARY COMPONENTS -- --- -- --- ADA.CONTAINERS.HASH_TABLES.GENERIC_FORMAL_OPERATIONS -- --- -- --- B o d y -- --- -- --- Copyright (C) 2004-2024, 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- This unit was originally developed by Matthew J Heaney. -- ------------------------------------------------------------------------------- - -with System; use type System.Address; - -package body Ada.Containers.Hash_Tables.Generic_Formal_Operations is - - Checks : constant Boolean := Container_Checks'Enabled; - - ----------- - -- Clear -- - ----------- - - procedure Clear (HT : in out Hash_Table_Type) is - begin - HT.Length := 0; - HT.Free := -1; - HT.Buckets := [others => 0]; -- optimize this somehow ??? - end Clear; - - --------------------------- - -- Delete_Node_Sans_Free -- - --------------------------- - - procedure Delete_Node_Sans_Free - (HT : in out Hash_Table_Type; - X : Count_Type) - is - pragma Assert (X /= 0); - - Indx : Hash_Type; - Prev : Count_Type; - Curr : Count_Type; - - begin - if Checks and then HT.Length = 0 then - raise Program_Error with - "attempt to delete node from empty hashed container"; - end if; - - Indx := Index (HT, HT.Nodes (X)); - 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; - - if Curr = X then - Set_Next (HT.Nodes (Prev), Next => Next (HT.Nodes (Curr))); - HT.Length := HT.Length - 1; - return; - end if; - - Prev := Curr; - end loop; - end Delete_Node_Sans_Free; - - ----------- - -- First -- - ----------- - - function First (HT : Hash_Table_Type) return Count_Type is - Indx : Hash_Type; - - begin - if HT.Length = 0 then - return 0; - end if; - - Indx := HT.Buckets'First; - loop - if HT.Buckets (Indx) /= 0 then - return HT.Buckets (Indx); - end if; - - Indx := Indx + 1; - end loop; - end First; - - ---------- - -- Free -- - ---------- - - procedure Free - (HT : in out Hash_Table_Type; - X : Count_Type) - is - N : Nodes_Type renames HT.Nodes; - - begin - -- This subprogram "deallocates" a node by relinking the node off of the - -- active list and onto the free list. Previously it would flag index - -- value 0 as an error. The precondition was weakened, so that index - -- value 0 is now allowed, and this value is interpreted to mean "do - -- nothing". This makes its behavior analogous to the behavior of - -- Ada.Unchecked_Deallocation, and allows callers to avoid having to add - -- special-case checks at the point of call. - - if X = 0 then - return; - end if; - - pragma Assert (X <= HT.Capacity); - - -- pragma Assert (N (X).Prev >= 0); -- node is active - -- Find a way to mark a node as active vs. inactive; we could - -- use a special value in Color_Type for this. ??? - - -- The hash table actually contains two data structures: a list for - -- the "active" nodes that contain elements that have been inserted - -- onto the container, and another for the "inactive" nodes of the free - -- store. - -- - -- We desire that merely declaring an object should have only minimal - -- cost; specially, we want to avoid having to initialize the free - -- store (to fill in the links), especially if the capacity is large. - -- - -- The head of the free list is indicated by Container.Free. If its - -- value is non-negative, then the free store has been initialized - -- 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 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 - -- have not been initialized. In this case the link values are - -- implied: the free store comprises the components of the node array - -- started with the absolute value of Container.Free, and continuing - -- until the end of the array (Nodes'Last). - -- - -- ??? - -- It might be possible to perform an optimization here. Suppose that - -- the free store can be represented as having two parts: one - -- comprising the non-contiguous inactive nodes linked together - -- in the normal way, and the other comprising the contiguous - -- inactive nodes (that are not linked together, at the end of the - -- nodes array). This would allow us to never have to initialize - -- the free store, except in a lazy way as nodes become inactive. - - -- When an element is deleted from the list container, its node - -- becomes inactive, and so we set its Next component to value of - -- the node's index (in the nodes array), to indicate that it is - -- now inactive. This provides a useful way to detect a dangling - -- cursor reference. ??? - - Set_Next (N (X), Next => X); -- Node is deallocated (not on active list) - - if HT.Free >= 0 then - -- The free store has previously been initialized. All we need to - -- do here is link the newly-free'd node onto the free list. - - Set_Next (N (X), HT.Free); - HT.Free := X; - - elsif X + 1 = abs HT.Free then - -- The free store has not been initialized, and the node becoming - -- inactive immediately precedes the start of the free store. All - -- we need to do is move the start of the free store back by one. - - HT.Free := HT.Free + 1; - - else - -- The free store has not been initialized, and the node becoming - -- inactive does not immediately precede the free store. Here we - -- first initialize the free store (meaning the links are given - -- values in the traditional way), and then link the newly-free'd - -- node onto the head of the free store. - - -- ??? - -- See the comments above for an optimization opportunity. If - -- the next link for a node on the free store is negative, then - -- this means the remaining nodes on the free store are - -- physically contiguous, starting as the absolute value of - -- that index value. - - HT.Free := abs HT.Free; - - if HT.Free > HT.Capacity then - HT.Free := 0; - - else - for I in HT.Free .. HT.Capacity - 1 loop - Set_Next (Node => N (I), Next => I + 1); - end loop; - - Set_Next (Node => N (HT.Capacity), Next => 0); - end if; - - Set_Next (Node => N (X), Next => HT.Free); - HT.Free := X; - end if; - end Free; - - ---------------------- - -- Generic_Allocate -- - ---------------------- - - procedure Generic_Allocate - (HT : in out Hash_Table_Type; - Node : out Count_Type) - is - N : Nodes_Type renames HT.Nodes; - - begin - if HT.Free >= 0 then - Node := HT.Free; - - -- We always perform the assignment first, before we - -- change container state, in order to defend against - -- exceptions duration assignment. - - Set_Element (N (Node)); - HT.Free := Next (N (Node)); - - else - -- A negative free store value means that the links of the nodes - -- in the free store have not been initialized. In this case, the - -- nodes are physically contiguous in the array, starting at the - -- index that is the absolute value of the Container.Free, and - -- continuing until the end of the array (Nodes'Last). - - Node := abs HT.Free; - - -- As above, we perform this assignment first, before modifying - -- any container state. - - Set_Element (N (Node)); - HT.Free := HT.Free - 1; - end if; - end Generic_Allocate; - - ------------------- - -- Generic_Equal -- - ------------------- - - function Generic_Equal - (L, R : Hash_Table_Type) return Boolean - is - L_Index : Hash_Type; - L_Node : Count_Type; - - N : Count_Type; - - begin - if L.Length /= R.Length then - return False; - end if; - - if L.Length = 0 then - return True; - end if; - - -- Find the first node of hash table L - - L_Index := L.Buckets'First; - loop - L_Node := L.Buckets (L_Index); - exit when L_Node /= 0; - L_Index := L_Index + 1; - end loop; - - -- For each node of hash table L, search for an equivalent node in hash - -- table R. - - N := L.Length; - loop - if not Find (HT => R, Key => L.Nodes (L_Node)) then - return False; - end if; - - N := N - 1; - - L_Node := Next (L.Nodes (L_Node)); - - if L_Node = 0 then - - -- We have exhausted the nodes in this bucket - - if N = 0 then - return True; - end if; - - -- Find the next bucket - - loop - L_Index := L_Index + 1; - L_Node := L.Buckets (L_Index); - exit when L_Node /= 0; - end loop; - end if; - end loop; - end Generic_Equal; - - ----------------------- - -- Generic_Iteration -- - ----------------------- - - procedure Generic_Iteration (HT : Hash_Table_Type) is - Node : Count_Type; - - begin - if HT.Length = 0 then - return; - end if; - - for Indx in HT.Buckets'Range loop - Node := HT.Buckets (Indx); - while Node /= 0 loop - Process (Node); - Node := Next (HT.Nodes (Node)); - end loop; - end loop; - end Generic_Iteration; - - ----------- - -- Index -- - ----------- - - function Index - (Buckets : Buckets_Type; - Node : Node_Type) return Hash_Type is - begin - return Buckets'First + Hash_Node (Node) mod Buckets'Length; - end Index; - - function Index - (HT : Hash_Table_Type; - Node : Node_Type) return Hash_Type is - begin - return Index (HT.Buckets, Node); - end Index; - - ---------- - -- Next -- - ---------- - - function Next - (HT : Hash_Table_Type; - Node : Count_Type) return Count_Type - is - Result : Count_Type; - First : Hash_Type; - - begin - Result := Next (HT.Nodes (Node)); - - if Result /= 0 then -- another node in same bucket - return Result; - end if; - - -- This was the last node in the bucket, so move to the next - -- bucket, and start searching for next node from there. - - First := Index (HT, HT.Nodes (Node)) + 1; - for Indx in First .. HT.Buckets'Last loop - Result := HT.Buckets (Indx); - - if Result /= 0 then -- bucket is not empty - return Result; - end if; - end loop; - - return 0; - end Next; - -end Ada.Containers.Hash_Tables.Generic_Formal_Operations; diff --git a/gcc/ada/libgnat/a-chtgfo.ads b/gcc/ada/libgnat/a-chtgfo.ads deleted file mode 100644 index f4471be..0000000 --- a/gcc/ada/libgnat/a-chtgfo.ads +++ /dev/null @@ -1,114 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT LIBRARY COMPONENTS -- --- -- --- ADA.CONTAINERS.HASH_TABLES.GENERIC_FORMAL_OPERATIONS -- --- -- --- S p e c -- --- -- --- Copyright (C) 2004-2024, 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- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- This unit was originally developed by Matthew J Heaney. -- ------------------------------------------------------------------------------- - --- Hash_Table_Type is used to implement hashed containers. This package --- declares hash-table operations that do not depend on keys. - -generic - with package HT_Types is - new Generic_Formal_Hash_Table_Types (<>); - - use HT_Types; - - with function Hash_Node (Node : Node_Type) return Hash_Type; - - with function Next (Node : Node_Type) return Count_Type; - - with procedure Set_Next - (Node : in out Node_Type; - Next : Count_Type); - -package Ada.Containers.Hash_Tables.Generic_Formal_Operations is - pragma Pure; - - function Index - (Buckets : Buckets_Type; - Node : Node_Type) return Hash_Type; - pragma Inline (Index); - -- Uses the hash value of Node to compute its Buckets array index - - function Index - (HT : Hash_Table_Type; - Node : Node_Type) return Hash_Type; - pragma Inline (Index); - -- Uses the hash value of Node to compute its Hash_Table buckets array - -- index. - - generic - with function Find - (HT : Hash_Table_Type; - Key : Node_Type) return Boolean; - function Generic_Equal (L, R : Hash_Table_Type) return Boolean; - -- Used to implement hashed container equality. For each node in hash table - -- L, it calls Find to search for an equivalent item in hash table R. If - -- Find returns False for any node then Generic_Equal terminates - -- immediately and returns False. Otherwise if Find returns True for every - -- node then Generic_Equal returns True. - - procedure Clear (HT : in out Hash_Table_Type); - -- Empties the hash table HT - - procedure Delete_Node_Sans_Free - (HT : in out Hash_Table_Type; - X : Count_Type); - -- Removes node X from the hash table without deallocating the node - - generic - with procedure Set_Element (Node : in out Node_Type); - procedure Generic_Allocate - (HT : in out Hash_Table_Type; - Node : out Count_Type); - -- Claim a node from the free store. Generic_Allocate first - -- calls Set_Element on the potential node, and then returns - -- the node's index as the value of the Node parameter. - - procedure Free - (HT : in out Hash_Table_Type; - X : Count_Type); - -- Return a node back to the free store, from where it had - -- been previously claimed via Generic_Allocate. - - function First (HT : Hash_Table_Type) return Count_Type; - -- Returns the head of the list in the first (lowest-index) non-empty - -- bucket. - - function Next - (HT : Hash_Table_Type; - Node : Count_Type) return Count_Type; - -- Returns the node that immediately follows Node. This corresponds to - -- either the next node in the same bucket, or (if Node is the last node in - -- its bucket) the head of the list in the first non-empty bucket that - -- follows. - - generic - with procedure Process (Node : Count_Type); - procedure Generic_Iteration (HT : Hash_Table_Type); - -- Calls Process for each node in hash table HT - -end Ada.Containers.Hash_Tables.Generic_Formal_Operations; diff --git a/gcc/ada/libgnat/a-cohata.ads b/gcc/ada/libgnat/a-cohata.ads index 2ae2be7..89540d4 100644 --- a/gcc/ada/libgnat/a-cohata.ads +++ b/gcc/ada/libgnat/a-cohata.ads @@ -79,23 +79,4 @@ package Ada.Containers.Hash_Tables is package Implementation is new Helpers.Generic_Implementation; end Generic_Bounded_Hash_Table_Types; - generic - type Node_Type is private; - package Generic_Formal_Hash_Table_Types is - - type Nodes_Type is array (Count_Type range <>) of Node_Type; - type Buckets_Type is array (Hash_Type range <>) of Count_Type; - - type Hash_Table_Type - (Capacity : Count_Type; - Modulus : Hash_Type) is - record - Length : Count_Type := 0; - Free : Count_Type'Base := -1; - Nodes : Nodes_Type (1 .. Capacity); - Buckets : Buckets_Type (1 .. Modulus) := [others => 0]; - end record; - - end Generic_Formal_Hash_Table_Types; - end Ada.Containers.Hash_Tables; |