Branch data Line data Source code
1 : : /* m2type.cc provides an interface to GCC type trees.
2 : :
3 : : Copyright (C) 2012-2025 Free Software Foundation, Inc.
4 : : Contributed by Gaius Mulley <gaius@glam.ac.uk>.
5 : :
6 : : This file is part of GNU Modula-2.
7 : :
8 : : GNU Modula-2 is free software; you can redistribute it and/or modify
9 : : it under the terms of the GNU General Public License as published by
10 : : the Free Software Foundation; either version 3, or (at your option)
11 : : any later version.
12 : :
13 : : GNU Modula-2 is distributed in the hope that it will be useful, but
14 : : WITHOUT ANY WARRANTY; without even the implied warranty of
15 : : MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 : : General Public License for more details.
17 : :
18 : : You should have received a copy of the GNU General Public License
19 : : along with GNU Modula-2; see the file COPYING3. If not see
20 : : <http://www.gnu.org/licenses/>. */
21 : :
22 : : #include "gcc-consolidation.h"
23 : :
24 : : #include "../gm2-lang.h"
25 : : #include "../m2-tree.h"
26 : :
27 : : #define m2type_c
28 : : #include "m2assert.h"
29 : : #include "m2block.h"
30 : : #include "m2builtins.h"
31 : : #include "m2convert.h"
32 : : #include "m2decl.h"
33 : : #include "m2except.h"
34 : : #include "m2expr.h"
35 : : #include "m2linemap.h"
36 : : #include "m2tree.h"
37 : : #include "m2treelib.h"
38 : : #include "m2type.h"
39 : : #include "m2options.h"
40 : : #include "m2configure.h"
41 : :
42 : : #define USE_BOOLEAN
43 : : static int broken_set_debugging_info = true;
44 : :
45 : :
46 : : struct GTY (()) struct_constructor
47 : : {
48 : : /* Constructor_type, the type that we are constructing. */
49 : : tree GTY ((skip (""))) constructor_type;
50 : : /* Constructor_fields, the list of fields belonging to
51 : : constructor_type. Used by SET and RECORD constructors. */
52 : : tree GTY ((skip (""))) constructor_fields;
53 : : /* Constructor_element_list, the list of constants used by SET and
54 : : RECORD constructors. */
55 : : tree GTY ((skip (""))) constructor_element_list;
56 : : /* Constructor_elements, used by an ARRAY initializer all elements
57 : : are held in reverse order. */
58 : : vec<constructor_elt, va_gc> *constructor_elements;
59 : : /* Level, the next level down in the constructor stack. */
60 : : struct struct_constructor *level;
61 : : };
62 : :
63 : : static GTY (()) struct struct_constructor *top_constructor = NULL;
64 : :
65 : : typedef struct GTY (()) array_desc
66 : : {
67 : : int type;
68 : : tree index;
69 : : tree array;
70 : : struct array_desc *next;
71 : : } array_desc;
72 : :
73 : : static GTY (()) array_desc *list_of_arrays = NULL;
74 : : /* Used in BuildStartFunctionType. */
75 : : static GTY (()) tree param_type_list;
76 : :
77 : : static GTY (()) tree proc_type_node;
78 : : static GTY (()) tree bitset_type_node;
79 : : static GTY (()) tree bitnum_type_node;
80 : : static GTY (()) tree m2_char_type_node;
81 : : static GTY (()) tree m2_integer_type_node;
82 : : static GTY (()) tree m2_cardinal_type_node;
83 : : static GTY (()) tree m2_short_real_type_node;
84 : : static GTY (()) tree m2_real_type_node;
85 : : static GTY (()) tree m2_long_real_type_node;
86 : : static GTY (()) tree m2_long_int_type_node;
87 : : static GTY (()) tree m2_long_card_type_node;
88 : : static GTY (()) tree m2_short_int_type_node;
89 : : static GTY (()) tree m2_short_card_type_node;
90 : : static GTY (()) tree m2_z_type_node;
91 : : static GTY (()) tree m2_iso_loc_type_node;
92 : : static GTY (()) tree m2_iso_byte_type_node;
93 : : static GTY (()) tree m2_iso_word_type_node;
94 : : static GTY (()) tree m2_integer8_type_node;
95 : : static GTY (()) tree m2_integer16_type_node;
96 : : static GTY (()) tree m2_integer32_type_node;
97 : : static GTY (()) tree m2_integer64_type_node;
98 : : static GTY (()) tree m2_cardinal8_type_node;
99 : : static GTY (()) tree m2_cardinal16_type_node;
100 : : static GTY (()) tree m2_cardinal32_type_node;
101 : : static GTY (()) tree m2_cardinal64_type_node;
102 : : static GTY (()) tree m2_word16_type_node;
103 : : static GTY (()) tree m2_word32_type_node;
104 : : static GTY (()) tree m2_word64_type_node;
105 : : static GTY (()) tree m2_bitset8_type_node;
106 : : static GTY (()) tree m2_bitset16_type_node;
107 : : static GTY (()) tree m2_bitset32_type_node;
108 : : static GTY (()) tree m2_real32_type_node;
109 : : static GTY (()) tree m2_real64_type_node;
110 : : static GTY (()) tree m2_real96_type_node;
111 : : static GTY (()) tree m2_real128_type_node;
112 : : static GTY (()) tree m2_complex_type_node;
113 : : static GTY (()) tree m2_long_complex_type_node;
114 : : static GTY (()) tree m2_short_complex_type_node;
115 : : static GTY (()) tree m2_c_type_node;
116 : : static GTY (()) tree m2_complex32_type_node;
117 : : static GTY (()) tree m2_complex64_type_node;
118 : : static GTY (()) tree m2_complex96_type_node;
119 : : static GTY (()) tree m2_complex128_type_node;
120 : : static GTY (()) tree m2_packed_boolean_type_node;
121 : : static GTY (()) tree m2_cardinal_address_type_node;
122 : : static GTY (()) tree m2_offt_type_node;
123 : :
124 : : /* gm2_canonicalize_array - returns a unique array node based on
125 : : index_type and type. */
126 : :
127 : : static tree
128 : 178948 : gm2_canonicalize_array (tree index_type, int type)
129 : : {
130 : 178948 : array_desc *l = list_of_arrays;
131 : :
132 : 419873 : while (l != NULL)
133 : : {
134 : 347398 : if (l->type == type && l->index == index_type)
135 : 106473 : return l->array;
136 : : else
137 : 240925 : l = l->next;
138 : : }
139 : 72475 : l = ggc_alloc<array_desc> ();
140 : 72475 : l->next = list_of_arrays;
141 : 72475 : l->type = type;
142 : 72475 : l->index = index_type;
143 : 72475 : l->array = make_node (ARRAY_TYPE);
144 : 72475 : TREE_TYPE (l->array) = NULL_TREE;
145 : 72475 : TYPE_DOMAIN (l->array) = index_type;
146 : 72475 : list_of_arrays = l;
147 : 72475 : return l->array;
148 : : }
149 : :
150 : : /* BuildStartArrayType - creates an array with an indextype and
151 : : elttype. The front end symbol type is also passed to allow the
152 : : gccgm2 to return the canonical edition of the array type even if
153 : : the GCC elttype is NULL_TREE. */
154 : :
155 : : tree
156 : 89904 : m2type_BuildStartArrayType (tree index_type, tree elt_type, int type)
157 : : {
158 : 89904 : tree t;
159 : :
160 : 89904 : elt_type = m2tree_skip_type_decl (elt_type);
161 : 89904 : ASSERT_CONDITION (index_type != NULL_TREE);
162 : 89904 : if (elt_type == NULL_TREE)
163 : : {
164 : : /* Cannot use GCC canonicalization routines yet, so we use our front
165 : : end version based on the front end type. */
166 : 7765 : return gm2_canonicalize_array (index_type, type);
167 : : }
168 : 82139 : t = gm2_canonicalize_array (index_type, type);
169 : 82139 : if (TREE_TYPE (t) == NULL_TREE)
170 : 65582 : TREE_TYPE (t) = elt_type;
171 : : else
172 : 16557 : ASSERT_CONDITION (TREE_TYPE (t) == elt_type);
173 : :
174 : : return t;
175 : : }
176 : :
177 : : /* PutArrayType assignes TREE_TYPE (array) to the skipped type. */
178 : :
179 : : void
180 : 7723 : m2type_PutArrayType (tree array, tree type)
181 : : {
182 : 7723 : TREE_TYPE (array) = m2tree_skip_type_decl (type);
183 : 7723 : }
184 : :
185 : : /* gccgm2_GetArrayNoOfElements returns the number of elements in
186 : : arraytype. */
187 : :
188 : : tree
189 : 964 : m2type_GetArrayNoOfElements (location_t location, tree arraytype)
190 : : {
191 : 964 : tree index_type = TYPE_DOMAIN (m2tree_skip_type_decl (arraytype));
192 : 964 : tree min = TYPE_MIN_VALUE (index_type);
193 : 964 : tree max = TYPE_MAX_VALUE (index_type);
194 : :
195 : 964 : m2assert_AssertLocation (location);
196 : 964 : return m2expr_FoldAndStrip (m2expr_BuildSub (location, max, min, false));
197 : : }
198 : :
199 : : /* gm2_finish_build_array_type complete building the partially
200 : : created array type, arrayType. The arrayType is now known to be
201 : : declared as: ARRAY index_type OF elt_type. There will only ever
202 : : be one gcc tree type for this array definition. The third
203 : : parameter type is a front end type and this is necessary so that
204 : : the canonicalization creates unique array types for each type. */
205 : :
206 : : static tree
207 : 89044 : gm2_finish_build_array_type (tree arrayType, tree elt_type, tree index_type,
208 : : int type)
209 : : {
210 : 89044 : tree old = arrayType;
211 : :
212 : 89044 : elt_type = m2tree_skip_type_decl (elt_type);
213 : 89044 : ASSERT_CONDITION (index_type != NULL_TREE);
214 : 89044 : if (TREE_CODE (elt_type) == FUNCTION_TYPE)
215 : : {
216 : 0 : error ("arrays of functions are not meaningful");
217 : 0 : elt_type = integer_type_node;
218 : : }
219 : :
220 : 89044 : TREE_TYPE (arrayType) = elt_type;
221 : 89044 : TYPE_DOMAIN (arrayType) = index_type;
222 : :
223 : 89044 : arrayType = gm2_canonicalize_array (index_type, type);
224 : 89044 : if (arrayType != old)
225 : 0 : internal_error ("array declaration canonicalization has failed");
226 : :
227 : 89044 : if (!COMPLETE_TYPE_P (arrayType))
228 : 72475 : layout_type (arrayType);
229 : 89044 : return arrayType;
230 : : }
231 : :
232 : : /* BuildEndArrayType returns a type which is an array indexed by
233 : : IndexType and which has ElementType elements. */
234 : :
235 : : tree
236 : 89044 : m2type_BuildEndArrayType (tree arraytype, tree elementtype, tree indextype,
237 : : int type)
238 : : {
239 : 89044 : elementtype = m2tree_skip_type_decl (elementtype);
240 : 89044 : ASSERT (indextype == TYPE_DOMAIN (arraytype), indextype);
241 : :
242 : 89044 : if (TREE_CODE (elementtype) == FUNCTION_TYPE)
243 : 0 : return gm2_finish_build_array_type (arraytype, ptr_type_node, indextype,
244 : 0 : type);
245 : : else
246 : 89044 : return gm2_finish_build_array_type (
247 : 89044 : arraytype, m2tree_skip_type_decl (elementtype), indextype, type);
248 : : }
249 : :
250 : : /* gm2_build_array_type returns a type which is an array indexed by
251 : : IndexType and which has ElementType elements. */
252 : :
253 : : static tree
254 : 63540 : gm2_build_array_type (tree elementtype, tree indextype, int fetype)
255 : : {
256 : 63540 : tree arrayType = m2type_BuildStartArrayType (indextype, elementtype, fetype);
257 : 63540 : return m2type_BuildEndArrayType (arrayType, elementtype, indextype, fetype);
258 : : }
259 : :
260 : : /* ValueInTypeRange returns true if the constant, value, lies within
261 : : the range of type. */
262 : :
263 : : bool
264 : 66538 : m2type_ValueInTypeRange (tree type, tree value)
265 : : {
266 : 66538 : tree low_type = m2tree_skip_type_decl (type);
267 : 66538 : tree min_value = TYPE_MIN_VALUE (low_type);
268 : 66538 : tree max_value = TYPE_MAX_VALUE (low_type);
269 : :
270 : 66538 : value = m2expr_FoldAndStrip (value);
271 : 66538 : return ((tree_int_cst_compare (min_value, value) <= 0)
272 : 66538 : && (tree_int_cst_compare (value, max_value) <= 0));
273 : : }
274 : :
275 : : /* ValueOutOfTypeRange returns true if the constant, value, exceeds
276 : : the range of type. */
277 : :
278 : : bool
279 : 66538 : m2type_ValueOutOfTypeRange (tree type, tree value)
280 : : {
281 : 66538 : return (!m2type_ValueInTypeRange (type, value));
282 : : }
283 : :
284 : : /* ExceedsTypeRange return true if low or high exceed the range of
285 : : type. */
286 : :
287 : : bool
288 : 33269 : m2type_ExceedsTypeRange (tree type, tree low, tree high)
289 : : {
290 : 33269 : return (m2type_ValueOutOfTypeRange (type, low)
291 : 33269 : || m2type_ValueOutOfTypeRange (type, high));
292 : : }
293 : :
294 : : /* WithinTypeRange return true if low and high are within the range
295 : : of type. */
296 : :
297 : : bool
298 : 0 : m2type_WithinTypeRange (tree type, tree low, tree high)
299 : : {
300 : 0 : return (m2type_ValueInTypeRange (type, low)
301 : 0 : && m2type_ValueInTypeRange (type, high));
302 : : }
303 : :
304 : : /* BuildArrayIndexType creates an integer index which accesses an
305 : : array. low and high are the min, max elements of the array. GCC
306 : : insists we access an array with an integer indice. */
307 : :
308 : : tree
309 : 96809 : m2type_BuildArrayIndexType (tree low, tree high)
310 : : {
311 : 96809 : tree sizelow = convert (m2type_GetIntegerType (), m2expr_FoldAndStrip (low));
312 : 96809 : tree sizehigh
313 : 96809 : = convert (m2type_GetIntegerType (), m2expr_FoldAndStrip (high));
314 : :
315 : 96809 : if (m2expr_TreeOverflow (sizelow))
316 : 0 : error ("low bound for the array is outside the ztype limits");
317 : 96809 : if (m2expr_TreeOverflow (sizehigh))
318 : 0 : error ("high bound for the array is outside the ztype limits");
319 : :
320 : 96809 : return build_range_type (m2type_GetIntegerType (),
321 : : m2expr_FoldAndStrip (sizelow),
322 : 96809 : m2expr_FoldAndStrip (sizehigh));
323 : : }
324 : :
325 : : /* build_m2_type_node_by_array builds a ISO Modula-2 word type from
326 : : ARRAY [low..high] OF arrayType. This matches the front end data
327 : : type fetype which is only used during canonicalization. */
328 : :
329 : : static tree
330 : 47655 : build_m2_type_node_by_array (tree arrayType, tree low, tree high, int fetype)
331 : : {
332 : 47655 : return gm2_build_array_type (arrayType,
333 : 47655 : m2type_BuildArrayIndexType (low, high), fetype);
334 : : }
335 : :
336 : : /* build_m2_word16_type_node build an ISO 16 bit word as an ARRAY
337 : : [0..1] OF loc. */
338 : :
339 : : static tree
340 : 15885 : build_m2_word16_type_node (location_t location, int loc)
341 : : {
342 : 15885 : return build_m2_type_node_by_array (m2type_GetISOLocType (),
343 : : m2expr_GetIntegerZero (location),
344 : 15885 : m2expr_GetIntegerOne (location), loc);
345 : : }
346 : :
347 : : /* build_m2_word32_type_node build an ISO 32 bit word as an ARRAY
348 : : [0..3] OF loc. */
349 : :
350 : : static tree
351 : 15885 : build_m2_word32_type_node (location_t location, int loc)
352 : : {
353 : 15885 : return build_m2_type_node_by_array (m2type_GetISOLocType (),
354 : : m2expr_GetIntegerZero (location),
355 : 15885 : m2decl_BuildIntegerConstant (3), loc);
356 : : }
357 : :
358 : : /* build_m2_word64_type_node build an ISO 32 bit word as an ARRAY
359 : : [0..7] OF loc. */
360 : :
361 : : static tree
362 : 15885 : build_m2_word64_type_node (location_t location, int loc)
363 : : {
364 : 15885 : return build_m2_type_node_by_array (m2type_GetISOLocType (),
365 : : m2expr_GetIntegerZero (location),
366 : 15885 : m2decl_BuildIntegerConstant (7), loc);
367 : : }
368 : :
369 : :
370 : : /* GetM2Complex32 return the fixed size complex type. */
371 : :
372 : : tree
373 : 30869 : m2type_GetM2Complex32 (void)
374 : : {
375 : 30869 : return m2_complex32_type_node;
376 : : }
377 : :
378 : : /* GetM2Complex64 return the fixed size complex type. */
379 : :
380 : : tree
381 : 30869 : m2type_GetM2Complex64 (void)
382 : : {
383 : 30869 : return m2_complex64_type_node;
384 : : }
385 : :
386 : : /* GetM2Complex96 return the fixed size complex type. */
387 : :
388 : : tree
389 : 30869 : m2type_GetM2Complex96 (void)
390 : : {
391 : 30869 : return m2_complex96_type_node;
392 : : }
393 : :
394 : : /* GetM2Complex128 return the fixed size complex type. */
395 : :
396 : : tree
397 : 30869 : m2type_GetM2Complex128 (void)
398 : : {
399 : 30869 : return m2_complex128_type_node;
400 : : }
401 : :
402 : : /* GetM2CType a test function. */
403 : :
404 : : tree
405 : 31049 : m2type_GetM2CType (void)
406 : : {
407 : 31049 : return m2_c_type_node;
408 : : }
409 : :
410 : : /* GetM2ShortComplexType return the short complex type. */
411 : :
412 : : tree
413 : 62639 : m2type_GetM2ShortComplexType (void)
414 : : {
415 : 62639 : return m2_short_complex_type_node;
416 : : }
417 : :
418 : : /* GetM2LongComplexType return the long complex type. */
419 : :
420 : : tree
421 : 618614 : m2type_GetM2LongComplexType (void)
422 : : {
423 : 618614 : return m2_long_complex_type_node;
424 : : }
425 : :
426 : : /* GetM2ComplexType return the complex type. */
427 : :
428 : : tree
429 : 62639 : m2type_GetM2ComplexType (void)
430 : : {
431 : 62639 : return m2_complex_type_node;
432 : : }
433 : :
434 : : /* GetM2Real128 return the real 128 bit type. */
435 : :
436 : : tree
437 : 30869 : m2type_GetM2Real128 (void)
438 : : {
439 : 30869 : return m2_real128_type_node;
440 : : }
441 : :
442 : : /* GetM2Real96 return the real 96 bit type. */
443 : :
444 : : tree
445 : 30869 : m2type_GetM2Real96 (void)
446 : : {
447 : 30869 : return m2_real96_type_node;
448 : : }
449 : :
450 : : /* GetM2Real64 return the real 64 bit type. */
451 : :
452 : : tree
453 : 30869 : m2type_GetM2Real64 (void)
454 : : {
455 : 30869 : return m2_real64_type_node;
456 : : }
457 : :
458 : : /* GetM2Real32 return the real 32 bit type. */
459 : :
460 : : tree
461 : 30869 : m2type_GetM2Real32 (void)
462 : : {
463 : 30869 : return m2_real32_type_node;
464 : : }
465 : :
466 : : /* GetM2Bitset32 return the bitset 32 bit type. */
467 : :
468 : : tree
469 : 30869 : m2type_GetM2Bitset32 (void)
470 : : {
471 : 30869 : return m2_bitset32_type_node;
472 : : }
473 : :
474 : : /* GetM2Bitset16 return the bitset 16 bit type. */
475 : :
476 : : tree
477 : 30869 : m2type_GetM2Bitset16 (void)
478 : : {
479 : 30869 : return m2_bitset16_type_node;
480 : : }
481 : :
482 : : /* GetM2Bitset8 return the bitset 8 bit type. */
483 : :
484 : : tree
485 : 30869 : m2type_GetM2Bitset8 (void)
486 : : {
487 : 30869 : return m2_bitset8_type_node;
488 : : }
489 : :
490 : : /* GetM2Word64 return the word 64 bit type. */
491 : :
492 : : tree
493 : 10458782 : m2type_GetM2Word64 (void)
494 : : {
495 : 10458782 : return m2_word64_type_node;
496 : : }
497 : :
498 : : /* GetM2Word32 return the word 32 bit type. */
499 : :
500 : : tree
501 : 10458782 : m2type_GetM2Word32 (void)
502 : : {
503 : 10458782 : return m2_word32_type_node;
504 : : }
505 : :
506 : : /* GetM2Word16 return the word 16 bit type. */
507 : :
508 : : tree
509 : 10458782 : m2type_GetM2Word16 (void)
510 : : {
511 : 10458782 : return m2_word16_type_node;
512 : : }
513 : :
514 : : /* GetM2Cardinal64 return the cardinal 64 bit type. */
515 : :
516 : : tree
517 : 218815 : m2type_GetM2Cardinal64 (void)
518 : : {
519 : 218815 : return m2_cardinal64_type_node;
520 : : }
521 : :
522 : : /* GetM2Cardinal32 return the cardinal 32 bit type. */
523 : :
524 : : tree
525 : 218815 : m2type_GetM2Cardinal32 (void)
526 : : {
527 : 218815 : return m2_cardinal32_type_node;
528 : : }
529 : :
530 : : /* GetM2Cardinal16 return the cardinal 16 bit type. */
531 : :
532 : : tree
533 : 218815 : m2type_GetM2Cardinal16 (void)
534 : : {
535 : 218815 : return m2_cardinal16_type_node;
536 : : }
537 : :
538 : : /* GetM2Cardinal8 return the cardinal 8 bit type. */
539 : :
540 : : tree
541 : 30869 : m2type_GetM2Cardinal8 (void)
542 : : {
543 : 30869 : return m2_cardinal8_type_node;
544 : : }
545 : :
546 : : /* GetM2Integer64 return the integer 64 bit type. */
547 : :
548 : : tree
549 : 30869 : m2type_GetM2Integer64 (void)
550 : : {
551 : 30869 : return m2_integer64_type_node;
552 : : }
553 : :
554 : : /* GetM2Integer32 return the integer 32 bit type. */
555 : :
556 : : tree
557 : 30869 : m2type_GetM2Integer32 (void)
558 : : {
559 : 30869 : return m2_integer32_type_node;
560 : : }
561 : :
562 : : /* GetM2Integer16 return the integer 16 bit type. */
563 : :
564 : : tree
565 : 30869 : m2type_GetM2Integer16 (void)
566 : : {
567 : 30869 : return m2_integer16_type_node;
568 : : }
569 : :
570 : : /* GetM2Integer8 return the integer 8 bit type. */
571 : :
572 : : tree
573 : 30869 : m2type_GetM2Integer8 (void)
574 : : {
575 : 30869 : return m2_integer8_type_node;
576 : : }
577 : :
578 : : /* GetM2RType return the ISO R data type, the longest real
579 : : datatype. */
580 : :
581 : : tree
582 : 74707 : m2type_GetM2RType (void)
583 : : {
584 : 74707 : return long_double_type_node;
585 : : }
586 : :
587 : : /* GetM2ZType return the ISO Z data type, the longest int datatype. */
588 : :
589 : : tree
590 : 1127729 : m2type_GetM2ZType (void)
591 : : {
592 : 1127729 : return m2_z_type_node;
593 : : }
594 : :
595 : : /* GetShortCardType return the C short unsigned data type. */
596 : :
597 : : tree
598 : 0 : m2type_GetShortCardType (void)
599 : : {
600 : 0 : return short_unsigned_type_node;
601 : : }
602 : :
603 : : /* GetM2ShortCardType return the m2 short cardinal data type. */
604 : :
605 : : tree
606 : 94409 : m2type_GetM2ShortCardType (void)
607 : : {
608 : 94409 : return m2_short_card_type_node;
609 : : }
610 : :
611 : : /* GetShortIntType return the C short int data type. */
612 : :
613 : : tree
614 : 0 : m2type_GetShortIntType (void)
615 : : {
616 : 0 : return short_integer_type_node;
617 : : }
618 : :
619 : : /* GetM2ShortIntType return the m2 short integer data type. */
620 : :
621 : : tree
622 : 94409 : m2type_GetM2ShortIntType (void)
623 : : {
624 : 94409 : return m2_short_int_type_node;
625 : : }
626 : :
627 : : /* GetM2LongCardType return the m2 long cardinal data type. */
628 : :
629 : : tree
630 : 94409 : m2type_GetM2LongCardType (void)
631 : : {
632 : 94409 : return m2_long_card_type_node;
633 : : }
634 : :
635 : : /* GetM2LongIntType return the m2 long integer data type. */
636 : :
637 : : tree
638 : 94409 : m2type_GetM2LongIntType (void)
639 : : {
640 : 94409 : return m2_long_int_type_node;
641 : : }
642 : :
643 : : /* GetM2LongRealType return the m2 long real data type. */
644 : :
645 : : tree
646 : 761579 : m2type_GetM2LongRealType (void)
647 : : {
648 : 761579 : return m2_long_real_type_node;
649 : : }
650 : :
651 : : /* GetM2RealType return the m2 real data type. */
652 : :
653 : : tree
654 : 94409 : m2type_GetM2RealType (void)
655 : : {
656 : 94409 : return m2_real_type_node;
657 : : }
658 : :
659 : : /* GetM2ShortRealType return the m2 short real data type. */
660 : :
661 : : tree
662 : 94409 : m2type_GetM2ShortRealType (void)
663 : : {
664 : 94409 : return m2_short_real_type_node;
665 : : }
666 : :
667 : : /* GetM2CardinalType return the m2 cardinal data type. */
668 : :
669 : : tree
670 : 121238 : m2type_GetM2CardinalType (void)
671 : : {
672 : 121238 : return m2_cardinal_type_node;
673 : : }
674 : :
675 : : /* GetM2IntegerType return the m2 integer data type. */
676 : :
677 : : tree
678 : 79580 : m2type_GetM2IntegerType (void)
679 : : {
680 : 79580 : return m2_integer_type_node;
681 : : }
682 : :
683 : : /* GetM2CharType return the m2 char data type. */
684 : :
685 : : tree
686 : 110212 : m2type_GetM2CharType (void)
687 : : {
688 : 110212 : return m2_char_type_node;
689 : : }
690 : :
691 : : /* GetProcType return the m2 proc data type. */
692 : :
693 : : tree
694 : 30869 : m2type_GetProcType (void)
695 : : {
696 : 30869 : return proc_type_node;
697 : : }
698 : :
699 : : /* GetISOWordType return the m2 iso word data type. */
700 : :
701 : : tree
702 : 10587685 : m2type_GetISOWordType (void)
703 : : {
704 : 10587685 : return m2_iso_word_type_node;
705 : : }
706 : :
707 : : /* GetISOByteType return the m2 iso byte data type. */
708 : :
709 : : tree
710 : 7035502 : m2type_GetISOByteType (void)
711 : : {
712 : 7035502 : return m2_iso_byte_type_node;
713 : : }
714 : :
715 : : /* GetISOLocType return the m2 loc word data type. */
716 : :
717 : : tree
718 : 7025801 : m2type_GetISOLocType (void)
719 : : {
720 : 7025801 : return m2_iso_loc_type_node;
721 : : }
722 : :
723 : : /* GetWordType return the C unsigned data type. */
724 : :
725 : : tree
726 : 2826260 : m2type_GetWordType (void)
727 : : {
728 : 2826260 : return unsigned_type_node;
729 : : }
730 : :
731 : : /* GetLongIntType return the C long int data type. */
732 : :
733 : : tree
734 : 0 : m2type_GetLongIntType (void)
735 : : {
736 : 0 : return long_integer_type_node;
737 : : }
738 : :
739 : : /* GetShortRealType return the C float data type. */
740 : :
741 : : tree
742 : 1878741 : m2type_GetShortRealType (void)
743 : : {
744 : 1878741 : return float_type_node;
745 : : }
746 : :
747 : : /* GetLongRealType return the C long double data type. */
748 : :
749 : : tree
750 : 1929963 : m2type_GetLongRealType (void)
751 : : {
752 : 1929963 : return long_double_type_node;
753 : : }
754 : :
755 : : /* GetRealType returns the C double_type_node. */
756 : :
757 : : tree
758 : 1942281 : m2type_GetRealType (void)
759 : : {
760 : 1942281 : return double_type_node;
761 : : }
762 : :
763 : : /* GetBitnumType return the ISO bitnum type. */
764 : :
765 : : tree
766 : 14984 : m2type_GetBitnumType (void)
767 : : {
768 : 14984 : return bitnum_type_node;
769 : : }
770 : :
771 : : /* GetBitsetType return the bitset type. */
772 : :
773 : : tree
774 : 58440 : m2type_GetBitsetType (void)
775 : : {
776 : 58440 : return bitset_type_node;
777 : : }
778 : :
779 : : /* GetCardinalType return the cardinal type. */
780 : :
781 : : tree
782 : 158561 : m2type_GetCardinalType (void)
783 : : {
784 : 158561 : return unsigned_type_node;
785 : : }
786 : :
787 : : /* GetPointerType return the GCC ptr type node. Equivalent to
788 : : (void *). */
789 : :
790 : : tree
791 : 239638 : m2type_GetPointerType (void)
792 : : {
793 : 239638 : return ptr_type_node;
794 : : }
795 : :
796 : : /* GetVoidType return the C void type. */
797 : :
798 : : tree
799 : 0 : m2type_GetVoidType (void)
800 : : {
801 : 0 : return void_type_node;
802 : : }
803 : :
804 : : /* GetByteType return the byte type node. */
805 : :
806 : : tree
807 : 7382720 : m2type_GetByteType (void)
808 : : {
809 : 7382720 : return unsigned_char_type_node;
810 : : }
811 : :
812 : : /* GetCharType return the char type node. */
813 : :
814 : : tree
815 : 0 : m2type_GetCharType (void)
816 : : {
817 : 0 : return char_type_node;
818 : : }
819 : :
820 : : /* GetIntegerType return the integer type node. */
821 : :
822 : : tree
823 : 1724581 : m2type_GetIntegerType (void)
824 : : {
825 : 1724581 : return integer_type_node;
826 : : }
827 : :
828 : : /* GetCSizeTType return a type representing size_t. */
829 : :
830 : : tree
831 : 30869 : m2type_GetCSizeTType (void)
832 : : {
833 : 30869 : return sizetype;
834 : : }
835 : :
836 : : /* GetCSSizeTType return a type representing size_t. */
837 : :
838 : : tree
839 : 30869 : m2type_GetCSSizeTType (void)
840 : : {
841 : 30869 : return ssizetype;
842 : : }
843 : :
844 : : /* GetCSSizeTType return a type representing off_t. */
845 : :
846 : : tree
847 : 30869 : m2type_GetCOffTType (void)
848 : : {
849 : 30869 : return m2_offt_type_node;
850 : : }
851 : :
852 : : /* GetPackedBooleanType return the packed boolean data type node. */
853 : :
854 : : tree
855 : 14984 : m2type_GetPackedBooleanType (void)
856 : : {
857 : 14984 : return m2_packed_boolean_type_node;
858 : : }
859 : :
860 : : /* GetBooleanTrue return modula-2 true. */
861 : :
862 : : tree
863 : 64968 : m2type_GetBooleanTrue (void)
864 : : {
865 : : #if defined(USE_BOOLEAN)
866 : 64968 : return boolean_true_node;
867 : : #else /* !USE_BOOLEAN */
868 : : return m2expr_GetIntegerOne (m2linemap_BuiltinsLocation ());
869 : : #endif /* !USE_BOOLEAN */
870 : : }
871 : :
872 : : /* GetBooleanFalse return modula-2 FALSE. */
873 : :
874 : : tree
875 : 18260 : m2type_GetBooleanFalse (void)
876 : : {
877 : : #if defined(USE_BOOLEAN)
878 : 18260 : return boolean_false_node;
879 : : #else /* !USE_BOOLEAN */
880 : : return m2expr_GetIntegerZero (m2linemap_BuiltinsLocation ());
881 : : #endif /* !USE_BOOLEAN */
882 : : }
883 : :
884 : : /* GetBooleanType return the modula-2 BOOLEAN type. */
885 : :
886 : : tree
887 : 92079 : m2type_GetBooleanType (void)
888 : : {
889 : : #if defined(USE_BOOLEAN)
890 : 92079 : return boolean_type_node;
891 : : #else /* !USE_BOOLEAN */
892 : : return integer_type_node;
893 : : #endif /* !USE_BOOLEAN */
894 : : }
895 : :
896 : : /* GetCardinalAddressType returns the internal data type for
897 : : computing binary arithmetic upon the ADDRESS datatype. */
898 : :
899 : : tree
900 : 48010 : m2type_GetCardinalAddressType (void)
901 : : {
902 : 48010 : return m2_cardinal_address_type_node;
903 : : }
904 : :
905 : : #if 0
906 : : /* build_set_type creates a set type from the, domain, [low..high].
907 : : The values low..high all have type, range_type. */
908 : :
909 : : static tree
910 : : build_set_type (tree domain, tree range_type, int allow_void, int ispacked)
911 : : {
912 : : tree type;
913 : :
914 : : if (!m2tree_IsOrdinal (domain)
915 : : && !(allow_void && TREE_CODE (domain) == VOID_TYPE))
916 : : {
917 : : error ("set base type must be an ordinal type");
918 : : return NULL;
919 : : }
920 : :
921 : : if (TYPE_SIZE (range_type) == 0)
922 : : layout_type (range_type);
923 : :
924 : : if (TYPE_SIZE (domain) == 0)
925 : : layout_type (domain);
926 : :
927 : : type = make_node (SET_TYPE);
928 : : TREE_TYPE (type) = range_type;
929 : : TYPE_DOMAIN (type) = domain;
930 : : TYPE_PACKED (type) = ispacked;
931 : : return type;
932 : : }
933 : :
934 : :
935 : : /* convert_type_to_range does the conversion and copies the range
936 : : type */
937 : :
938 : : static tree
939 : : convert_type_to_range (tree type)
940 : : {
941 : : tree min, max;
942 : : tree itype;
943 : :
944 : : if (!m2tree_IsOrdinal (type))
945 : : {
946 : : error ("ordinal type expected");
947 : : return error_mark_node;
948 : : }
949 : :
950 : : min = TYPE_MIN_VALUE (type);
951 : : max = TYPE_MAX_VALUE (type);
952 : :
953 : : if (TREE_TYPE (min) != TREE_TYPE (max))
954 : : {
955 : : error ("range limits are not of the same type");
956 : : return error_mark_node;
957 : : }
958 : :
959 : : itype = build_range_type (TREE_TYPE (min), min, max);
960 : :
961 : : if (TREE_TYPE (type) == NULL_TREE)
962 : : {
963 : : layout_type (type);
964 : : TREE_TYPE (itype) = type;
965 : : }
966 : : else
967 : : {
968 : : layout_type (TREE_TYPE (type));
969 : : TREE_TYPE (itype) = TREE_TYPE (type);
970 : : }
971 : :
972 : : layout_type (itype);
973 : : return itype;
974 : : }
975 : : #endif
976 : :
977 : : /* build_bitset_type builds the type BITSET which is exported from
978 : : SYSTEM. It also builds BITNUM (the subrange from which BITSET is
979 : : created). */
980 : :
981 : : static tree
982 : 15885 : build_bitset_type (location_t location)
983 : : {
984 : 15885 : m2assert_AssertLocation (location);
985 : 15885 : bitnum_type_node = build_range_type (
986 : : m2tree_skip_type_decl (m2type_GetCardinalType ()),
987 : : m2decl_BuildIntegerConstant (0),
988 : 15885 : m2decl_BuildIntegerConstant (m2decl_GetBitsPerBitset () - 1));
989 : 15885 : layout_type (bitnum_type_node);
990 : :
991 : : #if 1
992 : 15885 : if (broken_set_debugging_info)
993 : 15885 : return unsigned_type_node;
994 : : #endif
995 : :
996 : 0 : ASSERT ((COMPLETE_TYPE_P (bitnum_type_node)), bitnum_type_node);
997 : :
998 : 0 : return m2type_BuildSetTypeFromSubrange (
999 : : location, NULL, bitnum_type_node, m2decl_BuildIntegerConstant (0),
1000 : 0 : m2decl_BuildIntegerConstant (m2decl_GetBitsPerBitset () - 1), false);
1001 : : }
1002 : :
1003 : : /* BuildSetTypeFromSubrange constructs a set type from a
1004 : : subrangeType. --fixme-- revisit once gdb/gcc supports dwarf-5 set type. */
1005 : :
1006 : : tree
1007 : 26659 : m2type_BuildSetTypeFromSubrange (location_t location,
1008 : : char *name __attribute__ ((unused)),
1009 : : tree subrangeType __attribute__ ((unused)),
1010 : : tree lowval, tree highval, bool ispacked)
1011 : : {
1012 : 26659 : m2assert_AssertLocation (location);
1013 : 26659 : lowval = m2expr_FoldAndStrip (lowval);
1014 : 26659 : highval = m2expr_FoldAndStrip (highval);
1015 : :
1016 : : #if 0
1017 : : if (broken_set_debugging_info)
1018 : : return unsigned_type_node;
1019 : : else
1020 : : #endif
1021 : 26659 : if (ispacked)
1022 : : {
1023 : 114 : tree noelements = m2expr_BuildAdd (
1024 : : location, m2expr_BuildSub (location, highval, lowval, false),
1025 : : integer_one_node, false);
1026 : 114 : highval = m2expr_FoldAndStrip (m2expr_BuildSub (
1027 : : location, m2expr_BuildLSL (location, m2expr_GetWordOne (location),
1028 : : noelements, false),
1029 : : m2expr_GetIntegerOne (location), false));
1030 : 114 : lowval = m2expr_GetIntegerZero (location);
1031 : 114 : return m2type_BuildSmallestTypeRange (location, lowval, highval);
1032 : : }
1033 : : else
1034 : 26545 : return unsigned_type_node;
1035 : : }
1036 : :
1037 : : /* build_m2_size_set_type build and return a set type with
1038 : : precision bits. */
1039 : :
1040 : : static tree
1041 : 0 : build_m2_size_set_type (location_t location, int precision)
1042 : : {
1043 : 0 : tree bitnum_type_node
1044 : 0 : = build_range_type (m2tree_skip_type_decl (m2type_GetCardinalType ()),
1045 : : m2decl_BuildIntegerConstant (0),
1046 : : m2decl_BuildIntegerConstant (precision - 1));
1047 : 0 : layout_type (bitnum_type_node);
1048 : 0 : m2assert_AssertLocation (location);
1049 : :
1050 : 0 : if (broken_set_debugging_info)
1051 : 0 : return unsigned_type_node;
1052 : :
1053 : 0 : ASSERT ((COMPLETE_TYPE_P (bitnum_type_node)), bitnum_type_node);
1054 : :
1055 : 0 : return m2type_BuildSetTypeFromSubrange (
1056 : : location, NULL, bitnum_type_node, m2decl_BuildIntegerConstant (0),
1057 : 0 : m2decl_BuildIntegerConstant (precision - 1), false);
1058 : : }
1059 : :
1060 : : /* build_m2_specific_size_type build a specific data type matching
1061 : : number of bits precision whether it is_signed. It creates a
1062 : : set type if base == SET_TYPE or returns the already created real,
1063 : : if REAL_TYPE is specified. */
1064 : :
1065 : : static tree
1066 : 270267 : build_m2_specific_size_type (location_t location, enum tree_code base,
1067 : : int precision, int is_signed)
1068 : : {
1069 : 270267 : tree c;
1070 : :
1071 : 270267 : m2assert_AssertLocation (location);
1072 : :
1073 : 270267 : c = make_node (base);
1074 : 270267 : TYPE_PRECISION (c) = precision;
1075 : :
1076 : 270267 : if (base == REAL_TYPE)
1077 : : {
1078 : 63540 : if (!float_mode_for_size (TYPE_PRECISION (c)).exists ())
1079 : : return NULL;
1080 : : }
1081 : 206727 : else if (base == SET_TYPE)
1082 : 0 : return build_m2_size_set_type (location, precision);
1083 : : else
1084 : : {
1085 : 206727 : TYPE_SIZE (c) = 0;
1086 : :
1087 : 206727 : if (is_signed)
1088 : : {
1089 : 79425 : fixup_signed_type (c);
1090 : 79425 : TYPE_UNSIGNED (c) = false;
1091 : : }
1092 : : else
1093 : : {
1094 : 127302 : fixup_unsigned_type (c);
1095 : 127302 : TYPE_UNSIGNED (c) = true;
1096 : : }
1097 : : }
1098 : 254382 : layout_type (c);
1099 : 254382 : return c;
1100 : : }
1101 : :
1102 : : /* BuildSmallestTypeRange returns the smallest INTEGER_TYPE which
1103 : : is sufficient to contain values: low..high. */
1104 : :
1105 : : tree
1106 : 222 : m2type_BuildSmallestTypeRange (location_t location, tree low, tree high)
1107 : : {
1108 : 222 : tree bits;
1109 : :
1110 : 222 : m2assert_AssertLocation (location);
1111 : 222 : low = fold (low);
1112 : 222 : high = fold (high);
1113 : 222 : bits = fold (m2expr_calcNbits (location, low, high));
1114 : 666 : return build_m2_specific_size_type (location, INTEGER_TYPE,
1115 : 222 : TREE_INT_CST_LOW (bits),
1116 : 222 : tree_int_cst_sgn (low) < 0);
1117 : : }
1118 : :
1119 : : /* GetTreeType returns TREE_TYPE (t). */
1120 : :
1121 : : tree
1122 : 24706 : m2type_GetTreeType (tree t)
1123 : : {
1124 : 24706 : return TREE_TYPE (t);
1125 : : }
1126 : :
1127 : : /* finish_build_pointer_type finish building a POINTER_TYPE node.
1128 : : necessary to solve self references in procedure types. */
1129 : :
1130 : : /* Code taken from tree.cc:build_pointer_type_for_mode. */
1131 : :
1132 : : static tree
1133 : 55520 : finish_build_pointer_type (tree t, tree to_type, enum machine_mode mode,
1134 : : bool can_alias_all)
1135 : : {
1136 : 55520 : TREE_TYPE (t) = to_type;
1137 : 55520 : SET_TYPE_MODE (t, mode);
1138 : 55520 : TYPE_REF_CAN_ALIAS_ALL (t) = can_alias_all;
1139 : 55520 : TYPE_NEXT_PTR_TO (t) = TYPE_POINTER_TO (to_type);
1140 : 55520 : TYPE_POINTER_TO (to_type) = t;
1141 : :
1142 : : /* Lay out the type. */
1143 : : /* layout_type (t); */
1144 : 55520 : layout_type (t);
1145 : 55520 : return t;
1146 : : }
1147 : :
1148 : : /* BuildParameterDeclaration creates and returns one parameter
1149 : : from, name, and, type. It appends this parameter to the internal
1150 : : param_type_list. */
1151 : :
1152 : : tree
1153 : 79174 : m2type_BuildProcTypeParameterDeclaration (location_t location, tree type,
1154 : : bool isreference)
1155 : : {
1156 : 79174 : m2assert_AssertLocation (location);
1157 : 79174 : ASSERT_BOOL (isreference);
1158 : 79174 : type = m2tree_skip_type_decl (type);
1159 : 79174 : if (isreference)
1160 : 6084 : type = build_reference_type (type);
1161 : :
1162 : 79174 : param_type_list = tree_cons (NULL_TREE, type, param_type_list);
1163 : 79174 : return type;
1164 : : }
1165 : :
1166 : : /* BuildEndFunctionType build a function type which would return a,
1167 : : value. The arguments have been created by
1168 : : BuildParameterDeclaration. */
1169 : :
1170 : : tree
1171 : 55520 : m2type_BuildEndFunctionType (tree func, tree return_type, bool uses_varargs)
1172 : : {
1173 : 55520 : tree last;
1174 : :
1175 : 55520 : if (return_type == NULL_TREE)
1176 : 48112 : return_type = void_type_node;
1177 : : else
1178 : 7408 : return_type = m2tree_skip_type_decl (return_type);
1179 : :
1180 : 55520 : if (uses_varargs)
1181 : : {
1182 : 0 : if (param_type_list != NULL_TREE)
1183 : : {
1184 : 0 : param_type_list = nreverse (param_type_list);
1185 : 0 : last = param_type_list;
1186 : 0 : param_type_list = nreverse (param_type_list);
1187 : 0 : gcc_assert (last != void_list_node);
1188 : : }
1189 : : }
1190 : 55520 : else if (param_type_list == NULL_TREE)
1191 : 20364 : param_type_list = void_list_node;
1192 : : else
1193 : : {
1194 : 35156 : param_type_list = nreverse (param_type_list);
1195 : 35156 : last = param_type_list;
1196 : 35156 : param_type_list = nreverse (param_type_list);
1197 : 35156 : TREE_CHAIN (last) = void_list_node;
1198 : : }
1199 : 55520 : param_type_list = build_function_type (return_type, param_type_list);
1200 : :
1201 : 55520 : func = finish_build_pointer_type (func, param_type_list, ptr_mode, false);
1202 : 55520 : TYPE_SIZE (func) = 0;
1203 : 55520 : layout_type (func);
1204 : 55520 : return func;
1205 : : }
1206 : :
1207 : : /* BuildStartFunctionType creates a pointer type, necessary to
1208 : : create a function type. */
1209 : :
1210 : : tree
1211 : 55520 : m2type_BuildStartFunctionType (location_t location ATTRIBUTE_UNUSED,
1212 : : char *name ATTRIBUTE_UNUSED)
1213 : : {
1214 : 55520 : tree n = make_node (POINTER_TYPE);
1215 : :
1216 : 55520 : m2assert_AssertLocation (location);
1217 : 55520 : return n;
1218 : : }
1219 : :
1220 : : /* InitFunctionTypeParameters resets the current function type
1221 : : parameter list. */
1222 : :
1223 : : void
1224 : 55520 : m2type_InitFunctionTypeParameters (void)
1225 : : {
1226 : 55520 : param_type_list = NULL_TREE;
1227 : 55520 : }
1228 : :
1229 : : /* gm2_finish_decl finishes VAR, TYPE and FUNCTION declarations. */
1230 : :
1231 : : static void
1232 : 1027850 : gm2_finish_decl (location_t location, tree decl)
1233 : : {
1234 : 1027850 : tree type = TREE_TYPE (decl);
1235 : 1027850 : int was_incomplete = (DECL_SIZE (decl) == 0);
1236 : :
1237 : 1027850 : m2assert_AssertLocation (location);
1238 : 1027850 : if (VAR_P (decl))
1239 : : {
1240 : 0 : if (DECL_SIZE (decl) == 0 && TREE_TYPE (decl) != error_mark_node
1241 : 0 : && COMPLETE_TYPE_P (TREE_TYPE (decl)))
1242 : 0 : layout_decl (decl, 0);
1243 : :
1244 : 0 : if (DECL_SIZE (decl) == 0
1245 : : /* Don't give an error if we already gave one earlier. */
1246 : 0 : && TREE_TYPE (decl) != error_mark_node)
1247 : : {
1248 : 0 : error_at (location, "storage size of %q+D isn%'t known", decl);
1249 : 0 : TREE_TYPE (decl) = error_mark_node;
1250 : : }
1251 : :
1252 : 0 : if ((DECL_EXTERNAL (decl) || TREE_STATIC (decl))
1253 : 0 : && DECL_SIZE (decl) != 0)
1254 : : {
1255 : 0 : if (TREE_CODE (DECL_SIZE (decl)) == INTEGER_CST)
1256 : 0 : m2expr_ConstantExpressionWarning (DECL_SIZE (decl));
1257 : : else
1258 : 0 : error_at (location, "storage size of %q+D isn%'t constant", decl);
1259 : : }
1260 : :
1261 : 0 : if (TREE_USED (type))
1262 : 0 : TREE_USED (decl) = 1;
1263 : : }
1264 : :
1265 : : /* Output the assembler code and/or RTL code for variables and
1266 : : functions, unless the type is an undefined structure or union. If
1267 : : not, it will get done when the type is completed. */
1268 : :
1269 : 1027850 : if (VAR_P (decl) || TREE_CODE (decl) == FUNCTION_DECL)
1270 : : {
1271 : 0 : if (DECL_FILE_SCOPE_P (decl))
1272 : : {
1273 : 0 : if (DECL_INITIAL (decl) == NULL_TREE
1274 : 0 : || DECL_INITIAL (decl) == error_mark_node)
1275 : :
1276 : : /* Don't output anything when a tentative file-scope definition is
1277 : : seen. But at end of compilation, do output code for them. */
1278 : 0 : DECL_DEFER_OUTPUT (decl) = 1;
1279 : 0 : rest_of_decl_compilation (decl, true, 0);
1280 : : }
1281 : :
1282 : 0 : if (!DECL_FILE_SCOPE_P (decl))
1283 : : {
1284 : :
1285 : : /* Recompute the RTL of a local array now if it used to be an
1286 : : incomplete type. */
1287 : 0 : if (was_incomplete && !TREE_STATIC (decl) && !DECL_EXTERNAL (decl))
1288 : : {
1289 : : /* If we used it already as memory, it must stay in memory. */
1290 : 0 : TREE_ADDRESSABLE (decl) = TREE_USED (decl);
1291 : : /* If it's still incomplete now, no init will save it. */
1292 : 0 : if (DECL_SIZE (decl) == 0)
1293 : 0 : DECL_INITIAL (decl) = 0;
1294 : : }
1295 : : }
1296 : : }
1297 : :
1298 : 1027850 : if (TREE_CODE (decl) == TYPE_DECL)
1299 : : {
1300 : 1349972 : if (!DECL_FILE_SCOPE_P (decl)
1301 : 675044 : && variably_modified_type_p (TREE_TYPE (decl), NULL_TREE))
1302 : 0 : m2block_pushDecl (build_stmt (location, DECL_EXPR, decl));
1303 : :
1304 : 1349914 : rest_of_decl_compilation (decl, DECL_FILE_SCOPE_P (decl), 0);
1305 : : }
1306 : 1027850 : }
1307 : :
1308 : : /* BuildVariableArrayAndDeclare creates a variable length array.
1309 : : high is the maximum legal elements (which is a runtime variable).
1310 : : This creates and array index, array type and local variable. */
1311 : :
1312 : : tree
1313 : 0 : m2type_BuildVariableArrayAndDeclare (location_t location, tree elementtype,
1314 : : tree high, char *name, tree scope)
1315 : : {
1316 : 0 : tree indextype = build_index_type (variable_size (high));
1317 : 0 : tree arraytype = build_array_type (elementtype, indextype);
1318 : 0 : tree id = get_identifier (name);
1319 : 0 : tree decl;
1320 : :
1321 : 0 : m2assert_AssertLocation (location);
1322 : 0 : decl = build_decl (location, VAR_DECL, id, arraytype);
1323 : :
1324 : 0 : DECL_EXTERNAL (decl) = false;
1325 : 0 : TREE_PUBLIC (decl) = true;
1326 : 0 : DECL_CONTEXT (decl) = scope;
1327 : 0 : TREE_USED (arraytype) = true;
1328 : 0 : TREE_USED (decl) = true;
1329 : :
1330 : 0 : m2block_pushDecl (decl);
1331 : :
1332 : 0 : gm2_finish_decl (location, indextype);
1333 : 0 : gm2_finish_decl (location, arraytype);
1334 : 0 : add_stmt (location, build_stmt (location, DECL_EXPR, decl));
1335 : 0 : return decl;
1336 : : }
1337 : :
1338 : : static tree
1339 : 15885 : build_m2_iso_word_node (location_t location, int loc)
1340 : : {
1341 : 15885 : tree c;
1342 : :
1343 : 15885 : m2assert_AssertLocation (location);
1344 : : /* Define `WORD' as specified in ISO m2
1345 : :
1346 : : WORD = ARRAY [0..SizeOfWord / SizeOfLoc] OF LOC ; */
1347 : :
1348 : 15885 : if (m2decl_GetBitsPerInt () == BITS_PER_UNIT)
1349 : 0 : c = m2type_GetISOLocType ();
1350 : : else
1351 : 31770 : c = gm2_build_array_type (
1352 : : m2type_GetISOLocType (),
1353 : : m2type_BuildArrayIndexType (
1354 : : m2expr_GetIntegerZero (location),
1355 : : (m2expr_BuildSub (location,
1356 : : m2decl_BuildIntegerConstant (
1357 : 15885 : m2decl_GetBitsPerInt () / BITS_PER_UNIT),
1358 : : m2expr_GetIntegerOne (location), false))),
1359 : : loc);
1360 : 15885 : return c;
1361 : : }
1362 : :
1363 : : static tree
1364 : 15885 : build_m2_iso_byte_node (location_t location, int loc)
1365 : : {
1366 : 15885 : tree c;
1367 : :
1368 : : /* Define `BYTE' as specified in ISO m2
1369 : :
1370 : : BYTE = ARRAY [0..SizeOfByte / SizeOfLoc] OF LOC ; */
1371 : :
1372 : 15885 : if (BITS_PER_UNIT == 8)
1373 : 0 : c = m2type_GetISOLocType ();
1374 : : else
1375 : : c = gm2_build_array_type (
1376 : : m2type_GetISOLocType (),
1377 : : m2type_BuildArrayIndexType (
1378 : : m2expr_GetIntegerZero (location),
1379 : : m2decl_BuildIntegerConstant (BITS_PER_UNIT / 8)),
1380 : : loc);
1381 : 15885 : return c;
1382 : : }
1383 : :
1384 : : static tree
1385 : 15885 : build_m2_offt_type_node (location_t location)
1386 : : {
1387 : 15885 : m2assert_AssertLocation (location);
1388 : 15885 : int offt_size = M2Options_GetFileOffsetBits ();
1389 : :
1390 : 15885 : if (offt_size == 0)
1391 : 15885 : offt_size = TREE_INT_CST_LOW (TYPE_SIZE (ssizetype));
1392 : 15885 : return build_m2_specific_size_type (location, INTEGER_TYPE,
1393 : 15885 : offt_size, true);
1394 : : }
1395 : :
1396 : : /* m2type_InitSystemTypes initialise loc and word derivatives. */
1397 : :
1398 : : void
1399 : 15885 : m2type_InitSystemTypes (location_t location, int loc)
1400 : : {
1401 : 15885 : m2assert_AssertLocation (location);
1402 : :
1403 : 15885 : m2_iso_word_type_node = build_m2_iso_word_node (location, loc);
1404 : 15885 : m2_iso_byte_type_node = build_m2_iso_byte_node (location, loc);
1405 : :
1406 : 15885 : m2_word16_type_node = build_m2_word16_type_node (location, loc);
1407 : 15885 : m2_word32_type_node = build_m2_word32_type_node (location, loc);
1408 : 15885 : m2_word64_type_node = build_m2_word64_type_node (location, loc);
1409 : 15885 : m2_offt_type_node = build_m2_offt_type_node (location);
1410 : 15885 : }
1411 : :
1412 : : static tree
1413 : 15885 : build_m2_integer_node (void)
1414 : : {
1415 : 0 : return m2type_GetIntegerType ();
1416 : : }
1417 : :
1418 : : static tree
1419 : 15885 : build_m2_cardinal_node (void)
1420 : : {
1421 : 0 : return m2type_GetCardinalType ();
1422 : : }
1423 : :
1424 : : static tree
1425 : 15885 : build_m2_char_node (void)
1426 : : {
1427 : 15885 : tree c;
1428 : :
1429 : : /* Define `CHAR', to be an unsigned char. */
1430 : :
1431 : 15885 : c = make_unsigned_type (CHAR_TYPE_SIZE);
1432 : 15885 : layout_type (c);
1433 : 15885 : return c;
1434 : : }
1435 : :
1436 : : static tree
1437 : 15885 : build_m2_short_real_node (void)
1438 : : {
1439 : : /* Define `SHORTREAL'. */
1440 : 15885 : ASSERT_CONDITION (TYPE_SIZE (float_type_node));
1441 : 15885 : return float_type_node;
1442 : : }
1443 : :
1444 : : static tree
1445 : 15885 : build_m2_real_node (void)
1446 : : {
1447 : : /* Define `REAL'. */
1448 : 15885 : ASSERT_CONDITION (TYPE_SIZE (double_type_node));
1449 : 15885 : return double_type_node;
1450 : : }
1451 : :
1452 : : static tree
1453 : 15885 : build_m2_long_real_node (void)
1454 : : {
1455 : 15885 : tree longreal;
1456 : :
1457 : : /* Define `LONGREAL'. */
1458 : 15885 : if (M2Options_GetIEEELongDouble ())
1459 : 0 : longreal = float128_type_node;
1460 : : else
1461 : 15885 : longreal = long_double_type_node;
1462 : 15885 : ASSERT_CONDITION (TYPE_SIZE (longreal));
1463 : 15885 : return longreal;
1464 : : }
1465 : :
1466 : : static tree
1467 : 15885 : build_m2_ztype_node (void)
1468 : : {
1469 : 15885 : tree ztype_node;
1470 : :
1471 : : /* Define `ZTYPE'. */
1472 : :
1473 : 15885 : if (targetm.scalar_mode_supported_p (TImode))
1474 : 15591 : ztype_node = gm2_type_for_size (128, 0);
1475 : : else
1476 : 294 : ztype_node = gm2_type_for_size (64, 0);
1477 : 15885 : layout_type (ztype_node);
1478 : 15885 : return ztype_node;
1479 : : }
1480 : :
1481 : : static tree
1482 : 15885 : build_m2_long_int_node (void)
1483 : : {
1484 : 15885 : tree c;
1485 : :
1486 : : /* Define `LONGINT'. */
1487 : :
1488 : 15885 : c = make_signed_type (LONG_LONG_TYPE_SIZE);
1489 : 15885 : layout_type (c);
1490 : 15885 : return c;
1491 : : }
1492 : :
1493 : : static tree
1494 : 15885 : build_m2_long_card_node (void)
1495 : : {
1496 : 15885 : tree c;
1497 : :
1498 : : /* Define `LONGCARD'. */
1499 : :
1500 : 15885 : c = make_unsigned_type (LONG_LONG_TYPE_SIZE);
1501 : 15885 : layout_type (c);
1502 : 15885 : return c;
1503 : : }
1504 : :
1505 : : static tree
1506 : 15885 : build_m2_short_int_node (void)
1507 : : {
1508 : 15885 : tree c;
1509 : :
1510 : : /* Define `SHORTINT'. */
1511 : :
1512 : 15885 : c = make_signed_type (SHORT_TYPE_SIZE);
1513 : 15885 : layout_type (c);
1514 : 15885 : return c;
1515 : : }
1516 : :
1517 : : static tree
1518 : 15885 : build_m2_short_card_node (void)
1519 : : {
1520 : 15885 : tree c;
1521 : :
1522 : : /* Define `SHORTCARD'. */
1523 : :
1524 : 15885 : c = make_unsigned_type (SHORT_TYPE_SIZE);
1525 : 15885 : layout_type (c);
1526 : 15885 : return c;
1527 : : }
1528 : :
1529 : : static tree
1530 : 15885 : build_m2_iso_loc_node (void)
1531 : : {
1532 : 15885 : tree c;
1533 : :
1534 : : /* Define `LOC' as specified in ISO m2. */
1535 : :
1536 : 15885 : c = make_node (INTEGER_TYPE);
1537 : 15885 : TYPE_PRECISION (c) = BITS_PER_UNIT;
1538 : 15885 : TYPE_SIZE (c) = 0;
1539 : :
1540 : 15885 : fixup_unsigned_type (c);
1541 : 15885 : TYPE_UNSIGNED (c) = 1;
1542 : 15885 : return c;
1543 : : }
1544 : :
1545 : : static tree
1546 : 15885 : build_m2_integer8_type_node (location_t location)
1547 : : {
1548 : 15885 : m2assert_AssertLocation (location);
1549 : 15885 : return build_m2_specific_size_type (location, INTEGER_TYPE, 8, true);
1550 : : }
1551 : :
1552 : : static tree
1553 : 15885 : build_m2_integer16_type_node (location_t location)
1554 : : {
1555 : 15885 : m2assert_AssertLocation (location);
1556 : 15885 : return build_m2_specific_size_type (location, INTEGER_TYPE, 16, true);
1557 : : }
1558 : :
1559 : : static tree
1560 : 15885 : build_m2_integer32_type_node (location_t location)
1561 : : {
1562 : 15885 : m2assert_AssertLocation (location);
1563 : 15885 : return build_m2_specific_size_type (location, INTEGER_TYPE, 32, true);
1564 : : }
1565 : :
1566 : : static tree
1567 : 15885 : build_m2_integer64_type_node (location_t location)
1568 : : {
1569 : 15885 : m2assert_AssertLocation (location);
1570 : 15885 : return build_m2_specific_size_type (location, INTEGER_TYPE, 64, true);
1571 : : }
1572 : :
1573 : : static tree
1574 : 15885 : build_m2_cardinal8_type_node (location_t location)
1575 : : {
1576 : 15885 : m2assert_AssertLocation (location);
1577 : 15885 : return build_m2_specific_size_type (location, INTEGER_TYPE, 8, false);
1578 : : }
1579 : :
1580 : : static tree
1581 : 15885 : build_m2_cardinal16_type_node (location_t location)
1582 : : {
1583 : 15885 : m2assert_AssertLocation (location);
1584 : 15885 : return build_m2_specific_size_type (location, INTEGER_TYPE, 16, false);
1585 : : }
1586 : :
1587 : : static tree
1588 : 15885 : build_m2_cardinal32_type_node (location_t location)
1589 : : {
1590 : 15885 : m2assert_AssertLocation (location);
1591 : 15885 : return build_m2_specific_size_type (location, INTEGER_TYPE, 32, false);
1592 : : }
1593 : :
1594 : : static tree
1595 : 15885 : build_m2_cardinal64_type_node (location_t location)
1596 : : {
1597 : 15885 : m2assert_AssertLocation (location);
1598 : 15885 : return build_m2_specific_size_type (location, INTEGER_TYPE, 64, false);
1599 : : }
1600 : :
1601 : : static tree
1602 : 15885 : build_m2_bitset8_type_node (location_t location)
1603 : : {
1604 : 15885 : m2assert_AssertLocation (location);
1605 : 15885 : if (broken_set_debugging_info)
1606 : 15885 : return build_m2_specific_size_type (location, INTEGER_TYPE, 8, false);
1607 : : else
1608 : 0 : return build_m2_specific_size_type (location, SET_TYPE, 8, false);
1609 : : }
1610 : :
1611 : : static tree
1612 : 15885 : build_m2_bitset16_type_node (location_t location)
1613 : : {
1614 : 15885 : m2assert_AssertLocation (location);
1615 : 15885 : if (broken_set_debugging_info)
1616 : 15885 : return build_m2_specific_size_type (location, INTEGER_TYPE, 16, false);
1617 : : else
1618 : 0 : return build_m2_specific_size_type (location, SET_TYPE, 16, false);
1619 : : }
1620 : :
1621 : : static tree
1622 : 15885 : build_m2_bitset32_type_node (location_t location)
1623 : : {
1624 : 15885 : m2assert_AssertLocation (location);
1625 : 15885 : if (broken_set_debugging_info)
1626 : 15885 : return build_m2_specific_size_type (location, INTEGER_TYPE, 32, false);
1627 : : else
1628 : 0 : return build_m2_specific_size_type (location, SET_TYPE, 32, false);
1629 : : }
1630 : :
1631 : : static tree
1632 : 15885 : build_m2_real32_type_node (location_t location)
1633 : : {
1634 : 15885 : m2assert_AssertLocation (location);
1635 : 15885 : return build_m2_specific_size_type (location, REAL_TYPE, 32, true);
1636 : : }
1637 : :
1638 : : static tree
1639 : 15885 : build_m2_real64_type_node (location_t location)
1640 : : {
1641 : 15885 : m2assert_AssertLocation (location);
1642 : 15885 : return build_m2_specific_size_type (location, REAL_TYPE, 64, true);
1643 : : }
1644 : :
1645 : : static tree
1646 : 15885 : build_m2_real96_type_node (location_t location)
1647 : : {
1648 : 15885 : m2assert_AssertLocation (location);
1649 : 15885 : return build_m2_specific_size_type (location, REAL_TYPE, 96, true);
1650 : : }
1651 : :
1652 : : static tree
1653 : 15885 : build_m2_real128_type_node (location_t location)
1654 : : {
1655 : 15885 : m2assert_AssertLocation (location);
1656 : 15885 : return build_m2_specific_size_type (location, REAL_TYPE, 128, true);
1657 : : }
1658 : :
1659 : : static tree
1660 : 111195 : build_m2_complex_type_from (tree scalar_type)
1661 : : {
1662 : 111195 : tree new_type;
1663 : :
1664 : 111195 : if (scalar_type == NULL)
1665 : : return NULL;
1666 : 95310 : if (scalar_type == float_type_node)
1667 : 15885 : return complex_float_type_node;
1668 : 79425 : if (scalar_type == double_type_node)
1669 : 15885 : return complex_double_type_node;
1670 : 63540 : if (scalar_type == long_double_type_node)
1671 : 15885 : return complex_long_double_type_node;
1672 : :
1673 : 47655 : new_type = make_node (COMPLEX_TYPE);
1674 : 47655 : TREE_TYPE (new_type) = scalar_type;
1675 : 47655 : layout_type (new_type);
1676 : 47655 : return new_type;
1677 : : }
1678 : :
1679 : : static tree
1680 : 15885 : build_m2_complex_type_node (void)
1681 : : {
1682 : 0 : return build_m2_complex_type_from (m2_real_type_node);
1683 : : }
1684 : :
1685 : : static tree
1686 : 15885 : build_m2_long_complex_type_node (void)
1687 : : {
1688 : 0 : return build_m2_complex_type_from (m2_long_real_type_node);
1689 : : }
1690 : :
1691 : : static tree
1692 : 15885 : build_m2_short_complex_type_node (void)
1693 : : {
1694 : 0 : return build_m2_complex_type_from (m2_short_real_type_node);
1695 : : }
1696 : :
1697 : : static tree
1698 : 15885 : build_m2_complex32_type_node (void)
1699 : : {
1700 : 0 : return build_m2_complex_type_from (m2_real32_type_node);
1701 : : }
1702 : :
1703 : : static tree
1704 : 15885 : build_m2_complex64_type_node (void)
1705 : : {
1706 : 0 : return build_m2_complex_type_from (m2_real64_type_node);
1707 : : }
1708 : :
1709 : : static tree
1710 : 15885 : build_m2_complex96_type_node (void)
1711 : : {
1712 : 0 : return build_m2_complex_type_from (m2_real96_type_node);
1713 : : }
1714 : :
1715 : : static tree
1716 : 15885 : build_m2_complex128_type_node (void)
1717 : : {
1718 : 0 : return build_m2_complex_type_from (m2_real128_type_node);
1719 : : }
1720 : :
1721 : : static tree
1722 : 15885 : build_m2_cardinal_address_type_node (location_t location)
1723 : : {
1724 : 15885 : tree size = size_in_bytes (ptr_type_node);
1725 : 15885 : int bits = TREE_INT_CST_LOW (size) * BITS_PER_UNIT;
1726 : :
1727 : 15885 : return build_m2_specific_size_type (location, INTEGER_TYPE, bits, false);
1728 : : }
1729 : :
1730 : : static void
1731 : 15885 : build_m2_boolean (location_t location)
1732 : : {
1733 : 15885 : tree tname = get_identifier ("BOOLEAN");
1734 : 15885 : tree typedecl = build_decl (location, TYPE_DECL, tname, boolean_type_node);
1735 : 15885 : DECL_ARTIFICIAL (typedecl) = 1;
1736 : 15885 : TYPE_NAME (boolean_type_node) = typedecl;
1737 : 15885 : }
1738 : :
1739 : :
1740 : : /* Return true if real types a and b are the same. */
1741 : :
1742 : : bool
1743 : 0 : m2type_SameRealType (tree a, tree b)
1744 : : {
1745 : 0 : return ((a == b)
1746 : 0 : || (TYPE_PRECISION (a) == TYPE_PRECISION (b)));
1747 : : }
1748 : :
1749 : : /* InitBaseTypes create the Modula-2 base types. */
1750 : :
1751 : : void
1752 : 15885 : m2type_InitBaseTypes (location_t location)
1753 : : {
1754 : 15885 : m2assert_AssertLocation (location);
1755 : 15885 : m2block_init ();
1756 : :
1757 : 15885 : ptr_type_node = build_pointer_type (void_type_node);
1758 : :
1759 : 15885 : proc_type_node
1760 : 15885 : = build_pointer_type (build_function_type (void_type_node, NULL_TREE));
1761 : :
1762 : 15885 : bitset_type_node = build_bitset_type (location);
1763 : 15885 : m2_char_type_node = build_m2_char_node ();
1764 : 15885 : m2_integer_type_node = build_m2_integer_node ();
1765 : 15885 : m2_cardinal_type_node = build_m2_cardinal_node ();
1766 : 15885 : m2_short_real_type_node = build_m2_short_real_node ();
1767 : 15885 : m2_real_type_node = build_m2_real_node ();
1768 : 15885 : m2_long_real_type_node = build_m2_long_real_node ();
1769 : 15885 : m2_long_int_type_node = build_m2_long_int_node ();
1770 : 15885 : m2_long_card_type_node = build_m2_long_card_node ();
1771 : 15885 : m2_short_int_type_node = build_m2_short_int_node ();
1772 : 15885 : m2_short_card_type_node = build_m2_short_card_node ();
1773 : 15885 : m2_z_type_node = build_m2_ztype_node ();
1774 : 15885 : m2_integer8_type_node = build_m2_integer8_type_node (location);
1775 : 15885 : m2_integer16_type_node = build_m2_integer16_type_node (location);
1776 : 15885 : m2_integer32_type_node = build_m2_integer32_type_node (location);
1777 : 15885 : m2_integer64_type_node = build_m2_integer64_type_node (location);
1778 : 15885 : m2_cardinal8_type_node = build_m2_cardinal8_type_node (location);
1779 : 15885 : m2_cardinal16_type_node = build_m2_cardinal16_type_node (location);
1780 : 15885 : m2_cardinal32_type_node = build_m2_cardinal32_type_node (location);
1781 : 15885 : m2_cardinal64_type_node = build_m2_cardinal64_type_node (location);
1782 : 15885 : m2_bitset8_type_node = build_m2_bitset8_type_node (location);
1783 : 15885 : m2_bitset16_type_node = build_m2_bitset16_type_node (location);
1784 : 15885 : m2_bitset32_type_node = build_m2_bitset32_type_node (location);
1785 : 15885 : m2_real32_type_node = build_m2_real32_type_node (location);
1786 : 15885 : m2_real64_type_node = build_m2_real64_type_node (location);
1787 : 15885 : m2_real96_type_node = build_m2_real96_type_node (location);
1788 : 15885 : m2_real128_type_node = build_m2_real128_type_node (location);
1789 : 15885 : m2_complex_type_node = build_m2_complex_type_node ();
1790 : 15885 : m2_long_complex_type_node = build_m2_long_complex_type_node ();
1791 : 15885 : m2_short_complex_type_node = build_m2_short_complex_type_node ();
1792 : 15885 : m2_c_type_node = m2_long_complex_type_node;
1793 : 15885 : m2_complex32_type_node = build_m2_complex32_type_node ();
1794 : 15885 : m2_complex64_type_node = build_m2_complex64_type_node ();
1795 : 15885 : m2_complex96_type_node = build_m2_complex96_type_node ();
1796 : 15885 : m2_complex128_type_node = build_m2_complex128_type_node ();
1797 : 15885 : m2_iso_loc_type_node = build_m2_iso_loc_node ();
1798 : :
1799 : 15885 : m2_cardinal_address_type_node
1800 : 15885 : = build_m2_cardinal_address_type_node (location);
1801 : :
1802 : 15885 : m2_packed_boolean_type_node = build_nonstandard_integer_type (1, true);
1803 : 15885 : build_m2_boolean (location);
1804 : :
1805 : 15885 : if (M2Options_GetPPOnly ())
1806 : : return;
1807 : :
1808 : 15885 : m2builtins_init (location);
1809 : 15885 : m2except_InitExceptions (location);
1810 : 15885 : m2expr_init (location);
1811 : : }
1812 : :
1813 : : /* BuildStartType given a, type, with a, name, return a GCC
1814 : : declaration of this type. TYPE name = foo ;
1815 : :
1816 : : the type, foo, maybe a partially created type (which has
1817 : : yet to be 'gm2_finish_decl'ed). */
1818 : :
1819 : : tree
1820 : 674986 : m2type_BuildStartType (location_t location, char *name, tree type)
1821 : : {
1822 : 674986 : tree id = get_identifier (name);
1823 : 674986 : tree decl, tem;
1824 : :
1825 : 674986 : m2assert_AssertLocation (location);
1826 : 674986 : ASSERT (m2tree_is_type (type), type);
1827 : 674986 : type = m2tree_skip_type_decl (type);
1828 : 674986 : decl = build_decl (location, TYPE_DECL, id, type);
1829 : :
1830 : 674986 : tem = m2block_pushDecl (decl);
1831 : 674986 : ASSERT (tem == decl, decl);
1832 : 674986 : ASSERT (m2tree_is_type (decl), decl);
1833 : :
1834 : 674986 : return tem;
1835 : : }
1836 : :
1837 : : /* BuildEndType finish declaring, type, and return, type. */
1838 : :
1839 : : tree
1840 : 674986 : m2type_BuildEndType (location_t location, tree type)
1841 : : {
1842 : 674986 : m2assert_AssertLocation (location);
1843 : 674986 : layout_type (TREE_TYPE (type));
1844 : 674986 : gm2_finish_decl (location, type);
1845 : 674986 : return type;
1846 : : }
1847 : :
1848 : : /* DeclareKnownType given a, type, with a, name, return a GCC
1849 : : declaration of this type. TYPE name = foo ; */
1850 : :
1851 : : tree
1852 : 645763 : m2type_DeclareKnownType (location_t location, char *name, tree type)
1853 : : {
1854 : 645763 : m2assert_AssertLocation (location);
1855 : 645763 : return m2type_BuildEndType (location,
1856 : 645763 : m2type_BuildStartType (location, name, type));
1857 : : }
1858 : :
1859 : : /* GetDefaultType given a, type, with a, name, return a GCC
1860 : : declaration of this type. Checks to see whether the type name has
1861 : : already been declared as a default type and if so it returns this
1862 : : declaration. Otherwise it declares the type. In Modula-2 this is
1863 : : equivalent to:
1864 : :
1865 : : TYPE name = type ;
1866 : :
1867 : : We need this function during gm2 initialization as it allows
1868 : : gm2 to access default types before creating Modula-2 types. */
1869 : :
1870 : : tree
1871 : 644312 : m2type_GetDefaultType (location_t location, char *name, tree type)
1872 : : {
1873 : 644312 : tree id = maybe_get_identifier (name);
1874 : :
1875 : 644312 : m2assert_AssertLocation (location);
1876 : 644312 : if (id == NULL)
1877 : : {
1878 : : tree prev = type;
1879 : : tree t;
1880 : :
1881 : 1486813 : while (prev != NULL)
1882 : : {
1883 : 842501 : if (TYPE_NAME (prev) == NULL)
1884 : 610947 : TYPE_NAME (prev) = get_identifier (name);
1885 : 842501 : prev = TREE_TYPE (prev);
1886 : : }
1887 : 644312 : t = m2type_DeclareKnownType (location, name, type);
1888 : 644312 : return t;
1889 : : }
1890 : : else
1891 : : return id;
1892 : : }
1893 : :
1894 : : tree
1895 : 47655 : do_min_real (tree type)
1896 : : {
1897 : 47655 : REAL_VALUE_TYPE r;
1898 : 47655 : char buf[128];
1899 : 47655 : enum machine_mode mode = TYPE_MODE (type);
1900 : :
1901 : 47655 : get_max_float (REAL_MODE_FORMAT (mode), buf, sizeof (buf), false);
1902 : 47655 : real_from_string (&r, buf);
1903 : 47655 : return build1 (NEGATE_EXPR, type, build_real (type, r));
1904 : : }
1905 : :
1906 : : /* GetMinFrom given a, type, return a constant representing the
1907 : : minimum legal value. */
1908 : :
1909 : : tree
1910 : 976467 : m2type_GetMinFrom (location_t location, tree type)
1911 : : {
1912 : 976467 : m2assert_AssertLocation (location);
1913 : :
1914 : 976467 : if (type == m2_real_type_node || type == m2type_GetRealType ())
1915 : 15885 : return do_min_real (type);
1916 : 960582 : if (type == m2_long_real_type_node || type == m2type_GetLongRealType ())
1917 : 15885 : return do_min_real (type);
1918 : 944697 : if (type == m2_short_real_type_node || type == m2type_GetShortRealType ())
1919 : 15885 : return do_min_real (type);
1920 : 928812 : if (type == ptr_type_node)
1921 : 15885 : return m2expr_GetPointerZero (location);
1922 : :
1923 : 912927 : return TYPE_MIN_VALUE (m2tree_skip_type_decl (type));
1924 : : }
1925 : :
1926 : : tree
1927 : 47655 : do_max_real (tree type)
1928 : : {
1929 : 47655 : REAL_VALUE_TYPE r;
1930 : 47655 : char buf[128];
1931 : 47655 : enum machine_mode mode = TYPE_MODE (type);
1932 : :
1933 : 47655 : get_max_float (REAL_MODE_FORMAT (mode), buf, sizeof (buf), false);
1934 : 47655 : real_from_string (&r, buf);
1935 : 47655 : return build_real (type, r);
1936 : : }
1937 : :
1938 : : /* GetMaxFrom given a, type, return a constant representing the
1939 : : maximum legal value. */
1940 : :
1941 : : tree
1942 : 997584 : m2type_GetMaxFrom (location_t location, tree type)
1943 : : {
1944 : 997584 : m2assert_AssertLocation (location);
1945 : :
1946 : 997584 : if (type == m2_real_type_node || type == m2type_GetRealType ())
1947 : 15885 : return do_max_real (type);
1948 : 981699 : if (type == m2_long_real_type_node || type == m2type_GetLongRealType ())
1949 : 15885 : return do_max_real (type);
1950 : 965814 : if (type == m2_short_real_type_node || type == m2type_GetShortRealType ())
1951 : 15885 : return do_max_real (type);
1952 : 949929 : if (type == ptr_type_node)
1953 : 15885 : return fold (m2expr_BuildSub (location, m2expr_GetPointerZero (location),
1954 : 15885 : m2expr_GetPointerOne (location), false));
1955 : :
1956 : 934044 : return TYPE_MAX_VALUE (m2tree_skip_type_decl (type));
1957 : : }
1958 : :
1959 : : /* BuildTypeDeclaration adds the, type, to the current statement
1960 : : list. */
1961 : :
1962 : : void
1963 : 43936 : m2type_BuildTypeDeclaration (location_t location, tree type)
1964 : : {
1965 : 43936 : enum tree_code code = TREE_CODE (type);
1966 : :
1967 : 43936 : m2assert_AssertLocation (location);
1968 : 43936 : if (code == TYPE_DECL || code == RECORD_TYPE || code == POINTER_TYPE)
1969 : : {
1970 : 43936 : m2block_pushDecl (build_decl (location, TYPE_DECL, NULL, type));
1971 : : }
1972 : 0 : else if (code == VAR_DECL)
1973 : : {
1974 : 0 : m2type_BuildTypeDeclaration (location, TREE_TYPE (type));
1975 : 0 : m2block_pushDecl (
1976 : : build_stmt (location, DECL_EXPR,
1977 : : type)); /* Is this safe? --fixme--. */
1978 : : }
1979 : 43936 : }
1980 : :
1981 : : /* Begin compiling the definition of an enumeration type. NAME is
1982 : : its name (or null if anonymous). Returns the type object, as yet
1983 : : incomplete. Also records info about it so that build_enumerator may
1984 : : be used to declare the individual values as they are read. */
1985 : :
1986 : : static tree
1987 : 23119 : gm2_start_enum (location_t location, tree name, int ispacked)
1988 : : {
1989 : 23119 : tree enumtype = make_node (ENUMERAL_TYPE);
1990 : :
1991 : 23119 : m2assert_AssertLocation (location);
1992 : 23119 : if (TYPE_VALUES (enumtype) != 0)
1993 : : {
1994 : : /* This enum is a named one that has been declared already. */
1995 : 0 : error_at (location, "redeclaration of enum %qs",
1996 : 0 : IDENTIFIER_POINTER (name));
1997 : :
1998 : : /* Completely replace its old definition. The old enumerators remain
1999 : : defined, however. */
2000 : 0 : TYPE_VALUES (enumtype) = 0;
2001 : : }
2002 : :
2003 : 23119 : TYPE_PACKED (enumtype) = ispacked;
2004 : 23119 : TREE_TYPE (enumtype) = m2type_GetIntegerType ();
2005 : :
2006 : : /* This is required as rest_of_type_compilation will use this field
2007 : : when called from gm2_finish_enum.
2008 : :
2009 : : Create a fake NULL-named TYPE_DECL node whose TREE_TYPE will be the
2010 : : tagged type we just added to the current scope. This fake NULL-named
2011 : : TYPE_DECL node helps dwarfout.cc to know when it needs to output a
2012 : : representation of a tagged type, and it also gives us a convenient
2013 : : place to record the "scope start" address for the tagged type. */
2014 : :
2015 : 23119 : TYPE_STUB_DECL (enumtype) = m2block_pushDecl (
2016 : : build_decl (location, TYPE_DECL, NULL_TREE, enumtype));
2017 : :
2018 : 23119 : return enumtype;
2019 : : }
2020 : :
2021 : : /* After processing and defining all the values of an enumeration
2022 : : type, install their decls in the enumeration type and finish it off.
2023 : : ENUMTYPE is the type object, VALUES a list of decl-value pairs, and
2024 : : ATTRIBUTES are the specified attributes. Returns ENUMTYPE. */
2025 : :
2026 : : static tree
2027 : 23119 : gm2_finish_enum (location_t location, tree enumtype, tree values)
2028 : : {
2029 : 23119 : tree pair, tem;
2030 : 23119 : tree minnode = 0, maxnode = 0;
2031 : 23119 : int precision;
2032 : 23119 : signop sign;
2033 : :
2034 : : /* Calculate the maximum value of any enumerator in this type. */
2035 : :
2036 : 23119 : if (values == error_mark_node)
2037 : 0 : minnode = maxnode = integer_zero_node;
2038 : : else
2039 : : {
2040 : 23119 : minnode = maxnode = TREE_VALUE (values);
2041 : 419219 : for (pair = TREE_CHAIN (values); pair; pair = TREE_CHAIN (pair))
2042 : : {
2043 : 396100 : tree value = TREE_VALUE (pair);
2044 : 396100 : if (tree_int_cst_lt (maxnode, value))
2045 : 84 : maxnode = value;
2046 : 396100 : if (tree_int_cst_lt (value, minnode))
2047 : 396000 : minnode = value;
2048 : : }
2049 : : }
2050 : :
2051 : : /* Construct the final type of this enumeration. It is the same as
2052 : : one of the integral types the narrowest one that fits, except that
2053 : : normally we only go as narrow as int and signed iff any of the
2054 : : values are negative. */
2055 : 23119 : sign = (tree_int_cst_sgn (minnode) >= 0) ? UNSIGNED : SIGNED;
2056 : 23119 : precision = MAX (tree_int_cst_min_precision (minnode, sign),
2057 : : tree_int_cst_min_precision (maxnode, sign));
2058 : :
2059 : 23119 : if (precision > TYPE_PRECISION (integer_type_node))
2060 : : {
2061 : 0 : warning (0, "enumeration values exceed range of integer");
2062 : 0 : tem = long_long_integer_type_node;
2063 : : }
2064 : 23119 : else if (TYPE_PACKED (enumtype))
2065 : 36 : tem = m2type_BuildSmallestTypeRange (location, minnode, maxnode);
2066 : : else
2067 : 23083 : tem = sign == UNSIGNED ? unsigned_type_node : integer_type_node;
2068 : :
2069 : 23119 : TYPE_MIN_VALUE (enumtype) = TYPE_MIN_VALUE (tem);
2070 : 23119 : TYPE_MAX_VALUE (enumtype) = TYPE_MAX_VALUE (tem);
2071 : 23119 : TYPE_UNSIGNED (enumtype) = TYPE_UNSIGNED (tem);
2072 : 23119 : TYPE_SIZE (enumtype) = 0;
2073 : :
2074 : : /* If the precision of the type was specific with an attribute and it
2075 : : was too small, give an error. Otherwise, use it. */
2076 : 23119 : if (TYPE_PRECISION (enumtype))
2077 : : {
2078 : 0 : if (precision > TYPE_PRECISION (enumtype))
2079 : 0 : error ("specified mode too small for enumerated values");
2080 : : }
2081 : : else
2082 : 23119 : TYPE_PRECISION (enumtype) = TYPE_PRECISION (tem);
2083 : :
2084 : 23119 : layout_type (enumtype);
2085 : :
2086 : 23119 : if (values != error_mark_node)
2087 : : {
2088 : :
2089 : : /* Change the type of the enumerators to be the enum type. We need
2090 : : to do this irrespective of the size of the enum, for proper type
2091 : : checking. Replace the DECL_INITIALs of the enumerators, and the
2092 : : value slots of the list, with copies that have the enum type; they
2093 : : cannot be modified in place because they may be shared (e.g.
2094 : : integer_zero_node) Finally, change the purpose slots to point to the
2095 : : names of the decls. */
2096 : 442338 : for (pair = values; pair; pair = TREE_CHAIN (pair))
2097 : : {
2098 : 419219 : tree enu = TREE_PURPOSE (pair);
2099 : 419219 : tree ini = DECL_INITIAL (enu);
2100 : :
2101 : 419219 : TREE_TYPE (enu) = enumtype;
2102 : :
2103 : 419219 : if (TREE_TYPE (ini) != integer_type_node)
2104 : 0 : ini = convert (enumtype, ini);
2105 : :
2106 : 419219 : DECL_INITIAL (enu) = ini;
2107 : 419219 : TREE_PURPOSE (pair) = DECL_NAME (enu);
2108 : 419219 : TREE_VALUE (pair) = ini;
2109 : : }
2110 : :
2111 : 23119 : TYPE_VALUES (enumtype) = values;
2112 : : }
2113 : :
2114 : : /* Fix up all variant types of this enum type. */
2115 : 46238 : for (tem = TYPE_MAIN_VARIANT (enumtype); tem; tem = TYPE_NEXT_VARIANT (tem))
2116 : : {
2117 : 23119 : if (tem == enumtype)
2118 : 23119 : continue;
2119 : 0 : TYPE_VALUES (tem) = TYPE_VALUES (enumtype);
2120 : 0 : TYPE_MIN_VALUE (tem) = TYPE_MIN_VALUE (enumtype);
2121 : 0 : TYPE_MAX_VALUE (tem) = TYPE_MAX_VALUE (enumtype);
2122 : 0 : TYPE_SIZE (tem) = TYPE_SIZE (enumtype);
2123 : 0 : TYPE_SIZE_UNIT (tem) = TYPE_SIZE_UNIT (enumtype);
2124 : 0 : SET_TYPE_MODE (tem, TYPE_MODE (enumtype));
2125 : 0 : TYPE_PRECISION (tem) = TYPE_PRECISION (enumtype);
2126 : 0 : SET_TYPE_ALIGN (tem, TYPE_ALIGN (enumtype));
2127 : 0 : TYPE_USER_ALIGN (tem) = TYPE_USER_ALIGN (enumtype);
2128 : 0 : TYPE_UNSIGNED (tem) = TYPE_UNSIGNED (enumtype);
2129 : 0 : TYPE_LANG_SPECIFIC (tem) = TYPE_LANG_SPECIFIC (enumtype);
2130 : : }
2131 : :
2132 : : /* Finish debugging output for this type. */
2133 : 23119 : rest_of_type_compilation (enumtype, m2block_toplevel ());
2134 : 23119 : return enumtype;
2135 : : }
2136 : :
2137 : : /* BuildStartEnumeration create an enumerated type in gcc. */
2138 : :
2139 : : tree
2140 : 23119 : m2type_BuildStartEnumeration (location_t location, char *name, bool ispacked)
2141 : : {
2142 : 23119 : tree id;
2143 : :
2144 : 23119 : m2assert_AssertLocation (location);
2145 : 23119 : if ((name == NULL) || (strcmp (name, "") == 0))
2146 : : id = NULL_TREE;
2147 : : else
2148 : 22880 : id = get_identifier (name);
2149 : :
2150 : 23119 : return gm2_start_enum (location, id, ispacked);
2151 : : }
2152 : :
2153 : : /* BuildEndEnumeration finish building the enumeration, it uses the
2154 : : enum list, enumvalues, and returns a enumeration type tree. */
2155 : :
2156 : : tree
2157 : 23119 : m2type_BuildEndEnumeration (location_t location, tree enumtype,
2158 : : tree enumvalues)
2159 : : {
2160 : 23119 : tree finished ATTRIBUTE_UNUSED
2161 : 23119 : = gm2_finish_enum (location, enumtype, enumvalues);
2162 : 23119 : return enumtype;
2163 : : }
2164 : :
2165 : : /* Build and install a CONST_DECL for one value of the current
2166 : : enumeration type (one that was begun with start_enum). Return a
2167 : : tree-list containing the CONST_DECL and its value. Assignment of
2168 : : sequential values by default is handled here. */
2169 : :
2170 : : static tree
2171 : 419219 : gm2_build_enumerator (location_t location, tree name, tree value)
2172 : : {
2173 : 419219 : tree decl, type;
2174 : :
2175 : 419219 : m2assert_AssertLocation (location);
2176 : : /* Remove no-op casts from the value. */
2177 : 419219 : if (value)
2178 : 419219 : STRIP_TYPE_NOPS (value);
2179 : :
2180 : : /* Now create a declaration for the enum value name. */
2181 : :
2182 : 419219 : type = TREE_TYPE (value);
2183 : :
2184 : 419219 : decl = build_decl (location, CONST_DECL, name, type);
2185 : 419219 : DECL_INITIAL (decl) = convert (type, value);
2186 : 419219 : m2block_pushDecl (decl);
2187 : :
2188 : 419219 : return tree_cons (decl, value, NULL_TREE);
2189 : : }
2190 : :
2191 : : /* BuildEnumerator build an enumerator and add it to the,
2192 : : enumvalues, list. It returns a copy of the value. */
2193 : :
2194 : : tree
2195 : 419219 : m2type_BuildEnumerator (location_t location, char *name, tree value,
2196 : : tree *enumvalues)
2197 : : {
2198 : 419219 : tree id = get_identifier (name);
2199 : 419219 : tree copy_of_value = copy_node (value);
2200 : 419219 : tree gccenum = gm2_build_enumerator (location, id, copy_of_value);
2201 : :
2202 : 419219 : m2assert_AssertLocation (location);
2203 : : /* Choose copy_of_value for enum value. */
2204 : 419219 : *enumvalues = chainon (gccenum, *enumvalues);
2205 : 419219 : return copy_of_value;
2206 : : }
2207 : :
2208 : : /* BuildPointerType returns a type which is a pointer to, totype. */
2209 : :
2210 : : tree
2211 : 164741 : m2type_BuildPointerType (tree totype)
2212 : : {
2213 : 164741 : return build_pointer_type (m2tree_skip_type_decl (totype));
2214 : : }
2215 : :
2216 : : /* BuildConstPointerType returns a type which is a const pointer
2217 : : to, totype. */
2218 : :
2219 : : tree
2220 : 54 : m2type_BuildConstPointerType (tree totype)
2221 : : {
2222 : 54 : tree t = build_pointer_type (m2tree_skip_type_decl (totype));
2223 : 54 : TYPE_READONLY (t) = true;
2224 : 54 : return t;
2225 : : }
2226 : :
2227 : : /* BuildSetType creates a SET OF [lowval..highval]. */
2228 : :
2229 : : tree
2230 : 26659 : m2type_BuildSetType (location_t location, char *name, tree type, tree lowval,
2231 : : tree highval, bool ispacked)
2232 : : {
2233 : 26659 : tree range = build_range_type (m2tree_skip_type_decl (type),
2234 : : m2expr_FoldAndStrip (lowval),
2235 : : m2expr_FoldAndStrip (highval));
2236 : :
2237 : 26659 : TYPE_PACKED (range) = ispacked;
2238 : 26659 : m2assert_AssertLocation (location);
2239 : 26659 : return m2type_BuildSetTypeFromSubrange (location, name, range,
2240 : : m2expr_FoldAndStrip (lowval),
2241 : : m2expr_FoldAndStrip (highval),
2242 : 26659 : ispacked);
2243 : : }
2244 : :
2245 : : /* push_constructor returns a new compound constructor frame. */
2246 : :
2247 : : static struct struct_constructor *
2248 : 5311 : push_constructor (void)
2249 : : {
2250 : 0 : struct struct_constructor *p = ggc_alloc<struct_constructor> ();
2251 : :
2252 : 5311 : p->level = top_constructor;
2253 : 5311 : top_constructor = p;
2254 : 5311 : return p;
2255 : : }
2256 : :
2257 : : /* pop_constructor throws away the top constructor frame on the
2258 : : stack. */
2259 : :
2260 : : static void
2261 : 5311 : pop_constructor (struct struct_constructor *p)
2262 : : {
2263 : 5311 : ASSERT_CONDITION (p
2264 : 5311 : == top_constructor); /* p should be the top_constructor. */
2265 : 5311 : top_constructor = top_constructor->level;
2266 : 5311 : }
2267 : :
2268 : : /* BuildStartSetConstructor starts to create a set constant.
2269 : : Remember that type is really a record type. */
2270 : :
2271 : : void *
2272 : 1703 : m2type_BuildStartSetConstructor (tree type)
2273 : : {
2274 : 1703 : struct struct_constructor *p = push_constructor ();
2275 : :
2276 : 1703 : type = m2tree_skip_type_decl (type);
2277 : 1703 : layout_type (type);
2278 : 1703 : p->constructor_type = type;
2279 : 1703 : p->constructor_fields = TYPE_FIELDS (type);
2280 : 1703 : p->constructor_element_list = NULL_TREE;
2281 : 1703 : vec_alloc (p->constructor_elements, 1);
2282 : 1703 : return (void *)p;
2283 : : }
2284 : :
2285 : : /* BuildSetConstructorElement adds, value, to the
2286 : : constructor_element_list. */
2287 : :
2288 : : void
2289 : 27814 : m2type_BuildSetConstructorElement (void *p, tree value)
2290 : : {
2291 : 27814 : struct struct_constructor *c = (struct struct_constructor *)p;
2292 : :
2293 : 27814 : if (value == NULL_TREE)
2294 : : {
2295 : 0 : internal_error ("set type cannot be initialized with a %qs",
2296 : : "NULL_TREE");
2297 : : return;
2298 : : }
2299 : :
2300 : 27814 : if (c->constructor_fields == NULL)
2301 : : {
2302 : 0 : internal_error ("set type does not take another integer value");
2303 : : return;
2304 : : }
2305 : :
2306 : 27814 : c->constructor_element_list
2307 : 27814 : = tree_cons (c->constructor_fields, value, c->constructor_element_list);
2308 : 27814 : c->constructor_fields = TREE_CHAIN (c->constructor_fields);
2309 : : }
2310 : :
2311 : : /* BuildEndSetConstructor finishes building a set constant. */
2312 : :
2313 : : tree
2314 : 1703 : m2type_BuildEndSetConstructor (void *p)
2315 : : {
2316 : 1703 : tree constructor;
2317 : 1703 : tree link;
2318 : 1703 : struct struct_constructor *c = (struct struct_constructor *)p;
2319 : :
2320 : 19893 : for (link = c->constructor_element_list; link; link = TREE_CHAIN (link))
2321 : : {
2322 : 18190 : tree field = TREE_PURPOSE (link);
2323 : 18190 : DECL_SIZE (field) = bitsize_int (SET_WORD_SIZE);
2324 : 18190 : DECL_BIT_FIELD (field) = 1;
2325 : : }
2326 : :
2327 : 1703 : constructor = build_constructor_from_list (
2328 : : c->constructor_type, nreverse (c->constructor_element_list));
2329 : 1703 : TREE_CONSTANT (constructor) = 1;
2330 : 1703 : TREE_STATIC (constructor) = 1;
2331 : :
2332 : 1703 : pop_constructor (c);
2333 : :
2334 : 1703 : return constructor;
2335 : : }
2336 : :
2337 : : /* BuildStartRecordConstructor initializes a record compound
2338 : : constructor frame. */
2339 : :
2340 : : void *
2341 : 2332 : m2type_BuildStartRecordConstructor (tree type)
2342 : : {
2343 : 2332 : struct struct_constructor *p = push_constructor ();
2344 : :
2345 : 2332 : type = m2tree_skip_type_decl (type);
2346 : 2332 : layout_type (type);
2347 : 2332 : p->constructor_type = type;
2348 : 2332 : p->constructor_fields = TYPE_FIELDS (type);
2349 : 2332 : p->constructor_element_list = NULL_TREE;
2350 : 2332 : vec_alloc (p->constructor_elements, 1);
2351 : 2332 : return (void *)p;
2352 : : }
2353 : :
2354 : : /* BuildEndRecordConstructor returns a tree containing the record
2355 : : compound literal. */
2356 : :
2357 : : tree
2358 : 2332 : m2type_BuildEndRecordConstructor (void *p)
2359 : : {
2360 : 2332 : struct struct_constructor *c = (struct struct_constructor *)p;
2361 : 2332 : tree constructor = build_constructor_from_list (
2362 : : c->constructor_type, nreverse (c->constructor_element_list));
2363 : 2332 : TREE_CONSTANT (constructor) = 1;
2364 : 2332 : TREE_STATIC (constructor) = 1;
2365 : :
2366 : 2332 : pop_constructor (c);
2367 : :
2368 : 2332 : return constructor;
2369 : : }
2370 : :
2371 : : /* BuildRecordConstructorElement adds, value, to the
2372 : : constructor_element_list. */
2373 : :
2374 : : void
2375 : 9624 : m2type_BuildRecordConstructorElement (void *p, tree value)
2376 : : {
2377 : 9624 : m2type_BuildSetConstructorElement (p, value);
2378 : 9624 : }
2379 : :
2380 : : /* BuildStartArrayConstructor initializes an array compound
2381 : : constructor frame. */
2382 : :
2383 : : void *
2384 : 1276 : m2type_BuildStartArrayConstructor (tree type)
2385 : : {
2386 : 1276 : struct struct_constructor *p = push_constructor ();
2387 : :
2388 : 1276 : type = m2tree_skip_type_decl (type);
2389 : 1276 : layout_type (type);
2390 : 1276 : p->constructor_type = type;
2391 : 1276 : p->constructor_fields = TREE_TYPE (type);
2392 : 1276 : p->constructor_element_list = NULL_TREE;
2393 : 1276 : vec_alloc (p->constructor_elements, 1);
2394 : 1276 : return (void *)p;
2395 : : }
2396 : :
2397 : : /* BuildEndArrayConstructor returns a tree containing the array
2398 : : compound literal. */
2399 : :
2400 : : tree
2401 : 1276 : m2type_BuildEndArrayConstructor (void *p)
2402 : : {
2403 : 1276 : struct struct_constructor *c = (struct struct_constructor *)p;
2404 : 1276 : tree constructor;
2405 : :
2406 : 1276 : constructor
2407 : 1276 : = build_constructor (c->constructor_type, c->constructor_elements);
2408 : 1276 : TREE_CONSTANT (constructor) = true;
2409 : 1276 : TREE_STATIC (constructor) = true;
2410 : :
2411 : 1276 : pop_constructor (c);
2412 : :
2413 : 1276 : return constructor;
2414 : : }
2415 : :
2416 : : /* BuildArrayConstructorElement adds, value, to the
2417 : : constructor_element_list. */
2418 : :
2419 : : void
2420 : 13544 : m2type_BuildArrayConstructorElement (void *p, tree value, tree indice)
2421 : : {
2422 : 13544 : struct struct_constructor *c = (struct struct_constructor *)p;
2423 : 13544 : constructor_elt celt;
2424 : :
2425 : 13544 : if (value == NULL_TREE)
2426 : : {
2427 : 0 : internal_error ("array cannot be initialized with a %qs", "NULL_TREE");
2428 : : return;
2429 : : }
2430 : :
2431 : 13544 : if (c->constructor_fields == NULL_TREE)
2432 : : {
2433 : 0 : internal_error ("array type must be initialized");
2434 : : return;
2435 : : }
2436 : :
2437 : 13544 : if (c->constructor_fields != TREE_TYPE (value))
2438 : : {
2439 : 0 : internal_error (
2440 : : "array element value must be the same type as its declaration");
2441 : : return;
2442 : : }
2443 : :
2444 : 13544 : celt.index = indice;
2445 : 13544 : celt.value = value;
2446 : 13544 : vec_safe_push (c->constructor_elements, celt);
2447 : : }
2448 : :
2449 : : /* BuildArrayStringConstructor creates an array constructor for,
2450 : : arrayType, consisting of the character elements defined by, str,
2451 : : of, length, characters. */
2452 : :
2453 : : tree
2454 : 24 : m2type_BuildArrayStringConstructor (location_t location, tree arrayType,
2455 : : tree str, tree length)
2456 : : {
2457 : 24 : tree n;
2458 : 24 : tree val;
2459 : 24 : int i = 0;
2460 : 24 : const char *p = TREE_STRING_POINTER (str);
2461 : 24 : tree type = m2tree_skip_type_decl (TREE_TYPE (arrayType));
2462 : 24 : struct struct_constructor *c
2463 : 24 : = (struct struct_constructor *)m2type_BuildStartArrayConstructor (
2464 : : arrayType);
2465 : 24 : char nul[1];
2466 : 24 : int len = strlen (p);
2467 : :
2468 : 24 : nul[0] = (char)0;
2469 : :
2470 : 24 : m2assert_AssertLocation (location);
2471 : 24 : n = m2expr_GetIntegerZero (location);
2472 : 336 : while (m2expr_CompareTrees (n, length) < 0)
2473 : : {
2474 : 288 : if (i < len)
2475 : 264 : val = m2convert_BuildConvert (
2476 : 264 : location, type, m2type_BuildCharConstant (location, &p[i]), false);
2477 : : else
2478 : 24 : val = m2type_BuildCharConstant (location, &nul[0]);
2479 : 288 : m2type_BuildArrayConstructorElement (c, val, n);
2480 : 288 : i += 1;
2481 : 288 : n = m2expr_BuildAdd (location, n, m2expr_GetIntegerOne (location),
2482 : : false);
2483 : : }
2484 : 24 : return m2type_BuildEndArrayConstructor (c);
2485 : : }
2486 : :
2487 : : /* BuildSubrangeType creates a subrange of, type, with, lowval,
2488 : : highval. */
2489 : :
2490 : : tree
2491 : 69807 : m2type_BuildSubrangeType (location_t location, char *name, tree type,
2492 : : tree lowval, tree highval)
2493 : : {
2494 : 69807 : tree range_type;
2495 : :
2496 : 69807 : m2assert_AssertLocation (location);
2497 : 69807 : type = m2tree_skip_type_decl (type);
2498 : :
2499 : 69807 : lowval = m2expr_FoldAndStrip (lowval);
2500 : 69807 : highval = m2expr_FoldAndStrip (highval);
2501 : :
2502 : 69807 : if (m2expr_TreeOverflow (lowval))
2503 : 0 : error ("low bound for the subrange has overflowed");
2504 : 69807 : if (m2expr_TreeOverflow (highval))
2505 : 0 : error ("high bound for the subrange has overflowed");
2506 : :
2507 : : /* First build a type with the base range. */
2508 : 69807 : range_type = build_range_type (type, lowval, highval);
2509 : :
2510 : 69807 : TYPE_UNSIGNED (range_type) = TYPE_UNSIGNED (type);
2511 : : #if 0
2512 : : /* Then set the actual range. */
2513 : : SET_TYPE_RM_MIN_VALUE (range_type, lowval);
2514 : : SET_TYPE_RM_MAX_VALUE (range_type, highval);
2515 : : #endif
2516 : :
2517 : 69807 : if ((name != NULL) && (strcmp (name, "") != 0))
2518 : : {
2519 : : /* Declared as TYPE foo = [x..y]; */
2520 : 1451 : range_type = m2type_DeclareKnownType (location, name, range_type);
2521 : 1451 : layout_type (m2tree_skip_type_decl (range_type));
2522 : : }
2523 : :
2524 : 69807 : return range_type;
2525 : : }
2526 : :
2527 : : /* BuildCharConstantChar creates a character constant given a character, ch. */
2528 : :
2529 : : tree
2530 : 28010 : m2type_BuildCharConstantChar (location_t location, char ch)
2531 : : {
2532 : 28010 : tree id = build_int_cst (char_type_node, (int) ch);
2533 : 28010 : id = m2convert_BuildConvert (location, m2type_GetM2CharType (), id, false);
2534 : 28010 : return m2block_RememberConstant (id);
2535 : : }
2536 : :
2537 : : /* BuildCharConstant creates a character constant given a, string. */
2538 : :
2539 : : tree
2540 : 24146 : m2type_BuildCharConstant (location_t location, const char *string)
2541 : : {
2542 : 24146 : return m2type_BuildCharConstantChar (location, string[0]);
2543 : : }
2544 : :
2545 : : /* RealToTree convert a real number into a Tree. */
2546 : :
2547 : : tree
2548 : 6484 : m2type_RealToTree (char *name)
2549 : : {
2550 : 6484 : return build_real (
2551 : : m2type_GetLongRealType (),
2552 : 6484 : REAL_VALUE_ATOF (name, TYPE_MODE (m2type_GetLongRealType ())));
2553 : : }
2554 : :
2555 : : /* gm2_start_struct start to create a struct. */
2556 : :
2557 : : static tree
2558 : 84456 : gm2_start_struct (location_t location, enum tree_code code, char *name)
2559 : : {
2560 : 84456 : tree s = make_node (code);
2561 : 84456 : tree id;
2562 : :
2563 : 84456 : m2assert_AssertLocation (location);
2564 : 84456 : if ((name == NULL) || (strcmp (name, "") == 0))
2565 : : id = NULL_TREE;
2566 : : else
2567 : 51105 : id = get_identifier (name);
2568 : :
2569 : : /* This maybe set true later if necessary. */
2570 : 84456 : TYPE_PACKED (s) = false;
2571 : :
2572 : 84456 : m2block_pushDecl (build_decl (location, TYPE_DECL, id, s));
2573 : 84456 : return s;
2574 : : }
2575 : :
2576 : : /* BuildStartRecord return a RECORD tree. */
2577 : :
2578 : : tree
2579 : 84180 : m2type_BuildStartRecord (location_t location, char *name)
2580 : : {
2581 : 84180 : m2assert_AssertLocation (location);
2582 : 84180 : return gm2_start_struct (location, RECORD_TYPE, name);
2583 : : }
2584 : :
2585 : : /* BuildStartUnion return a union tree. */
2586 : :
2587 : : tree
2588 : 276 : m2type_BuildStartUnion (location_t location, char *name)
2589 : : {
2590 : 276 : m2assert_AssertLocation (location);
2591 : 276 : return gm2_start_struct (location, UNION_TYPE, name);
2592 : : }
2593 : :
2594 : : /* m2type_BuildStartVarient builds a varient record. It creates a
2595 : : record field which has a, name, and whose type is a union. */
2596 : :
2597 : : tree
2598 : 276 : m2type_BuildStartVarient (location_t location, char *name)
2599 : : {
2600 : 276 : tree varient = m2type_BuildStartUnion (location, name);
2601 : 276 : tree field = m2type_BuildStartFieldRecord (location, name, varient);
2602 : 276 : m2assert_AssertLocation (location);
2603 : 276 : return field;
2604 : : }
2605 : :
2606 : : /* m2type_BuildEndVarient finish the varientField by calling
2607 : : decl_finish and also finish the type of varientField (which is a
2608 : : union). */
2609 : :
2610 : : tree
2611 : 276 : m2type_BuildEndVarient (location_t location, tree varientField,
2612 : : tree varientList, bool isPacked)
2613 : : {
2614 : 276 : tree varient = TREE_TYPE (varientField);
2615 : 276 : m2assert_AssertLocation (location);
2616 : 276 : varient = m2type_BuildEndRecord (location, varient, varientList, isPacked);
2617 : 276 : gm2_finish_decl (location, varientField);
2618 : 276 : return varientField;
2619 : : }
2620 : :
2621 : : /* m2type_BuildStartFieldVarient builds a field varient record. It
2622 : : creates a record field which has a, name, and whose type is a
2623 : : record. */
2624 : :
2625 : : tree
2626 : 666 : m2type_BuildStartFieldVarient (location_t location, char *name)
2627 : : {
2628 : 666 : tree record = m2type_BuildStartRecord (location, name);
2629 : 666 : tree field = m2type_BuildStartFieldRecord (location, name, record);
2630 : 666 : m2assert_AssertLocation (location);
2631 : 666 : return field;
2632 : : }
2633 : :
2634 : : /* BuildEndRecord a heavily pruned finish_struct from c-decl.cc. It
2635 : : sets the context for each field to, t, propagates isPacked
2636 : : throughout the fields in the structure. */
2637 : :
2638 : : tree
2639 : 84456 : m2type_BuildEndRecord (location_t location, tree record, tree fieldlist,
2640 : : bool isPacked)
2641 : : {
2642 : 84456 : tree x, d;
2643 : :
2644 : 84456 : m2assert_AssertLocation (location);
2645 : :
2646 : : /* If this type was previously laid out as a forward reference, make
2647 : : sure we lay it out again. */
2648 : :
2649 : 84456 : TYPE_SIZE (record) = 0;
2650 : :
2651 : : /* Install struct as DECL_CONTEXT of each field decl. Also process
2652 : : specified field sizes, found in the DECL_INITIAL, storing 0 there
2653 : : after the type has been changed to precision equal to its width,
2654 : : rather than the precision of the specified standard type. (Correct
2655 : : layout requires the original type to have been preserved until now). */
2656 : :
2657 : 437290 : for (x = fieldlist; x; x = TREE_CHAIN (x))
2658 : : {
2659 : 352834 : DECL_CONTEXT (x) = record;
2660 : :
2661 : 352834 : if (TYPE_PACKED (record) && TYPE_ALIGN (TREE_TYPE (x)) > BITS_PER_UNIT)
2662 : 0 : DECL_PACKED (x) = 1;
2663 : :
2664 : 352834 : if (isPacked)
2665 : : {
2666 : 108 : DECL_PACKED (x) = 1;
2667 : 108 : DECL_BIT_FIELD (x) = 1;
2668 : : }
2669 : : }
2670 : :
2671 : : /* Now we have the nearly final fieldlist. Record it, then lay out
2672 : : the structure or union (including the fields). */
2673 : :
2674 : 84456 : TYPE_FIELDS (record) = fieldlist;
2675 : 84456 : layout_type (record);
2676 : :
2677 : : /* Now we have the truly final field list. Store it in this type and
2678 : : in the variants. */
2679 : :
2680 : 168912 : for (x = TYPE_MAIN_VARIANT (record); x; x = TYPE_NEXT_VARIANT (x))
2681 : : {
2682 : 84456 : TYPE_FIELDS (x) = TYPE_FIELDS (record);
2683 : 84456 : TYPE_LANG_SPECIFIC (x) = TYPE_LANG_SPECIFIC (record);
2684 : 84456 : SET_TYPE_ALIGN (x, TYPE_ALIGN (record));
2685 : 84456 : TYPE_USER_ALIGN (x) = TYPE_USER_ALIGN (record);
2686 : : }
2687 : :
2688 : 84456 : d = build_decl (location, TYPE_DECL, NULL, record);
2689 : 84456 : TYPE_STUB_DECL (record) = d;
2690 : :
2691 : : /* Finish debugging output for this type. This must be done after we have
2692 : : called build_decl. */
2693 : 84456 : rest_of_type_compilation (record, m2block_toplevel ());
2694 : :
2695 : 84456 : return record;
2696 : : }
2697 : :
2698 : : /* m2type_BuildEndFieldVarient finish the varientField by calling
2699 : : decl_finish and also finish the type of varientField (which is a
2700 : : record). */
2701 : :
2702 : : tree
2703 : 666 : m2type_BuildEndFieldVarient (location_t location, tree varientField,
2704 : : tree varientList, bool isPacked)
2705 : : {
2706 : 666 : tree record = TREE_TYPE (varientField);
2707 : :
2708 : 666 : m2assert_AssertLocation (location);
2709 : 666 : record = m2type_BuildEndRecord (location, record, varientList, isPacked);
2710 : 666 : gm2_finish_decl (location, varientField);
2711 : 666 : return varientField;
2712 : : }
2713 : :
2714 : : /* m2type_BuildStartFieldRecord starts building a field record. It
2715 : : returns the field which must be completed by calling
2716 : : gm2_finish_decl. */
2717 : :
2718 : : tree
2719 : 352864 : m2type_BuildStartFieldRecord (location_t location, char *name, tree type)
2720 : : {
2721 : 352864 : tree field, declarator;
2722 : :
2723 : 352864 : m2assert_AssertLocation (location);
2724 : 352864 : if ((name == NULL) || (strcmp (name, "") == 0))
2725 : : declarator = NULL_TREE;
2726 : : else
2727 : 326976 : declarator = get_identifier (name);
2728 : :
2729 : 352864 : field = build_decl (location, FIELD_DECL, declarator,
2730 : : m2tree_skip_type_decl (type));
2731 : 352864 : return field;
2732 : : }
2733 : :
2734 : : /* Build a record field with name (name maybe NULL), returning the
2735 : : new field declaration, FIELD_DECL.
2736 : :
2737 : : This is done during the parsing of the struct declaration. The
2738 : : FIELD_DECL nodes are chained together and the lot of them are
2739 : : ultimately passed to `build_struct' to make the RECORD_TYPE node. */
2740 : :
2741 : : tree
2742 : 351922 : m2type_BuildFieldRecord (location_t location, char *name, tree type)
2743 : : {
2744 : 351922 : tree field = m2type_BuildStartFieldRecord (location, name, type);
2745 : :
2746 : 351922 : m2assert_AssertLocation (location);
2747 : 351922 : gm2_finish_decl (location, field);
2748 : 351922 : return field;
2749 : : }
2750 : :
2751 : : /* ChainOn interface so that Modula-2 can also create chains of
2752 : : declarations. */
2753 : :
2754 : : tree
2755 : 352834 : m2type_ChainOn (tree t1, tree t2)
2756 : : {
2757 : 352834 : return chainon (t1, t2);
2758 : : }
2759 : :
2760 : : /* ChainOnParamValue adds a list node {{name, str}, value} into the
2761 : : tree list. */
2762 : :
2763 : : tree
2764 : 24 : m2type_ChainOnParamValue (tree list, tree name, tree str, tree value)
2765 : : {
2766 : 24 : return chainon (list, build_tree_list (build_tree_list (name, str), value));
2767 : : }
2768 : :
2769 : : /* AddStringToTreeList adds, string, to list. */
2770 : :
2771 : : tree
2772 : 0 : m2type_AddStringToTreeList (tree list, tree string)
2773 : : {
2774 : 0 : return tree_cons (NULL_TREE, string, list);
2775 : : }
2776 : :
2777 : : /* SetAlignment sets the alignment of a, node, to, align. It
2778 : : duplicates the, node, and sets the alignment to prevent alignment
2779 : : effecting behaviour elsewhere. */
2780 : :
2781 : : tree
2782 : 84 : m2type_SetAlignment (tree node, tree align)
2783 : : {
2784 : 84 : tree type = NULL_TREE;
2785 : 84 : tree decl = NULL_TREE;
2786 : 84 : bool is_type = false;
2787 : 84 : int i;
2788 : :
2789 : 84 : if (DECL_P (node))
2790 : : {
2791 : 42 : decl = node;
2792 : 42 : is_type = (TREE_CODE (node) == TYPE_DECL);
2793 : 42 : type = TREE_TYPE (decl);
2794 : : }
2795 : 42 : else if (TYPE_P (node))
2796 : : {
2797 : 42 : is_type = true;
2798 : 42 : type = node;
2799 : : }
2800 : :
2801 : 84 : if (TREE_CODE (align) != INTEGER_CST)
2802 : 0 : error ("requested alignment is not a constant");
2803 : 84 : else if ((i = tree_log2 (align)) == -1)
2804 : 0 : error ("requested alignment is not a power of 2");
2805 : 84 : else if (i > HOST_BITS_PER_INT - 2)
2806 : 0 : error ("requested alignment is too large");
2807 : 84 : else if (is_type)
2808 : : {
2809 : : /* If we have a TYPE_DECL, then copy the type, so that we don't
2810 : : accidentally modify a builtin type. See pushdecl. */
2811 : 18 : if (decl && TREE_TYPE (decl) != error_mark_node
2812 : 78 : && DECL_ORIGINAL_TYPE (decl) == NULL_TREE)
2813 : : {
2814 : 18 : tree tt = TREE_TYPE (decl);
2815 : 18 : type = build_variant_type_copy (type);
2816 : 18 : DECL_ORIGINAL_TYPE (decl) = tt;
2817 : 18 : TYPE_NAME (type) = decl;
2818 : 18 : TREE_USED (type) = TREE_USED (decl);
2819 : 18 : TREE_TYPE (decl) = type;
2820 : : }
2821 : :
2822 : 60 : SET_TYPE_ALIGN (type, (1 << i) * BITS_PER_UNIT);
2823 : 60 : TYPE_USER_ALIGN (type) = 1;
2824 : :
2825 : 60 : if (decl)
2826 : : {
2827 : 18 : SET_DECL_ALIGN (decl, (1 << i) * BITS_PER_UNIT);
2828 : 18 : DECL_USER_ALIGN (decl) = 1;
2829 : : }
2830 : : }
2831 : 24 : else if (TREE_CODE (decl) != VAR_DECL && TREE_CODE (decl) != FIELD_DECL)
2832 : 0 : error ("alignment may not be specified for %qD", decl);
2833 : : else
2834 : : {
2835 : 24 : SET_DECL_ALIGN (decl, (1 << i) * BITS_PER_UNIT);
2836 : 24 : DECL_USER_ALIGN (decl) = 1;
2837 : : }
2838 : 84 : return node;
2839 : : }
2840 : :
2841 : : /* SetDeclPacked sets the packed bit in decl TREE, node. It
2842 : : returns the node. */
2843 : :
2844 : : tree
2845 : 216 : m2type_SetDeclPacked (tree node)
2846 : : {
2847 : 216 : DECL_PACKED (node) = 1;
2848 : 216 : return node;
2849 : : }
2850 : :
2851 : : /* SetTypePacked sets the packed bit in type TREE, node. It
2852 : : returns the node. */
2853 : :
2854 : : tree
2855 : 36 : m2type_SetTypePacked (tree node)
2856 : : {
2857 : 36 : TYPE_PACKED (node) = 1;
2858 : 36 : return node;
2859 : : }
2860 : :
2861 : : /* SetRecordFieldOffset returns field after the byteOffset and
2862 : : bitOffset has been applied to it. */
2863 : :
2864 : : tree
2865 : 108 : m2type_SetRecordFieldOffset (tree field, tree byteOffset, tree bitOffset,
2866 : : tree fieldtype, tree nbits)
2867 : : {
2868 : 108 : DECL_FIELD_OFFSET (field) = byteOffset;
2869 : 108 : DECL_FIELD_BIT_OFFSET (field) = bitOffset;
2870 : 108 : TREE_TYPE (field) = m2tree_skip_type_decl (fieldtype);
2871 : 108 : DECL_SIZE (field) = bitsize_int (TREE_INT_CST_LOW (nbits));
2872 : 108 : return field;
2873 : : }
2874 : :
2875 : : /* BuildPackedFieldRecord builds a packed field record of, name,
2876 : : and, fieldtype. */
2877 : :
2878 : : tree
2879 : 0 : m2type_BuildPackedFieldRecord (location_t location, char *name, tree fieldtype)
2880 : : {
2881 : 0 : m2assert_AssertLocation (location);
2882 : 0 : return m2type_BuildFieldRecord (location, name, fieldtype);
2883 : : }
2884 : :
2885 : : /* BuildNumberOfArrayElements returns the number of elements in an
2886 : : arrayType. */
2887 : :
2888 : : tree
2889 : 456 : m2type_BuildNumberOfArrayElements (location_t location, tree arrayType)
2890 : : {
2891 : 456 : tree index = TYPE_DOMAIN (arrayType);
2892 : 456 : tree high = TYPE_MAX_VALUE (index);
2893 : 456 : tree low = TYPE_MIN_VALUE (index);
2894 : 456 : tree elements = m2expr_BuildAdd (
2895 : : location, m2expr_BuildSub (location, high, low, false),
2896 : : m2expr_GetIntegerOne (location), false);
2897 : 456 : m2assert_AssertLocation (location);
2898 : 456 : return elements;
2899 : : }
2900 : :
2901 : : /* AddStatement maps onto add_stmt. */
2902 : :
2903 : : void
2904 : 302377 : m2type_AddStatement (location_t location, tree t)
2905 : : {
2906 : 302377 : if (t != NULL_TREE)
2907 : 213059 : add_stmt (location, t);
2908 : 302377 : }
2909 : :
2910 : : /* MarkFunctionReferenced marks a function as referenced. */
2911 : :
2912 : : void
2913 : 14421 : m2type_MarkFunctionReferenced (tree f)
2914 : : {
2915 : 14421 : if (f != NULL_TREE)
2916 : 8016 : if (TREE_CODE (f) == FUNCTION_DECL)
2917 : 5648 : mark_decl_referenced (f);
2918 : 14421 : }
2919 : :
2920 : : /* GarbageCollect force gcc to garbage collect. */
2921 : :
2922 : : void
2923 : 0 : m2type_GarbageCollect (void)
2924 : : {
2925 : 0 : ggc_collect ();
2926 : 0 : }
2927 : :
2928 : : /* gm2_type_for_size return an integer type with BITS bits of
2929 : : precision, that is unsigned if UNSIGNEDP is nonzero, otherwise
2930 : : signed. */
2931 : :
2932 : : tree
2933 : 0 : m2type_gm2_type_for_size (unsigned int bits, bool unsignedp)
2934 : : {
2935 : 0 : if (bits == TYPE_PRECISION (integer_type_node))
2936 : 0 : return unsignedp ? unsigned_type_node : integer_type_node;
2937 : :
2938 : 0 : if (bits == TYPE_PRECISION (signed_char_type_node))
2939 : 0 : return unsignedp ? unsigned_char_type_node : signed_char_type_node;
2940 : :
2941 : 0 : if (bits == TYPE_PRECISION (short_integer_type_node))
2942 : 0 : return unsignedp ? short_unsigned_type_node : short_integer_type_node;
2943 : :
2944 : 0 : if (bits == TYPE_PRECISION (long_integer_type_node))
2945 : 0 : return unsignedp ? long_unsigned_type_node : long_integer_type_node;
2946 : :
2947 : 0 : if (bits == TYPE_PRECISION (long_long_integer_type_node))
2948 : 0 : return (unsignedp ? long_long_unsigned_type_node
2949 : 0 : : long_long_integer_type_node);
2950 : :
2951 : 0 : if (bits <= TYPE_PRECISION (intQI_type_node))
2952 : 0 : return unsignedp ? unsigned_intQI_type_node : intQI_type_node;
2953 : :
2954 : 0 : if (bits <= TYPE_PRECISION (intHI_type_node))
2955 : 0 : return unsignedp ? unsigned_intHI_type_node : intHI_type_node;
2956 : :
2957 : 0 : if (bits <= TYPE_PRECISION (intSI_type_node))
2958 : 0 : return unsignedp ? unsigned_intSI_type_node : intSI_type_node;
2959 : :
2960 : 0 : if (bits <= TYPE_PRECISION (intDI_type_node))
2961 : 0 : return unsignedp ? unsigned_intDI_type_node : intDI_type_node;
2962 : :
2963 : : return 0;
2964 : : }
2965 : :
2966 : : /* gm2_unsigned_type return an unsigned type the same as TYPE in
2967 : : other respects. */
2968 : :
2969 : : tree
2970 : 6 : m2type_gm2_unsigned_type (tree type)
2971 : : {
2972 : 6 : tree type1 = TYPE_MAIN_VARIANT (type);
2973 : 6 : if (type1 == signed_char_type_node || type1 == char_type_node)
2974 : 0 : return unsigned_char_type_node;
2975 : 6 : if (type1 == integer_type_node)
2976 : 6 : return unsigned_type_node;
2977 : 0 : if (type1 == short_integer_type_node)
2978 : 0 : return short_unsigned_type_node;
2979 : 0 : if (type1 == long_integer_type_node)
2980 : 0 : return long_unsigned_type_node;
2981 : 0 : if (type1 == long_long_integer_type_node)
2982 : 0 : return long_long_unsigned_type_node;
2983 : :
2984 : : #if HOST_BITS_PER_WIDE_INT >= 64
2985 : 0 : if (type1 == intTI_type_node)
2986 : 0 : return unsigned_intTI_type_node;
2987 : : #endif
2988 : 0 : if (type1 == intDI_type_node)
2989 : 0 : return unsigned_intDI_type_node;
2990 : 0 : if (type1 == intSI_type_node)
2991 : 0 : return unsigned_intSI_type_node;
2992 : 0 : if (type1 == intHI_type_node)
2993 : 0 : return unsigned_intHI_type_node;
2994 : 0 : if (type1 == intQI_type_node)
2995 : 0 : return unsigned_intQI_type_node;
2996 : :
2997 : 0 : return m2type_gm2_signed_or_unsigned_type (true, type);
2998 : : }
2999 : :
3000 : : /* gm2_signed_type return a signed type the same as TYPE in other
3001 : : respects. */
3002 : :
3003 : : tree
3004 : 50 : m2type_gm2_signed_type (tree type)
3005 : : {
3006 : 50 : tree type1 = TYPE_MAIN_VARIANT (type);
3007 : 50 : if (type1 == unsigned_char_type_node || type1 == char_type_node)
3008 : 0 : return signed_char_type_node;
3009 : 50 : if (type1 == unsigned_type_node)
3010 : 12 : return integer_type_node;
3011 : 38 : if (type1 == short_unsigned_type_node)
3012 : 0 : return short_integer_type_node;
3013 : 38 : if (type1 == long_unsigned_type_node)
3014 : 0 : return long_integer_type_node;
3015 : 38 : if (type1 == long_long_unsigned_type_node)
3016 : 0 : return long_long_integer_type_node;
3017 : :
3018 : : #if HOST_BITS_PER_WIDE_INT >= 64
3019 : 38 : if (type1 == unsigned_intTI_type_node)
3020 : 0 : return intTI_type_node;
3021 : : #endif
3022 : 38 : if (type1 == unsigned_intDI_type_node)
3023 : 0 : return intDI_type_node;
3024 : 38 : if (type1 == unsigned_intSI_type_node)
3025 : 0 : return intSI_type_node;
3026 : 38 : if (type1 == unsigned_intHI_type_node)
3027 : 0 : return intHI_type_node;
3028 : 38 : if (type1 == unsigned_intQI_type_node)
3029 : 0 : return intQI_type_node;
3030 : :
3031 : 38 : return m2type_gm2_signed_or_unsigned_type (false, type);
3032 : : }
3033 : :
3034 : : /* check_type if the precision of baseType and type are the same
3035 : : then return true and set the signed or unsigned type in result
3036 : : else return false. */
3037 : :
3038 : : static int
3039 : 76 : check_type (tree baseType, tree type, int unsignedp, tree baseu, tree bases,
3040 : : tree *result)
3041 : : {
3042 : 76 : if (TYPE_PRECISION (baseType) == TYPE_PRECISION (type))
3043 : : {
3044 : 38 : if (unsignedp)
3045 : 0 : *result = baseu;
3046 : : else
3047 : 38 : *result = bases;
3048 : 38 : return true;
3049 : : }
3050 : : return false;
3051 : : }
3052 : :
3053 : : /* gm2_signed_or_unsigned_type return a type the same as TYPE
3054 : : except unsigned or signed according to UNSIGNEDP. */
3055 : :
3056 : : tree
3057 : 38 : m2type_gm2_signed_or_unsigned_type (int unsignedp, tree type)
3058 : : {
3059 : 38 : tree result;
3060 : :
3061 : 38 : if (!INTEGRAL_TYPE_P (type) || TYPE_UNSIGNED (type) == unsignedp)
3062 : : return type;
3063 : :
3064 : : /* For INTEGER_TYPEs we must check the precision as well, so as to
3065 : : yield correct results for bit-field types. */
3066 : :
3067 : 38 : if (check_type (signed_char_type_node, type, unsignedp,
3068 : : unsigned_char_type_node, signed_char_type_node, &result))
3069 : 0 : return result;
3070 : 38 : if (check_type (integer_type_node, type, unsignedp, unsigned_type_node,
3071 : : integer_type_node, &result))
3072 : 38 : return result;
3073 : 0 : if (check_type (short_integer_type_node, type, unsignedp,
3074 : : short_unsigned_type_node, short_integer_type_node, &result))
3075 : 0 : return result;
3076 : 0 : if (check_type (long_integer_type_node, type, unsignedp,
3077 : : long_unsigned_type_node, long_integer_type_node, &result))
3078 : 0 : return result;
3079 : 0 : if (check_type (long_long_integer_type_node, type, unsignedp,
3080 : : long_long_unsigned_type_node, long_long_integer_type_node,
3081 : : &result))
3082 : 0 : return result;
3083 : :
3084 : : #if HOST_BITS_PER_WIDE_INT >= 64
3085 : 0 : if (check_type (intTI_type_node, type, unsignedp, unsigned_intTI_type_node,
3086 : : intTI_type_node, &result))
3087 : 0 : return result;
3088 : : #endif
3089 : 0 : if (check_type (intDI_type_node, type, unsignedp, unsigned_intDI_type_node,
3090 : : intDI_type_node, &result))
3091 : 0 : return result;
3092 : 0 : if (check_type (intSI_type_node, type, unsignedp, unsigned_intSI_type_node,
3093 : : intSI_type_node, &result))
3094 : 0 : return result;
3095 : 0 : if (check_type (intHI_type_node, type, unsignedp, unsigned_intHI_type_node,
3096 : : intHI_type_node, &result))
3097 : 0 : return result;
3098 : 0 : if (check_type (intQI_type_node, type, unsignedp, unsigned_intQI_type_node,
3099 : : intQI_type_node, &result))
3100 : 0 : return result;
3101 : : #undef TYPE_OK
3102 : :
3103 : : return type;
3104 : : }
3105 : :
3106 : : /* IsAddress returns true if the type is an ADDRESS. */
3107 : :
3108 : : int
3109 : 1596222 : m2type_IsAddress (tree type)
3110 : : {
3111 : 1596222 : return type == ptr_type_node;
3112 : : }
3113 : :
3114 : : #include "gt-m2-m2type.h"
|
