如何使用 Ada95 中的存储池自动解除分配
How to automate deallocation with storage pools in Ada95
我读到可以创建用户定义的存储池来简化重新分配过程，在某些情况下甚至 自动化 它。对这种可能性感到头晕，我一直在尝试在 Ada95 中制作一个简单的存储池示例，但我 运行 遇到了麻烦。
我一直在阅读以下 recommended page 以查看实现示例，并尝试 运行 在我的机器上使用它。然而，在调整了一些 with 和 use 语句以使其编译后，当我 运行 它时，我看到它实际上有时会失败并声称 "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 字节访问).
您可以先在 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。
我读到可以创建用户定义的存储池来简化重新分配过程，在某些情况下甚至 自动化 它。对这种可能性感到头晕，我一直在尝试在 Ada95 中制作一个简单的存储池示例，但我 运行 遇到了麻烦。
我一直在阅读以下 recommended page 以查看实现示例，并尝试 运行 在我的机器上使用它。然而，在调整了一些 with 和 use 语句以使其编译后，当我 运行 它时，我看到它实际上有时会失败并声称 "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 字节访问).
您可以先在 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。