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