1 /* Backend support for Fortran 95 basic types and derived types.
2 Copyright (C) 2002, 2003, 2004, 2005 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
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
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
23 /* trans-types.c -- gfortran backend types */
27 #include "coretypes.h"
35 #include "trans-types.h"
36 #include "trans-const.h"
40 #if (GFC_MAX_DIMENSIONS < 10)
41 #define GFC_RANK_DIGITS 1
42 #define GFC_RANK_PRINTF_FORMAT "%01d"
43 #elif (GFC_MAX_DIMENSIONS < 100)
44 #define GFC_RANK_DIGITS 2
45 #define GFC_RANK_PRINTF_FORMAT "%02d"
47 #error If you really need >99 dimensions, continue the sequence above...
50 static tree gfc_get_derived_type (gfc_symbol * derived);
52 tree gfc_array_index_type;
54 tree ppvoid_type_node;
56 tree gfc_character1_type_node;
57 tree gfc_charlen_type_node;
59 static GTY(()) tree gfc_desc_dim_type;
60 static GTY(()) tree gfc_max_array_element_size;
62 /* Arrays for all integral and real kinds. We'll fill this in at runtime
63 after the target has a chance to process command-line options. */
65 #define MAX_INT_KINDS 5
66 gfc_integer_info gfc_integer_kinds[MAX_INT_KINDS + 1];
67 gfc_logical_info gfc_logical_kinds[MAX_INT_KINDS + 1];
68 static GTY(()) tree gfc_integer_types[MAX_INT_KINDS + 1];
69 static GTY(()) tree gfc_logical_types[MAX_INT_KINDS + 1];
71 #define MAX_REAL_KINDS 4
72 gfc_real_info gfc_real_kinds[MAX_REAL_KINDS + 1];
73 static GTY(()) tree gfc_real_types[MAX_REAL_KINDS + 1];
74 static GTY(()) tree gfc_complex_types[MAX_REAL_KINDS + 1];
76 /* The integer kind to use for array indices. This will be set to the
77 proper value based on target information from the backend. */
79 int gfc_index_integer_kind;
81 /* The default kinds of the various types. */
83 int gfc_default_integer_kind;
84 int gfc_max_integer_kind;
85 int gfc_default_real_kind;
86 int gfc_default_double_kind;
87 int gfc_default_character_kind;
88 int gfc_default_logical_kind;
89 int gfc_default_complex_kind;
92 /* Query the target to determine which machine modes are available for
93 computation. Choose KIND numbers for them. */
98 enum machine_mode mode;
100 bool saw_i4 = false, saw_i8 = false;
101 bool saw_r4 = false, saw_r8 = false, saw_r16 = false;
103 for (i_index = 0, mode = MIN_MODE_INT; mode <= MAX_MODE_INT; mode++)
107 if (!targetm.scalar_mode_supported_p (mode))
110 /* The middle end doesn't support constants larger than 2*HWI.
111 Perhaps the target hook shouldn't have accepted these either,
112 but just to be safe... */
113 bitsize = GET_MODE_BITSIZE (mode);
114 if (bitsize > 2*HOST_BITS_PER_WIDE_INT)
117 gcc_assert (i_index != MAX_INT_KINDS);
119 /* Let the kind equal the bit size divided by 8. This insulates the
120 programmer from the underlying byte size. */
128 gfc_integer_kinds[i_index].kind = kind;
129 gfc_integer_kinds[i_index].radix = 2;
130 gfc_integer_kinds[i_index].digits = bitsize - 1;
131 gfc_integer_kinds[i_index].bit_size = bitsize;
133 gfc_logical_kinds[i_index].kind = kind;
134 gfc_logical_kinds[i_index].bit_size = bitsize;
139 /* Set the maximum integer kind. Used with at least BOZ constants. */
140 gfc_max_integer_kind = gfc_integer_kinds[i_index - 1].kind;
142 for (r_index = 0, mode = MIN_MODE_FLOAT; mode <= MAX_MODE_FLOAT; mode++)
144 const struct real_format *fmt = REAL_MODE_FORMAT (mode);
149 if (!targetm.scalar_mode_supported_p (mode))
152 /* Let the kind equal the precision divided by 8, rounding up. Again,
153 this insulates the programmer from the underlying byte size.
155 Also, it effectively deals with IEEE extended formats. There, the
156 total size of the type may equal 16, but it's got 6 bytes of padding
157 and the increased size can get in the way of a real IEEE quad format
158 which may also be supported by the target.
160 We round up so as to handle IA-64 __floatreg (RFmode), which is an
161 82 bit type. Not to be confused with __float80 (XFmode), which is
162 an 80 bit type also supported by IA-64. So XFmode should come out
163 to be kind=10, and RFmode should come out to be kind=11. Egads. */
165 kind = (GET_MODE_PRECISION (mode) + 7) / 8;
174 /* Careful we don't stumble a wierd internal mode. */
175 gcc_assert (r_index <= 0 || gfc_real_kinds[r_index-1].kind != kind);
176 /* Or have too many modes for the allocated space. */
177 gcc_assert (r_index != MAX_REAL_KINDS);
179 gfc_real_kinds[r_index].kind = kind;
180 gfc_real_kinds[r_index].radix = fmt->b;
181 gfc_real_kinds[r_index].digits = fmt->p;
182 gfc_real_kinds[r_index].min_exponent = fmt->emin;
183 gfc_real_kinds[r_index].max_exponent = fmt->emax;
184 gfc_real_kinds[r_index].mode_precision = GET_MODE_PRECISION (mode);
188 /* Choose the default integer kind. We choose 4 unless the user
189 directs us otherwise. */
190 if (gfc_option.flag_default_integer)
193 fatal_error ("integer kind=8 not available for -fdefault-integer-8 option");
194 gfc_default_integer_kind = 8;
197 gfc_default_integer_kind = 4;
199 gfc_default_integer_kind = gfc_integer_kinds[i_index - 1].kind;
201 /* Choose the default real kind. Again, we choose 4 when possible. */
202 if (gfc_option.flag_default_real)
205 fatal_error ("real kind=8 not available for -fdefault-real-8 option");
206 gfc_default_real_kind = 8;
209 gfc_default_real_kind = 4;
211 gfc_default_real_kind = gfc_real_kinds[0].kind;
213 /* Choose the default double kind. If -fdefault-real and -fdefault-double
214 are specified, we use kind=8, if it's available. If -fdefault-real is
215 specified without -fdefault-double, we use kind=16, if it's available.
216 Otherwise we do not change anything. */
217 if (gfc_option.flag_default_double && !gfc_option.flag_default_real)
218 fatal_error ("Use of -fdefault-double-8 requires -fdefault-real-8");
220 if (gfc_option.flag_default_real && gfc_option.flag_default_double && saw_r8)
221 gfc_default_double_kind = 8;
222 else if (gfc_option.flag_default_real && saw_r16)
223 gfc_default_double_kind = 16;
224 else if (saw_r4 && saw_r8)
225 gfc_default_double_kind = 8;
228 /* F95 14.6.3.1: A nonpointer scalar object of type double precision
229 real ... occupies two contiguous numeric storage units.
231 Therefore we must be supplied a kind twice as large as we chose
232 for single precision. There are loopholes, in that double
233 precision must *occupy* two storage units, though it doesn't have
234 to *use* two storage units. Which means that you can make this
235 kind artificially wide by padding it. But at present there are
236 no GCC targets for which a two-word type does not exist, so we
237 just let gfc_validate_kind abort and tell us if something breaks. */
239 gfc_default_double_kind
240 = gfc_validate_kind (BT_REAL, gfc_default_real_kind * 2, false);
243 /* The default logical kind is constrained to be the same as the
244 default integer kind. Similarly with complex and real. */
245 gfc_default_logical_kind = gfc_default_integer_kind;
246 gfc_default_complex_kind = gfc_default_real_kind;
248 /* Choose the smallest integer kind for our default character. */
249 gfc_default_character_kind = gfc_integer_kinds[0].kind;
251 /* Choose the integer kind the same size as "void*" for our index kind. */
252 gfc_index_integer_kind = POINTER_SIZE / 8;
253 /* Pick a kind the same size as the C "int" type. */
254 gfc_c_int_kind = INT_TYPE_SIZE / 8;
257 /* Make sure that a valid kind is present. Returns an index into the
258 associated kinds array, -1 if the kind is not present. */
261 validate_integer (int kind)
265 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
266 if (gfc_integer_kinds[i].kind == kind)
273 validate_real (int kind)
277 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
278 if (gfc_real_kinds[i].kind == kind)
285 validate_logical (int kind)
289 for (i = 0; gfc_logical_kinds[i].kind; i++)
290 if (gfc_logical_kinds[i].kind == kind)
297 validate_character (int kind)
299 return kind == gfc_default_character_kind ? 0 : -1;
302 /* Validate a kind given a basic type. The return value is the same
303 for the child functions, with -1 indicating nonexistence of the
304 type. If MAY_FAIL is false, then -1 is never returned, and we ICE. */
307 gfc_validate_kind (bt type, int kind, bool may_fail)
313 case BT_REAL: /* Fall through */
315 rc = validate_real (kind);
318 rc = validate_integer (kind);
321 rc = validate_logical (kind);
324 rc = validate_character (kind);
328 gfc_internal_error ("gfc_validate_kind(): Got bad type");
331 if (rc < 0 && !may_fail)
332 gfc_internal_error ("gfc_validate_kind(): Got bad kind");
338 /* Four subroutines of gfc_init_types. Create type nodes for the given kind.
339 Reuse common type nodes where possible. Recognize if the kind matches up
340 with a C type. This will be used later in determining which routines may
341 be scarfed from libm. */
344 gfc_build_int_type (gfc_integer_info *info)
346 int mode_precision = info->bit_size;
348 if (mode_precision == CHAR_TYPE_SIZE)
350 if (mode_precision == SHORT_TYPE_SIZE)
352 if (mode_precision == INT_TYPE_SIZE)
354 if (mode_precision == LONG_TYPE_SIZE)
356 if (mode_precision == LONG_LONG_TYPE_SIZE)
357 info->c_long_long = 1;
359 if (TYPE_PRECISION (intQI_type_node) == mode_precision)
360 return intQI_type_node;
361 if (TYPE_PRECISION (intHI_type_node) == mode_precision)
362 return intHI_type_node;
363 if (TYPE_PRECISION (intSI_type_node) == mode_precision)
364 return intSI_type_node;
365 if (TYPE_PRECISION (intDI_type_node) == mode_precision)
366 return intDI_type_node;
367 if (TYPE_PRECISION (intTI_type_node) == mode_precision)
368 return intTI_type_node;
370 return make_signed_type (mode_precision);
374 gfc_build_real_type (gfc_real_info *info)
376 int mode_precision = info->mode_precision;
379 if (mode_precision == FLOAT_TYPE_SIZE)
381 if (mode_precision == DOUBLE_TYPE_SIZE)
383 if (mode_precision == LONG_DOUBLE_TYPE_SIZE)
384 info->c_long_double = 1;
386 if (TYPE_PRECISION (float_type_node) == mode_precision)
387 return float_type_node;
388 if (TYPE_PRECISION (double_type_node) == mode_precision)
389 return double_type_node;
390 if (TYPE_PRECISION (long_double_type_node) == mode_precision)
391 return long_double_type_node;
393 new_type = make_node (REAL_TYPE);
394 TYPE_PRECISION (new_type) = mode_precision;
395 layout_type (new_type);
400 gfc_build_complex_type (tree scalar_type)
404 if (scalar_type == NULL)
406 if (scalar_type == float_type_node)
407 return complex_float_type_node;
408 if (scalar_type == double_type_node)
409 return complex_double_type_node;
410 if (scalar_type == long_double_type_node)
411 return complex_long_double_type_node;
413 new_type = make_node (COMPLEX_TYPE);
414 TREE_TYPE (new_type) = scalar_type;
415 layout_type (new_type);
420 gfc_build_logical_type (gfc_logical_info *info)
422 int bit_size = info->bit_size;
425 if (bit_size == BOOL_TYPE_SIZE)
428 return boolean_type_node;
431 new_type = make_unsigned_type (bit_size);
432 TREE_SET_CODE (new_type, BOOLEAN_TYPE);
433 TYPE_MAX_VALUE (new_type) = build_int_cst (new_type, 1);
434 TYPE_PRECISION (new_type) = 1;
440 /* Return the bit size of the C "size_t". */
446 if (strcmp (SIZE_TYPE, "unsigned int") == 0)
447 return INT_TYPE_SIZE;
448 if (strcmp (SIZE_TYPE, "long unsigned int") == 0)
449 return LONG_TYPE_SIZE;
450 if (strcmp (SIZE_TYPE, "short unsigned int") == 0)
451 return SHORT_TYPE_SIZE;
454 return LONG_TYPE_SIZE;
459 /* Create the backend type nodes. We map them to their
460 equivalent C type, at least for now. We also give
461 names to the types here, and we push them in the
462 global binding level context.*/
465 gfc_init_types (void)
471 unsigned HOST_WIDE_INT hi;
472 unsigned HOST_WIDE_INT lo;
474 /* Create and name the types. */
475 #define PUSH_TYPE(name, node) \
476 pushdecl (build_decl (TYPE_DECL, get_identifier (name), node))
478 for (index = 0; gfc_integer_kinds[index].kind != 0; ++index)
480 type = gfc_build_int_type (&gfc_integer_kinds[index]);
481 gfc_integer_types[index] = type;
482 snprintf (name_buf, sizeof(name_buf), "int%d",
483 gfc_integer_kinds[index].kind);
484 PUSH_TYPE (name_buf, type);
487 for (index = 0; gfc_logical_kinds[index].kind != 0; ++index)
489 type = gfc_build_logical_type (&gfc_logical_kinds[index]);
490 gfc_logical_types[index] = type;
491 snprintf (name_buf, sizeof(name_buf), "logical%d",
492 gfc_logical_kinds[index].kind);
493 PUSH_TYPE (name_buf, type);
496 for (index = 0; gfc_real_kinds[index].kind != 0; index++)
498 type = gfc_build_real_type (&gfc_real_kinds[index]);
499 gfc_real_types[index] = type;
500 snprintf (name_buf, sizeof(name_buf), "real%d",
501 gfc_real_kinds[index].kind);
502 PUSH_TYPE (name_buf, type);
504 type = gfc_build_complex_type (type);
505 gfc_complex_types[index] = type;
506 snprintf (name_buf, sizeof(name_buf), "complex%d",
507 gfc_real_kinds[index].kind);
508 PUSH_TYPE (name_buf, type);
511 gfc_character1_type_node = build_type_variant (unsigned_char_type_node,
513 PUSH_TYPE ("char", gfc_character1_type_node);
515 PUSH_TYPE ("byte", unsigned_char_type_node);
516 PUSH_TYPE ("void", void_type_node);
518 /* DBX debugging output gets upset if these aren't set. */
519 if (!TYPE_NAME (integer_type_node))
520 PUSH_TYPE ("c_integer", integer_type_node);
521 if (!TYPE_NAME (char_type_node))
522 PUSH_TYPE ("c_char", char_type_node);
526 pvoid_type_node = build_pointer_type (void_type_node);
527 ppvoid_type_node = build_pointer_type (pvoid_type_node);
528 pchar_type_node = build_pointer_type (gfc_character1_type_node);
530 gfc_array_index_type = gfc_get_int_type (gfc_index_integer_kind);
532 /* The maximum array element size that can be handled is determined
533 by the number of bits available to store this field in the array
536 n = TYPE_PRECISION (gfc_array_index_type) - GFC_DTYPE_SIZE_SHIFT;
537 lo = ~ (unsigned HOST_WIDE_INT) 0;
538 if (n > HOST_BITS_PER_WIDE_INT)
539 hi = lo >> (2*HOST_BITS_PER_WIDE_INT - n);
541 hi = 0, lo >>= HOST_BITS_PER_WIDE_INT - n;
542 gfc_max_array_element_size
543 = build_int_cst_wide (long_unsigned_type_node, lo, hi);
545 size_type_node = gfc_array_index_type;
547 boolean_type_node = gfc_get_logical_type (gfc_default_logical_kind);
548 boolean_true_node = build_int_cst (boolean_type_node, 1);
549 boolean_false_node = build_int_cst (boolean_type_node, 0);
551 /* ??? Shouldn't this be based on gfc_index_integer_kind or so? */
552 gfc_charlen_type_node = gfc_get_int_type (4);
555 /* Get the type node for the given type and kind. */
558 gfc_get_int_type (int kind)
560 int index = gfc_validate_kind (BT_INTEGER, kind, false);
561 return gfc_integer_types[index];
565 gfc_get_real_type (int kind)
567 int index = gfc_validate_kind (BT_REAL, kind, false);
568 return gfc_real_types[index];
572 gfc_get_complex_type (int kind)
574 int index = gfc_validate_kind (BT_COMPLEX, kind, false);
575 return gfc_complex_types[index];
579 gfc_get_logical_type (int kind)
581 int index = gfc_validate_kind (BT_LOGICAL, kind, false);
582 return gfc_logical_types[index];
585 /* Create a character type with the given kind and length. */
588 gfc_get_character_type_len (int kind, tree len)
592 gfc_validate_kind (BT_CHARACTER, kind, false);
594 bounds = build_range_type (gfc_charlen_type_node, gfc_index_one_node, len);
595 type = build_array_type (gfc_character1_type_node, bounds);
596 TYPE_STRING_FLAG (type) = 1;
602 /* Get a type node for a character kind. */
605 gfc_get_character_type (int kind, gfc_charlen * cl)
609 len = (cl == NULL) ? NULL_TREE : cl->backend_decl;
611 return gfc_get_character_type_len (kind, len);
614 /* Covert a basic type. This will be an array for character types. */
617 gfc_typenode_for_spec (gfc_typespec * spec)
627 basetype = gfc_get_int_type (spec->kind);
631 basetype = gfc_get_real_type (spec->kind);
635 basetype = gfc_get_complex_type (spec->kind);
639 basetype = gfc_get_logical_type (spec->kind);
643 basetype = gfc_get_character_type (spec->kind, spec->cl);
647 basetype = gfc_get_derived_type (spec->derived);
656 /* Build an INT_CST for constant expressions, otherwise return NULL_TREE. */
659 gfc_conv_array_bound (gfc_expr * expr)
661 /* If expr is an integer constant, return that. */
662 if (expr != NULL && expr->expr_type == EXPR_CONSTANT)
663 return gfc_conv_mpz_to_tree (expr->value.integer, gfc_index_integer_kind);
665 /* Otherwise return NULL. */
670 gfc_get_element_type (tree type)
674 if (GFC_ARRAY_TYPE_P (type))
676 if (TREE_CODE (type) == POINTER_TYPE)
677 type = TREE_TYPE (type);
678 gcc_assert (TREE_CODE (type) == ARRAY_TYPE);
679 element = TREE_TYPE (type);
683 gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
684 element = TREE_TYPE (TYPE_FIELDS (type));
686 gcc_assert (TREE_CODE (element) == POINTER_TYPE);
687 element = TREE_TYPE (element);
689 gcc_assert (TREE_CODE (element) == ARRAY_TYPE);
690 element = TREE_TYPE (element);
696 /* Build an array. This function is called from gfc_sym_type().
697 Actually returns array descriptor type.
699 Format of array descriptors is as follows:
701 struct gfc_array_descriptor
706 struct descriptor_dimension dimension[N_DIM];
709 struct descriptor_dimension
716 Translation code should use gfc_conv_descriptor_* rather than accessing
717 the descriptor directly. Any changes to the array descriptor type will
718 require changes in gfc_conv_descriptor_* and gfc_build_array_initializer.
720 This is represented internally as a RECORD_TYPE. The index nodes are
721 gfc_array_index_type and the data node is a pointer to the data. See below
722 for the handling of character types.
724 The dtype member is formatted as follows:
725 rank = dtype & GFC_DTYPE_RANK_MASK // 3 bits
726 type = (dtype & GFC_DTYPE_TYPE_MASK) >> GFC_DTYPE_TYPE_SHIFT // 3 bits
727 size = dtype >> GFC_DTYPE_SIZE_SHIFT
729 I originally used nested ARRAY_TYPE nodes to represent arrays, but this
730 generated poor code for assumed/deferred size arrays. These require
731 use of PLACEHOLDER_EXPR/WITH_RECORD_EXPR, which isn't part of the GENERIC
732 grammar. Also, there is no way to explicitly set the array stride, so
733 all data must be packed(1). I've tried to mark all the functions which
734 would require modification with a GCC ARRAYS comment.
736 The data component points to the first element in the array.
737 The offset field is the position of the origin of the array
738 (ie element (0, 0 ...)). This may be outsite the bounds of the array.
740 An element is accessed by
741 data[offset + index0*stride0 + index1*stride1 + index2*stride2]
742 This gives good performance as the computation does not involve the
743 bounds of the array. For packed arrays, this is optimized further by
744 substituting the known strides.
746 This system has one problem: all array bounds must be withing 2^31 elements
747 of the origin (2^63 on 64-bit machines). For example
748 integer, dimension (80000:90000, 80000:90000, 2) :: array
749 may not work properly on 32-bit machines because 80000*80000 > 2^31, so
750 the calculation for stride02 would overflow. This may still work, but
751 I haven't checked, and it relies on the overflow doing the right thing.
753 The way to fix this problem is to access elements as follows:
754 data[(index0-lbound0)*stride0 + (index1-lbound1)*stride1]
755 Obviously this is much slower. I will make this a compile time option,
756 something like -fsmall-array-offsets. Mixing code compiled with and without
757 this switch will work.
759 (1) This can be worked around by modifying the upper bound of the previous
760 dimension. This requires extra fields in the descriptor (both real_ubound
761 and fake_ubound). In tree.def there is mention of TYPE_SEP, which
762 may allow us to do this. However I can't find mention of this anywhere
766 /* Returns true if the array sym does not require a descriptor. */
769 gfc_is_nodesc_array (gfc_symbol * sym)
771 gcc_assert (sym->attr.dimension);
773 /* We only want local arrays. */
774 if (sym->attr.pointer || sym->attr.allocatable)
779 if (sym->as->type != AS_ASSUMED_SHAPE)
785 if (sym->attr.result || sym->attr.function)
788 if (sym->attr.pointer || sym->attr.allocatable)
791 gcc_assert (sym->as->type == AS_EXPLICIT);
797 /* Create an array descriptor type. */
800 gfc_build_array_type (tree type, gfc_array_spec * as)
802 tree lbound[GFC_MAX_DIMENSIONS];
803 tree ubound[GFC_MAX_DIMENSIONS];
806 for (n = 0; n < as->rank; n++)
808 /* Create expressions for the known bounds of the array. */
809 if (as->type == AS_ASSUMED_SHAPE && as->lower[n] == NULL)
810 lbound[n] = gfc_index_one_node;
812 lbound[n] = gfc_conv_array_bound (as->lower[n]);
813 ubound[n] = gfc_conv_array_bound (as->upper[n]);
816 return gfc_get_array_type_bounds (type, as->rank, lbound, ubound, 0);
819 /* Returns the struct descriptor_dimension type. */
822 gfc_get_desc_dim_type (void)
828 if (gfc_desc_dim_type)
829 return gfc_desc_dim_type;
831 /* Build the type node. */
832 type = make_node (RECORD_TYPE);
834 TYPE_NAME (type) = get_identifier ("descriptor_dimension");
835 TYPE_PACKED (type) = 1;
837 /* Consists of the stride, lbound and ubound members. */
838 decl = build_decl (FIELD_DECL,
839 get_identifier ("stride"), gfc_array_index_type);
840 DECL_CONTEXT (decl) = type;
843 decl = build_decl (FIELD_DECL,
844 get_identifier ("lbound"), gfc_array_index_type);
845 DECL_CONTEXT (decl) = type;
846 fieldlist = chainon (fieldlist, decl);
848 decl = build_decl (FIELD_DECL,
849 get_identifier ("ubound"), gfc_array_index_type);
850 DECL_CONTEXT (decl) = type;
851 fieldlist = chainon (fieldlist, decl);
853 /* Finish off the type. */
854 TYPE_FIELDS (type) = fieldlist;
856 gfc_finish_type (type);
858 gfc_desc_dim_type = type;
863 /* Return the DTYPE for an array. This describes the type and type parameters
865 /* TODO: Only call this when the value is actually used, and make all the
866 unknown cases abort. */
869 gfc_get_dtype (tree type)
879 gcc_assert (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type));
881 if (GFC_TYPE_ARRAY_DTYPE (type))
882 return GFC_TYPE_ARRAY_DTYPE (type);
884 rank = GFC_TYPE_ARRAY_RANK (type);
885 etype = gfc_get_element_type (type);
887 switch (TREE_CODE (etype))
890 n = GFC_DTYPE_INTEGER;
894 n = GFC_DTYPE_LOGICAL;
902 n = GFC_DTYPE_COMPLEX;
905 /* We will never have arrays of arrays. */
907 n = GFC_DTYPE_DERIVED;
911 n = GFC_DTYPE_CHARACTER;
915 /* TODO: Don't do dtype for temporary descriptorless arrays. */
916 /* We can strange array types for temporary arrays. */
917 return gfc_index_zero_node;
920 gcc_assert (rank <= GFC_DTYPE_RANK_MASK);
921 size = TYPE_SIZE_UNIT (etype);
923 i = rank | (n << GFC_DTYPE_TYPE_SHIFT);
924 if (size && INTEGER_CST_P (size))
926 if (tree_int_cst_lt (gfc_max_array_element_size, size))
927 internal_error ("Array element size too big");
929 i += TREE_INT_CST_LOW (size) << GFC_DTYPE_SIZE_SHIFT;
931 dtype = build_int_cst (gfc_array_index_type, i);
933 if (size && !INTEGER_CST_P (size))
935 tmp = build_int_cst (gfc_array_index_type, GFC_DTYPE_SIZE_SHIFT);
936 tmp = fold_build2 (LSHIFT_EXPR, gfc_array_index_type, size, tmp);
937 dtype = fold_build2 (PLUS_EXPR, gfc_array_index_type, tmp, dtype);
939 /* If we don't know the size we leave it as zero. This should never happen
940 for anything that is actually used. */
941 /* TODO: Check this is actually true, particularly when repacking
942 assumed size parameters. */
944 GFC_TYPE_ARRAY_DTYPE (type) = dtype;
949 /* Build an array type for use without a descriptor. Valid values of packed
950 are 0=no, 1=partial, 2=full, 3=static. */
953 gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, int packed)
966 mpz_init_set_ui (offset, 0);
967 mpz_init_set_ui (stride, 1);
970 /* We don't use build_array_type because this does not include include
971 lang-specific information (i.e. the bounds of the array) when checking
973 type = make_node (ARRAY_TYPE);
975 GFC_ARRAY_TYPE_P (type) = 1;
976 TYPE_LANG_SPECIFIC (type) = (struct lang_type *)
977 ggc_alloc_cleared (sizeof (struct lang_type));
979 known_stride = (packed != 0);
981 for (n = 0; n < as->rank; n++)
983 /* Fill in the stride and bound components of the type. */
985 tmp = gfc_conv_mpz_to_tree (stride, gfc_index_integer_kind);
988 GFC_TYPE_ARRAY_STRIDE (type, n) = tmp;
991 if (expr->expr_type == EXPR_CONSTANT)
993 tmp = gfc_conv_mpz_to_tree (expr->value.integer,
994 gfc_index_integer_kind);
1001 GFC_TYPE_ARRAY_LBOUND (type, n) = tmp;
1005 /* Calculate the offset. */
1006 mpz_mul (delta, stride, as->lower[n]->value.integer);
1007 mpz_sub (offset, offset, delta);
1012 expr = as->upper[n];
1013 if (expr && expr->expr_type == EXPR_CONSTANT)
1015 tmp = gfc_conv_mpz_to_tree (expr->value.integer,
1016 gfc_index_integer_kind);
1023 GFC_TYPE_ARRAY_UBOUND (type, n) = tmp;
1027 /* Calculate the stride. */
1028 mpz_sub (delta, as->upper[n]->value.integer,
1029 as->lower[n]->value.integer);
1030 mpz_add_ui (delta, delta, 1);
1031 mpz_mul (stride, stride, delta);
1034 /* Only the first stride is known for partial packed arrays. */
1041 GFC_TYPE_ARRAY_OFFSET (type) =
1042 gfc_conv_mpz_to_tree (offset, gfc_index_integer_kind);
1045 GFC_TYPE_ARRAY_OFFSET (type) = NULL_TREE;
1049 GFC_TYPE_ARRAY_SIZE (type) =
1050 gfc_conv_mpz_to_tree (stride, gfc_index_integer_kind);
1053 GFC_TYPE_ARRAY_SIZE (type) = NULL_TREE;
1055 GFC_TYPE_ARRAY_RANK (type) = as->rank;
1056 GFC_TYPE_ARRAY_DTYPE (type) = NULL_TREE;
1057 range = build_range_type (gfc_array_index_type, gfc_index_zero_node,
1059 /* TODO: use main type if it is unbounded. */
1060 GFC_TYPE_ARRAY_DATAPTR_TYPE (type) =
1061 build_pointer_type (build_array_type (etype, range));
1065 mpz_sub_ui (stride, stride, 1);
1066 range = gfc_conv_mpz_to_tree (stride, gfc_index_integer_kind);
1071 range = build_range_type (gfc_array_index_type, gfc_index_zero_node, range);
1072 TYPE_DOMAIN (type) = range;
1074 build_pointer_type (etype);
1075 TREE_TYPE (type) = etype;
1083 if (packed < 3 || !known_stride)
1085 /* For dummy arrays and automatic (heap allocated) arrays we
1086 want a pointer to the array. */
1087 type = build_pointer_type (type);
1088 GFC_ARRAY_TYPE_P (type) = 1;
1089 TYPE_LANG_SPECIFIC (type) = TYPE_LANG_SPECIFIC (TREE_TYPE (type));
1095 /* Build an array (descriptor) type with given bounds. */
1098 gfc_get_array_type_bounds (tree etype, int dimen, tree * lbound,
1099 tree * ubound, int packed)
1101 tree fat_type, fat_pointer_type;
1106 char name[8 + GFC_RANK_DIGITS + GFC_MAX_SYMBOL_LEN];
1107 const char *typename;
1113 /* Build the type node. */
1114 fat_type = make_node (RECORD_TYPE);
1115 GFC_DESCRIPTOR_TYPE_P (fat_type) = 1;
1116 TYPE_LANG_SPECIFIC (fat_type) = (struct lang_type *)
1117 ggc_alloc_cleared (sizeof (struct lang_type));
1118 GFC_TYPE_ARRAY_RANK (fat_type) = dimen;
1119 GFC_TYPE_ARRAY_DTYPE (fat_type) = NULL_TREE;
1121 tmp = TYPE_NAME (etype);
1122 if (tmp && TREE_CODE (tmp) == TYPE_DECL)
1123 tmp = DECL_NAME (tmp);
1125 typename = IDENTIFIER_POINTER (tmp);
1127 typename = "unknown";
1129 sprintf (name, "array" GFC_RANK_PRINTF_FORMAT "_%.*s", dimen,
1130 GFC_MAX_SYMBOL_LEN, typename);
1131 TYPE_NAME (fat_type) = get_identifier (name);
1132 TYPE_PACKED (fat_type) = 0;
1134 fat_pointer_type = build_pointer_type (fat_type);
1136 /* Build an array descriptor record type. */
1138 stride = gfc_index_one_node;
1142 for (n = 0; n < dimen; n++)
1144 GFC_TYPE_ARRAY_STRIDE (fat_type, n) = stride;
1151 if (lower != NULL_TREE)
1153 if (INTEGER_CST_P (lower))
1154 GFC_TYPE_ARRAY_LBOUND (fat_type, n) = lower;
1160 if (upper != NULL_TREE)
1162 if (INTEGER_CST_P (upper))
1163 GFC_TYPE_ARRAY_UBOUND (fat_type, n) = upper;
1168 if (upper != NULL_TREE && lower != NULL_TREE && stride != NULL_TREE)
1170 tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, upper, lower);
1171 tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, tmp,
1172 gfc_index_one_node);
1174 fold_build2 (MULT_EXPR, gfc_array_index_type, tmp, stride);
1175 /* Check the folding worked. */
1176 gcc_assert (INTEGER_CST_P (stride));
1181 GFC_TYPE_ARRAY_SIZE (fat_type) = stride;
1182 /* TODO: known offsets for descriptors. */
1183 GFC_TYPE_ARRAY_OFFSET (fat_type) = NULL_TREE;
1185 /* We define data as an unknown size array. Much better than doing
1186 pointer arithmetic. */
1188 build_array_type (etype,
1189 build_range_type (gfc_array_index_type,
1190 gfc_index_zero_node, NULL_TREE));
1191 arraytype = build_pointer_type (arraytype);
1192 GFC_TYPE_ARRAY_DATAPTR_TYPE (fat_type) = arraytype;
1194 /* The pointer to the array data. */
1195 decl = build_decl (FIELD_DECL, get_identifier ("data"), arraytype);
1197 DECL_CONTEXT (decl) = fat_type;
1198 /* Add the data member as the first element of the descriptor. */
1201 /* Add the base component. */
1202 decl = build_decl (FIELD_DECL, get_identifier ("offset"),
1203 gfc_array_index_type);
1204 DECL_CONTEXT (decl) = fat_type;
1205 fieldlist = chainon (fieldlist, decl);
1207 /* Add the dtype component. */
1208 decl = build_decl (FIELD_DECL, get_identifier ("dtype"),
1209 gfc_array_index_type);
1210 DECL_CONTEXT (decl) = fat_type;
1211 fieldlist = chainon (fieldlist, decl);
1213 /* Build the array type for the stride and bound components. */
1215 build_array_type (gfc_get_desc_dim_type (),
1216 build_range_type (gfc_array_index_type,
1217 gfc_index_zero_node,
1218 gfc_rank_cst[dimen - 1]));
1220 decl = build_decl (FIELD_DECL, get_identifier ("dim"), arraytype);
1221 DECL_CONTEXT (decl) = fat_type;
1222 DECL_INITIAL (decl) = NULL_TREE;
1223 fieldlist = chainon (fieldlist, decl);
1225 /* Finish off the type. */
1226 TYPE_FIELDS (fat_type) = fieldlist;
1228 gfc_finish_type (fat_type);
1233 /* Build a pointer type. This function is called from gfc_sym_type(). */
1236 gfc_build_pointer_type (gfc_symbol * sym, tree type)
1238 /* Array pointer types aren't actually pointers. */
1239 if (sym->attr.dimension)
1242 return build_pointer_type (type);
1245 /* Return the type for a symbol. Special handling is required for character
1246 types to get the correct level of indirection.
1247 For functions return the return type.
1248 For subroutines return void_type_node.
1249 Calling this multiple times for the same symbol should be avoided,
1250 especially for character and array types. */
1253 gfc_sym_type (gfc_symbol * sym)
1258 if (sym->attr.flavor == FL_PROCEDURE && !sym->attr.function)
1259 return void_type_node;
1261 if (sym->backend_decl)
1263 if (sym->attr.function)
1264 return TREE_TYPE (TREE_TYPE (sym->backend_decl));
1266 return TREE_TYPE (sym->backend_decl);
1269 /* The frontend doesn't set all the attributes for a function with an
1270 explicit result value, so we use that instead when present. */
1271 if (sym->attr.function && sym->result)
1274 type = gfc_typenode_for_spec (&sym->ts);
1275 if (gfc_option.flag_f2c
1276 && sym->attr.function
1277 && sym->ts.type == BT_REAL
1278 && sym->ts.kind == gfc_default_real_kind
1279 && !sym->attr.always_explicit)
1281 /* Special case: f2c calling conventions require that (scalar)
1282 default REAL functions return the C type double instead. */
1283 sym->ts.kind = gfc_default_double_kind;
1284 type = gfc_typenode_for_spec (&sym->ts);
1285 sym->ts.kind = gfc_default_real_kind;
1288 if (sym->attr.dummy && !sym->attr.function)
1293 if (sym->attr.dimension)
1295 if (gfc_is_nodesc_array (sym))
1297 /* If this is a character argument of unknown length, just use the
1299 if (sym->ts.type != BT_CHARACTER
1300 || !(sym->attr.dummy || sym->attr.function || sym->attr.result)
1301 || sym->ts.cl->backend_decl)
1303 type = gfc_get_nodesc_array_type (type, sym->as,
1309 type = gfc_build_array_type (type, sym->as);
1313 if (sym->attr.allocatable || sym->attr.pointer)
1314 type = gfc_build_pointer_type (sym, type);
1317 /* We currently pass all parameters by reference.
1318 See f95_get_function_decl. For dummy function parameters return the
1322 /* We must use pointer types for potentially absent variables. The
1323 optimizers assume a reference type argument is never NULL. */
1324 if (sym->attr.optional || sym->ns->proc_name->attr.entry_master)
1325 type = build_pointer_type (type);
1327 type = build_reference_type (type);
1333 /* Layout and output debug info for a record type. */
1336 gfc_finish_type (tree type)
1340 decl = build_decl (TYPE_DECL, NULL_TREE, type);
1341 TYPE_STUB_DECL (type) = decl;
1343 rest_of_type_compilation (type, 1);
1344 rest_of_decl_compilation (decl, 1, 0);
1347 /* Add a field of given NAME and TYPE to the context of a UNION_TYPE
1348 or RECORD_TYPE pointed to by STYPE. The new field is chained
1349 to the fieldlist pointed to by FIELDLIST.
1351 Returns a pointer to the new field. */
1354 gfc_add_field_to_struct (tree *fieldlist, tree context,
1355 tree name, tree type)
1359 decl = build_decl (FIELD_DECL, name, type);
1361 DECL_CONTEXT (decl) = context;
1362 DECL_INITIAL (decl) = 0;
1363 DECL_ALIGN (decl) = 0;
1364 DECL_USER_ALIGN (decl) = 0;
1365 TREE_CHAIN (decl) = NULL_TREE;
1366 *fieldlist = chainon (*fieldlist, decl);
1372 /* Build a tree node for a derived type. */
1375 gfc_get_derived_type (gfc_symbol * derived)
1377 tree typenode, field, field_type, fieldlist;
1380 gcc_assert (derived && derived->attr.flavor == FL_DERIVED);
1382 /* derived->backend_decl != 0 means we saw it before, but its
1383 components' backend_decl may have not been built. */
1384 if (derived->backend_decl)
1386 /* Its components' backend_decl have been built. */
1387 if (TYPE_FIELDS (derived->backend_decl))
1388 return derived->backend_decl;
1390 typenode = derived->backend_decl;
1394 /* We see this derived type first time, so build the type node. */
1395 typenode = make_node (RECORD_TYPE);
1396 TYPE_NAME (typenode) = get_identifier (derived->name);
1397 TYPE_PACKED (typenode) = gfc_option.flag_pack_derived;
1398 derived->backend_decl = typenode;
1401 /* Build the type member list. Install the newly created RECORD_TYPE
1402 node as DECL_CONTEXT of each FIELD_DECL. */
1403 fieldlist = NULL_TREE;
1404 for (c = derived->components; c; c = c->next)
1406 if (c->ts.type == BT_DERIVED && c->pointer)
1408 if (c->ts.derived->backend_decl)
1409 /* We already saw this derived type so use the exiting type.
1410 It doesn't matter if it is incomplete. */
1411 field_type = c->ts.derived->backend_decl;
1413 /* Recurse into the type. */
1414 field_type = gfc_get_derived_type (c->ts.derived);
1418 if (c->ts.type == BT_CHARACTER)
1420 /* Evaluate the string length. */
1421 gfc_conv_const_charlen (c->ts.cl);
1422 gcc_assert (c->ts.cl->backend_decl);
1425 field_type = gfc_typenode_for_spec (&c->ts);
1428 /* This returns an array descriptor type. Initialization may be
1434 /* Pointers to arrays aren't actually pointer types. The
1435 descriptors are separate, but the data is common. */
1436 field_type = gfc_build_array_type (field_type, c->as);
1439 field_type = gfc_get_nodesc_array_type (field_type, c->as, 3);
1441 else if (c->pointer)
1442 field_type = build_pointer_type (field_type);
1444 field = gfc_add_field_to_struct (&fieldlist, typenode,
1445 get_identifier (c->name),
1448 DECL_PACKED (field) |= TYPE_PACKED (typenode);
1450 gcc_assert (!c->backend_decl);
1451 c->backend_decl = field;
1454 /* Now we have the final fieldlist. Record it, then lay out the
1455 derived type, including the fields. */
1456 TYPE_FIELDS (typenode) = fieldlist;
1458 gfc_finish_type (typenode);
1460 derived->backend_decl = typenode;
1466 gfc_return_by_reference (gfc_symbol * sym)
1470 if (!sym->attr.function)
1473 result = sym->result ? sym->result : sym;
1475 if (result->attr.dimension)
1478 if (result->ts.type == BT_CHARACTER)
1481 /* Possibly return complex numbers by reference for g77 compatibility.
1482 We don't do this for calls to intrinsics (as the library uses the
1483 -fno-f2c calling convention), nor for calls to functions which always
1484 require an explicit interface, as no compatibility problems can
1486 if (gfc_option.flag_f2c
1487 && result->ts.type == BT_COMPLEX
1488 && !sym->attr.intrinsic && !sym->attr.always_explicit)
1495 gfc_get_mixed_entry_union (gfc_namespace *ns)
1500 char name[GFC_MAX_SYMBOL_LEN + 1];
1501 gfc_entry_list *el, *el2;
1503 gcc_assert (ns->proc_name->attr.mixed_entry_master);
1504 gcc_assert (memcmp (ns->proc_name->name, "master.", 7) == 0);
1506 snprintf (name, GFC_MAX_SYMBOL_LEN, "munion.%s", ns->proc_name->name + 7);
1508 /* Build the type node. */
1509 type = make_node (UNION_TYPE);
1511 TYPE_NAME (type) = get_identifier (name);
1514 for (el = ns->entries; el; el = el->next)
1516 /* Search for duplicates. */
1517 for (el2 = ns->entries; el2 != el; el2 = el2->next)
1518 if (el2->sym->result == el->sym->result)
1523 decl = build_decl (FIELD_DECL,
1524 get_identifier (el->sym->result->name),
1525 gfc_sym_type (el->sym->result));
1526 DECL_CONTEXT (decl) = type;
1527 fieldlist = chainon (fieldlist, decl);
1531 /* Finish off the type. */
1532 TYPE_FIELDS (type) = fieldlist;
1534 gfc_finish_type (type);
1539 gfc_get_function_type (gfc_symbol * sym)
1543 gfc_formal_arglist *f;
1546 int alternate_return;
1548 /* Make sure this symbol is a function or a subroutine. */
1549 gcc_assert (sym->attr.flavor == FL_PROCEDURE);
1551 if (sym->backend_decl)
1552 return TREE_TYPE (sym->backend_decl);
1555 alternate_return = 0;
1556 typelist = NULL_TREE;
1558 if (sym->attr.entry_master)
1560 /* Additional parameter for selecting an entry point. */
1561 typelist = gfc_chainon_list (typelist, gfc_array_index_type);
1564 /* Some functions we use an extra parameter for the return value. */
1565 if (gfc_return_by_reference (sym))
1572 if (arg->ts.type == BT_CHARACTER)
1573 gfc_conv_const_charlen (arg->ts.cl);
1575 type = gfc_sym_type (arg);
1576 if (arg->ts.type == BT_COMPLEX
1577 || arg->attr.dimension
1578 || arg->ts.type == BT_CHARACTER)
1579 type = build_reference_type (type);
1581 typelist = gfc_chainon_list (typelist, type);
1582 if (arg->ts.type == BT_CHARACTER)
1583 typelist = gfc_chainon_list (typelist, gfc_charlen_type_node);
1586 /* Build the argument types for the function. */
1587 for (f = sym->formal; f; f = f->next)
1592 /* Evaluate constant character lengths here so that they can be
1593 included in the type. */
1594 if (arg->ts.type == BT_CHARACTER)
1595 gfc_conv_const_charlen (arg->ts.cl);
1597 if (arg->attr.flavor == FL_PROCEDURE)
1599 type = gfc_get_function_type (arg);
1600 type = build_pointer_type (type);
1603 type = gfc_sym_type (arg);
1605 /* Parameter Passing Convention
1607 We currently pass all parameters by reference.
1608 Parameters with INTENT(IN) could be passed by value.
1609 The problem arises if a function is called via an implicit
1610 prototype. In this situation the INTENT is not known.
1611 For this reason all parameters to global functions must be
1612 passed by reference. Passing by value would potentialy
1613 generate bad code. Worse there would be no way of telling that
1614 this code was bad, except that it would give incorrect results.
1616 Contained procedures could pass by value as these are never
1617 used without an explicit interface, and connot be passed as
1618 actual parameters for a dummy procedure. */
1619 if (arg->ts.type == BT_CHARACTER)
1621 typelist = gfc_chainon_list (typelist, type);
1625 if (sym->attr.subroutine)
1626 alternate_return = 1;
1630 /* Add hidden string length parameters. */
1632 typelist = gfc_chainon_list (typelist, gfc_charlen_type_node);
1634 typelist = gfc_chainon_list (typelist, void_type_node);
1636 if (alternate_return)
1637 type = integer_type_node;
1638 else if (!sym->attr.function || gfc_return_by_reference (sym))
1639 type = void_type_node;
1640 else if (sym->attr.mixed_entry_master)
1641 type = gfc_get_mixed_entry_union (sym->ns);
1643 type = gfc_sym_type (sym);
1645 type = build_function_type (type, typelist);
1650 /* Language hooks for middle-end access to type nodes. */
1652 /* Return an integer type with BITS bits of precision,
1653 that is unsigned if UNSIGNEDP is nonzero, otherwise signed. */
1656 gfc_type_for_size (unsigned bits, int unsignedp)
1661 for (i = 0; i <= MAX_INT_KINDS; ++i)
1663 tree type = gfc_integer_types[i];
1664 if (type && bits == TYPE_PRECISION (type))
1670 if (bits == TYPE_PRECISION (unsigned_intQI_type_node))
1671 return unsigned_intQI_type_node;
1672 if (bits == TYPE_PRECISION (unsigned_intHI_type_node))
1673 return unsigned_intHI_type_node;
1674 if (bits == TYPE_PRECISION (unsigned_intSI_type_node))
1675 return unsigned_intSI_type_node;
1676 if (bits == TYPE_PRECISION (unsigned_intDI_type_node))
1677 return unsigned_intDI_type_node;
1678 if (bits == TYPE_PRECISION (unsigned_intTI_type_node))
1679 return unsigned_intTI_type_node;
1685 /* Return a data type that has machine mode MODE. If the mode is an
1686 integer, then UNSIGNEDP selects between signed and unsigned types. */
1689 gfc_type_for_mode (enum machine_mode mode, int unsignedp)
1694 if (GET_MODE_CLASS (mode) == MODE_FLOAT)
1695 base = gfc_real_types;
1696 else if (GET_MODE_CLASS (mode) == MODE_COMPLEX_FLOAT)
1697 base = gfc_complex_types;
1698 else if (SCALAR_INT_MODE_P (mode))
1699 return gfc_type_for_size (GET_MODE_PRECISION (mode), unsignedp);
1700 else if (VECTOR_MODE_P (mode))
1702 enum machine_mode inner_mode = GET_MODE_INNER (mode);
1703 tree inner_type = gfc_type_for_mode (inner_mode, unsignedp);
1704 if (inner_type != NULL_TREE)
1705 return build_vector_type_for_mode (inner_type, mode);
1711 for (i = 0; i <= MAX_REAL_KINDS; ++i)
1713 tree type = base[i];
1714 if (type && mode == TYPE_MODE (type))
1721 /* Return a type the same as TYPE except unsigned or
1722 signed according to UNSIGNEDP. */
1725 gfc_signed_or_unsigned_type (int unsignedp, tree type)
1727 if (TREE_CODE (type) != INTEGER_TYPE || TYPE_UNSIGNED (type) == unsignedp)
1730 return gfc_type_for_size (TYPE_PRECISION (type), unsignedp);
1733 /* Return an unsigned type the same as TYPE in other respects. */
1736 gfc_unsigned_type (tree type)
1738 return gfc_signed_or_unsigned_type (1, type);
1741 /* Return a signed type the same as TYPE in other respects. */
1744 gfc_signed_type (tree type)
1746 return gfc_signed_or_unsigned_type (0, type);
1749 #include "gt-fortran-trans-types.h"