with System; use System;
with System.Memory; use System.Memory;
with System.Address_To_Access_Conversions;
package body GNAT.Dynamic_Tables is
Min : constant Integer := Integer (Table_Low_Bound);
procedure Reallocate (T : in out Instance);
package Table_Conversions is
new System.Address_To_Access_Conversions (Big_Table_Type);
function To_Address (Table : Table_Ptr) return Address;
pragma Inline (To_Address);
function To_Pointer (Table : Address) return Table_Ptr;
pragma Inline (To_Pointer);
procedure Allocate
(T : in out Instance;
Num : Integer := 1)
is
begin
T.P.Last_Val := T.P.Last_Val + Num;
if T.P.Last_Val > T.P.Max then
Reallocate (T);
end if;
end Allocate;
procedure Append (T : in out Instance; New_Val : Table_Component_Type) is
begin
Increment_Last (T);
T.Table (Table_Index_Type (T.P.Last_Val)) := New_Val;
end Append;
procedure Decrement_Last (T : in out Instance) is
begin
T.P.Last_Val := T.P.Last_Val - 1;
end Decrement_Last;
procedure Free (T : in out Instance) is
begin
Free (To_Address (T.Table));
T.Table := null;
T.P.Length := 0;
end Free;
procedure Increment_Last (T : in out Instance) is
begin
T.P.Last_Val := T.P.Last_Val + 1;
if T.P.Last_Val > T.P.Max then
Reallocate (T);
end if;
end Increment_Last;
procedure Init (T : in out Instance) is
Old_Length : constant Integer := T.P.Length;
begin
T.P.Last_Val := Min - 1;
T.P.Max := Min + Table_Initial - 1;
T.P.Length := T.P.Max - Min + 1;
if Old_Length = T.P.Length then
return;
else
Reallocate (T);
end if;
end Init;
function Last (T : in Instance) return Table_Index_Type is
begin
return Table_Index_Type (T.P.Last_Val);
end Last;
procedure Reallocate (T : in out Instance) is
New_Size : size_t;
begin
if T.P.Max < T.P.Last_Val then
while T.P.Max < T.P.Last_Val loop
T.P.Length := T.P.Length * (100 + Table_Increment) / 100;
T.P.Max := Min + T.P.Length - 1;
end loop;
end if;
New_Size :=
size_t ((T.P.Max - Min + 1) *
(Table_Type'Component_Size / Storage_Unit));
if T.Table = null then
T.Table := To_Pointer (Alloc (New_Size));
elsif New_Size > 0 then
T.Table :=
To_Pointer (Realloc (Ptr => To_Address (T.Table),
Size => New_Size));
end if;
if T.P.Length /= 0 and then T.Table = null then
raise Storage_Error;
end if;
end Reallocate;
procedure Release (T : in out Instance) is
begin
T.P.Length := T.P.Last_Val - Integer (Table_Low_Bound) + 1;
T.P.Max := T.P.Last_Val;
Reallocate (T);
end Release;
procedure Set_Item
(T : in out Instance;
Index : Table_Index_Type;
Item : Table_Component_Type)
is
begin
if Integer (Index) > T.P.Max then
Set_Last (T, Index);
end if;
T.Table (Index) := Item;
end Set_Item;
procedure Set_Last (T : in out Instance; New_Val : Table_Index_Type) is
begin
if Integer (New_Val) < T.P.Last_Val then
T.P.Last_Val := Integer (New_Val);
else
T.P.Last_Val := Integer (New_Val);
if T.P.Last_Val > T.P.Max then
Reallocate (T);
end if;
end if;
end Set_Last;
function To_Address (Table : Table_Ptr) return Address is
begin
return Table_Conversions.To_Address
(Table_Conversions.Object_Pointer (Table));
end To_Address;
function To_Pointer (Table : Address) return Table_Ptr is
begin
return Table_Ptr (Table_Conversions.To_Pointer (Table));
end To_Pointer;
end GNAT.Dynamic_Tables;