Memory management can cause real headache due to memory leakage over
time. That is, memory allocation is not properly deallocated after the
call. When the memory runs out, the result could be catastrophic for
some applications. This problem can be recued by garbage collector
built-in the compiler such as Java. However, the cost of run-time
overhead is high.
Here comes Ada 95 to the recue. How is it possible you may ask? Ah!
Ada 95 provides a feature called Storage Pool. It allows the users
have total control over the memory management. Best of all, it does
not involve run-time overhead as garbage collector. When it is
combined with controlled type, the memory leakage problem is history.
As shown in the test case, 100 storage elements were allocated
initially. Then, these storage elements are reused again and again. It
is pretty cool isn't it? Enjoy.
----------------------------------------
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;
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 := False;
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);
-- 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)));
Display_Info ("storage elements 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));
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;
Addr_To_Acc.To_Pointer (Storage_Address).Next_Address :=
Free_Storage_Keeper (Marker);
Free_Storage_Keeper (Marker) := Storage_Address;
Display_Info ("Address returned to pool: " &
System.Storage_Elements.Integer_Address'Image (
System.Storage_Elements.To_Integer
(Storage_Address)));
Display_Info ("storage elements returned to pool: " &
System.Storage_Elements.Storage_Count'Image
(Size_In_Storage_Elements));
Display_Info ("Alignment used in deallocation: " &
System.Storage_Elements.Storage_Count'Image (Alignment));
end Deallocate;
function Storage_Size (Pool : in User_Pool)
return Storage_Elements.Storage_Count is
begin
return Pool.Size;
end Storage_Size;
begin
null;
end Memory_Management;
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;
with Ada.Unchecked_Deallocation;
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;
with Ada.Finalization;
with Ada.Text_Io;
with Memory_Management.Support;
procedure Memory_Management.Test is
use Ada;
use Text_Io;
begin
Put_Line ("********* Memory Control Testing Starts **********");
for Index in 1 .. 10 loop
declare
David_Botton : Support.General_Data;
Nick_Roberts : Support.General_Data;
Anh_Vo : Support.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;
|
