ada - 如何在 Ada95 中使用存储池自动解除分配

Question

我读到可以制作用户定义的存储池来简化释放过程，在某些情况下甚至可以自动化它。对这种可能性感到头晕目眩，我一直试图在 Ada95 中制作一个简单的存储池示例，但我遇到了麻烦。

我一直在阅读以下推荐页面以查看实现示例，并尝试在我的机器上运行它。但是，在调整了一些withanduse语句以使其编译后，当我运行它时，我发现它有时实际上会失败并声称“调整/完成引发错误”。调整异常处理以进一步传播完整的详细信息，我收到以下消息：

raised CONSTRAINT_ERROR : memory_management.adb:113 index check failed

我正在为此苦苦挣扎，因为Unchecked_Deallocation调用似乎是提供不准确的对象大小导致索引不准确的原因！该new调用从不报告分配尝试解除分配的金额。由于我对这个概念很陌生，所以我不知道下一步该做什么。如果有人愿意指出我的愚蠢错误或强调我误解的东西，我将非常感激。

这是我修改后的代码，完全按照我的组织方式：

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;

内存管理.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

score 0 · Accepted Answer

我坚持我在上述评论中的评论，存在以下问题：

该Marker变量是请求的大小除以请求的对齐方式（向上取整），用于索引Free_Storage_Keeper，大概是为了将相同大小的块保持在一起。但是 16 字节/对齐 4 将以与 32 字节/对齐 8 相同的索引结束。
没有尝试实际对齐请求。
你需要一个Adjustfor General_Data（你总是需要一个AdjustforControlled包含指针的类型）。
Free_Storage_Keeper应该存在于存储池中（如果你有两个实例会发生User_Pool什么？任务呢？）

但是，我认为崩溃的直接原因是以下语句Deallocate：

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

因为它假定指针可以适合分配，这Integer在 64 位操作系统上肯定不是这种情况（4 字节整数与 8 字节访问）。

您可以首先强制在Allocate,中进行最小分配Deallocate：

  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自始至终。

ada - 如何在 Ada95 中使用存储池自动解除分配

1 回答 1

Related

Reference