我读到可以制作用户定义的存储池来简化释放过程，在某些情况下甚至可以自动化它。对这种可能性感到头晕目眩，我一直试图在 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