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
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
|
/****************************************************************************
* *
* GNAT COMPILER COMPONENTS *
* *
* A D A - T R E E *
* *
* C Header File *
* *
* Copyright (C) 1992-2004 Free Software Foundation, Inc. *
* *
* GNAT 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 2, or (at your option) any later ver- *
* sion. GNAT is distributed in the hope that it will be useful, but WITH- *
* OUT 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 distributed with GNAT; see file COPYING. If not, write *
* to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, *
* MA 02111-1307, USA. *
* *
* GNAT was originally developed by the GNAT team at New York University. *
* Extensive contributions were provided by Ada Core Technologies Inc. *
* *
****************************************************************************/
/* Ada language-specific GC tree codes. */
#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) SYM,
enum gnat_tree_code {
__DUMMY = LAST_AND_UNUSED_TREE_CODE,
#include "ada-tree.def"
LAST_GNAT_TREE_CODE
};
#undef DEFTREECODE
/* Ada uses the lang_decl and lang_type fields to hold a tree. */
union lang_tree_node
GTY((desc ("0"),
chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.t)")))
{
union tree_node GTY((tag ("0"))) t;
};
struct lang_decl GTY(()) {tree t; };
struct lang_type GTY(()) {tree t; };
/* Define macros to get and set the tree in TYPE_ and DECL_LANG_SPECIFIC. */
#define GET_TYPE_LANG_SPECIFIC(NODE) \
(TYPE_LANG_SPECIFIC (NODE) ? TYPE_LANG_SPECIFIC (NODE)->t : NULL_TREE)
#define SET_TYPE_LANG_SPECIFIC(NODE, X) \
(TYPE_LANG_SPECIFIC (NODE) \
= (TYPE_LANG_SPECIFIC (NODE) \
? TYPE_LANG_SPECIFIC (NODE) : ggc_alloc (sizeof (struct lang_type)))) \
->t = X;
#define GET_DECL_LANG_SPECIFIC(NODE) \
(DECL_LANG_SPECIFIC (NODE) ? DECL_LANG_SPECIFIC (NODE)->t : NULL_TREE)
#define SET_DECL_LANG_SPECIFIC(NODE, VALUE) \
(DECL_LANG_SPECIFIC (NODE) \
= (DECL_LANG_SPECIFIC (NODE) \
? DECL_LANG_SPECIFIC (NODE) : ggc_alloc (sizeof (struct lang_decl)))) \
->t = VALUE;
/* Flags added to GCC type nodes. */
/* For RECORD_TYPE, UNION_TYPE, and QUAL_UNION_TYPE, nonzero if this is a
record being used as a fat pointer (only true for RECORD_TYPE). */
#define TYPE_IS_FAT_POINTER_P(NODE) TYPE_LANG_FLAG_0 (NODE)
#define TYPE_FAT_POINTER_P(NODE) \
(TREE_CODE (NODE) == RECORD_TYPE && TYPE_IS_FAT_POINTER_P (NODE))
/* For integral types and array types, nonzero if this is a packed array type.
Such types should not be extended to a larger size. */
#define TYPE_PACKED_ARRAY_TYPE_P(NODE) TYPE_LANG_FLAG_0 (NODE)
#define TYPE_IS_PACKED_ARRAY_TYPE_P(NODE) \
((TREE_CODE (NODE) == INTEGER_TYPE || TREE_CODE (NODE) == ARRAY_TYPE) \
&& TYPE_PACKED_ARRAY_TYPE_P (NODE))
/* For INTEGER_TYPE, nonzero if this is a modular type with a modulus that
is not equal to two to the power of its mode's size. */
#define TYPE_MODULAR_P(NODE) TYPE_LANG_FLAG_1 (INTEGER_TYPE_CHECK (NODE))
/* For ARRAY_TYPE, nonzero if this type corresponds to a dimension of
an Ada array other than the first. */
#define TYPE_MULTI_ARRAY_P(NODE) TYPE_LANG_FLAG_1 (ARRAY_TYPE_CHECK (NODE))
/* For FUNCTION_TYPE, nonzero if this denotes a function returning an
unconstrained array or record. */
#define TYPE_RETURNS_UNCONSTRAINED_P(NODE) \
TYPE_LANG_FLAG_1 (FUNCTION_TYPE_CHECK (NODE))
/* For RECORD_TYPE, UNION_TYPE, and QUAL_UNION_TYPE, nonzero if this denotes
a justified modular type (will only be true for RECORD_TYPE). */
#define TYPE_JUSTIFIED_MODULAR_P(NODE) \
TYPE_LANG_FLAG_1 (RECORD_OR_UNION_CHECK (NODE))
/* Nonzero in an arithmetic subtype if this is a subtype not known to the
front-end. */
#define TYPE_EXTRA_SUBTYPE_P(NODE) TYPE_LANG_FLAG_2 (NODE)
/* Nonzero for composite types if this is a by-reference type. */
#define TYPE_BY_REFERENCE_P(NODE) TYPE_LANG_FLAG_2 (NODE)
/* For RECORD_TYPE, UNION_TYPE, and QUAL_UNION_TYPE, nonzero if this is the
type for an object whose type includes its template in addition to
its value (only true for RECORD_TYPE). */
#define TYPE_CONTAINS_TEMPLATE_P(NODE) \
TYPE_LANG_FLAG_3 (RECORD_OR_UNION_CHECK (NODE))
/* For INTEGER_TYPE, nonzero if this really represents a VAX
floating-point type. */
#define TYPE_VAX_FLOATING_POINT_P(NODE) \
TYPE_LANG_FLAG_3 (INTEGER_TYPE_CHECK (NODE))
/* True if NODE is a thin pointer. */
#define TYPE_THIN_POINTER_P(NODE) \
(POINTER_TYPE_P (NODE) \
&& TREE_CODE (TREE_TYPE (NODE)) == RECORD_TYPE \
&& TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (NODE)))
/* True if TYPE is either a fat or thin pointer to an unconstrained
array. */
#define TYPE_FAT_OR_THIN_POINTER_P(NODE) \
(TYPE_FAT_POINTER_P (NODE) || TYPE_THIN_POINTER_P (NODE))
/* For INTEGER_TYPEs, nonzero if the type has a biased representation. */
#define TYPE_BIASED_REPRESENTATION_P(NODE) \
TYPE_LANG_FLAG_4 (INTEGER_TYPE_CHECK (NODE))
/* For ARRAY_TYPEs, nonzero if the array type has Convention_Fortran. */
#define TYPE_CONVENTION_FORTRAN_P(NODE) \
TYPE_LANG_FLAG_4 (ARRAY_TYPE_CHECK (NODE))
/* For FUNCTION_TYPEs, nonzero if the function returns by reference. */
#define TYPE_RETURNS_BY_REF_P(NODE) \
TYPE_LANG_FLAG_4 (FUNCTION_TYPE_CHECK (NODE))
/* For FUNCTION_TYPEs, nonzero if function returns by being passed a pointer
to a place to store its result. */
#define TYPE_RETURNS_BY_TARGET_PTR_P(NODE) \
TYPE_LANG_FLAG_5 (FUNCTION_TYPE_CHECK (NODE))
/* For VOID_TYPE, ENUMERAL_TYPE, UNION_TYPE, and RECORD_TYPE, nonzero if this
is a dummy type, made to correspond to a private or incomplete type. */
#define TYPE_DUMMY_P(NODE) TYPE_LANG_FLAG_4 (NODE)
/* True if TYPE is such a dummy type. */
#define TYPE_IS_DUMMY_P(NODE) \
((TREE_CODE (NODE) == VOID_TYPE || TREE_CODE (NODE) == RECORD_TYPE \
|| TREE_CODE (NODE) == UNION_TYPE || TREE_CODE (NODE) == ENUMERAL_TYPE) \
&& TYPE_DUMMY_P (NODE))
/* For an INTEGER_TYPE, nonzero if TYPE_ACTUAL_BOUNDS is present. */
#define TYPE_HAS_ACTUAL_BOUNDS_P(NODE) \
TYPE_LANG_FLAG_5 (INTEGER_TYPE_CHECK (NODE))
/* For a RECORD_TYPE, nonzero if this was made just to supply needed
padding or alignment. */
#define TYPE_IS_PADDING_P(NODE) TYPE_LANG_FLAG_5 (RECORD_TYPE_CHECK (NODE))
/* This field is only defined for FUNCTION_TYPE nodes. If the Ada
subprogram contains no parameters passed by copy in/copy out then this
field is 0. Otherwise it points to a list of nodes used to specify the
return values of the out (or in out) parameters that qualify to be passed
by copy in copy out. It is a CONSTRUCTOR. For a full description of the
cico parameter passing mechanism refer to the routine gnat_to_gnu_entity. */
#define TYPE_CI_CO_LIST(NODE) TYPE_LANG_SLOT_1 (FUNCTION_TYPE_CHECK (NODE))
/* For an INTEGER_TYPE with TYPE_MODULAR_P, this is the value of the
modulus. */
#define TYPE_MODULUS(NODE) GET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))
#define SET_TYPE_MODULUS(NODE, X) \
SET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE), X)
/* For an INTEGER_TYPE that is the TYPE_DOMAIN of some ARRAY_TYPE, points to
the type corresponding to the Ada index type. */
#define TYPE_INDEX_TYPE(NODE) \
GET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))
#define SET_TYPE_INDEX_TYPE(NODE, X) \
SET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE), X)
/* For an INTEGER_TYPE with TYPE_VAX_FLOATING_POINT_P, stores the
Digits_Value. */
#define TYPE_DIGITS_VALUE(NODE) \
GET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE))
#define SET_TYPE_DIGITS_VALUE(NODE, X) \
SET_TYPE_LANG_SPECIFIC (INTEGER_TYPE_CHECK (NODE), X)
/* For numeric types, stores the RM_Size of the type. */
#define TYPE_RM_SIZE_NUM(NODE) TYPE_LANG_SLOT_1 (NUMERICAL_TYPE_CHECK (NODE))
#define TYPE_RM_SIZE(NODE) \
(INTEGRAL_TYPE_P (NODE) || TREE_CODE (NODE) == REAL_TYPE \
? TYPE_RM_SIZE_NUM (NODE) : 0)
/* For a RECORD_TYPE that is a fat pointer, point to the type for the
unconstrained object. Likewise for a RECORD_TYPE that is pointed
to by a thin pointer. */
#define TYPE_UNCONSTRAINED_ARRAY(NODE) \
GET_TYPE_LANG_SPECIFIC (RECORD_TYPE_CHECK (NODE))
#define SET_TYPE_UNCONSTRAINED_ARRAY(NODE, X) \
SET_TYPE_LANG_SPECIFIC (RECORD_TYPE_CHECK (NODE), X)
/* For other RECORD_TYPEs and all UNION_TYPEs and QUAL_UNION_TYPEs, the Ada
size of the object. This differs from the GCC size in that it does not
include any rounding up to the alignment of the type. */
#define TYPE_ADA_SIZE(NODE) \
GET_TYPE_LANG_SPECIFIC (RECORD_OR_UNION_CHECK (NODE))
#define SET_TYPE_ADA_SIZE(NODE, X) \
SET_TYPE_LANG_SPECIFIC (RECORD_OR_UNION_CHECK (NODE), X)
/* For an INTEGER_TYPE with TYPE_HAS_ACTUAL_BOUNDS_P or an ARRAY_TYPE, this is
the index type that should be used when the actual bounds are required for
a template. This is used in the case of packed arrays. */
#define TYPE_ACTUAL_BOUNDS(NODE) \
GET_TYPE_LANG_SPECIFIC (TREE_CHECK2 (NODE, INTEGER_TYPE, ARRAY_TYPE))
#define SET_TYPE_ACTUAL_BOUNDS(NODE, X) \
SET_TYPE_LANG_SPECIFIC (TREE_CHECK2 (NODE, INTEGER_TYPE, ARRAY_TYPE), X)
/* In an UNCONSTRAINED_ARRAY_TYPE, points to the record containing both
the template and object.
??? We also put this on an ENUMERAL_TYPE that's dummy. Technically,
this is a conflict on the minval field, but there doesn't seem to be
simple fix, so we'll live with this kludge for now. */
#define TYPE_OBJECT_RECORD_TYPE(NODE) \
(TREE_CHECK2 ((NODE), UNCONSTRAINED_ARRAY_TYPE, ENUMERAL_TYPE)->type.minval)
/* Nonzero in a FUNCTION_DECL that represents a stubbed function
discriminant. */
#define DECL_STUBBED_P(NODE) DECL_LANG_FLAG_0 (FUNCTION_DECL_CHECK (NODE))
/* Nonzero if this decl is always used by reference; i.e., an INDIRECT_REF
is needed to access the object. */
#define DECL_BY_REF_P(NODE) DECL_LANG_FLAG_1 (NODE)
/* Nonzero if this decl is a PARM_DECL for an Ada array being passed to a
foreign convention subprogram. */
#define DECL_BY_COMPONENT_PTR_P(NODE) DECL_LANG_FLAG_2 (PARM_DECL_CHECK (NODE))
/* Nonzero in a FIELD_DECL that is a dummy built for some internal reason. */
#define DECL_INTERNAL_P(NODE) DECL_LANG_FLAG_3 (FIELD_DECL_CHECK (NODE))
/* Nonzero in a FUNCTION_DECL that corresponds to an elaboration procedure. */
#define DECL_ELABORATION_PROC_P(NODE) \
DECL_LANG_FLAG_3 (FUNCTION_DECL_CHECK (NODE))
/* Nonzero if this is a decl for a pointer that points to something which
is readonly. Used mostly for fat pointers. */
#define DECL_POINTS_TO_READONLY_P(NODE) DECL_LANG_FLAG_4 (NODE)
/* Nonzero in a FIELD_DECL if there was a record rep clause. */
#define DECL_HAS_REP_P(NODE) DECL_LANG_FLAG_5 (FIELD_DECL_CHECK (NODE))
/* Nonzero in a PARM_DECL if we are to pass by descriptor. */
#define DECL_BY_DESCRIPTOR_P(NODE) DECL_LANG_FLAG_5 (PARM_DECL_CHECK (NODE))
/* In a CONST_DECL, points to a VAR_DECL that is allocatable to
memory. Used when a scalar constant is aliased or has its
address taken. */
#define DECL_CONST_CORRESPONDING_VAR(NODE) \
GET_DECL_LANG_SPECIFIC (CONST_DECL_CHECK (NODE))
#define SET_DECL_CONST_CORRESPONDING_VAR(NODE, X) \
SET_DECL_LANG_SPECIFIC (CONST_DECL_CHECK (NODE), X)
/* In a FIELD_DECL, points to the FIELD_DECL that was the ultimate
source of the decl. */
#define DECL_ORIGINAL_FIELD(NODE) \
GET_DECL_LANG_SPECIFIC (FIELD_DECL_CHECK (NODE))
#define SET_DECL_ORIGINAL_FIELD(NODE, X) \
SET_DECL_LANG_SPECIFIC (FIELD_DECL_CHECK (NODE), X)
/* In a FIELD_DECL corresponding to a discriminant, contains the
discriminant number. */
#define DECL_DISCRIMINANT_NUMBER(NODE) DECL_INITIAL (FIELD_DECL_CHECK (NODE))
/* Define fields and macros for statements.
Start by defining which tree codes are used for statements. */
#define IS_STMT(NODE) (STATEMENT_CLASS_P (NODE))
#define IS_ADA_STMT(NODE) (IS_STMT (NODE) \
&& TREE_CODE (NODE) >= STMT_STMT)
#define STMT_STMT_STMT(NODE) TREE_OPERAND_CHECK_CODE (NODE, STMT_STMT, 0)
#define LOOP_STMT_TOP_COND(NODE) TREE_OPERAND_CHECK_CODE (NODE, LOOP_STMT, 0)
#define LOOP_STMT_BOT_COND(NODE) TREE_OPERAND_CHECK_CODE (NODE, LOOP_STMT, 1)
#define LOOP_STMT_UPDATE(NODE) TREE_OPERAND_CHECK_CODE (NODE, LOOP_STMT, 2)
#define LOOP_STMT_BODY(NODE) TREE_OPERAND_CHECK_CODE (NODE, LOOP_STMT, 3)
#define LOOP_STMT_LABEL(NODE) TREE_OPERAND_CHECK_CODE (NODE, LOOP_STMT, 4)
#define EXIT_STMT_COND(NODE) TREE_OPERAND_CHECK_CODE (NODE, EXIT_STMT, 0)
#define EXIT_STMT_LABEL(NODE) TREE_OPERAND_CHECK_CODE (NODE, EXIT_STMT, 1)
#define REGION_STMT_BODY(NODE) TREE_OPERAND_CHECK_CODE (NODE, REGION_STMT, 0)
#define REGION_STMT_HANDLE(NODE) TREE_OPERAND_CHECK_CODE (NODE, REGION_STMT, 1)
#define REGION_STMT_BLOCK(NODE) TREE_OPERAND_CHECK_CODE (NODE, REGION_STMT, 2)
#define HANDLER_STMT_ARG(NODE) TREE_OPERAND_CHECK_CODE (NODE, HANDLER_STMT, 0)
#define HANDLER_STMT_LIST(NODE) TREE_OPERAND_CHECK_CODE (NODE, HANDLER_STMT, 1)
#define HANDLER_STMT_BLOCK(NODE) TREE_OPERAND_CHECK_CODE(NODE, HANDLER_STMT, 2)
|
