我了解到可以创建用户定义的存储池来简化重新分配过程，在某些情况下甚至可以自动化。可能性很大，我一直在尝试在Ada95中创建一个简单的存储池示例，但是我遇到了麻烦。
我一直在阅读以下recommended page，以查看实现示例，并尝试在我的计算机上运行该实现。但是，在对某些with和use语句进行了调整以使其可编译之后，当我运行它时，我发现它实际上有时会失败，并声称“调整/完成会引发错误”。 。调整异常处理以进一步传播所有详细信息，我得到以下消息：
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;
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
答案 0 :(得分：0)
我谨在上面的评论中说，存在以下问题：
Marker变量，它是请求的大小除以请求的对齐方式（向上舍入），用于索引Free_Storage_Keeper，大概是为了将相同大小的块保持在一起。但是16字节/对齐方式4将以与32字节/对齐方式8相同的索引结尾。Adjust，您需要一个General_Data（对于包含指针的Adjust类型，您始终需要一个Controlled）。 Free_Storage_Keeper应该位于存储池中（如果您有两个User_Pool实例，会发生什么？任务呢？）但是，我认为导致崩溃的直接原因是Deallocate中的以下语句：
Addr_To_Acc.To_Pointer(Storage_Address).Next_Address :=
Free_Storage_Keeper(Marker);
因为它假定指针可以适合分配，所以在64位OS（4字节整数与8字节访问）上使用Integer肯定不是这种情况。
您可以先在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。