with System.Memory;
with Unchecked_Conversion;
package body System.Pool_Local is
package SSE renames System.Storage_Elements;
use type SSE.Storage_Offset;
Pointer_Size : constant SSE.Storage_Offset := Address'Size / Storage_Unit;
Pointers_Size : constant SSE.Storage_Offset := 2 * Pointer_Size;
type Acc_Address is access all Address;
function To_Acc_Address is new Unchecked_Conversion (Address, Acc_Address);
function Next (A : Address) return Acc_Address;
pragma Inline (Next);
function Prev (A : Address) return Acc_Address;
pragma Inline (Prev);
procedure Allocate
(Pool : in out Unbounded_Reclaim_Pool;
Address : out System.Address;
Storage_Size : SSE.Storage_Count;
Alignment : SSE.Storage_Count)
is
pragma Warnings (Off, Alignment);
Allocated : constant System.Address :=
Memory.Alloc
(Memory.size_t (Storage_Size + Pointers_Size));
begin
if Allocated = Null_Address then
raise Storage_Error;
else
Address := Allocated + Pointers_Size;
Next (Allocated).all := Pool.First;
Prev (Allocated).all := Null_Address;
if Pool.First /= Null_Address then
Prev (Pool.First).all := Allocated;
end if;
Pool.First := Allocated;
end if;
end Allocate;
procedure Deallocate
(Pool : in out Unbounded_Reclaim_Pool;
Address : System.Address;
Storage_Size : SSE.Storage_Count;
Alignment : SSE.Storage_Count)
is
pragma Warnings (Off, Storage_Size);
pragma Warnings (Off, Alignment);
Allocated : constant System.Address := Address - Pointers_Size;
begin
if Prev (Allocated).all = Null_Address then
Pool.First := Next (Allocated).all;
Prev (Pool.First).all := Null_Address;
else
Next (Prev (Allocated).all).all := Next (Allocated).all;
end if;
if Next (Allocated).all /= Null_Address then
Prev (Next (Allocated).all).all := Prev (Allocated).all;
end if;
Memory.Free (Allocated);
end Deallocate;
procedure Finalize (Pool : in out Unbounded_Reclaim_Pool) is
N : System.Address := Pool.First;
Allocated : System.Address;
begin
while N /= Null_Address loop
Allocated := N;
N := Next (N).all;
Memory.Free (Allocated);
end loop;
end Finalize;
function Next (A : Address) return Acc_Address is
begin
return To_Acc_Address (A);
end Next;
function Prev (A : Address) return Acc_Address is
begin
return To_Acc_Address (A + Pointer_Size);
end Prev;
end System.Pool_Local;