I read that user-defined Storage Pools can be made to simplify the deallocation process and in some cases even automate it. Giddy at the possibility, I have been trying to make a simple storage pool example in Ada95, but I am running into trouble.
I have been reading the following recommended page to see an example of an implementation, and try and run it on my machine. However, after tweaking some of the with and use statements in order to get it to compile, when I ran it I saw that it actually failed on occasion and claimed that "adjust/finalize raised an error". Tweaking the exception handling to further propagate the full details I got the following message:
raised CONSTRAINT_ERROR : memory_management.adb:113 index check failed
I'm struggling with this because the Unchecked_Deallocation call seems to be what is providing the inaccurate object size that is resulting in an inaccurate index! The new call never reports allocating the amount that is attempting to be deallocated. As I am very new to this concept, I am stumped as to what to do next. If anyone is willing to point out my silly mistake or highlight something I am misunderstanding, I would be very grateful.
Here is the code after I modified it, exactly as I organized it:
memory_management.ads
with System.Storage_Pools;
with System.Storage_Elements;
package Memory_Management is
use System;
type User_Pool (Size : Storage_Elements.Storage_Count) is new
System.Storage_Pools.Root_Storage_Pool with private;
procedure Allocate (
Pool : in out User_Pool;
Storage_Address : out System.Address;
Size_In_Storage_Elements : in Storage_Elements.Storage_Count;
Alignment : in Storage_Elements.Storage_Count);
procedure Deallocate (
Pool : in out User_Pool;
Storage_Address : in System.Address;
Size_In_Storage_Elements : in Storage_Elements.Storage_Count;
Alignment : in Storage_Elements.Storage_Count);
function Storage_Size (Pool : in User_Pool)
return Storage_Elements.Storage_Count;
-- Exeption declaration
Memory_Exhausted : exception;
Item_Too_Big : exception;
private
type User_Pool (Size : Storage_Elements.Storage_Count) is new
System.Storage_Pools.Root_Storage_Pool with record
Data : Storage_Elements.Storage_Array (1 .. Size);
Addr_Index : Storage_Elements.Storage_Count := 1;
end record;
end Memory_Management;
memory_management.adb
with Ada.Exceptions;
with Ada.Text_Io;
with System.Storage_Elements;
with System.Address_To_Access_Conversions;
package body Memory_Management is
use Ada;
use Text_Io;
use type System.Storage_Elements.Storage_Count;
Package_Name: constant String := "Memory_Management.";
-- Used to turn on/off the debug information
Debug_On: Boolean := True;
type Holder is record
Next_Address: System.Address := System.Null_Address;
end record;
package Addr_To_Acc is new Address_To_Access_Conversions(Holder);
-- Keep track of the size of memory block for reuse
Free_Storage_Keeper : array (Storage_Elements.Storage_Count
range 1 .. 100) of System.Address :=
(others => System.Null_Address);
procedure Display_Info(Message : String;
With_New_Line : Boolean := True) is
begin
if Debug_On then
if With_New_Line then
Put_Line(Message);
else
Put(Message);
end if;
end if;
end Display_Info;
procedure Allocate(
Pool : in out User_Pool;
Storage_Address : out System.Address;
Size_In_Storage_Elements : in Storage_Elements.Storage_Count;
Alignment : in Storage_Elements.Storage_Count) is
Procedure_Name : constant String := "Allocate";
Temp_Address : System.Address := System.Null_Address;
Marker : Storage_Elements.Storage_Count;
begin
Marker := (Size_In_Storage_Elements + Alignment - 1) / Alignment;
if Free_Storage_Keeper(Marker) /= System.Null_Address then
Storage_Address := Free_Storage_Keeper(Marker);
Free_Storage_Keeper(Marker) :=
Addr_To_Acc.To_Pointer(Free_Storage_Keeper(
Marker)).Next_Address;
else
Temp_Address := Pool.Data(Pool.Addr_Index)'Address;
Pool.Addr_Index := Pool.Addr_Index + Alignment *
((Size_In_Storage_Elements + Alignment - 1) / Alignment);
Display_Info("storage elements to be allocated from pool: " &
System.Storage_Elements.Storage_Count'Image(
Size_In_Storage_Elements));
Display_Info("Alignment in allocation operation: " &
System.Storage_Elements.Storage_Count'Image(Alignment));
-- make sure memory is available as requested
if Pool.Addr_Index > Pool.Size then
Exceptions.Raise_Exception(Storage_Error'Identity,
"Storage exhausted in " & Package_Name &
Procedure_Name);
else
Storage_Address := Temp_Address;
end if;
end if;
--Display_Info("Address allocated from pool: " &
-- System.Storage_Elements.Integer_Address'Image(
-- System.Storage_Elements.To_Integer(Storage_Address)));
exception
when Error : others => -- Object too big or memory exhausted
Display_Info(Exceptions.Exception_Information(Error));
raise;
end Allocate;
procedure Deallocate(
Pool : in out User_Pool;
Storage_Address : in System.Address;
Size_In_Storage_Elements : in Storage_Elements.Storage_Count;
Alignment : in Storage_Elements.Storage_Count) is
Marker : Storage_Elements.Storage_Count;
begin
Marker := (Size_In_Storage_Elements + Alignment - 1) / Alignment;
--Display_Info("Address to be returned to pool: " &
-- System.Storage_Elements.Integer_Address'Image(
-- System.Storage_Elements.To_Integer(Storage_Address)));
Display_Info("storage elements to return to pool: " &
System.Storage_Elements.Storage_Count'Image(
Size_In_Storage_Elements));
Display_Info("Alignment to be used in deallocation: " &
System.Storage_Elements.Storage_Count'Image(Alignment));
Addr_To_Acc.To_Pointer(Storage_Address).Next_Address :=
Free_Storage_Keeper(Marker);
Free_Storage_Keeper(Marker) := Storage_Address;
exception
when Error: others =>
Ada.Text_IO.Put_Line(Ada.Exceptions.Exception_Information(Error));
raise;
end Deallocate;
function Storage_Size (Pool : in User_Pool)
return Storage_Elements.Storage_Count is
begin
return Pool.Size;
end Storage_Size;
end Memory_Management;
memory_management-support.ads
with Ada.Finalization;
package Memory_Management.Support is
use Ada;
-- Adjust the storage size according to the application
Big_Pool : User_Pool(Size => 100);
type Int_Acc is access Integer;
for Int_Acc'Storage_Pool use Big_Pool;
type Str_Acc is access all String;
for Str_Acc'Storage_Pool use Int_Acc'Storage_Pool;
type General_Data is new Finalization.Controlled
with record
Id : Int_Acc;
Name : Str_Acc;
end record;
procedure Initialize(Object : in out General_Data);
procedure Finalize(Object : in out General_Data);
end Memory_Management.Support;
memory_management-support.adb
with Ada.Unchecked_Deallocation;
with Ada.Exceptions;
with Ada.Text_IO;
package body Memory_Management.Support is
procedure Free is new Ada.Unchecked_Deallocation(Integer, Int_Acc);
procedure Free is new Ada.Unchecked_Deallocation(String, Str_Acc);
procedure Initialize(Object : in out General_Data) is
begin
null;
end Initialize;
procedure Finalize(Object : in out General_Data) is
begin
Free(Object.Id);
Free(Object.Name);
end Finalize;
end Memory_Management.Support;
memory_management_test.adb
with Ada.Finalization;
with Ada.Text_Io;
with Memory_Management.Support;
procedure Memory_Management_Test is
use Ada;
use Text_Io;
use Memory_Management.Support;
begin
Put_Line ("********* Memory Control Testing Starts **********");
for Index in 1 .. 10 loop
declare
David_Botton : General_Data;
Nick_Roberts : General_Data;
Anh_Vo : General_Data;
begin
David_Botton := (Finalization.Controlled with
Id => new Integer'(111),
Name => new String'("David Botton"));
Nick_Roberts := (Finalization.Controlled with
Id => new Integer'(222),
Name => new String' ("Nick Roberts"));
Anh_Vo := (Finalization.Controlled with
Id => new Integer'(333),
Name => new String' ("Anh Vo"));
end;
end loop;
Put_Line ("Memory Management Test Passes");
exception
when others =>
Put_Line ("Memory Management Test Fails");
end Memory_Management_Test;
lastly, here is what the output looks like upon failure:
********* Memory Control Testing Starts **********
storage elements to be allocated from pool: 4
Alignment in allocation operation: 4
storage elements to be allocated from pool: 20
Alignment in allocation operation: 4
storage elements to return to pool: 4
Alignment to be used in deallocation: 4
storage elements to return to pool: 24
Alignment to be used in deallocation: 4
storage elements to be allocated from pool: 20
Alignment in allocation operation: 4
storage elements to return to pool: 4
Alignment to be used in deallocation: 4
storage elements to return to pool: 20
Alignment to be used in deallocation: 4
storage elements to be allocated from pool: 16
Alignment in allocation operation: 4
storage elements to return to pool: 4
Alignment to be used in deallocation: 4
storage elements to return to pool: 16
Alignment to be used in deallocation: 4
storage elements to return to pool: 4
Alignment to be used in deallocation: 4
storage elements to return to pool: 12
Alignment to be used in deallocation: 4
storage elements to return to pool: 4
Alignment to be used in deallocation: 4
storage elements to return to pool: 12
Alignment to be used in deallocation: 4
storage elements to return to pool: 4
Alignment to be used in deallocation: 4
storage elements to return to pool: 8
Alignment to be used in deallocation: 4
storage elements to return to pool: 4
Alignment to be used in deallocation: 4
storage elements to return to pool: 20
Alignment to be used in deallocation: 4
storage elements to return to pool: 4
Alignment to be used in deallocation: 4
storage elements to return to pool: 20
Alignment to be used in deallocation: 4
storage elements to return to pool: 4
Alignment to be used in deallocation: 4
storage elements to return to pool: 16
Alignment to be used in deallocation: 4
storage elements to return to pool: 4
Alignment to be used in deallocation: 4
storage elements to return to pool: 12
Alignment to be used in deallocation: 4
storage elements to return to pool: 4
Alignment to be used in deallocation: 4
storage elements to return to pool: 238878632
Alignment to be used in deallocation: 4
raised CONSTRAINT_ERROR : memory_management.adb:113 index check failed
storage elements to return to pool: 4
Alignment to be used in deallocation: 4
storage elements to return to pool: 238878632
Alignment to be used in deallocation: 4
raised CONSTRAINT_ERROR : memory_management.adb:113 index check failed
Memory Management Test Fails
I stand by my remarks in the comments above, that the following problems exist:
Marker variable, which is the requested size divided by the requested alignment (rounded up), and is used to index the Free_Storage_Keeper, presumably in an attempt to keep same-sized blocks together. But 16 bytes/alignment 4 will end in the same index as 32 bytes/alignment 8.Adjust for General_Data (you always need an Adjust for a Controlled type containing pointers). Free_Storage_Keeper ought to live in the storage pool (what happens if you have two instances of User_Pool? what about tasks?)However, I think the immediate cause of the crash is this statement in Deallocate:
Addr_To_Acc.To_Pointer(Storage_Address).Next_Address :=
Free_Storage_Keeper(Marker);
because it assumes that a pointer can fit in an allocation, which is certainly not the case with an Integer on a 64-bit OS (4-byte integer vs 8-byte access).
You could start by forcing a minimum allocation in Allocate, Deallocate:
Size : constant Storage_Elements.Storage_Count
:= Storage_Elements.Storage_Count'Max
(Size_In_Storage_Elements,
System.Address'Max_Size_In_Storage_Elements);
and then use Size instead of Size_In_Storage_Elements throughout.