1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
|
------------------------------------------------------------------------------
-- --
-- POLYORB COMPONENTS --
-- --
-- T Y P E S --
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2012, Free Software Foundation, Inc. --
-- --
-- This is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. This software is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
-- TABILITY 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 and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- PolyORB is maintained by AdaCore --
-- (email: sales@adacore.com) --
-- --
------------------------------------------------------------------------------
with Unchecked_Deallocation;
package Types is
pragma Preelaborate (Types);
-- This package contains host independent type definitions which are used
-- in more than one unit in the compiler. They are gathered here for easy
-- reference, though in some cases the full description is found in the
-- relevant module which implements the definition. The main reason that
-- they are not in their "natural" specs is that this would cause a lot of
-- inter-spec dependencies, and in particular some awkward circular
-- dependencies would have to be dealt with.
-------------------------------
-- General Use Integer Types --
-------------------------------
type Int is range -2 ** 31 .. +2 ** 31 - 1;
-- Signed 32-bit integer
type Dint is range -2 ** 63 .. +2 ** 63 - 1;
-- Double length (64-bit) integer
subtype Nat is Int range 0 .. Int'Last;
-- Non-negative Int values
subtype Dnat is Dint range 0 .. Dint'Last;
subtype Pos is Int range 1 .. Int'Last;
-- Positive Int values
type Word is mod 2 ** 32;
-- Unsigned 32-bit integer
type Byte is mod 2 ** 8;
for Byte'Size use 8;
-- 8-bit unsigned integer
type size_t is mod 2 ** Standard'Address_Size;
-- Memory size value, for use in calls to C routines
--------------------------------------
-- 8-Bit Character and String Types --
--------------------------------------
-- We use Standard.Character and Standard.String freely, since we are
-- compiling ourselves, and we properly implement the required 8-bit
-- character code as required in Ada 95. This section defines a few
-- general use constants and subtypes.
EOF : constant Character := ASCII.SUB;
-- The character SUB (16#1A#) is used in DOS and other systems derived
-- from DOS (OS/2, NT etc) to signal the end of a text file. Internally
-- all source files are ended by an EOF character, even on Unix systems.
-- An EOF character acts as the end of file only as the last character
-- of a source buffer, in any other position, it is treated as a blank
-- if it appears between tokens, and as an illegal character otherwise.
-- This makes life easier dealing with files that originated from DOS,
-- including concatenated files with interspersed EOF characters.
subtype Graphic_Character is Character range ' ' .. '~';
-- Graphic characters, as defined in ARM
subtype Line_Terminator is Character range ASCII.LF .. ASCII.CR;
-- Line terminator characters (LF, VT, FF, CR)
subtype Upper_Half_Character is
Character range Character'Val (16#80#) .. Character'Val (16#FF#);
-- Characters with the upper bit set
type Character_Ptr is access all Character;
type String_Ptr is access all String;
-- Standard character and string pointers
procedure Free is new Unchecked_Deallocation (String, String_Ptr);
-- Procedure for freeing dynamically allocated String values
-----------------------------------------
-- Types Used for Text Buffer Handling --
-----------------------------------------
-- We can't use type String for text buffers, since we must use the
-- standard 32-bit integer as an index value, since we count on all
-- index values being the same size.
type Text_Ptr is new Int;
-- Type used for subscripts in text buffer
type Text_Buffer is array (Text_Ptr range <>) of Character;
-- Text buffer used to hold source file or library information file
type Text_Buffer_Ptr is access all Text_Buffer;
-- Text buffers for input files are allocated dynamically and this type
-- is used to reference these text buffers.
procedure Free is new Unchecked_Deallocation (Text_Buffer, Text_Buffer_Ptr);
-- Procedure for freeing dynamically allocated text buffers
------------------------------------------
-- Types Used for Source Input Handling --
------------------------------------------
type Logical_Line_Number is range 0 .. Int'Last;
for Logical_Line_Number'Size use 32;
-- Line number type, used for storing logical line numbers (i.e. line
-- numbers that include effects of any Source_Reference pragmas in the
-- source file). The value zero indicates a line containing a source
-- reference pragma.
No_Line_Number : constant Logical_Line_Number := 0;
-- Special value used to indicate no line number
type Physical_Line_Number is range 1 .. Int'Last;
for Physical_Line_Number'Size use 32;
-- Line number type, used for storing physical line numbers (i.e.
-- line numbers in the physical file being compiled, unaffected by
-- the presence of source reference pragmas.
type Column_Number is range 0 .. 32767;
for Column_Number'Size use 16;
-- Column number (assume that 2**15 is large enough, see declaration
-- of Hostparm.Max_Line_Length)
No_Column_Number : constant Column_Number := 0;
-- Special value used to indicate no column number
-----------------------------
-- Types for Namet Package --
-----------------------------
-- Name_Id values are used to identify entries in the names table. Except
-- for the special value No_Name, they are subscript values for the Names
-- table defined in package Namet.
-- Note that with only a few exceptions, which are clearly documented, the
-- type Name_Id should be regarded as a private type. In particular it is
-- never appropriate to perform arithmetic operations using this type.
Names_Low_Bound : constant := 300_000_000;
-- Low bound for name Id values
Names_High_Bound : constant := 399_999_999;
-- Maximum number of names that can be allocated is 100 million, which is
-- in practice infinite and there is no need to check the range.
type Name_Id is range Names_Low_Bound .. Names_High_Bound;
for Name_Id'Size use 32;
-- Type used to identify entries in the names table
No_Name : constant Name_Id := Names_Low_Bound;
-- The special Name_Id value No_Name is used in the parser to indicate
-- a situation where no name is present (e.g. on a loop or block).
First_Name_Id : constant Name_Id := Names_Low_Bound + 2;
-- Subscript of first entry in names table
type Node_Id is new Int;
No_Node : constant Node_Id := 0;
function Present (E : Node_Id) return Boolean;
-- Return true when E is not No_Node
function No (E : Node_Id) return Boolean;
-- Return true when E is No_Node
procedure Dummy (E : Node_Id);
type List_Id is new Node_Id;
No_List : constant List_Id := 0;
type Operator_Id is new Byte;
type Value_Id is new Int;
Mode_In : constant := 0;
Mode_Inout : constant := 1;
Mode_Out : constant := 2;
type Mode_Id is new Byte range Mode_In .. Mode_Out;
type Base_Type is new Node_Id;
type Short_Short is range -2 ** 7 .. 2 ** 7 - 1;
for Short_Short'Size use 8;
type Short is range -2 ** 15 .. 2 ** 15 - 1;
for Short'Size use 16;
type Long is range -2 ** 31 .. 2 ** 31 - 1;
for Long'Size use 32;
type Long_Long is range -2 ** 63 .. 2 ** 63 - 1;
for Long_Long'Size use 64;
type Octet is mod 2 ** 8;
for Octet'Size use 8;
type Unsigned_Short_Short is mod 2 ** 8;
for Unsigned_Short_Short'Size use 8;
type Unsigned_Short is mod 2 ** 16;
for Unsigned_Short'Size use 16;
type Unsigned_Long is mod 2 ** 32;
for Unsigned_Long'Size use 32;
type Unsigned_Long_Long is mod 2 ** 64;
for Unsigned_Long_Long'Size use 64;
-- Floating point types. We assume that we are on an IEEE machine, and
-- that the types Short_Float and Long_Float in Standard refer to the
-- 32-bit short and 64-bit long IEEE forms. Furthermore, if there is
-- an extended float, we assume that it is available as Long_Long_Float.
-- Note: it is harmless, and explicitly permitted, to include additional
-- types in interfaces, so it is not wrong to have IEEE_Extended_Float
-- defined even if the extended format is not available.
pragma Warnings (Off); -- redefinition of entity in Standard
type Float is new Short_Float;
pragma Warnings (On);
type Double is new Long_Float;
type Long_Double is new Long_Long_Float;
FSS : constant := Short_Short'First;
LSS : constant := Short_Short'Last;
FS : constant := Short'First;
LS : constant := Short'Last;
FL : constant := Long'First;
LL : constant := Long'Last;
FLL : constant := Long_Long'First;
LLL : constant := Long_Long'Last;
FO : constant := Octet'First;
LO : constant := Octet'Last;
FUSS : constant := Unsigned_Short_Short'First;
LUSS : constant := Unsigned_Short_Short'Last;
FUS : constant := Unsigned_Short'First;
LUS : constant := Unsigned_Short'Last;
FUL : constant := Unsigned_Long'First;
LUL : constant := Unsigned_Long'Last;
FULL : constant := Unsigned_Long_Long'First;
LULL : constant := Unsigned_Long_Long'Last;
function Shift_Left
(Value : Unsigned_Long_Long;
Amount : Natural)
return Unsigned_Long_Long;
function Shift_Right
(Value : Unsigned_Long_Long;
Amount : Natural)
return Unsigned_Long_Long;
pragma Import (Intrinsic, Shift_Left);
pragma Import (Intrinsic, Shift_Right);
end Types;
|
