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