Using protected entry argument in barrier condition

Question

I have a protected Hashed_Map with Vectors of data. To get an element from a specific Vector, I need to pass its key to the entry and, if the Vector is empty, wait for new elements to appear in it. In the barrier condition, the key argument is not yet available and I had to make an entry nested in procedure that takes a key. In this case, a warning appears about a possible blocking operation.

Is there any other way to do this?

with Ada.Containers.Vectors;
with Ada.Containers.Hashed_Maps;

package Protected_Map is

   use Ada.Containers;

   type Element_Key is new Positive;
   type Data_Type is null record;

   package Data_Vectors is new Vectors
     (Index_Type   => Natural,
      Element_Type => Data_Type);

   function Data_Vector_Hash
     (Key : Element_Key) return Ada.Containers.Hash_Type is
     (Hash_Type (Key));

   package Data_Vector_Maps is new Hashed_Maps
     (Key_Type        => Element_Key,
      Element_Type    => Data_Vectors.Vector,
      Hash            => Data_Vector_Hash,
      Equivalent_Keys => "=",
      "="             => Data_Vectors."=");

   protected Map is

      procedure Create (Key : out Element_Key);

      procedure Put (Data : Data_Type);

      procedure Get
        (Key  : Element_Key;
         Data : out Data_Type);

      procedure Delete (Key : Element_Key);

   private

      entry Get_Element
        (Key  : Element_Key;
         Data : out Data_Type);

      Data_Vector_Map : Data_Vector_Maps.Map;

   end Map;

end Protected_Map;

egilhh · Answer 1 · 2021-06-17T16:55:30.667

Since your Element_Key is a discrete type, you could use an entry family (an array of entries). There's also no need to use an actual map here, an array will suffice.

