What is the equivalent of placement new in Ada?

Question

I'm trying to learn Ada by writing a set of procedures for managing a dynamic array but I have no idea how to go about it. In C++ I can easily put arbitrary objects in memory like so:

#include <new>
#include <iostream>

class object {
  private:
    int value;

  public:
    ~object() noexcept { std::cout << "<> "; }
    object(int value) noexcept : value(value) { std::cout << object::value << ' '; }
};

constexpr auto size = 16;

int main() {
    auto buffer = static_cast<object*>(::operator new(size * sizeof(object)));
    for (auto offset = 0; offset < size; offset++)
        new (buffer + offset) object(offset);
    for (auto offset = 0; offset < size; offset++)
        (buffer + offset)->~object();
    ::operator delete(buffer);
}

Is there an equivalent of this type of "allocate x * sizeof(y) and initialize x y-items" operation in Ada?

Answer 1

In Ada you can write a custom "storage pool" (or subpool) where you redefine an Allocate function to use your buffer. Then you "bind" the access type to your storage pool object.

with System.Storage_Pools;
with System.Storage_Elements;

procedure Main is
   type My_Storage_Pool is new System.Storage_Pools.Root_Storage_Pool with record
      Buffer : System.Storage_Elements.Storage_Array (1 .. 1024);
      Offset : System.Storage_Elements.Storage_Count := 1;
   end record;

   overriding procedure Allocate
     (Self      : in out My_Storage_Pool;
      Address   : out System.Address;
      Size      : System.Storage_Elements.Storage_Count;
      Alignment : System.Storage_Elements.Storage_Count);
   
   overriding procedure Deallocate
     (Self      : in out My_Storage_Pool;
      Address   : System.Address;
      Size      : System.Storage_Elements.Storage_Count;
      Alignment : System.Storage_Elements.Storage_Count) is null;

   overriding function Storage_Size
     (Self : My_Storage_Pool)
      return System.Storage_Elements.Storage_Count is (Self.Buffer'Length);
   
   procedure Allocate
     (Self      : in out My_Storage_Pool;
      Address   : out System.Address;
      Size      : System.Storage_Elements.Storage_Count;
      Alignment : System.Storage_Elements.Storage_Count)
   is
      use type System.Storage_Elements.Storage_Count;
   begin
      Address := Self.Buffer (Self.Offset)'Address;
      Self.Offset := Self.Offset + Size;
   end Allocate;
   
   Pool : My_Storage_Pool;
   
   type Object is null record;
   type Object_Access is access Object with Storage_Pool => Pool;

   X : Object_Access := new Object;
begin
   null;
end Main;

Also, for untagged types you can use Address clause to place an object to a given address. This is much simpler. But this way object initialization won't work, so a tagged type object won't get virtual table pointer:

Buffer : Stream_Element_Array (1..1024);
Object : My_Object_Type
  with Import, Address => Buffer (Offset)'Address;
--  Here Object'Tag is unassigned and dispatching won't work

Answer 2

Yes. Ada does allow dynamic memory allocation. The subject of allocators is handled in section 4.8 of the Ada Reference Manual. Examples from the reference manual are:

16
Examples of allocators:
17
new Cell'(0, null, null)                          -- initialized explicitly, see 3.10.1
new Cell'(Value => 0, Succ => null, Pred => null) -- initialized explicitly
new Cell                                          -- not initialized
18
new Matrix(1 .. 10, 1 .. 20)                      -- the bounds only are given
new Matrix'(1 .. 10 => (1 .. 20 => 0.0))          -- initialized explicitly
19
new Buffer(100)                                   -- the discriminant only is given
new Buffer'(Size => 80, Pos => 0, Value => (1 .. 80 => 'A')) -- initialized explicitly

You must first declare the type to be allocated, then the access type to access the allocated memory.

The following example performs parallel addition on an array of Integers. The array is dynamically allocated because one can allocate a much larger array using the allocator than can be allocated on the stack.

The package specification defines the array type and the access type.

package Parallel_Addition is
   type Data_Array is array(Integer range <>) of Integer;
   type Data_Access is access all Data_Array;
   function Sum(Item : in not null Data_Access) return Integer;
end Parallel_Addition;

The package body sums the contents of the array using two tasks.

package body Parallel_Addition is

   ---------
   -- Sum --
   ---------

   function Sum (Item : in not null Data_Access) return Integer is
      task type Adder is
         entry Set (Min : Integer; Max : Integer);
         entry Report (Value : out Integer);
      end Adder;

      task body Adder is
         Total : Integer := 0;
         First : Integer;
         Last  : Integer;
      begin
         accept Set (Min : Integer; Max : Integer) do
            First := Min;
            Last  := Max;
         end Set;
         for I in First .. Last loop
            Total := Total + Item (I);
         end loop;
         accept Report (Value : out Integer) do
            Value := Total;
         end Report;
      end Adder;
      A1  : Adder;
      A2  : Adder;
      R1  : Integer;
      R2  : Integer;
      Mid : constant Integer := (Item'Length / 2) + Item'First;
   begin
      A1.Set (Min => Item'First, Max => Mid);
      A2.Set (Min => Mid + 1, Max => Item'Last);
      A1.Report (R1);
      A2.Report (R2);
      return R1 + R2;
   end Sum;

end Parallel_Addition;

As you can see above, the array elements are accessed without special syntax for dereferencing the array through the access type. The "main" procedure for this program is

with Parallel_Addition; use Parallel_Addition;
with Ada.Text_IO;       use Ada.Text_IO;
with Ada.Calendar;      use Ada.Calendar;

procedure Parallel_Addition_Test is
   The_Data : Data_Access := new Data_Array (1 .. Integer'Last);
   Start    : Time;
   Stop     : Time;
   The_Sum  : Integer;

begin
   The_Data.all := (others => 1);
   Start        := Clock;
   The_Sum      := Sum (The_Data);
   Stop         := Clock;
   Put_Line ("The sum is: " & Integer'Image (The_Sum));
   Put_Line
     ("Addition elapsed time is " &
      Duration'Image (Stop - Start) &
        " seconds.");
   Put_Line
     ("Time per addition operation is " &
        Float'Image(Float(Stop - Start) / Float(The_Data'Length)) &
        " seconds.");
end Parallel_Addition_Test;

The output of this program when run on my Windows 10 computer is:

The sum is:  2147483647
Addition elapsed time is  5.628780600 seconds.
Time per addition operation is  2.62111E-09 seconds.