-- GHDL Run Time (GRT) - Resizable array -- Copyright (C) 2008 Tristan Gingold -- -- GHDL is free software; you can redistribute it and/or modify it under -- the terms of the GNU General Public License as published by the Free -- Software Foundation; either version 2, or (at your option) any later -- version. -- -- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY -- WARRANTY; without even the implied warranty of MERCHANTABILITY or -- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- for more details. -- -- You should have received a copy of the GNU General Public License -- along with GCC; see the file COPYING. If not, write to the Free -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with System; use System; with Grt.C; use Grt.C; package body Grt.Table is -- Maximum index of table before resizing. Max : Table_Index_Type := Table_Low_Bound - 1; -- Current value of Last Last_Val : Table_Index_Type; function Malloc (Size : size_t) return Table_Ptr; pragma Import (C, Malloc); procedure Free (T : Table_Ptr); pragma Import (C, Free); -- Resize and reallocate the table according to LAST_VAL. procedure Resize is function Realloc (T : Table_Ptr; Size : size_t) return Table_Ptr; pragma Import (C, Realloc); New_Size : size_t; begin while Max < Last_Val loop Max := Max + (Max - Table_Low_Bound + 1); end loop; New_Size := size_t ((Max - Table_Low_Bound + 1) * (Table_Type'Component_Size / Storage_Unit)); Table := Realloc (Table, New_Size); if Table = null then raise Storage_Error; end if; end Resize; procedure Append (New_Val : Table_Component_Type) is begin Increment_Last; Table (Last_Val) := New_Val; end Append; procedure Decrement_Last is begin Last_Val := Last_Val - 1; end Decrement_Last; procedure Free is begin Free (Table); Table := null; end Free; procedure Increment_Last is begin Last_Val := Last_Val + 1; if Last_Val > Max then Resize; end if; end Increment_Last; function Last return Table_Index_Type is begin return Last_Val; end Last; procedure Release is begin Max := Last_Val; Resize; end Release; procedure Set_Last (New_Val : Table_Index_Type) is begin if New_Val < Last_Val then Last_Val := New_Val; else Last_Val := New_Val; if Last_Val > Max then Resize; end if; end if; end Set_Last; begin Last_Val := Table_Low_Bound - 1; Max := Table_Low_Bound + Table_Index_Type (Table_Initial) - 1; Table := Malloc (size_t (Table_Initial * (Table_Type'Component_Size / Storage_Unit))); end Grt.Table;