with GNAT.Heap_Sort_G;
with System; use System;
with System.Memory; use System.Memory;
with Unchecked_Conversion;
package body GNAT.Dynamic_Tables is
Min : constant Integer := Integer (Table_Low_Bound);
procedure Reallocate (T : in out Instance);
pragma Warnings (Off);
function To_Address is new Unchecked_Conversion (Table_Ptr, Address);
function To_Pointer is new Unchecked_Conversion (Address, Table_Ptr);
pragma Warnings (On);
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 For_Each (Table : Instance) is
Quit : Boolean := False;
begin
for Index in Table_Low_Bound .. Table_Index_Type (Table.P.Last_Val) loop
Action (Index, Table.Table (Index), Quit);
exit when Quit;
end loop;
end For_Each;
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_Length : Integer;
New_Size : size_t;
begin
if T.P.Max < T.P.Last_Val then
while T.P.Max < T.P.Last_Val loop
New_Length := T.P.Length * (100 + Table_Increment) / 100;
if New_Length > T.P.Length then
T.P.Length := New_Length;
else
T.P.Length := T.P.Length + 1;
end if;
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.Last_Val 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;
procedure Sort_Table (Table : in out Instance) is
Temp : Table_Component_Type;
function Index_Of (Idx : Natural) return Table_Index_Type;
function Lower_Than (Op1, Op2 : Natural) return Boolean;
procedure Move (From : Natural; To : Natural);
package Heap_Sort is new GNAT.Heap_Sort_G (Move, Lower_Than);
function Index_Of (Idx : Natural) return Table_Index_Type is
begin
return First + Table_Index_Type (Idx) - 1;
end Index_Of;
procedure Move (From : Natural; To : Natural) is
begin
if From = 0 then
Table.Table (Index_Of (To)) := Temp;
elsif To = 0 then
Temp := Table.Table (Index_Of (From));
else
Table.Table (Index_Of (To)) :=
Table.Table (Index_Of (From));
end if;
end Move;
function Lower_Than (Op1, Op2 : Natural) return Boolean is
begin
if Op1 = 0 then
return Lt (Temp, Table.Table (Index_Of (Op2)));
elsif Op2 = 0 then
return Lt (Table.Table (Index_Of (Op1)), Temp);
else
return
Lt (Table.Table (Index_Of (Op1)),
Table.Table (Index_Of (Op2)));
end if;
end Lower_Than;
begin
Heap_Sort.Sort (Natural (Last (Table) - First) + 1);
end Sort_Table;
end GNAT.Dynamic_Tables;