2004-08-23 Eric Christopher <echristo@redhat.com>
[official-gcc.git] / gcc / fortran / trans-types.c
blob8f0749d0fe2a2aaa6a8041600c487a6168e9cb4d
1 /* Backend support for Fortran 95 basic types and derived types.
2 Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
3 Contributed by Paul Brook <paul@nowt.org>
4 and Steven Bosscher <s.bosscher@student.tudelft.nl>
6 This file is part of GCC.
8 GCC is free software; you can redistribute it and/or modify it under
9 the terms of the GNU General Public License as published by the Free
10 Software Foundation; either version 2, or (at your option) any later
11 version.
13 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
14 WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16 for more details.
18 You should have received a copy of the GNU General Public License
19 along with GCC; see the file COPYING. If not, write to the Free
20 Software Foundation, 59 Temple Place - Suite 330, Boston, MA
21 02111-1307, USA. */
23 /* trans-types.c -- gfortran backend types */
25 #include "config.h"
26 #include "system.h"
27 #include "coretypes.h"
28 #include "tree.h"
29 #include <stdio.h>
30 #include "ggc.h"
31 #include "toplev.h"
32 #include <assert.h>
33 #include "gfortran.h"
34 #include "trans.h"
35 #include "trans-types.h"
36 #include "trans-const.h"
39 #if (GFC_MAX_DIMENSIONS < 10)
40 #define GFC_RANK_DIGITS 1
41 #define GFC_RANK_PRINTF_FORMAT "%01d"
42 #elif (GFC_MAX_DIMENSIONS < 100)
43 #define GFC_RANK_DIGITS 2
44 #define GFC_RANK_PRINTF_FORMAT "%02d"
45 #else
46 #error If you really need >99 dimensions, continue the sequence above...
47 #endif
49 static tree gfc_get_derived_type (gfc_symbol * derived);
51 tree gfc_type_nodes[NUM_F95_TYPES];
53 tree gfc_array_index_type;
54 tree pvoid_type_node;
55 tree ppvoid_type_node;
56 tree pchar_type_node;
58 static GTY(()) tree gfc_desc_dim_type = NULL;
60 static GTY(()) tree gfc_max_array_element_size;
62 /* Create the backend type nodes. We map them to their
63 equivalent C type, at least for now. We also give
64 names to the types here, and we push them in the
65 global binding level context.*/
67 void
68 gfc_init_types (void)
70 unsigned n;
71 unsigned HOST_WIDE_INT hi;
72 unsigned HOST_WIDE_INT lo;
74 /* Name the types. */
75 #define PUSH_TYPE(name, node) \
76 pushdecl (build_decl (TYPE_DECL, get_identifier (name), node))
78 gfc_int1_type_node = signed_char_type_node;
79 PUSH_TYPE ("int1", gfc_int1_type_node);
80 gfc_int2_type_node = short_integer_type_node;
81 PUSH_TYPE ("int2", gfc_int2_type_node);
82 gfc_int4_type_node = gfc_type_for_size (32, 0 /*unsigned */ );
83 PUSH_TYPE ("int4", gfc_int4_type_node);
84 gfc_int8_type_node = gfc_type_for_size (64, 0 /*unsigned */ );
85 PUSH_TYPE ("int8", gfc_int8_type_node);
86 #if (GFC_USE_TYPES16 && (HOST_BITS_PER_WIDE_INT >= 64))
87 gfc_int16_type_node = gfc_type_for_size (128, 0 /*unsigned */ );
88 PUSH_TYPE ("int16", gfc_int16_type_node);
89 #endif
91 gfc_real4_type_node = float_type_node;
92 PUSH_TYPE ("real4", gfc_real4_type_node);
93 gfc_real8_type_node = double_type_node;
94 PUSH_TYPE ("real8", gfc_real8_type_node);
95 #if (GFC_USE_TYPES16 && (HOST_BITS_PER_WIDE_INT >= 64))
96 /* Hmm, this will not work. Ref. g77 */
97 gfc_real16_type_node = long_double_type_node;
98 PUSH_TYPE ("real16", gfc_real16_type_node);
99 #endif
101 gfc_complex4_type_node = complex_float_type_node;
102 PUSH_TYPE ("complex4", gfc_complex4_type_node);
103 gfc_complex8_type_node = complex_double_type_node;
104 PUSH_TYPE ("complex8", gfc_complex8_type_node);
105 #if (GFC_USE_TYPES16 && (HOST_BITS_PER_WIDE_INT >= 64))
106 /* Hmm, this will not work. Ref. g77 */
107 gfc_complex16_type_node = complex_long_double_type_node;
108 PUSH_TYPE ("complex16", gfc_complex16_type_node);
109 #endif
111 gfc_logical1_type_node = make_node (BOOLEAN_TYPE);
112 TYPE_PRECISION (gfc_logical1_type_node) = 8;
113 fixup_unsigned_type (gfc_logical1_type_node);
114 PUSH_TYPE ("logical1", gfc_logical1_type_node);
115 gfc_logical2_type_node = make_node (BOOLEAN_TYPE);
116 TYPE_PRECISION (gfc_logical2_type_node) = 16;
117 fixup_unsigned_type (gfc_logical2_type_node);
118 PUSH_TYPE ("logical2", gfc_logical2_type_node);
119 gfc_logical4_type_node = make_node (BOOLEAN_TYPE);
120 TYPE_PRECISION (gfc_logical4_type_node) = 32;
121 fixup_unsigned_type (gfc_logical4_type_node);
122 PUSH_TYPE ("logical4", gfc_logical4_type_node);
123 gfc_logical8_type_node = make_node (BOOLEAN_TYPE);
124 TYPE_PRECISION (gfc_logical8_type_node) = 64;
125 fixup_unsigned_type (gfc_logical8_type_node);
126 PUSH_TYPE ("logical8", gfc_logical8_type_node);
127 #if (GFC_USE_TYPES16 && (HOST_BITS_PER_WIDE_INT >= 64))
128 gfc_logical16_type_node = make_node (BOOLEAN_TYPE);
129 TYPE_PRECISION (gfc_logical16_type_node) = 128;
130 fixup_unsigned_type (gfc_logical16_type_node);
131 PUSH_TYPE ("logical16", gfc_logical16_type_node);
132 #endif
134 gfc_character1_type_node = build_type_variant (signed_char_type_node, 0, 0);
135 PUSH_TYPE ("char", gfc_character1_type_node);
137 PUSH_TYPE ("byte", unsigned_char_type_node);
138 PUSH_TYPE ("void", void_type_node);
140 /* DBX debugging output gets upset if these aren't set. */
141 if (!TYPE_NAME (integer_type_node))
142 PUSH_TYPE ("c_integer", integer_type_node);
143 if (!TYPE_NAME (char_type_node))
144 PUSH_TYPE ("c_char", char_type_node);
145 #undef PUSH_TYPE
147 pvoid_type_node = build_pointer_type (void_type_node);
148 ppvoid_type_node = build_pointer_type (pvoid_type_node);
149 pchar_type_node = build_pointer_type (gfc_character1_type_node);
151 gfc_index_integer_kind = TYPE_PRECISION (long_unsigned_type_node) / 8;
152 gfc_array_index_type = gfc_get_int_type (gfc_index_integer_kind);
154 /* The maximum array element size that can be handled is determined
155 by the number of bits available to store this field in the array
156 descriptor. */
158 n = TREE_INT_CST_LOW (TYPE_SIZE (gfc_array_index_type))
159 - GFC_DTYPE_SIZE_SHIFT;
161 if (n > sizeof (HOST_WIDE_INT) * 8)
163 lo = ~(unsigned HOST_WIDE_INT) 0;
164 hi = lo >> (sizeof (HOST_WIDE_INT) * 16 - n);
166 else
168 hi = 0;
169 lo = (~(unsigned HOST_WIDE_INT) 0) >> (sizeof (HOST_WIDE_INT) * 8 - n);
171 gfc_max_array_element_size = build_int_cst (long_unsigned_type_node, lo, hi);
173 size_type_node = gfc_array_index_type;
174 boolean_type_node = gfc_get_logical_type (gfc_default_logical_kind ());
176 boolean_true_node = build_int_cst (boolean_type_node, 1, 0);
177 boolean_false_node = build_int_cst (boolean_type_node, 0, 0);
180 /* Get a type node for an integer kind */
182 tree
183 gfc_get_int_type (int kind)
185 switch (kind)
187 case 1:
188 return (gfc_int1_type_node);
189 case 2:
190 return (gfc_int2_type_node);
191 case 4:
192 return (gfc_int4_type_node);
193 case 8:
194 return (gfc_int8_type_node);
195 #if (GFC_USE_TYPES16 && (HOST_BITS_PER_WIDE_INT >= 64))
196 case 16:
197 return (95 _int16_type_node);
198 #endif
199 default:
200 fatal_error ("integer kind=%d not available", kind);
204 /* Get a type node for a real kind */
206 tree
207 gfc_get_real_type (int kind)
209 switch (kind)
211 case 4:
212 return (gfc_real4_type_node);
213 case 8:
214 return (gfc_real8_type_node);
215 #if (GFC_USE_TYPES16 && (HOST_BITS_PER_WIDE_INT >= 64))
216 case 16:
217 return (gfc_real16_type_node);
218 #endif
219 default:
220 fatal_error ("real kind=%d not available", kind);
224 /* Get a type node for a complex kind */
226 tree
227 gfc_get_complex_type (int kind)
229 switch (kind)
231 case 4:
232 return (gfc_complex4_type_node);
233 case 8:
234 return (gfc_complex8_type_node);
235 #if (GFC_USE_TYPES16 && (HOST_BITS_PER_WIDE_INT >= 64))
236 case 16:
237 return (gfc_complex16_type_node);
238 #endif
239 default:
240 fatal_error ("complex kind=%d not available", kind);
244 /* Get a type node for a logical kind */
246 tree
247 gfc_get_logical_type (int kind)
249 switch (kind)
251 case 1:
252 return (gfc_logical1_type_node);
253 case 2:
254 return (gfc_logical2_type_node);
255 case 4:
256 return (gfc_logical4_type_node);
257 case 8:
258 return (gfc_logical8_type_node);
259 #if (GFC_USE_TYPES16 && (HOST_BITS_PER_WIDE_INT >= 64))
260 case 16:
261 return (gfc_logical16_type_node);
262 #endif
263 default:
264 fatal_error ("logical kind=%d not available", kind);
268 /* Get a type node for a character kind. */
270 tree
271 gfc_get_character_type (int kind, gfc_charlen * cl)
273 tree base;
274 tree type;
275 tree len;
276 tree bounds;
278 switch (kind)
280 case 1:
281 base = gfc_character1_type_node;
282 break;
284 default:
285 fatal_error ("character kind=%d not available", kind);
288 len = (cl == 0) ? NULL_TREE : cl->backend_decl;
290 bounds = build_range_type (gfc_array_index_type, gfc_index_one_node, len);
291 type = build_array_type (base, bounds);
292 TYPE_STRING_FLAG (type) = 1;
294 return type;
297 /* Covert a basic type. This will be an array for character types. */
299 tree
300 gfc_typenode_for_spec (gfc_typespec * spec)
302 tree basetype;
304 switch (spec->type)
306 case BT_UNKNOWN:
307 abort ();
308 break;
310 case BT_INTEGER:
311 basetype = gfc_get_int_type (spec->kind);
312 break;
314 case BT_REAL:
315 basetype = gfc_get_real_type (spec->kind);
316 break;
318 case BT_COMPLEX:
319 basetype = gfc_get_complex_type (spec->kind);
320 break;
322 case BT_LOGICAL:
323 basetype = gfc_get_logical_type (spec->kind);
324 break;
326 case BT_CHARACTER:
327 basetype = gfc_get_character_type (spec->kind, spec->cl);
328 break;
330 case BT_DERIVED:
331 basetype = gfc_get_derived_type (spec->derived);
332 break;
334 default:
335 abort ();
336 break;
338 return basetype;
341 /* Build an INT_CST for constant expressions, otherwise return NULL_TREE. */
343 static tree
344 gfc_conv_array_bound (gfc_expr * expr)
346 /* If expr is an integer constant, return that. */
347 if (expr != NULL && expr->expr_type == EXPR_CONSTANT)
348 return gfc_conv_mpz_to_tree (expr->value.integer, gfc_index_integer_kind);
350 /* Otherwise return NULL. */
351 return NULL_TREE;
354 tree
355 gfc_get_element_type (tree type)
357 tree element;
359 if (GFC_ARRAY_TYPE_P (type))
361 if (TREE_CODE (type) == POINTER_TYPE)
362 type = TREE_TYPE (type);
363 assert (TREE_CODE (type) == ARRAY_TYPE);
364 element = TREE_TYPE (type);
366 else
368 assert (GFC_DESCRIPTOR_TYPE_P (type));
369 element = TREE_TYPE (TYPE_FIELDS (type));
371 assert (TREE_CODE (element) == POINTER_TYPE);
372 element = TREE_TYPE (element);
374 assert (TREE_CODE (element) == ARRAY_TYPE);
375 element = TREE_TYPE (element);
378 return element;
381 /* Build an array. This function is called from gfc_sym_type().
382 Actually returns array descriptor type.
384 Format of array descriptors is as follows:
386 struct gfc_array_descriptor
388 array *data
389 index offset;
390 index dtype;
391 struct descriptor_dimension dimension[N_DIM];
394 struct descriptor_dimension
396 index stride;
397 index lbound;
398 index ubound;
401 Translation code should use gfc_conv_descriptor_* rather than accessing
402 the descriptor directly. Any changes to the array descriptor type will
403 require changes in gfc_conv_descriptor_* and gfc_build_array_initializer.
405 This is represented internally as a RECORD_TYPE. The index nodes are
406 gfc_array_index_type and the data node is a pointer to the data. See below
407 for the handling of character types.
409 The dtype member is formatted as follows:
410 rank = dtype & GFC_DTYPE_RANK_MASK // 3 bits
411 type = (dtype & GFC_DTYPE_TYPE_MASK) >> GFC_DTYPE_TYPE_SHIFT // 3 bits
412 size = dtype >> GFC_DTYPE_SIZE_SHIFT
414 I originally used nested ARRAY_TYPE nodes to represent arrays, but this
415 generated poor code for assumed/deferred size arrays. These require
416 use of PLACEHOLDER_EXPR/WITH_RECORD_EXPR, which isn't part of the GENERIC
417 grammar. Also, there is no way to explicitly set the array stride, so
418 all data must be packed(1). I've tried to mark all the functions which
419 would require modification with a GCC ARRAYS comment.
421 The data component points to the first element in the array.
422 The offset field is the position of the origin of the array
423 (ie element (0, 0 ...)). This may be outsite the bounds of the array.
425 An element is accessed by
426 data[offset + index0*stride0 + index1*stride1 + index2*stride2]
427 This gives good performance as the computation does not involve the
428 bounds of the array. For packed arrays, this is optimized further by
429 substituting the known strides.
431 This system has one problem: all array bounds must be withing 2^31 elements
432 of the origin (2^63 on 64-bit machines). For example
433 integer, dimension (80000:90000, 80000:90000, 2) :: array
434 may not work properly on 32-bit machines because 80000*80000 > 2^31, so
435 the calculation for stride02 would overflow. This may still work, but
436 I haven't checked, and it relies on the overflow doing the right thing.
438 The way to fix this problem is to access alements as follows:
439 data[(index0-lbound0)*stride0 + (index1-lbound1)*stride1]
440 Obviously this is much slower. I will make this a compile time option,
441 something like -fsmall-array-offsets. Mixing code compiled with and without
442 this switch will work.
444 (1) This can be worked around by modifying the upper bound of the previous
445 dimension. This requires extra fields in the descriptor (both real_ubound
446 and fake_ubound). In tree.def there is mention of TYPE_SEP, which
447 may allow us to do this. However I can't find mention of this anywhere
448 else.
452 /* Returns true if the array sym does not require a descriptor. */
455 gfc_is_nodesc_array (gfc_symbol * sym)
457 assert (sym->attr.dimension);
459 /* We only want local arrays. */
460 if (sym->attr.pointer || sym->attr.allocatable)
461 return 0;
463 if (sym->attr.dummy)
465 if (sym->as->type != AS_ASSUMED_SHAPE)
466 return 1;
467 else
468 return 0;
471 if (sym->attr.result || sym->attr.function)
472 return 0;
474 if (sym->attr.pointer || sym->attr.allocatable)
475 return 0;
477 assert (sym->as->type == AS_EXPLICIT);
479 return 1;
482 static tree
483 gfc_build_array_type (tree type, gfc_array_spec * as)
485 tree lbound[GFC_MAX_DIMENSIONS];
486 tree ubound[GFC_MAX_DIMENSIONS];
487 int n;
489 for (n = 0; n < as->rank; n++)
491 /* Create expressions for the known bounds of the array. */
492 if (as->type == AS_ASSUMED_SHAPE && as->lower[n] == NULL)
493 lbound[n] = gfc_index_one_node;
494 else
495 lbound[n] = gfc_conv_array_bound (as->lower[n]);
496 ubound[n] = gfc_conv_array_bound (as->upper[n]);
499 return gfc_get_array_type_bounds (type, as->rank, lbound, ubound, 0);
502 /* Returns the struct descriptor_dimension type. */
504 static tree
505 gfc_get_desc_dim_type (void)
507 tree type;
508 tree decl;
509 tree fieldlist;
511 if (gfc_desc_dim_type)
512 return gfc_desc_dim_type;
514 /* Build the type node. */
515 type = make_node (RECORD_TYPE);
517 TYPE_NAME (type) = get_identifier ("descriptor_dimension");
518 TYPE_PACKED (type) = 1;
520 /* Consists of the stride, lbound and ubound members. */
521 decl = build_decl (FIELD_DECL,
522 get_identifier ("stride"), gfc_array_index_type);
523 DECL_CONTEXT (decl) = type;
524 fieldlist = decl;
526 decl = build_decl (FIELD_DECL,
527 get_identifier ("lbound"), gfc_array_index_type);
528 DECL_CONTEXT (decl) = type;
529 fieldlist = chainon (fieldlist, decl);
531 decl = build_decl (FIELD_DECL,
532 get_identifier ("ubound"), gfc_array_index_type);
533 DECL_CONTEXT (decl) = type;
534 fieldlist = chainon (fieldlist, decl);
536 /* Finish off the type. */
537 TYPE_FIELDS (type) = fieldlist;
539 gfc_finish_type (type);
541 gfc_desc_dim_type = type;
542 return type;
545 static tree
546 gfc_get_dtype (tree type, int rank)
548 tree size;
549 int n;
550 HOST_WIDE_INT i;
551 tree tmp;
552 tree dtype;
554 if (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type))
555 return (GFC_TYPE_ARRAY_DTYPE (type));
557 /* TODO: Correctly identify LOGICAL types. */
558 switch (TREE_CODE (type))
560 case INTEGER_TYPE:
561 n = GFC_DTYPE_INTEGER;
562 break;
564 case BOOLEAN_TYPE:
565 n = GFC_DTYPE_LOGICAL;
566 break;
568 case REAL_TYPE:
569 n = GFC_DTYPE_REAL;
570 break;
572 case COMPLEX_TYPE:
573 n = GFC_DTYPE_COMPLEX;
574 break;
576 /* Arrays have already been dealt with. */
577 case RECORD_TYPE:
578 n = GFC_DTYPE_DERIVED;
579 break;
581 case ARRAY_TYPE:
582 n = GFC_DTYPE_CHARACTER;
583 break;
585 default:
586 abort ();
589 assert (rank <= GFC_DTYPE_RANK_MASK);
590 size = TYPE_SIZE_UNIT (type);
592 i = rank | (n << GFC_DTYPE_TYPE_SHIFT);
593 if (size && INTEGER_CST_P (size))
595 if (tree_int_cst_lt (gfc_max_array_element_size, size))
596 internal_error ("Array element size too big");
598 i += TREE_INT_CST_LOW (size) << GFC_DTYPE_SIZE_SHIFT;
600 dtype = build_int_cst (gfc_array_index_type, i, 0);
602 if (size && !INTEGER_CST_P (size))
604 tmp = build_int_cst (gfc_array_index_type, GFC_DTYPE_SIZE_SHIFT, 0);
605 tmp = fold (build (LSHIFT_EXPR, gfc_array_index_type, size, tmp));
606 dtype = fold (build (PLUS_EXPR, gfc_array_index_type, tmp, dtype));
608 /* If we don't know the size we leave it as zero. This should never happen
609 for anything that is actually used. */
610 /* TODO: Check this is actually true, particularly when repacking
611 assumed size parameters. */
613 return dtype;
617 /* Build an array type for use without a descriptor. Valid values of packed
618 are 0=no, 1=partial, 2=full, 3=static. */
620 tree
621 gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, int packed)
623 tree range;
624 tree type;
625 tree tmp;
626 int n;
627 int known_stride;
628 int known_offset;
629 mpz_t offset;
630 mpz_t stride;
631 mpz_t delta;
632 gfc_expr *expr;
634 mpz_init_set_ui (offset, 0);
635 mpz_init_set_ui (stride, 1);
636 mpz_init (delta);
638 /* We don't use build_array_type because this does not include include
639 lang-specific information (ie. the bounds of the array) when checking
640 for duplicates. */
641 type = make_node (ARRAY_TYPE);
643 GFC_ARRAY_TYPE_P (type) = 1;
644 TYPE_LANG_SPECIFIC (type) = (struct lang_type *)
645 ggc_alloc_cleared (sizeof (struct lang_type));
647 known_stride = (packed != 0);
648 known_offset = 1;
649 for (n = 0; n < as->rank; n++)
651 /* Fill in the stride and bound components of the type. */
652 if (known_stride)
653 tmp = gfc_conv_mpz_to_tree (stride, gfc_index_integer_kind);
654 else
655 tmp = NULL_TREE;
656 GFC_TYPE_ARRAY_STRIDE (type, n) = tmp;
658 expr = as->lower[n];
659 if (expr->expr_type == EXPR_CONSTANT)
661 tmp = gfc_conv_mpz_to_tree (expr->value.integer,
662 gfc_index_integer_kind);
664 else
666 known_stride = 0;
667 tmp = NULL_TREE;
669 GFC_TYPE_ARRAY_LBOUND (type, n) = tmp;
671 if (known_stride)
673 /* Calculate the offset. */
674 mpz_mul (delta, stride, as->lower[n]->value.integer);
675 mpz_sub (offset, offset, delta);
677 else
678 known_offset = 0;
680 expr = as->upper[n];
681 if (expr && expr->expr_type == EXPR_CONSTANT)
683 tmp = gfc_conv_mpz_to_tree (expr->value.integer,
684 gfc_index_integer_kind);
686 else
688 tmp = NULL_TREE;
689 known_stride = 0;
691 GFC_TYPE_ARRAY_UBOUND (type, n) = tmp;
693 if (known_stride)
695 /* Calculate the stride. */
696 mpz_sub (delta, as->upper[n]->value.integer,
697 as->lower[n]->value.integer);
698 mpz_add_ui (delta, delta, 1);
699 mpz_mul (stride, stride, delta);
702 /* Only the first stride is known for partial packed arrays. */
703 if (packed < 2)
704 known_stride = 0;
707 if (known_offset)
709 GFC_TYPE_ARRAY_OFFSET (type) =
710 gfc_conv_mpz_to_tree (offset, gfc_index_integer_kind);
712 else
713 GFC_TYPE_ARRAY_OFFSET (type) = NULL_TREE;
715 if (known_stride)
717 GFC_TYPE_ARRAY_SIZE (type) =
718 gfc_conv_mpz_to_tree (stride, gfc_index_integer_kind);
720 else
721 GFC_TYPE_ARRAY_SIZE (type) = NULL_TREE;
723 GFC_TYPE_ARRAY_DTYPE (type) = gfc_get_dtype (etype, as->rank);
724 GFC_TYPE_ARRAY_RANK (type) = as->rank;
725 range = build_range_type (gfc_array_index_type, gfc_index_zero_node,
726 NULL_TREE);
727 /* TODO: use main type if it is unbounded. */
728 GFC_TYPE_ARRAY_DATAPTR_TYPE (type) =
729 build_pointer_type (build_array_type (etype, range));
731 if (known_stride)
733 mpz_sub_ui (stride, stride, 1);
734 range = gfc_conv_mpz_to_tree (stride, gfc_index_integer_kind);
736 else
737 range = NULL_TREE;
739 range = build_range_type (gfc_array_index_type, gfc_index_zero_node, range);
740 TYPE_DOMAIN (type) = range;
742 build_pointer_type (etype);
743 TREE_TYPE (type) = etype;
745 layout_type (type);
747 mpz_clear (offset);
748 mpz_clear (stride);
749 mpz_clear (delta);
751 if (packed < 3 || !known_stride)
753 /* For dummy arrays and automatic (heap allocated) arrays we
754 want a pointer to the array. */
755 type = build_pointer_type (type);
756 GFC_ARRAY_TYPE_P (type) = 1;
757 TYPE_LANG_SPECIFIC (type) = TYPE_LANG_SPECIFIC (TREE_TYPE (type));
759 return type;
763 /* Build an array (descriptor) type with given bounds. */
765 tree
766 gfc_get_array_type_bounds (tree etype, int dimen, tree * lbound,
767 tree * ubound, int packed)
769 tree fat_type, fat_pointer_type;
770 tree fieldlist;
771 tree arraytype;
772 tree decl;
773 int n;
774 char name[8 + GFC_RANK_DIGITS + GFC_MAX_SYMBOL_LEN];
775 const char *typename;
776 tree lower;
777 tree upper;
778 tree stride;
779 tree tmp;
781 /* Build the type node. */
782 fat_type = make_node (RECORD_TYPE);
783 GFC_DESCRIPTOR_TYPE_P (fat_type) = 1;
784 TYPE_LANG_SPECIFIC (fat_type) = (struct lang_type *)
785 ggc_alloc_cleared (sizeof (struct lang_type));
786 GFC_TYPE_ARRAY_RANK (fat_type) = dimen;
787 GFC_TYPE_ARRAY_DTYPE (fat_type) = gfc_get_dtype (etype, dimen);
789 tmp = TYPE_NAME (etype);
790 if (tmp && TREE_CODE (tmp) == TYPE_DECL)
791 tmp = DECL_NAME (tmp);
792 if (tmp)
793 typename = IDENTIFIER_POINTER (tmp);
794 else
795 typename = "unknown";
797 sprintf (name, "array" GFC_RANK_PRINTF_FORMAT "_%.*s", dimen,
798 GFC_MAX_SYMBOL_LEN, typename);
799 TYPE_NAME (fat_type) = get_identifier (name);
800 TYPE_PACKED (fat_type) = 0;
802 fat_pointer_type = build_pointer_type (fat_type);
804 /* Build an array descriptor record type. */
805 if (packed != 0)
806 stride = gfc_index_one_node;
807 else
808 stride = NULL_TREE;
810 for (n = 0; n < dimen; n++)
812 GFC_TYPE_ARRAY_STRIDE (fat_type, n) = stride;
814 if (lbound)
815 lower = lbound[n];
816 else
817 lower = NULL_TREE;
819 if (lower != NULL_TREE)
821 if (INTEGER_CST_P (lower))
822 GFC_TYPE_ARRAY_LBOUND (fat_type, n) = lower;
823 else
824 lower = NULL_TREE;
827 upper = ubound[n];
828 if (upper != NULL_TREE)
830 if (INTEGER_CST_P (upper))
831 GFC_TYPE_ARRAY_UBOUND (fat_type, n) = upper;
832 else
833 upper = NULL_TREE;
836 if (upper != NULL_TREE && lower != NULL_TREE && stride != NULL_TREE)
838 tmp = fold (build (MINUS_EXPR, gfc_array_index_type, upper, lower));
839 tmp = fold (build (PLUS_EXPR, gfc_array_index_type, tmp,
840 gfc_index_one_node));
841 stride =
842 fold (build (MULT_EXPR, gfc_array_index_type, tmp, stride));
843 /* Check the folding worked. */
844 assert (INTEGER_CST_P (stride));
846 else
847 stride = NULL_TREE;
849 GFC_TYPE_ARRAY_SIZE (fat_type) = stride;
850 /* TODO: known offsets for descriptors. */
851 GFC_TYPE_ARRAY_OFFSET (fat_type) = NULL_TREE;
853 /* We define data as an unknown size array. Much better than doing
854 pointer arithmetic. */
855 arraytype =
856 build_array_type (etype,
857 build_range_type (gfc_array_index_type,
858 gfc_index_zero_node, NULL_TREE));
859 arraytype = build_pointer_type (arraytype);
860 GFC_TYPE_ARRAY_DATAPTR_TYPE (fat_type) = arraytype;
862 /* The pointer to the array data. */
863 decl = build_decl (FIELD_DECL, get_identifier ("data"), arraytype);
865 DECL_CONTEXT (decl) = fat_type;
866 /* Add the data member as the first element of the descriptor. */
867 fieldlist = decl;
869 /* Add the base component. */
870 decl = build_decl (FIELD_DECL, get_identifier ("offset"),
871 gfc_array_index_type);
872 DECL_CONTEXT (decl) = fat_type;
873 fieldlist = chainon (fieldlist, decl);
875 /* Add the dtype component. */
876 decl = build_decl (FIELD_DECL, get_identifier ("dtype"),
877 gfc_array_index_type);
878 DECL_CONTEXT (decl) = fat_type;
879 fieldlist = chainon (fieldlist, decl);
881 /* Build the array type for the stride and bound components. */
882 arraytype =
883 build_array_type (gfc_get_desc_dim_type (),
884 build_range_type (gfc_array_index_type,
885 gfc_index_zero_node,
886 gfc_rank_cst[dimen - 1]));
888 decl = build_decl (FIELD_DECL, get_identifier ("dim"), arraytype);
889 DECL_CONTEXT (decl) = fat_type;
890 DECL_INITIAL (decl) = NULL_TREE;
891 fieldlist = chainon (fieldlist, decl);
893 /* Finish off the type. */
894 TYPE_FIELDS (fat_type) = fieldlist;
896 gfc_finish_type (fat_type);
898 return fat_type;
901 /* Build a pointer type. This function is called from gfc_sym_type(). */
903 static tree
904 gfc_build_pointer_type (gfc_symbol * sym, tree type)
906 /* Array pointer types aren't actualy pointers. */
907 if (sym->attr.dimension)
908 return type;
909 else
910 return build_pointer_type (type);
913 /* Return the type for a symbol. Special handling is required for character
914 types to get the correct level of indirection.
915 For functions return the return type.
916 For subroutines return void_type_node.
917 Calling this multiple times for the same symbol should be avoided,
918 especially for character and array types. */
920 tree
921 gfc_sym_type (gfc_symbol * sym)
923 tree type;
924 int byref;
926 if (sym->attr.flavor == FL_PROCEDURE && !sym->attr.function)
927 return void_type_node;
929 if (sym->backend_decl)
931 if (sym->attr.function)
932 return TREE_TYPE (TREE_TYPE (sym->backend_decl));
933 else
934 return TREE_TYPE (sym->backend_decl);
937 /* The frontend doesn't set all the attributes for a function with an
938 explicit result value, so we use that instead when present. */
939 if (sym->attr.function && sym->result)
940 sym = sym->result;
942 type = gfc_typenode_for_spec (&sym->ts);
944 if (sym->attr.dummy && !sym->attr.function)
945 byref = 1;
946 else
947 byref = 0;
949 if (sym->attr.dimension)
951 if (gfc_is_nodesc_array (sym))
953 /* If this is a character argument of unknown length, just use the
954 base type. */
955 if (sym->ts.type != BT_CHARACTER
956 || !(sym->attr.dummy || sym->attr.function || sym->attr.result)
957 || sym->ts.cl->backend_decl)
959 type = gfc_get_nodesc_array_type (type, sym->as,
960 byref ? 2 : 3);
961 byref = 0;
964 else
965 type = gfc_build_array_type (type, sym->as);
967 else
969 if (sym->attr.allocatable || sym->attr.pointer)
970 type = gfc_build_pointer_type (sym, type);
973 /* We currently pass all parameters by reference.
974 See f95_get_function_decl. For dummy function parameters return the
975 function type. */
976 if (byref)
978 /* We must use pointer types for potentially absent variables. The
979 optimizers assume a reference type argument is never NULL. */
980 if (sym->attr.optional || sym->ns->proc_name->attr.entry_master)
981 type = build_pointer_type (type);
982 else
983 type = build_reference_type (type);
986 return (type);
989 /* Layout and output debug info for a record type. */
991 void
992 gfc_finish_type (tree type)
994 tree decl;
996 decl = build_decl (TYPE_DECL, NULL_TREE, type);
997 TYPE_STUB_DECL (type) = decl;
998 layout_type (type);
999 rest_of_type_compilation (type, 1);
1000 rest_of_decl_compilation (decl, 1, 0);
1003 /* Add a field of given NAME and TYPE to the context of a UNION_TYPE
1004 or RECORD_TYPE pointed to by STYPE. The new field is chained
1005 to the fieldlist pointed to by FIELDLIST.
1007 Returns a pointer to the new field. */
1009 tree
1010 gfc_add_field_to_struct (tree *fieldlist, tree context,
1011 tree name, tree type)
1013 tree decl;
1015 decl = build_decl (FIELD_DECL, name, type);
1017 DECL_CONTEXT (decl) = context;
1018 DECL_INITIAL (decl) = 0;
1019 DECL_ALIGN (decl) = 0;
1020 DECL_USER_ALIGN (decl) = 0;
1021 TREE_CHAIN (decl) = NULL_TREE;
1022 *fieldlist = chainon (*fieldlist, decl);
1024 return decl;
1028 /* Build a tree node for a derived type. */
1030 static tree
1031 gfc_get_derived_type (gfc_symbol * derived)
1033 tree typenode, field, field_type, fieldlist;
1034 gfc_component *c;
1036 assert (derived && derived->attr.flavor == FL_DERIVED);
1038 /* derived->backend_decl != 0 means we saw it before, but its
1039 component's backend_decl may have not been built. */
1040 if (derived->backend_decl)
1042 /* Its component's backend_decl has been built. */
1043 if (TYPE_FIELDS (derived->backend_decl))
1044 return derived->backend_decl;
1045 else
1046 typenode = derived->backend_decl;
1048 else
1050 /* We see this derived type first time, so build the type node. */
1051 typenode = make_node (RECORD_TYPE);
1052 TYPE_NAME (typenode) = get_identifier (derived->name);
1053 TYPE_PACKED (typenode) = gfc_option.flag_pack_derived;
1054 derived->backend_decl = typenode;
1057 /* Build the type member list. Install the newly created RECORD_TYPE
1058 node as DECL_CONTEXT of each FIELD_DECL. */
1059 fieldlist = NULL_TREE;
1060 for (c = derived->components; c; c = c->next)
1062 if (c->ts.type == BT_DERIVED && c->pointer)
1064 if (c->ts.derived->backend_decl)
1065 field_type = c->ts.derived->backend_decl;
1066 else
1068 /* Build the type node. */
1069 field_type = make_node (RECORD_TYPE);
1070 TYPE_NAME (field_type) = get_identifier (c->ts.derived->name);
1071 TYPE_PACKED (field_type) = gfc_option.flag_pack_derived;
1072 c->ts.derived->backend_decl = field_type;
1075 else
1077 if (c->ts.type == BT_CHARACTER)
1079 /* Evaluate the string length. */
1080 gfc_conv_const_charlen (c->ts.cl);
1081 assert (c->ts.cl->backend_decl);
1084 field_type = gfc_typenode_for_spec (&c->ts);
1087 /* This returns an array descriptor type. Initialisation may be
1088 required. */
1089 if (c->dimension)
1091 if (c->pointer)
1093 /* Pointers to arrays aren't actualy pointer types. The
1094 descriptors are seperate, but the data is common. */
1095 field_type = gfc_build_array_type (field_type, c->as);
1097 else
1098 field_type = gfc_get_nodesc_array_type (field_type, c->as, 3);
1100 else if (c->pointer)
1101 field_type = build_pointer_type (field_type);
1103 field = gfc_add_field_to_struct (&fieldlist, typenode,
1104 get_identifier (c->name),
1105 field_type);
1107 DECL_PACKED (field) |= TYPE_PACKED (typenode);
1109 assert (!c->backend_decl);
1110 c->backend_decl = field;
1113 /* Now we have the final fieldlist. Record it, then lay out the
1114 derived type, including the fields. */
1115 TYPE_FIELDS (typenode) = fieldlist;
1117 gfc_finish_type (typenode);
1119 derived->backend_decl = typenode;
1121 return typenode;
1125 gfc_return_by_reference (gfc_symbol * sym)
1127 if (!sym->attr.function)
1128 return 0;
1130 assert (sym->attr.function);
1132 if (sym->result)
1133 sym = sym->result;
1135 if (sym->attr.dimension)
1136 return 1;
1138 if (sym->ts.type == BT_CHARACTER)
1139 return 1;
1141 if (sym->ts.type == BT_DERIVED)
1142 gfc_todo_error ("Returning derived types");
1143 /* Possibly return derived types by reference. */
1144 return 0;
1148 tree
1149 gfc_get_function_type (gfc_symbol * sym)
1151 tree type;
1152 tree typelist;
1153 gfc_formal_arglist *f;
1154 gfc_symbol *arg;
1155 int nstr;
1156 int alternate_return;
1158 /* Make sure this symbol is a function or a subroutine. */
1159 assert (sym->attr.flavor == FL_PROCEDURE);
1161 if (sym->backend_decl)
1162 return TREE_TYPE (sym->backend_decl);
1164 nstr = 0;
1165 alternate_return = 0;
1166 typelist = NULL_TREE;
1168 if (sym->attr.entry_master)
1170 /* Additional parameter for selecting an entry point. */
1171 typelist = gfc_chainon_list (typelist, gfc_array_index_type);
1174 /* Some functions we use an extra parameter for the return value. */
1175 if (gfc_return_by_reference (sym))
1177 if (sym->result)
1178 arg = sym->result;
1179 else
1180 arg = sym;
1182 if (arg->ts.type == BT_CHARACTER)
1183 gfc_conv_const_charlen (arg->ts.cl);
1185 type = gfc_sym_type (arg);
1186 if (arg->ts.type == BT_DERIVED
1187 || arg->attr.dimension
1188 || arg->ts.type == BT_CHARACTER)
1189 type = build_reference_type (type);
1191 typelist = gfc_chainon_list (typelist, type);
1192 if (arg->ts.type == BT_CHARACTER)
1193 typelist = gfc_chainon_list (typelist, gfc_strlen_type_node);
1196 /* Build the argument types for the function */
1197 for (f = sym->formal; f; f = f->next)
1199 arg = f->sym;
1200 if (arg)
1202 /* Evaluate constant character lengths here so that they can be
1203 included in the type. */
1204 if (arg->ts.type == BT_CHARACTER)
1205 gfc_conv_const_charlen (arg->ts.cl);
1207 if (arg->attr.flavor == FL_PROCEDURE)
1209 type = gfc_get_function_type (arg);
1210 type = build_pointer_type (type);
1212 else
1213 type = gfc_sym_type (arg);
1215 /* Parameter Passing Convention
1217 We currently pass all parameters by reference.
1218 Parameters with INTENT(IN) could be passed by value.
1219 The problem arises if a function is called via an implicit
1220 prototype. In this situation the INTENT is not known.
1221 For this reason all parameters to global functions must be
1222 passed by reference. Passing by value would potentialy
1223 generate bad code. Worse there would be no way of telling that
1224 this code was bad, except that it would give incorrect results.
1226 Contained procedures could pass by value as these are never
1227 used without an explicit interface, and connot be passed as
1228 actual parameters for a dummy procedure. */
1229 if (arg->ts.type == BT_CHARACTER)
1230 nstr++;
1231 typelist = gfc_chainon_list (typelist, type);
1233 else
1235 if (sym->attr.subroutine)
1236 alternate_return = 1;
1240 /* Add hidden string length parameters. */
1241 while (nstr--)
1242 typelist = gfc_chainon_list (typelist, gfc_strlen_type_node);
1244 typelist = gfc_chainon_list (typelist, void_type_node);
1246 if (alternate_return)
1247 type = integer_type_node;
1248 else if (!sym->attr.function || gfc_return_by_reference (sym))
1249 type = void_type_node;
1250 else
1251 type = gfc_sym_type (sym);
1253 type = build_function_type (type, typelist);
1255 return type;
1258 /* Routines for getting integer type nodes */
1261 /* Return an integer type with BITS bits of precision,
1262 that is unsigned if UNSIGNEDP is nonzero, otherwise signed. */
1264 tree
1265 gfc_type_for_size (unsigned bits, int unsignedp)
1267 if (bits == TYPE_PRECISION (integer_type_node))
1268 return unsignedp ? unsigned_type_node : integer_type_node;
1270 if (bits == TYPE_PRECISION (signed_char_type_node))
1271 return unsignedp ? unsigned_char_type_node : signed_char_type_node;
1273 if (bits == TYPE_PRECISION (short_integer_type_node))
1274 return unsignedp ? short_unsigned_type_node : short_integer_type_node;
1276 if (bits == TYPE_PRECISION (long_integer_type_node))
1277 return unsignedp ? long_unsigned_type_node : long_integer_type_node;
1279 if (bits == TYPE_PRECISION (long_long_integer_type_node))
1280 return (unsignedp ? long_long_unsigned_type_node
1281 : long_long_integer_type_node);
1282 /*TODO: We currently don't initialise this...
1283 if (bits == TYPE_PRECISION (widest_integer_literal_type_node))
1284 return (unsignedp ? widest_unsigned_literal_type_node
1285 : widest_integer_literal_type_node);*/
1287 if (bits <= TYPE_PRECISION (intQI_type_node))
1288 return unsignedp ? unsigned_intQI_type_node : intQI_type_node;
1290 if (bits <= TYPE_PRECISION (intHI_type_node))
1291 return unsignedp ? unsigned_intHI_type_node : intHI_type_node;
1293 if (bits <= TYPE_PRECISION (intSI_type_node))
1294 return unsignedp ? unsigned_intSI_type_node : intSI_type_node;
1296 if (bits <= TYPE_PRECISION (intDI_type_node))
1297 return unsignedp ? unsigned_intDI_type_node : intDI_type_node;
1299 return 0;
1302 /* Return a data type that has machine mode MODE.
1303 If the mode is an integer,
1304 then UNSIGNEDP selects between signed and unsigned types. */
1306 tree
1307 gfc_type_for_mode (enum machine_mode mode, int unsignedp)
1309 if (mode == TYPE_MODE (integer_type_node))
1310 return unsignedp ? unsigned_type_node : integer_type_node;
1312 if (mode == TYPE_MODE (signed_char_type_node))
1313 return unsignedp ? unsigned_char_type_node : signed_char_type_node;
1315 if (mode == TYPE_MODE (short_integer_type_node))
1316 return unsignedp ? short_unsigned_type_node : short_integer_type_node;
1318 if (mode == TYPE_MODE (long_integer_type_node))
1319 return unsignedp ? long_unsigned_type_node : long_integer_type_node;
1321 if (mode == TYPE_MODE (long_long_integer_type_node))
1322 return unsignedp ? long_long_unsigned_type_node :
1323 long_long_integer_type_node;
1325 /*TODO: see above
1326 if (mode == TYPE_MODE (widest_integer_literal_type_node))
1327 return unsignedp ? widest_unsigned_literal_type_node
1328 : widest_integer_literal_type_node;
1331 if (mode == QImode)
1332 return unsignedp ? unsigned_intQI_type_node : intQI_type_node;
1334 if (mode == HImode)
1335 return unsignedp ? unsigned_intHI_type_node : intHI_type_node;
1337 if (mode == SImode)
1338 return unsignedp ? unsigned_intSI_type_node : intSI_type_node;
1340 if (mode == DImode)
1341 return unsignedp ? unsigned_intDI_type_node : intDI_type_node;
1343 #if HOST_BITS_PER_WIDE_INT >= 64
1344 if (mode == TYPE_MODE (intTI_type_node))
1345 return unsignedp ? unsigned_intTI_type_node : intTI_type_node;
1346 #endif
1348 if (mode == TYPE_MODE (float_type_node))
1349 return float_type_node;
1351 if (mode == TYPE_MODE (double_type_node))
1352 return double_type_node;
1354 if (mode == TYPE_MODE (long_double_type_node))
1355 return long_double_type_node;
1357 if (mode == TYPE_MODE (build_pointer_type (char_type_node)))
1358 return build_pointer_type (char_type_node);
1360 if (mode == TYPE_MODE (build_pointer_type (integer_type_node)))
1361 return build_pointer_type (integer_type_node);
1363 if (VECTOR_MODE_P (mode))
1365 enum machine_mode inner_mode = GET_MODE_INNER (mode);
1366 tree inner_type = gfc_type_for_mode (inner_mode, unsignedp);
1367 if (inner_type != NULL_TREE)
1368 return build_vector_type_for_mode (inner_type, mode);
1371 return 0;
1374 /* Return an unsigned type the same as TYPE in other respects. */
1376 tree
1377 gfc_unsigned_type (tree type)
1379 tree type1 = TYPE_MAIN_VARIANT (type);
1380 if (type1 == signed_char_type_node || type1 == char_type_node)
1381 return unsigned_char_type_node;
1382 if (type1 == integer_type_node)
1383 return unsigned_type_node;
1384 if (type1 == short_integer_type_node)
1385 return short_unsigned_type_node;
1386 if (type1 == long_integer_type_node)
1387 return long_unsigned_type_node;
1388 if (type1 == long_long_integer_type_node)
1389 return long_long_unsigned_type_node;
1390 /*TODO :see others
1391 if (type1 == widest_integer_literal_type_node)
1392 return widest_unsigned_literal_type_node;
1394 #if HOST_BITS_PER_WIDE_INT >= 64
1395 if (type1 == intTI_type_node)
1396 return unsigned_intTI_type_node;
1397 #endif
1398 if (type1 == intDI_type_node)
1399 return unsigned_intDI_type_node;
1400 if (type1 == intSI_type_node)
1401 return unsigned_intSI_type_node;
1402 if (type1 == intHI_type_node)
1403 return unsigned_intHI_type_node;
1404 if (type1 == intQI_type_node)
1405 return unsigned_intQI_type_node;
1407 return gfc_signed_or_unsigned_type (1, type);
1410 /* Return a signed type the same as TYPE in other respects. */
1412 tree
1413 gfc_signed_type (tree type)
1415 tree type1 = TYPE_MAIN_VARIANT (type);
1416 if (type1 == unsigned_char_type_node || type1 == char_type_node)
1417 return signed_char_type_node;
1418 if (type1 == unsigned_type_node)
1419 return integer_type_node;
1420 if (type1 == short_unsigned_type_node)
1421 return short_integer_type_node;
1422 if (type1 == long_unsigned_type_node)
1423 return long_integer_type_node;
1424 if (type1 == long_long_unsigned_type_node)
1425 return long_long_integer_type_node;
1426 /*TODO: see others
1427 if (type1 == widest_unsigned_literal_type_node)
1428 return widest_integer_literal_type_node;
1430 #if HOST_BITS_PER_WIDE_INT >= 64
1431 if (type1 == unsigned_intTI_type_node)
1432 return intTI_type_node;
1433 #endif
1434 if (type1 == unsigned_intDI_type_node)
1435 return intDI_type_node;
1436 if (type1 == unsigned_intSI_type_node)
1437 return intSI_type_node;
1438 if (type1 == unsigned_intHI_type_node)
1439 return intHI_type_node;
1440 if (type1 == unsigned_intQI_type_node)
1441 return intQI_type_node;
1443 return gfc_signed_or_unsigned_type (0, type);
1446 /* Return a type the same as TYPE except unsigned or
1447 signed according to UNSIGNEDP. */
1449 tree
1450 gfc_signed_or_unsigned_type (int unsignedp, tree type)
1452 if (!INTEGRAL_TYPE_P (type) || TYPE_UNSIGNED (type) == unsignedp)
1453 return type;
1455 if (TYPE_PRECISION (type) == TYPE_PRECISION (signed_char_type_node))
1456 return unsignedp ? unsigned_char_type_node : signed_char_type_node;
1457 if (TYPE_PRECISION (type) == TYPE_PRECISION (integer_type_node))
1458 return unsignedp ? unsigned_type_node : integer_type_node;
1459 if (TYPE_PRECISION (type) == TYPE_PRECISION (short_integer_type_node))
1460 return unsignedp ? short_unsigned_type_node : short_integer_type_node;
1461 if (TYPE_PRECISION (type) == TYPE_PRECISION (long_integer_type_node))
1462 return unsignedp ? long_unsigned_type_node : long_integer_type_node;
1463 if (TYPE_PRECISION (type) == TYPE_PRECISION (long_long_integer_type_node))
1464 return (unsignedp ? long_long_unsigned_type_node
1465 : long_long_integer_type_node);
1466 /*TODO: see others
1467 if (TYPE_PRECISION (type) == TYPE_PRECISION (widest_integer_literal_type_node))
1468 return (unsignedp ? widest_unsigned_literal_type_node
1469 : widest_integer_literal_type_node);
1471 #if HOST_BITS_PER_WIDE_INT >= 64
1472 if (TYPE_PRECISION (type) == TYPE_PRECISION (intTI_type_node))
1473 return unsignedp ? unsigned_intTI_type_node : intTI_type_node;
1474 #endif
1475 if (TYPE_PRECISION (type) == TYPE_PRECISION (intDI_type_node))
1476 return unsignedp ? unsigned_intDI_type_node : intDI_type_node;
1477 if (TYPE_PRECISION (type) == TYPE_PRECISION (intSI_type_node))
1478 return unsignedp ? unsigned_intSI_type_node : intSI_type_node;
1479 if (TYPE_PRECISION (type) == TYPE_PRECISION (intHI_type_node))
1480 return unsignedp ? unsigned_intHI_type_node : intHI_type_node;
1481 if (TYPE_PRECISION (type) == TYPE_PRECISION (intQI_type_node))
1482 return unsignedp ? unsigned_intQI_type_node : intQI_type_node;
1484 return type;
1487 #include "gt-fortran-trans-types.h"