1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- G N A T . T A B L E --
9 -- Copyright (C) 1998-2017, AdaCore --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 -- This package provides a singleton version of GNAT.Dynamic_Tables
33 -- (g-dyntab.ads). See that package for documentation. This package just
34 -- declares a single instance of GNAT.Dynamic_Tables.Instance, and provides
35 -- wrappers for all the subprograms, passing that single instance.
37 -- Note that these three interfaces should remain synchronized to keep as much
38 -- coherency as possible among these related units:
40 -- GNAT.Dynamic_Tables
42 -- Table (the compiler unit)
44 pragma Compiler_Unit_Warning
;
46 with GNAT
.Dynamic_Tables
;
49 type Table_Component_Type
is private;
50 type Table_Index_Type
is range <>;
52 Table_Low_Bound
: Table_Index_Type
:= Table_Index_Type
'First;
53 Table_Initial
: Positive := 8;
54 Table_Increment
: Natural := 100;
55 Table_Name
: String := ""; -- for debugging printouts
56 pragma Unreferenced
(Table_Name
);
57 Release_Threshold
: Natural := 0;
60 pragma Elaborate_Body
;
62 package Tab
is new GNAT
.Dynamic_Tables
63 (Table_Component_Type
,
70 subtype Valid_Table_Index_Type
is Tab
.Valid_Table_Index_Type
;
71 subtype Table_Last_Type
is Tab
.Table_Last_Type
;
72 subtype Table_Type
is Tab
.Table_Type
;
73 function "=" (X
, Y
: Table_Type
) return Boolean renames Tab
."=";
75 subtype Table_Ptr
is Tab
.Table_Ptr
;
77 The_Instance
: Tab
.Instance
;
78 Table
: Table_Ptr
renames The_Instance
.Table
;
79 Locked
: Boolean renames The_Instance
.Locked
;
81 function Is_Empty
return Boolean;
88 function First
return Table_Index_Type
;
89 pragma Inline
(First
);
91 function Last
return Table_Last_Type
;
95 pragma Inline
(Release
);
97 procedure Set_Last
(New_Val
: Table_Last_Type
);
98 pragma Inline
(Set_Last
);
100 procedure Increment_Last
;
101 pragma Inline
(Increment_Last
);
103 procedure Decrement_Last
;
104 pragma Inline
(Decrement_Last
);
106 procedure Append
(New_Val
: Table_Component_Type
);
107 pragma Inline
(Append
);
109 procedure Append_All
(New_Vals
: Table_Type
);
110 pragma Inline
(Append_All
);
113 (Index
: Valid_Table_Index_Type
;
114 Item
: Table_Component_Type
);
115 pragma Inline
(Set_Item
);
117 subtype Saved_Table
is Tab
.Instance
;
118 -- Type used for Save/Restore subprograms
120 function Save
return Saved_Table
;
121 pragma Inline
(Save
);
122 -- Resets table to empty, but saves old contents of table in returned
123 -- value, for possible later restoration by a call to Restore.
125 procedure Restore
(T
: in out Saved_Table
);
126 pragma Inline
(Restore
);
127 -- Given a Saved_Table value returned by a prior call to Save, restores
128 -- the table to the state it was in at the time of the Save call.
130 procedure Allocate
(Num
: Integer := 1);
131 function Allocate
(Num
: Integer := 1) return Valid_Table_Index_Type
;
132 pragma Inline
(Allocate
);
133 -- Adds Num to Last. The function version also returns the old value of
134 -- Last + 1. Note that this function has the possible side effect of
135 -- reallocating the table. This means that a reference X.Table (X.Allocate)
136 -- is incorrect, since the call to X.Allocate may modify the results of
140 with procedure Action
141 (Index
: Valid_Table_Index_Type
;
142 Item
: Table_Component_Type
;
143 Quit
: in out Boolean) is <>;
145 pragma Inline
(For_Each
);
148 with function Lt
(Comp1
, Comp2
: Table_Component_Type
) return Boolean;
149 procedure Sort_Table
;
150 pragma Inline
(Sort_Table
);