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