diff gcc/ada/libgnat/g-dynhta.adb @ 131:84e7813d76e9

gcc-8.2
author mir3636
date Thu, 25 Oct 2018 07:37:49 +0900
parents 04ced10e8804
children 1830386684a0
line wrap: on
line diff
--- a/gcc/ada/libgnat/g-dynhta.adb	Fri Oct 27 22:46:09 2017 +0900
+++ b/gcc/ada/libgnat/g-dynhta.adb	Thu Oct 25 07:37:49 2018 +0900
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 2002-2017, AdaCore                     --
+--                     Copyright (C) 2002-2018, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -38,11 +38,10 @@
    -------------------
 
    package body Static_HTable is
-
       function Get_Non_Null (T : Instance) return Elmt_Ptr;
       --  Returns Null_Ptr if Iterator_Started is False or if the Table is
-      --  empty. Returns Iterator_Ptr if non null, or the next non null
-      --  element in table if any.
+      --  empty. Returns Iterator_Ptr if non null, or the next non null element
+      --  in table if any.
 
       ---------
       -- Get --
@@ -363,7 +362,848 @@
       begin
          E.Next := Next;
       end Set_Next;
-
    end Simple_HTable;
 
+   --------------------
+   -- Dynamic_HTable --
+   --------------------
+
+   package body Dynamic_HTable is
+      Minimum_Size : constant Bucket_Range_Type := 8;
+      --  Minimum size of the buckets
+
+      Safe_Compression_Size : constant Bucket_Range_Type :=
+                                Minimum_Size * Compression_Factor;
+      --  Maximum safe size for hash table compression. Beyond this size, a
+      --  compression will violate the minimum size constraint on the buckets.
+
+      Safe_Expansion_Size : constant Bucket_Range_Type :=
+                              Bucket_Range_Type'Last / Expansion_Factor;
+      --  Maximum safe size for hash table expansion. Beyond this size, an
+      --  expansion will overflow the buckets.
+
+      procedure Destroy_Buckets (Bkts : Bucket_Table_Ptr);
+      pragma Inline (Destroy_Buckets);
+      --  Destroy all nodes within buckets Bkts
+
+      procedure Detach (Nod : Node_Ptr);
+      pragma Inline (Detach);
+      --  Detach node Nod from the bucket it resides in
+
+      procedure Ensure_Circular (Head : Node_Ptr);
+      pragma Inline (Ensure_Circular);
+      --  Ensure that dummy head Head is circular with respect to itself
+
+      procedure Ensure_Created (T : Instance);
+      pragma Inline (Ensure_Created);
+      --  Verify that hash table T is created. Raise Not_Created if this is not
+      --  the case.
+
+      procedure Ensure_Unlocked (T : Instance);
+      pragma Inline (Ensure_Unlocked);
+      --  Verify that hash table T is unlocked. Raise Iterated if this is not
+      --  the case.
+
+      function Find_Bucket
+        (Bkts : Bucket_Table_Ptr;
+         Key  : Key_Type) return Node_Ptr;
+      pragma Inline (Find_Bucket);
+      --  Find the bucket among buckets Bkts which corresponds to key Key, and
+      --  return its dummy head.
+
+      function Find_Node (Head : Node_Ptr; Key : Key_Type) return Node_Ptr;
+      pragma Inline (Find_Node);
+      --  Traverse a bucket indicated by dummy head Head to determine whether
+      --  there exists a node with key Key. If such a node exists, return it,
+      --  otherwise return null.
+
+      procedure First_Valid_Node
+        (T        : Instance;
+         Low_Bkt  : Bucket_Range_Type;
+         High_Bkt : Bucket_Range_Type;
+         Idx      : out Bucket_Range_Type;
+         Nod      : out Node_Ptr);
+      pragma Inline (First_Valid_Node);
+      --  Find the first valid node in the buckets of hash table T constrained
+      --  by the range Low_Bkt .. High_Bkt. If such a node exists, return its
+      --  bucket index in Idx and reference in Nod. If no such node exists,
+      --  Idx is set to 0 and Nod to null.
+
+      procedure Free is
+        new Ada.Unchecked_Deallocation (Bucket_Table, Bucket_Table_Ptr);
+
+      procedure Free is
+        new Ada.Unchecked_Deallocation (Hash_Table, Instance);
+
+      procedure Free is
+        new Ada.Unchecked_Deallocation (Node, Node_Ptr);
+
+      function Is_Valid (Iter : Iterator) return Boolean;
+      pragma Inline (Is_Valid);
+      --  Determine whether iterator Iter refers to a valid key-value pair
+
+      function Is_Valid (Nod : Node_Ptr; Head : Node_Ptr) return Boolean;
+      pragma Inline (Is_Valid);
+      --  Determine whether node Nod is non-null and does not refer to dummy
+      --  head Head, thus making it valid.
+
+      function Load_Factor (T : Instance) return Threshold_Type;
+      pragma Inline (Load_Factor);
+      --  Calculate the load factor of hash table T
+
+      procedure Lock (T : Instance);
+      pragma Inline (Lock);
+      --  Lock all mutation functionality of hash table T
+
+      procedure Mutate_And_Rehash (T : Instance; Size : Bucket_Range_Type);
+      pragma Inline (Mutate_And_Rehash);
+      --  Replace the buckets of hash table T with a new set of buckets of size
+      --  Size. Rehash all key-value pairs from the old to the new buckets.
+
+      procedure Prepend (Nod : Node_Ptr; Head : Node_Ptr);
+      pragma Inline (Prepend);
+      --  Insert node Nod immediately after dummy head Head
+
+      procedure Unlock (T : Instance);
+      pragma Inline (Unlock);
+      --  Unlock all mutation functionality of hash table T
+
+      ------------
+      -- Create --
+      ------------
+
+      function Create (Initial_Size : Positive) return Instance is
+         Size : constant Bucket_Range_Type :=
+                           Bucket_Range_Type'Max
+                             (Bucket_Range_Type (Initial_Size), Minimum_Size);
+         --  Ensure that the buckets meet a minimum size
+
+         T : constant Instance := new Hash_Table;
+
+      begin
+         T.Buckets      := new Bucket_Table (0 .. Size - 1);
+         T.Initial_Size := Size;
+
+         return T;
+      end Create;
+
+      ------------
+      -- Delete --
+      ------------
+
+      procedure Delete (T : Instance; Key : Key_Type) is
+         procedure Compress;
+         pragma Inline (Compress);
+         --  Determine whether hash table T requires compression, and if so,
+         --  half its size.
+
+         --------------
+         -- Compress --
+         --------------
+
+         procedure Compress is
+            pragma Assert (T /= null);
+            pragma Assert (T.Buckets /= null);
+
+            Old_Size : constant Bucket_Range_Type := T.Buckets'Length;
+
+         begin
+            --  The ratio of pairs to buckets is under the desited threshold.
+            --  Compress the hash table only when there is still room to do so.
+
+            if Load_Factor (T) < Compression_Threshold
+              and then Old_Size >= Safe_Compression_Size
+            then
+               Mutate_And_Rehash (T, Old_Size / Compression_Factor);
+            end if;
+         end Compress;
+
+         --  Local variables
+
+         Head : Node_Ptr;
+         Nod  : Node_Ptr;
+
+      --  Start of processing for Delete
+
+      begin
+         Ensure_Created  (T);
+         Ensure_Unlocked (T);
+
+         --  Obtain the dummy head of the bucket which should house the
+         --  key-value pair.
+
+         Head := Find_Bucket (T.Buckets, Key);
+
+         --  Try to find a node in the bucket which matches the key
+
+         Nod := Find_Node (Head, Key);
+
+         --  If such a node exists, remove it from the bucket and deallocate it
+
+         if Is_Valid (Nod, Head) then
+            Detach (Nod);
+            Free   (Nod);
+
+            --  The number of key-value pairs is updated when the hash table
+            --  contains a valid node which represents the pair.
+
+            T.Pairs := T.Pairs - 1;
+
+            --  Compress the hash table if the load factor drops below
+            --  Compression_Threshold.
+
+            Compress;
+         end if;
+      end Delete;
+
+      -------------
+      -- Destroy --
+      -------------
+
+      procedure Destroy (T : in out Instance) is
+      begin
+         Ensure_Created  (T);
+         Ensure_Unlocked (T);
+
+         --  Destroy all nodes in all buckets
+
+         Destroy_Buckets (T.Buckets);
+         Free (T.Buckets);
+         Free (T);
+      end Destroy;
+
+      ---------------------
+      -- Destroy_Buckets --
+      ---------------------
+
+      procedure Destroy_Buckets (Bkts : Bucket_Table_Ptr) is
+         procedure Destroy_Bucket (Head : Node_Ptr);
+         pragma Inline (Destroy_Bucket);
+         --  Destroy all nodes in a bucket with dummy head Head
+
+         --------------------
+         -- Destroy_Bucket --
+         --------------------
+
+         procedure Destroy_Bucket (Head : Node_Ptr) is
+            Nod : Node_Ptr;
+
+         begin
+            --  Destroy all valid nodes which follow the dummy head
+
+            while Is_Valid (Head.Next, Head) loop
+               Nod := Head.Next;
+
+               Detach (Nod);
+               Free   (Nod);
+            end loop;
+         end Destroy_Bucket;
+
+      --  Start of processing for Destroy_Buckets
+
+      begin
+         pragma Assert (Bkts /= null);
+
+         for Scan_Idx in Bkts'Range loop
+            Destroy_Bucket (Bkts (Scan_Idx)'Access);
+         end loop;
+      end Destroy_Buckets;
+
+      ------------
+      -- Detach --
+      ------------
+
+      procedure Detach (Nod : Node_Ptr) is
+         pragma Assert (Nod /= null);
+
+         Next : constant Node_Ptr := Nod.Next;
+         Prev : constant Node_Ptr := Nod.Prev;
+
+      begin
+         pragma Assert (Next /= null);
+         pragma Assert (Prev /= null);
+
+         Prev.Next := Next;
+         Next.Prev := Prev;
+
+         Nod.Next := null;
+         Nod.Prev := null;
+      end Detach;
+
+      ---------------------
+      -- Ensure_Circular --
+      ---------------------
+
+      procedure Ensure_Circular (Head : Node_Ptr) is
+         pragma Assert (Head /= null);
+
+      begin
+         if Head.Next = null and then Head.Prev = null then
+            Head.Next := Head;
+            Head.Prev := Head;
+         end if;
+      end Ensure_Circular;
+
+      --------------------
+      -- Ensure_Created --
+      --------------------
+
+      procedure Ensure_Created (T : Instance) is
+      begin
+         if T = null then
+            raise Not_Created;
+         end if;
+      end Ensure_Created;
+
+      ---------------------
+      -- Ensure_Unlocked --
+      ---------------------
+
+      procedure Ensure_Unlocked (T : Instance) is
+      begin
+         pragma Assert (T /= null);
+
+         --  The hash table has at least one outstanding iterator
+
+         if T.Iterators > 0 then
+            raise Iterated;
+         end if;
+      end Ensure_Unlocked;
+
+      -----------------
+      -- Find_Bucket --
+      -----------------
+
+      function Find_Bucket
+        (Bkts : Bucket_Table_Ptr;
+         Key  : Key_Type) return Node_Ptr
+      is
+         pragma Assert (Bkts /= null);
+
+         Idx : constant Bucket_Range_Type := Hash (Key) mod Bkts'Length;
+
+      begin
+         return Bkts (Idx)'Access;
+      end Find_Bucket;
+
+      ---------------
+      -- Find_Node --
+      ---------------
+
+      function Find_Node (Head : Node_Ptr; Key : Key_Type) return Node_Ptr is
+         pragma Assert (Head /= null);
+
+         Nod : Node_Ptr;
+
+      begin
+         --  Traverse the nodes of the bucket, looking for a key-value pair
+         --  with the same key.
+
+         Nod := Head.Next;
+         while Is_Valid (Nod, Head) loop
+            if Nod.Key = Key then
+               return Nod;
+            end if;
+
+            Nod := Nod.Next;
+         end loop;
+
+         return null;
+      end Find_Node;
+
+      ----------------------
+      -- First_Valid_Node --
+      ----------------------
+
+      procedure First_Valid_Node
+        (T        : Instance;
+         Low_Bkt  : Bucket_Range_Type;
+         High_Bkt : Bucket_Range_Type;
+         Idx      : out Bucket_Range_Type;
+         Nod      : out Node_Ptr)
+      is
+         Head : Node_Ptr;
+
+      begin
+         pragma Assert (T /= null);
+         pragma Assert (T.Buckets /= null);
+
+         --  Assume that no valid node exists
+
+         Idx := 0;
+         Nod := null;
+
+         --  Examine the buckets of the hash table within the requested range,
+         --  looking for the first valid node.
+
+         for Scan_Idx in Low_Bkt .. High_Bkt loop
+            Head := T.Buckets (Scan_Idx)'Access;
+
+            --  The bucket contains at least one valid node, return the first
+            --  such node.
+
+            if Is_Valid (Head.Next, Head) then
+               Idx := Scan_Idx;
+               Nod := Head.Next;
+               return;
+            end if;
+         end loop;
+      end First_Valid_Node;
+
+      ---------
+      -- Get --
+      ---------
+
+      function Get (T : Instance; Key : Key_Type) return Value_Type is
+         Head : Node_Ptr;
+         Nod  : Node_Ptr;
+
+      begin
+         Ensure_Created (T);
+
+         --  Obtain the dummy head of the bucket which should house the
+         --  key-value pair.
+
+         Head := Find_Bucket (T.Buckets, Key);
+
+         --  Try to find a node in the bucket which matches the key
+
+         Nod := Find_Node (Head, Key);
+
+         --  If such a node exists, return the value of the key-value pair
+
+         if Is_Valid (Nod, Head) then
+            return Nod.Value;
+         end if;
+
+         return No_Value;
+      end Get;
+
+      --------------
+      -- Has_Next --
+      --------------
+
+      function Has_Next (Iter : Iterator) return Boolean is
+         Is_OK : constant Boolean  := Is_Valid (Iter);
+         T     : constant Instance := Iter.Table;
+
+      begin
+         pragma Assert (T /= null);
+
+         --  The iterator is no longer valid which indicates that it has been
+         --  exhausted. Unlock all mutation functionality of the hash table
+         --  because the iterator cannot be advanced any further.
+
+         if not Is_OK then
+            Unlock (T);
+         end if;
+
+         return Is_OK;
+      end Has_Next;
+
+      --------------
+      -- Is_Empty --
+      --------------
+
+      function Is_Empty (T : Instance) return Boolean is
+      begin
+         Ensure_Created (T);
+
+         return T.Pairs = 0;
+      end Is_Empty;
+
+      --------------
+      -- Is_Valid --
+      --------------
+
+      function Is_Valid (Iter : Iterator) return Boolean is
+      begin
+         --  The invariant of Iterate and Next ensures that the iterator always
+         --  refers to a valid node if there exists one.
+
+         return Iter.Nod /= null;
+      end Is_Valid;
+
+      --------------
+      -- Is_Valid --
+      --------------
+
+      function Is_Valid (Nod : Node_Ptr; Head : Node_Ptr) return Boolean is
+      begin
+         --  A node is valid if it is non-null, and does not refer to the dummy
+         --  head of some bucket.
+
+         return Nod /= null and then Nod /= Head;
+      end Is_Valid;
+
+      -------------
+      -- Iterate --
+      -------------
+
+      function Iterate (T : Instance) return Iterator is
+         Iter : Iterator;
+
+      begin
+         Ensure_Created (T);
+         pragma Assert (T.Buckets /= null);
+
+         --  Initialize the iterator to reference the first valid node in
+         --  the full range of hash table buckets. If no such node exists,
+         --  the iterator is left in a state which does not allow it to
+         --  advance.
+
+         First_Valid_Node
+           (T        => T,
+            Low_Bkt  => T.Buckets'First,
+            High_Bkt => T.Buckets'Last,
+            Idx      => Iter.Idx,
+            Nod      => Iter.Nod);
+
+         --  Associate the iterator with the hash table to allow for future
+         --  mutation functionality unlocking.
+
+         Iter.Table := T;
+
+         --  Lock all mutation functionality of the hash table while it is
+         --  being iterated on.
+
+         Lock (T);
+
+         return Iter;
+      end Iterate;
+
+      -----------------
+      -- Load_Factor --
+      -----------------
+
+      function Load_Factor (T : Instance) return Threshold_Type is
+         pragma Assert (T /= null);
+         pragma Assert (T.Buckets /= null);
+
+      begin
+         --  The load factor is the ratio of key-value pairs to buckets
+
+         return Threshold_Type (T.Pairs) / Threshold_Type (T.Buckets'Length);
+      end Load_Factor;
+
+      ----------
+      -- Lock --
+      ----------
+
+      procedure Lock (T : Instance) is
+      begin
+         --  The hash table may be locked multiple times if multiple iterators
+         --  are operating over it.
+
+         T.Iterators := T.Iterators + 1;
+      end Lock;
+
+      -----------------------
+      -- Mutate_And_Rehash --
+      -----------------------
+
+      procedure Mutate_And_Rehash (T : Instance; Size : Bucket_Range_Type) is
+         procedure Rehash (From : Bucket_Table_Ptr; To : Bucket_Table_Ptr);
+         pragma Inline (Rehash);
+         --  Remove all nodes from buckets From and rehash them into buckets To
+
+         procedure Rehash_Bucket (Head : Node_Ptr; To : Bucket_Table_Ptr);
+         pragma Inline (Rehash_Bucket);
+         --  Detach all nodes starting from dummy head Head and rehash them
+         --  into To.
+
+         procedure Rehash_Node (Nod : Node_Ptr; To : Bucket_Table_Ptr);
+         pragma Inline (Rehash_Node);
+         --  Rehash node Nod into To
+
+         ------------
+         -- Rehash --
+         ------------
+
+         procedure Rehash (From : Bucket_Table_Ptr; To : Bucket_Table_Ptr) is
+         begin
+            pragma Assert (From /= null);
+            pragma Assert (To /= null);
+
+            for Scan_Idx in From'Range loop
+               Rehash_Bucket (From (Scan_Idx)'Access, To);
+            end loop;
+         end Rehash;
+
+         -------------------
+         -- Rehash_Bucket --
+         -------------------
+
+         procedure Rehash_Bucket (Head : Node_Ptr; To : Bucket_Table_Ptr) is
+            pragma Assert (Head /= null);
+
+            Nod : Node_Ptr;
+
+         begin
+            --  Detach all nodes which follow the dummy head
+
+            while Is_Valid (Head.Next, Head) loop
+               Nod := Head.Next;
+
+               Detach (Nod);
+               Rehash_Node (Nod, To);
+            end loop;
+         end Rehash_Bucket;
+
+         -----------------
+         -- Rehash_Node --
+         -----------------
+
+         procedure Rehash_Node (Nod : Node_Ptr; To : Bucket_Table_Ptr) is
+            pragma Assert (Nod /= null);
+
+            Head : Node_Ptr;
+
+         begin
+            --  Obtain the dummy head of the bucket which should house the
+            --  key-value pair.
+
+            Head := Find_Bucket (To, Nod.Key);
+
+            --  Ensure that the dummy head of an empty bucket is circular with
+            --  respect to itself.
+
+            Ensure_Circular (Head);
+
+            --  Prepend the node to the bucket
+
+            Prepend (Nod, Head);
+         end Rehash_Node;
+
+         --  Local declarations
+
+         Old_Bkts : Bucket_Table_Ptr;
+
+      --  Start of processing for Mutate_And_Rehash
+
+      begin
+         pragma Assert (T /= null);
+
+         Old_Bkts  := T.Buckets;
+         T.Buckets := new Bucket_Table (0 .. Size - 1);
+
+         --  Transfer and rehash all key-value pairs from the old buckets to
+         --  the new buckets.
+
+         Rehash (From => Old_Bkts, To => T.Buckets);
+         Free (Old_Bkts);
+      end Mutate_And_Rehash;
+
+      ----------
+      -- Next --
+      ----------
+
+      procedure Next (Iter : in out Iterator; Key : out Key_Type) is
+         Is_OK : constant Boolean  := Is_Valid (Iter);
+         Saved : constant Node_Ptr := Iter.Nod;
+         T     : constant Instance := Iter.Table;
+         Head  : Node_Ptr;
+
+      begin
+         pragma Assert (T /= null);
+         pragma Assert (T.Buckets /= null);
+
+         --  The iterator is no longer valid which indicates that it has been
+         --  exhausted. Unlock all mutation functionality of the hash table as
+         --  the iterator cannot be advanced any further.
+
+         if not Is_OK then
+            Unlock (T);
+            raise Iterator_Exhausted;
+         end if;
+
+         --  Advance to the next node along the same bucket
+
+         Iter.Nod := Iter.Nod.Next;
+         Head     := T.Buckets (Iter.Idx)'Access;
+
+         --  If the new node is no longer valid, then this indicates that the
+         --  current bucket has been exhausted. Advance to the next valid node
+         --  within the remaining range of buckets. If no such node exists, the
+         --  iterator is left in a state which does not allow it to advance.
+
+         if not Is_Valid (Iter.Nod, Head) then
+            First_Valid_Node
+              (T      => T,
+               Low_Bkt  => Iter.Idx + 1,
+               High_Bkt => T.Buckets'Last,
+               Idx      => Iter.Idx,
+               Nod      => Iter.Nod);
+         end if;
+
+         Key := Saved.Key;
+      end Next;
+
+      -------------
+      -- Prepend --
+      -------------
+
+      procedure Prepend (Nod : Node_Ptr; Head : Node_Ptr) is
+         pragma Assert (Nod /= null);
+         pragma Assert (Head /= null);
+
+         Next : constant Node_Ptr := Head.Next;
+
+      begin
+         Head.Next := Nod;
+         Next.Prev := Nod;
+
+         Nod.Next := Next;
+         Nod.Prev := Head;
+      end Prepend;
+
+      ---------
+      -- Put --
+      ---------
+
+      procedure Put (T : Instance; Key : Key_Type; Value : Value_Type) is
+         procedure Expand;
+         pragma Inline (Expand);
+         --  Determine whether hash table T requires expansion, and if so,
+         --  double its size.
+
+         procedure Prepend_Or_Replace (Head : Node_Ptr);
+         pragma Inline (Prepend_Or_Replace);
+         --  Update the value of a node within a bucket with dummy head Head
+         --  whose key is Key to Value. If there is no such node, prepend a new
+         --  key-value pair to the bucket.
+
+         ------------
+         -- Expand --
+         ------------
+
+         procedure Expand is
+            pragma Assert (T /= null);
+            pragma Assert (T.Buckets /= null);
+
+            Old_Size : constant Bucket_Range_Type := T.Buckets'Length;
+
+         begin
+            --  The ratio of pairs to buckets is over the desited threshold.
+            --  Expand the hash table only when there is still room to do so.
+
+            if Load_Factor (T) > Expansion_Threshold
+              and then Old_Size <= Safe_Expansion_Size
+            then
+               Mutate_And_Rehash (T, Old_Size * Expansion_Factor);
+            end if;
+         end Expand;
+
+         ------------------------
+         -- Prepend_Or_Replace --
+         ------------------------
+
+         procedure Prepend_Or_Replace (Head : Node_Ptr) is
+            pragma Assert (Head /= null);
+
+            Nod : Node_Ptr;
+
+         begin
+            --  If the bucket containst at least one valid node, then there is
+            --  a chance that a node with the same key as Key exists. If this
+            --  is the case, the value of that node must be updated.
+
+            Nod := Head.Next;
+            while Is_Valid (Nod, Head) loop
+               if Nod.Key = Key then
+                  Nod.Value := Value;
+                  return;
+               end if;
+
+               Nod := Nod.Next;
+            end loop;
+
+            --  At this point the bucket is either empty, or none of the nodes
+            --  match key Key. Prepend a new key-value pair.
+
+            Nod := new Node'(Key, Value, null, null);
+
+            Prepend (Nod, Head);
+
+            --  The number of key-value pairs must be updated for a prepend,
+            --  never for a replace.
+
+            T.Pairs := T.Pairs + 1;
+         end Prepend_Or_Replace;
+
+         --  Local variables
+
+         Head : Node_Ptr;
+
+      --  Start of processing for Put
+
+      begin
+         Ensure_Created  (T);
+         Ensure_Unlocked (T);
+
+         --  Obtain the dummy head of the bucket which should house the
+         --  key-value pair.
+
+         Head := Find_Bucket (T.Buckets, Key);
+
+         --  Ensure that the dummy head of an empty bucket is circular with
+         --  respect to itself.
+
+         Ensure_Circular (Head);
+
+         --  In case the bucket already contains a node with the same key,
+         --  replace its value, otherwise prepend a new key-value pair.
+
+         Prepend_Or_Replace (Head);
+
+         --  Expand the hash table if the ratio of pairs to buckets goes over
+         --  Expansion_Threshold.
+
+         Expand;
+      end Put;
+
+      -----------
+      -- Reset --
+      -----------
+
+      procedure Reset (T : Instance) is
+      begin
+         Ensure_Created  (T);
+         Ensure_Unlocked (T);
+
+         --  Destroy all nodes in all buckets
+
+         Destroy_Buckets (T.Buckets);
+         Free (T.Buckets);
+
+         --  Recreate the buckets using the original size from creation time
+
+         T.Buckets := new Bucket_Table (0 .. T.Initial_Size - 1);
+         T.Pairs   := 0;
+      end Reset;
+
+      ----------
+      -- Size --
+      ----------
+
+      function Size (T : Instance) return Natural is
+      begin
+         Ensure_Created (T);
+
+         return T.Pairs;
+      end Size;
+
+      ------------
+      -- Unlock --
+      ------------
+
+      procedure Unlock (T : Instance) is
+      begin
+         --  The hash table may be locked multiple times if multiple iterators
+         --  are operating over it.
+
+         T.Iterators := T.Iterators - 1;
+      end Unlock;
+   end Dynamic_HTable;
+
 end GNAT.Dynamic_HTables;