如何使用 Ada95 中的存储池自动解除分配

How to automate deallocation with storage pools in Ada95

我读到可以创建用户定义的存储池来简化重新分配过程,在某些情况下甚至 自动化 它。对这种可能性感到头晕,我一直在尝试在 Ada95 中制作一个简单的存储池示例,但我 运行 遇到了麻烦。

我一直在阅读以下 recommended page 以查看实现示例,并尝试 运行 在我的机器上使用它。然而,在调整了一些 withuse 语句以使其编译后,当我 运行 它时,我看到它实际上有时会失败并声称 "adjust/finalize raised an error".调整异常处理以进一步传播完整的详细信息我收到以下消息:

raised CONSTRAINT_ERROR : memory_management.adb:113 index check failed

我正在为此苦苦挣扎,因为 Unchecked_Deallocation 调用似乎提供了导致索引不准确的不准确对象大小! new 调用 never 报告分配了试图解除分配的数量。由于我对这个概念 非常 陌生,所以我不知道下一步该怎么做。如果有人愿意指出我的愚蠢错误或强调我误解的地方,我将不胜感激。

下面是我修改后的代码,和我整理的一模一样:

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;

最后,这是失败时的输出:

********* 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

我坚持上面评论中的说法,存在以下问题:

  • Marker 变量,它是请求的大小除以请求的对齐方式(四舍五入),用于索引 Free_Storage_Keeper,大概是为了保持相同大小的块一起。但是 16 bytes/alignment 4 将以与 32 bytes/alignment 8.
  • 相同的索引结尾
  • 没有尝试实际调整请求。
  • General_Data 需要 Adjust(包含指针的 Controlled 类型总是需要 Adjust)。
  • Free_Storage_Keeper 应该存在于存储池中(如果您有两个 User_Pool 实例会怎样?任务呢?)

但是,我认为崩溃的直接原因是 Deallocate 中的语句:

Addr_To_Acc.To_Pointer(Storage_Address).Next_Address :=
   Free_Storage_Keeper(Marker);

因为它假定指针可以适合分配,而 64 位 OS 上的 Integer 肯定不是这种情况(4 字节整数与 8 字节访问).

您可以先在 AllocateDeallocate:

中强制进行最小分配
  Size : constant Storage_Elements.Storage_Count
    := Storage_Elements.Storage_Count'Max
      (Size_In_Storage_Elements,
       System.Address'Max_Size_In_Storage_Elements);

然后始终使用 Size 而不是 Size_In_Storage_Elements