I desire to have a non-blocking FIFO generic indefinite container. For one particular use case, the container element is a u8_Array with the bounds defined at runtime. I would like to pool allocate all of the memory for the FIFO before use.
I know an unbounded array type cannot be used in a record, so I’m trying to use a u8_Array_Access type as the element. An access type size should be constant at runtime (the size of a memory address?) but I’m still running into errors using access types with my FIFO generic prototype.
Here’s some prototype code to illustrate the points:
generic
type Element_Type (<>) is private;
package FIFO is
type Element_Access is access all Element_Type;
type Queue_Type is private;
procedure Enqueue (Queue : in out Queue_Type; Item : Element_Access);
private
Type Element_Access_Array is array (Positive range <>) of Element_Access;
Type Queue_Type is record
Data : Element_Access_Array (1 .. 5);
end record;
end FIFO;
fifo.ads
package body FIFO is
procedure Enqueue (Queue : in out Queue_Type; Item : Element_Access) is
begin
-- Implementation placeholder...
Queue.Data(1) := Item;
end Enqueue;
end FIFO;
fifo.adb
with FIFO;
procedure Test_FIFO is
type u8 is mod 2**8;
type u8_Array is array (Positive range <>) of u8;
type u8_Array_Access is access u8_Array;
package u32_FIFO is new FIFO (u8_Array_Access);
use u32_FIFO;
Queue : Queue_Type;
Element_1 : u8_Array (1 .. 100);
Element_2 : u32_FIFO.Element_Access;
begin
-- Attempt #1: Failure
-- error: expected type "Element_Access" defined at fifo.ads:4, instance at line 9
-- error: found type access to subtype of "u8_Array" defined at line 21
Enqueue (Queue, Element_1'Access);
-- Attempt #2: Failure
-- error: argument oof conversion cannot be access attribute
-- error: use qualified expression instead
Element_2 := u32_FIFO.Element_Access (Element_1'Access);
Enqueue (Queue, Element_2);
end Test_FIFO;
test_fifo.adb (The errors have been added in the comments.)
Questions:
Can the errors in this implementation be resolved?
Is there a good way to define a FIFO that can have any type of access type as an element?
It’s trivial to create a record that containing System.Address and Length as the element, but I’m trying to see if there’s a more Ada way to do this.
For the first failure, the trouble is that u32_FIFO.Element_Access (why not u8_FIFO?) and access to subtype of "u8_Array" are different types. Try making Element_Access a formal parameter of FIFO.
I’m not clear from “non-blocking” if you want a queue that is protected. Your example seems to indicate that you want a bounded queue. Luckily, the PragmAda Reusable Components include both bounded and unbounded queues, both unprotected and protected, with the protected versions including both blocking and non-blocking (the protected-blocking versions are just wrappers around the standard syncronized queues). They can be used for any type of named access type. Look for file names beginning with “pragmarc-data_structures-queues-”.
These queues are for definite types. Versions for indefinite types are not included since it is so easy to instantiate the standard indefinite-holder package with your indefinite type, and then instantiate the queue package with the holder type.
generic
type Element_Type (<>) is private;
package Generic_Indefinite_FIFO is
type FIFO (Size : Storage_Count) is
new Ada.Finalization.Limited_Controlled with private;
function Get (Queue : FIFO) return Element_Type;
procedure Put
( Queue : in out FIFO;
Element : Element_Type
);
procedure Put
( Queue : in out FIFO;
Element : Element_Type;
Full : out Boolean
);
The idea is to represent FIFO as a storage pool:
type FIFO (Size : Storage_Count) is
new Root_Storage_Pool with
record
Free : Storage_Count := 1;
First : Storage_Count := 1;
Cut_Off : Storage_Count := Size + 1;
-- The following two are the private interface of Allocate
Last : System.Address; -- Of the last allocated element
Next : Storage_Count; -- The element next to last allocated
Self : FIFO_Ptr := FIFO'Unchecked_Access;
Storage : Buffer (1..Size);
pragma Atomic (Free);
pragma Atomic (First);
pragma Atomic (Cut_Off);
end record;
You put an element into FIFO by allocating it there. The access type is declared locally to refer to FIFO itself.
Thanks for the suggestions guys! I was able to get this instantiation working by using an access to a subtype as the element (instead of an access to a indefinite type - the u8_Array), and adding an additional formal parameter to the generic as Simon suggested.
Here’s the updated test code:
generic
type Element_Type (<>) is private;
type Element_Access is private;
package FIFO is
type Queue_Type is private;
procedure Enqueue (Queue : in out Queue_Type; Item : Element_Access);
private
Type Element_Access_Array is array (Positive range <>) of Element_Access;
Type Queue_Type is record
Data : Element_Access_Array (1 .. 5);
end record;
end FIFO;
fifo.ads
package body FIFO is
procedure Enqueue (Queue : in out Queue_Type; Item : Element_Access) is
begin
-- Implementation placeholder...
Queue.Data(1) := Item;
end Enqueue;
end FIFO;
fifo.adb
with FIFO;
procedure Test_FIFO is
type u8 is mod 2**8;
type u8_Array is array (Positive range <>) of u8;
subtype u8_100 is u8_Array (1 .. 100);
type u8_100_Access is access all u8_100;
type u8_100_AA is access all u8_100_Access;
Primary : aliased u8_100;
Element : aliased u8_100_Access;
Element_Access : u8_100_AA;
package u8_FIFO is new FIFO (u8_100_Access, u8_100_AA);
use u8_FIFO;
Queue : Queue_Type;
begin
Element := Primary'Access;
Element_Access := Element'Access;
Enqueue (Queue, Element_Access);
end Test_FIFO;
test_fifo.adb
With this component working I can finish this implementation to create a non-blocking (for the producer) protected queue.
Type Message( Length : String ) is record
Text : String(1..Length);
End record;
The discriminant is constraining the unconstrained type (String) here.
There’s no problem, unless you’re wanting some sort of Array (Positive range <>) of Message, because the variations of size means that the elements of the proposed array-type would be on non-uniform size: meaning that given A(X) we have no idea where that should be located in memory w/o traversing every prior element (thus losing key properties of Array)… with the trivial exception of A(A’First), because we know where to start.
Interesting; this error should be that Element_1 is not Aliased.
Ok, so the basic problem here is that u32_FIFO.Element_Access is NOT the same thing as u8_Array_Access — just like if you have Type Temp_measure is new Integer and Type Arc_measure is new Integer, even though both are using Integer as the underlying representation they are not the same type and cannot be interchanged, absent a conversion. Now, here you’re trying to convert, but access isn’t like that and you quickly run into problems if you were to try that. (Consider the subtle differences between something allowed to point to something on the stack, and something that cannot.)
For #1, hoist the access-type into the generic’s formal parameter.
For #2… something like this?
Package Queue is
Type Instance(<>) is private;
Function Create return Instance;
Procedure Process ( Object : in out Instance; Item : Element );
Procedure Dispatch( Object : in out Instance );
Private
Package Internals is new Ada.Containers.Vector( Positive, Element );
-- Or else, use a null record with not null discriminant, descending from
-- Ada.Controlled if FINALIZE is needed.
Type Instance is not null access all Internals.Vector;
Function Create return Instance is (New Internals.Vector);
End Queue;
Package Body Queue is
Procedure Process ( Object : in out Instance; Item : Element ) is
Begin
Object.All.Append( Item );
End Process;
Procedure Dispatch( Object : in out Instance ) is
Begin
Object.Delete_First;
End Dispatch;
End Queue;
And also Enqueue should receive a not null Element_Access most likely.
Without Simon’s suggested change, you can just remove Element_Type since you are not using it. Then you have a queue of “something”, which can be pointers or not. In this case, you might want to have another formal parameter namely with procedure Discard (Item : in out Element_Access); so that users can do something when an element is removed from the queue.
To summarize:
generic
type Element_Type is private;
with procedure Discard (Item : in out Element_Type);
package FIFO is
-- ??? If you store accesses, this should likely be limited, or you need to
-- make it controlled and duplicate the pointers in `Adjust`.
type Queue_Type is private;
procedure Enqueue (Q : in out Queue_Type; Item : Element_Type);
Users can then instantiate it with an access type if they want indefinite elements.
I have done this kind of API before, but it never seems exactly right. Who is to say that the caller is not going to free that point it just gave us, for instance. When you implement Dequeue you will be returning the access type, so users should also not free it (one approach for it is to return a Reference_Type like in the standard Ada containers.
There are so many little details when designing new APIs…
Thanks for the suggestions guys. For my FIFO, I ended up with a package like this:
generic
type Element is private;
type Element_Access is access all Element;
Size : Natural;
package FIFO is
FIFO_Not_Initialized : exception;
type Element_Access_Array is array (Positive range <>) of Element_Access;
protected type FIFO_Type is
procedure Push (Value : Element);
-- Add an element to the FIFO. Size of each element is 'Frame_Size' count of u32 words.
entry Pop (Value : out Element_Access);
-- Remove an element from the FIFO and write it the address 'Value'
function Count return Natural;
-- Return number of elements available
function Available return Boolean;
-- Return true if not empty
function Capacity return Natural;
-- Return number of elements that can be added.
procedure Initialize;
-- Element_Size is the number of u32 words in a FIFO element.
procedure Deinitialize;
private
Contents : Element_Access_Array (1 .. Size);
Head, Tail : Natural := 1;
Initialized : Boolean := False;
Exit_Entry_Gate : Boolean := False; -- For exiting the entry
end FIFO_Type;
end FIFO;
fifo.ads
with Ada.Unchecked_Deallocation;
package body FIFO is
protected body FIFO_Type is
procedure Push (Value : Element) is
begin
if not Initialized then
return;
end if;
if Capacity > 0 then
Contents (Head).all := Value;
if Head /= Contents'Last then
Head := Head + 1;
else
Head := Contents'First;
end if;
end if;
end Push;
entry Pop (Value : out Element_Access)
when Available or Exit_Entry_Gate is
begin
if Exit_Entry_Gate then
return;
end if;
if not Initialized then
return;
end if;
if Available then
Value := Contents (Tail);
if Tail /= Contents'Last then
Tail := Tail + 1;
else
Tail := Contents'First;
end if;
end if;
end Pop;
function Count return Natural is
begin
if Head > Tail then
return Head - Tail;
elsif Tail > Head then
return Contents'Length - (Tail - Head);
else
return 0;
end if;
end Count;
function Available return Boolean is
begin
if Count > 0 then
return True;
else
return False;
end if;
end;
function Capacity return Natural is
Current_Size : constant Natural := Count;
begin
if not Initialized then
raise FIFO_Not_Initialized;
end if;
return Contents'Length - Current_Size - 1;
end Capacity;
procedure Initialize is
begin
for Index in Contents'First .. Contents'Last loop
Contents (Index) := new Element;
end loop;
Initialized := True;
end Initialize;
procedure Deinitialize is
procedure Free is new Ada.Unchecked_Deallocation (Element, Element_Access);
begin
if not Initialized then
raise FIFO_Not_Initialized;
end if;
Exit_Entry_Gate := True;
Initialized := False;
for Index in Contents'First .. Contents'Last loop
Free (Contents (Index));
end loop;
end Deinitialize;
end FIFO_Type;
end FIFO;
fifo.adb
Things that I had to change along the way:
Add dynamic allocation: Initially the ‘Contents’ was just an array of the Element type and the Elements were copied around like normal objects. This broke when the size of the element grew to 2367360 bytes (segfaults from passing around large objects). Alas, the buffer contents were changed to access types and the buffer is dynamically allocated during initialization.
Switched to a constrained base type: For this use case (read data) I need to use a memory overlay with a generic type and changed the generic formal: type Element_Type (<>) is private; (unconstrained type, requires initialization) to the type Element_Type is private; (constrained type, no initialization required). The type has to be constrained, otherwise the compiler will not let me create an instance of the type using an overlay without initialization. For example:
Assume you wanted to use a memory address base for a generic type and return that as a return result:
generic
type Element_Type (<>) is private;
Default : Element_Type;
function Get_Test return Element_Type is
Device_Data : System.Address := Get_Data;
Element : Element_Type := Default with Address => Device_Data'Address;
begin
return Element;
end;
This would not work if you wanted to read the data from Device_Data’Address because after the address is mapped the Default value is written to the address. The workaround is to use the constrained version of Element_Type.
For the capacity function isn’t the -1 at the end wrong? Notionally I would have expected it to be Array’Length - Count, but I didn’t trace through your math for Count, so it may be correct if Count isn’t actually the number of elements, but wanted to check.
In Initialize, I would either add a check/exception if the FIFO is already initialized or a call to deinitialize to ensure memory is freed. Otherwise you run the risk of a memory leak if Initialize is called twice in a row.
Relative to point #2: You might consider making Deinitialize always work regardless of the state of the FIFO:
procedure Deinitialize is
procedure Free is new Ada.Unchecked_Deallocation (Element, Element_Access);
begin
if Initialized then
Exit_Entry_Gate := True;
Initialized := False;
for Index in Contents'First .. Contents'Last loop
Free (Contents (Index));
end loop;
end if;
end Deinitialize;
Then you could just place a call to it in the beginning of the Initialize procedure to ensure memory is always freed before it is reallocated.
An easy solution is a controlled object with a protected one inside it. The buffer can even be outside of the protected object. Initialize/Finalize take care of elements in the buffer.
Of course, there is no reason to use access types in FIFO. Normal items are just placed into the FIFO. Large elements use handles/holders/smart pointers. I think it was already mentioned in the discussion.
In a special case of tagged limited elements owned by the caller, one can take a universal access to without exposing the access type. E.g. job queues.
P.S. What happened with “access types are considered harmful?”