Arena storage pool

Dynamically allocated objects take their memory from a heap. The memory for an object is provided by an allocator which maintains the storage pool used for the heap. Often a call to allocator is denoted as <lang ada> P := new T </lang> where T is the type of an allocated object and P is a reference to the object.

The storage pool chosen by the allocator can be determined by either:

• the object type T;
• the type of pointer P.

In the former case objects can be allocated only in one storage pool. In the latter case objects of the type can be allocated in any storage pool or on the stack.

Task

Show how allocators and user-defined storage pools are supported by the language. In particular:

1. define an arena storage pool. An arena is a pool in which objects are allocated individually, but freed by groups.
2. allocate some objects, like integers in the pool.

Explain what controls the storage pool choice in the language.

Ada

In Ada the choice of storage pool is controlled by the type of the pointer. Objects pointed by anonymous access types are allocated in the default storage pool. Pool-specific pointer types may get a pool assigned to them: <lang ada> type My_Pointer is access My_Object; for My_Pointer'Storage_Pool use My_Pool; </lang> The following example illustrates implementation of an arena pool. Specification: <lang ada> with System.Storage_Elements; use System.Storage_Elements; with System.Storage_Pools; use System.Storage_Pools;

package Arena_Pools is

  type Arena (Size : Storage_Count) is new Root_Storage_Pool with private;
  overriding
     procedure Allocate
               (  Pool      : in out Arena;
                  Address   : out System.Address;
                  Size      : Storage_Count;
                  Alignment : Storage_Count
               );
  overriding
     procedure Deallocate
               (  Pool      : in out Arena;
                  Address   : System.Address;
                  Size      : Storage_Count;
                  Alignment : Storage_Count
               )  is null;
  overriding
     function Storage_Size (Pool : Arena) return Storage_Count;

private

  type Arena (Size : Storage_Count) is new Root_Storage_Pool with record
     Free : Storage_Offset := 1;
     Core : Storage_Array (1..Size);
  end record;

end Arena_Pools; </lang> Here is an implementation of the package: <lang ada> package body Arena_Pools is

  procedure Allocate
            (  Pool      : in out Arena;
               Address   : out System.Address;
               Size      : Storage_Count;
               Alignment : Storage_Count
            )  is
     Free : constant Storage_Offset :=
        Pool.Free + Alignment - Pool.Core (Pool.Free)'Address mod Alignment + Size;
  begin
     if Free - 1 > Pool.Size then
        raise Storage_Error;
     end if;
     Pool.Free := Free;
     Address := Pool.Core (Pool.Free - Size)'Address;
  end Allocate;

  function Storage_Size (Pool : Arena) return Storage_Count is
  begin
     return Pool.Size;
  end Storage_Size;

end Arena_Pools; </lang> The following is a test program that uses the pool: <lang ada> with Arena_Pools; use Arena_Pools;

procedure Test_Allocator is

  Pool : Arena_Pools.Arena (1024);
  type Integer_Ptr is access Integer;
  for Integer_Ptr'Storage_Pool use Pool;
  
  X : Integer_Ptr := new Integer'(1);
  Y : Integer_Ptr := new Integer'(2);
  Z : Integer_Ptr;

begin

  Z := new Integer;
  Z.all := X.all + Y.all;

end Test_Allocator; </lang>