1-- GHDL Run Time (GRT) - Resizable array 2-- Copyright (C) 2008 - 2014 Tristan Gingold 3-- 4-- This program is free software: you can redistribute it and/or modify 5-- it under the terms of the GNU General Public License as published by 6-- the Free Software Foundation, either version 2 of the License, or 7-- (at your option) any later version. 8-- 9-- This program is distributed in the hope that it will be useful, 10-- but WITHOUT ANY WARRANTY; without even the implied warranty of 11-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12-- GNU General Public License for more details. 13-- 14-- You should have received a copy of the GNU General Public License 15-- along with this program. If not, see <gnu.org/licenses>. 16-- 17-- As a special exception, if other files instantiate generics from this 18-- unit, or you link this unit with other files to produce an executable, 19-- this unit does not by itself cause the resulting executable to be 20-- covered by the GNU General Public License. This exception does not 21-- however invalidate any other reasons why the executable file might be 22-- covered by the GNU Public License. 23 24with System; use System; 25with Grt.C; use Grt.C; 26 27package body Grt.Table is 28 29 -- Maximum index of table before resizing. 30 Max : Table_Index_Type := Table_Index_Type'Pred (Table_Low_Bound); 31 32 -- Current value of Last 33 Last_Val : Table_Index_Type; 34 35 function Malloc (Size : size_t) return Table_Ptr; 36 pragma Import (C, Malloc); 37 38 procedure Free (T : Table_Ptr); 39 pragma Import (C, Free); 40 41 -- Resize and reallocate the table according to LAST_VAL. 42 procedure Resize is 43 function Realloc (T : Table_Ptr; Size : size_t) return Table_Ptr; 44 pragma Import (C, Realloc); 45 46 New_Size : size_t; 47 begin 48 while Max < Last_Val loop 49 Max := Max + (Max - Table_Low_Bound + 1); 50 end loop; 51 52 New_Size := size_t ((Max - Table_Low_Bound + 1) * 53 (Table_Type'Component_Size / Storage_Unit)); 54 55 Table := Realloc (Table, New_Size); 56 57 if Table = null then 58 raise Storage_Error; 59 end if; 60 end Resize; 61 62 procedure Append (New_Val : Table_Component_Type) is 63 begin 64 Increment_Last; 65 Table (Last_Val) := New_Val; 66 end Append; 67 68 procedure Decrement_Last is 69 begin 70 Last_Val := Table_Index_Type'Pred (Last_Val); 71 end Decrement_Last; 72 73 procedure Free is 74 begin 75 Free (Table); 76 Table := null; 77 end Free; 78 79 procedure Increment_Last is 80 begin 81 Last_Val := Table_Index_Type'Succ (Last_Val); 82 83 if Last_Val > Max then 84 Resize; 85 end if; 86 end Increment_Last; 87 88 function Last return Table_Index_Type is 89 begin 90 return Last_Val; 91 end Last; 92 93 procedure Release is 94 begin 95 Max := Last_Val; 96 Resize; 97 end Release; 98 99 procedure Set_Last (New_Val : Table_Index_Type) is 100 begin 101 if New_Val < Last_Val then 102 Last_Val := New_Val; 103 else 104 Last_Val := New_Val; 105 106 if Last_Val > Max then 107 Resize; 108 end if; 109 end if; 110 end Set_Last; 111 112begin 113 Last_Val := Table_Index_Type'Pred (Table_Low_Bound); 114 Max := Table_Low_Bound + Table_Index_Type (Table_Initial) - 1; 115 116 Table := Malloc (size_t (Table_Initial * 117 (Table_Type'Component_Size / Storage_Unit))); 118end Grt.Table; 119