In order to use an entry family, you would need to constrain the range of Element_Key to suit your actual problem (at least one popular compiler implements entry families as actual arrays, so you'll quickly run out of memory if the range is large).

Thus:

package Protected_Map is

   use Ada.Containers;

   type Element_Key is new Positive range 1..10; -- constrained range
   type Data_Type is null record;

   package Data_Vectors is new Vectors
     (Index_Type   => Natural,
      Element_Type => Data_Type);

   type Data_Vector_Array is array(Element_Key) of Data_Vectors.Vector;


   protected Map is

      procedure Put (Key : Element_Key; Data : Data_Type);

      entry Get
        (Element_Key) -- entry family
        (Data : out Data_Type);

      procedure Delete (Key : Element_Key);

   private

      Data_Vector_Map : Data_Vector_Array;

   end Map;

end Protected_Map;

and the entry body:

      entry Get
        (for Key in Element_Key) -- entry family
        (Data : out Data_Type)
        when not Data_Vector_Map(Key).Is_Empty
      is
      begin
         ...
      end Get;

and then (for example)

   for Key in Element_Key'Range loop
      Map.Get(Key)(The_Data);
   end loop;

I wanted to use a Hashed_Map because Vectors should be created and removed dynamically as needed. — Андрей Гриценко, Jun 18 '21 at 09:32

DeeDee · Accepted Answer · 2021-06-17T18:11:50.850

If the map key in your example is really some discrete value within a finite range, then the answer of @egilhh is indeed to consider. If this is not the case, then you might solve the problem by using a Get entry and some additional private Get_Retry entry as shown in the example below.

This "pattern" is used when you want to check for the availability of some item (the Get entry) and if not, requeue the request to another entry (Get_Retry) where it'll wait until new items arrive. The pattern is often used for programming thread-safe resource managers.

In this pattern, the Get entry is always enabled (i.e. the guard never blocks) so requests are always allowed to enter and see if an item of interest is already available:

entry Get (Key : Map_Key; Data : out Data_Type)
  when True   --  Never blocking guard.
is
begin
   if Data_Available (Key) then
      Data := Data_Vector_Map (Key).Last_Element;
      Data_Vector_Map (Key).Delete_Last;
   else
      requeue Get_Retry;   -- No data available, try again later.
   end if;
end Get;

If no item is available, then the request is requeued to the Get_Retry entry. This (private) entry has a guard that is unblocked by the Put subprogram. If an item arrives via Put, then Put will record the number of requests waiting for a retry, unblock the guard, and allow pending requests to see if the new item is of interest to them.

procedure Put (Key : Map_Key; Data : Data_Type) is
begin
   Data_Vector_Map (Key).Append (Data);
   
   --  If there are requests for data, then record the number
   --  of requests that are waiting and open the guard of Get_Retry.
   if Get_Retry'Count /= 0 then
      Get_Retry_Requests_Left := Get_Retry'Count;
      Get_Retry_Enabled       := True;
   end if;
   
end Put;

Once all pending requests are served once, Get_Retry will disable itself to prevent any request that were requeued again to itself to be served for a second time.

entry Get_Retry (Key : Map_Key; Data : out Data_Type)       
  when Get_Retry_Enabled   --  Guard unblocked by Put.
is
begin
   
   --  Set guard once all pending requests have been served once.         
   Get_Retry_Requests_Left := Get_Retry_Requests_Left - 1;
   if Get_Retry_Requests_Left = 0 then
      Get_Retry_Enabled := False;
   end if;
   
   --  Check if data is available, same logic as in Get.
   if Data_Available (Key) then
      Data := Data_Vector_Map (Key).Last_Element;
      Data_Vector_Map (Key).Delete_Last;
   else
      requeue Get_Retry;   -- No data available, try again later.
   end if;
   
end Get_Retry;

Note: both entry families (as discussed in the answer of @egilhh), as well as this pattern were discussed in a recent AdaCore blogpost.

protected_map.ads

with Ada.Containers.Vectors;
with Ada.Containers.Hashed_Maps;

package Protected_Map is

   use Ada.Containers;

   type Map_Key is new Positive;
   type Data_Type is new Integer;

   function Data_Vector_Hash (Key : Map_Key) return Hash_Type is
     (Hash_Type (Key));
   
   package Data_Vectors is new Vectors
     (Index_Type   => Natural,
      Element_Type => Data_Type);

   package Data_Vector_Maps is new Hashed_Maps
     (Key_Type        => Map_Key,
      Element_Type    => Data_Vectors.Vector,
      Hash            => Data_Vector_Hash,
      Equivalent_Keys => "=",
      "="             => Data_Vectors."=");

   protected Map is
      procedure Create (Key : Map_Key);
      procedure Delete (Key : Map_Key);
      
      procedure Put (Key : Map_Key; Data : Data_Type);      
      entry Get (Key : Map_Key; Data : out Data_Type);

   private
      
      entry Get_Retry (Key : Map_Key; Data : out Data_Type);
      
      Get_Retry_Requests_Left : Natural := 0;
      Get_Retry_Enabled       : Boolean := False;  
      
      Data_Vector_Map : Data_Vector_Maps.Map;
      
   end Map;

end Protected_Map;

protected_map.adb

package body Protected_Map is

   protected body Map is

      ------------
      -- Create --
      ------------
      
      procedure Create (Key : Map_Key) is
      begin
         Data_Vector_Map.Insert (Key, Data_Vectors.Empty_Vector);
      end Create;

      ------------
      -- Delete --
      ------------
      
      procedure Delete (Key : Map_Key) is
      begin
         Data_Vector_Map.Delete (Key);
      end Delete;
      
      ---------
      -- Put --
      ---------
      
      procedure Put (Key : Map_Key; Data : Data_Type) is
      begin
         Data_Vector_Map (Key).Append (Data);
         
         --  If there are requests for data, then record the number
         --  of requests that are waiting and unblock the guard of Get_Retry.
         if Get_Retry'Count /= 0 then
            Get_Retry_Requests_Left := Get_Retry'Count;
            Get_Retry_Enabled       := True;
         end if;
         
      end Put;
      
      --------------------
      -- Data_Available --
      --------------------
      
      function Data_Available (Key : Map_Key) return Boolean is
      begin
         return Data_Vector_Map.Contains (Key) and then
           not Data_Vector_Map (Key).Is_Empty;
      end Data_Available;
      
      ---------
      -- Get --
      ---------
      
      entry Get (Key : Map_Key; Data : out Data_Type)
        when True   --  No condition.
      is
      begin
         if Data_Available (Key) then
            Data := Data_Vector_Map (Key).Last_Element;
            Data_Vector_Map (Key).Delete_Last;
         else
            requeue Get_Retry;   -- No data available, try again later.
         end if;
      end Get;
      
      ---------------
      -- Get_Retry --
      ---------------
      
      entry Get_Retry (Key : Map_Key; Data : out Data_Type)       
        when Get_Retry_Enabled   --  Guard unblocked by Put.
      is
      begin
         
         --  Set guard once all pending requests have been served once.         
         Get_Retry_Requests_Left := Get_Retry_Requests_Left - 1;
         if Get_Retry_Requests_Left = 0 then
            Get_Retry_Enabled := False;
         end if;
         
         --  Check if data is available, same logic as in Get.
         if Data_Available (Key) then
            Data := Data_Vector_Map (Key).Last_Element;
            Data_Vector_Map (Key).Delete_Last;
         else
            requeue Get_Retry;   -- No data available, try again later.
         end if;
         
      end Get_Retry;
      
   end Map;

end Protected_Map;

main.adb

with Ada.Text_IO; use Ada.Text_IO;
with Protected_Map;

procedure Main is

   task Getter;
   
   task body Getter is
      Data : Protected_Map.Data_Type;
   begin
      Protected_Map.Map.Get (2, Data);
      Put_Line (Data'Image);
      
      Protected_Map.Map.Get (1, Data);
      Put_Line (Data'Image);
      
      Protected_Map.Map.Get (3, Data);
      Put_Line (Data'Image);
      
      Protected_Map.Map.Get (1, Data);
      Put_Line (Data'Image);
      
   end;
   
begin   
   Protected_Map.Map.Create (1);
   Protected_Map.Map.Create (2);
   Protected_Map.Map.Create (3);
   
   Protected_Map.Map.Put (1, 10);
   delay 0.5;   
   Protected_Map.Map.Put (1, 15);
   delay 0.5;   
   Protected_Map.Map.Put (2, 20);
   delay 0.5;   
   Protected_Map.Map.Put (3, 30);
   
end Main;

output

$ ./obj/main
 20
 15
 30
 10

Using protected entry argument in barrier condition

2 Answers2