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;
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