Memory Management with Storage Pools

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;