diff options
Diffstat (limited to 'src/tables.adb')
-rw-r--r-- | src/tables.adb | 97 |
1 files changed, 11 insertions, 86 deletions
diff --git a/src/tables.adb b/src/tables.adb index ca8674269..ef4cc385a 100644 --- a/src/tables.adb +++ b/src/tables.adb @@ -16,59 +16,13 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. -with Interfaces.C; use Interfaces.C; -with System; - package body Tables is - -- Number of allocated elements in the table. - Length : Natural := 0; - - -- Number of used elements in the table. - Last_Pos : Natural := 0; - - -- Size of an element in storage units (bytes). - El_Size : constant size_t := - size_t (Table_Type'Component_Size / System.Storage_Unit); - - -- Expand the table by doubling its size. The table must have been - -- initialized. - procedure Expand (Num : Natural) - is - -- For efficiency, directly call realloc. - function Crealloc (Ptr : Table_Thin_Ptr; Size : size_t) - return Table_Thin_Ptr; - pragma Import (C, Crealloc, "realloc"); - begin - pragma Assert (Length /= 0); - pragma Assert (Table /= null); - - -- Expand the bound. - Last_Pos := Last_Pos + Num; - - -- Check if need to reallocate. - if Last_Pos < Length then - return; - else - -- Double the length. - loop - Length := Length * 2; - exit when Length > Last_Pos; - end loop; - end if; - - -- Realloc and check result. - Table := Crealloc (Table, size_t (Length) * El_Size); - if Table = null then - raise Storage_Error; - end if; - end Expand; - function Allocate (Num : Natural := 1) return Table_Index_Type is Res : constant Table_Index_Type := Table_Index_Type'Val - (Table_Index_Type'Pos (Table_Low_Bound) + Last_Pos); + (Table_Index_Type'Pos (Last) + 1); begin - Expand (Num); + Dyn_Table.Allocate (T, Num); return Res; end Allocate; @@ -76,66 +30,37 @@ package body Tables is procedure Increment_Last is begin -- Increase by 1. - Expand (1); + Dyn_Table.Increment_Last (T); end Increment_Last; procedure Decrement_Last is begin - Last_Pos := Last_Pos - 1; + Dyn_Table.Decrement_Last (T); end Decrement_Last; - procedure Set_Last (Index : Table_Index_Type) - is - New_Last : constant Natural := - (Table_Index_Type'Pos (Index) - - Table_Index_Type'Pos (Table_Low_Bound) + 1); + procedure Set_Last (Index : Table_Index_Type) is begin - if New_Last < Last_Pos then - -- Decrease length. - Last_Pos := New_Last; - else - -- Increase length. - Expand (New_Last - Last_Pos); - end if; + Dyn_Table.Set_Last (T, Index); end Set_Last; - procedure Init - is - -- Direct interface to malloc. - function Cmalloc (Size : size_t) return Table_Thin_Ptr; - pragma Import (C, Cmalloc, "malloc"); + procedure Init is begin - if Table = null then - -- Allocate memory if not already allocated. - Length := Table_Initial; - Table := Cmalloc (size_t (Length) * El_Size); - end if; - - -- Table is initially empty. - Last_Pos := 0; + Dyn_Table.Init (T); end Init; function Last return Table_Index_Type is begin - return Table_Index_Type'Val - (Table_Index_Type'Pos (Table_Low_Bound) + Last_Pos - 1); + return Dyn_Table.Last (T); end Last; procedure Free is - -- Direct interface to free. - procedure Cfree (Ptr : Table_Thin_Ptr); - pragma Import (C, Cfree, "free"); begin - Cfree (Table); - Table := null; - Length := 0; - Last_Pos := 0; + Dyn_Table.Free (T); end Free; procedure Append (Val : Table_Component_Type) is begin - Increment_Last; - Table (Last) := Val; + Dyn_Table.Append (T, Val); end Append; begin |