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_default_real_kind
;
85 int gfc_default_double_kind
;
86 int gfc_default_character_kind
;
87 int gfc_default_logical_kind
;
88 int gfc_default_complex_kind
;
91 /* Query the target to determine which machine modes are available for
92 computation. Choose KIND numbers for them. */
97 enum machine_mode mode
;
99 bool saw_i4
= false, saw_i8
= false;
100 bool saw_r4
= false, saw_r8
= false, saw_r16
= false;
102 for (i_index
= 0, mode
= MIN_MODE_INT
; mode
<= MAX_MODE_INT
; mode
++)
106 if (!targetm
.scalar_mode_supported_p (mode
))
109 /* The middle end doesn't support constants larger than 2*HWI.
110 Perhaps the target hook shouldn't have accepted these either,
111 but just to be safe... */
112 bitsize
= GET_MODE_BITSIZE (mode
);
113 if (bitsize
> 2*HOST_BITS_PER_WIDE_INT
)
116 gcc_assert (i_index
!= MAX_INT_KINDS
);
118 /* Let the kind equal the bit size divided by 8. This insulates the
119 programmer from the underlying byte size. */
127 gfc_integer_kinds
[i_index
].kind
= kind
;
128 gfc_integer_kinds
[i_index
].radix
= 2;
129 gfc_integer_kinds
[i_index
].digits
= bitsize
- 1;
130 gfc_integer_kinds
[i_index
].bit_size
= bitsize
;
132 gfc_logical_kinds
[i_index
].kind
= kind
;
133 gfc_logical_kinds
[i_index
].bit_size
= bitsize
;
138 for (r_index
= 0, mode
= MIN_MODE_FLOAT
; mode
<= MAX_MODE_FLOAT
; mode
++)
140 const struct real_format
*fmt
= REAL_MODE_FORMAT (mode
);
145 if (!targetm
.scalar_mode_supported_p (mode
))
148 /* Let the kind equal the precision divided by 8, rounding up. Again,
149 this insulates the programmer from the underlying byte size.
151 Also, it effectively deals with IEEE extended formats. There, the
152 total size of the type may equal 16, but it's got 6 bytes of padding
153 and the increased size can get in the way of a real IEEE quad format
154 which may also be supported by the target.
156 We round up so as to handle IA-64 __floatreg (RFmode), which is an
157 82 bit type. Not to be confused with __float80 (XFmode), which is
158 an 80 bit type also supported by IA-64. So XFmode should come out
159 to be kind=10, and RFmode should come out to be kind=11. Egads. */
161 kind
= (GET_MODE_PRECISION (mode
) + 7) / 8;
170 /* Careful we don't stumble a wierd internal mode. */
171 gcc_assert (r_index
<= 0 || gfc_real_kinds
[r_index
-1].kind
!= kind
);
172 /* Or have too many modes for the allocated space. */
173 gcc_assert (r_index
!= MAX_REAL_KINDS
);
175 gfc_real_kinds
[r_index
].kind
= kind
;
176 gfc_real_kinds
[r_index
].radix
= fmt
->b
;
177 gfc_real_kinds
[r_index
].digits
= fmt
->p
;
178 gfc_real_kinds
[r_index
].min_exponent
= fmt
->emin
;
179 gfc_real_kinds
[r_index
].max_exponent
= fmt
->emax
;
180 gfc_real_kinds
[r_index
].mode_precision
= GET_MODE_PRECISION (mode
);
184 /* Choose the default integer kind. We choose 4 unless the user
185 directs us otherwise. */
189 fatal_error ("integer kind=8 not available for -i8 option");
190 gfc_default_integer_kind
= 8;
193 gfc_default_integer_kind
= 4;
195 gfc_default_integer_kind
= gfc_integer_kinds
[i_index
- 1].kind
;
197 /* Choose the default real kind. Again, we choose 4 when possible. */
201 fatal_error ("real kind=8 not available for -r8 option");
202 gfc_default_real_kind
= 8;
205 gfc_default_real_kind
= 4;
207 gfc_default_real_kind
= gfc_real_kinds
[0].kind
;
209 /* Choose the default double kind. If -r8 is specified, we use kind=16,
210 if it's available, otherwise we do not change anything. */
211 if (gfc_option
.r8
&& saw_r16
)
212 gfc_default_double_kind
= 16;
213 else if (saw_r4
&& saw_r8
)
214 gfc_default_double_kind
= 8;
217 /* F95 14.6.3.1: A nonpointer scalar object of type double precision
218 real ... occupies two contiguous numeric storage units.
220 Therefore we must be supplied a kind twice as large as we chose
221 for single precision. There are loopholes, in that double
222 precision must *occupy* two storage units, though it doesn't have
223 to *use* two storage units. Which means that you can make this
224 kind artificially wide by padding it. But at present there are
225 no GCC targets for which a two-word type does not exist, so we
226 just let gfc_validate_kind abort and tell us if something breaks. */
228 gfc_default_double_kind
229 = gfc_validate_kind (BT_REAL
, gfc_default_real_kind
* 2, false);
232 /* The default logical kind is constrained to be the same as the
233 default integer kind. Similarly with complex and real. */
234 gfc_default_logical_kind
= gfc_default_integer_kind
;
235 gfc_default_complex_kind
= gfc_default_real_kind
;
237 /* Choose the smallest integer kind for our default character. */
238 gfc_default_character_kind
= gfc_integer_kinds
[0].kind
;
240 /* Choose the integer kind the same size as "void*" for our index kind. */
241 gfc_index_integer_kind
= POINTER_SIZE
/ 8;
242 /* Pick a kind the same size as the C "int" type. */
243 gfc_c_int_kind
= INT_TYPE_SIZE
/ 8;
246 /* Make sure that a valid kind is present. Returns an index into the
247 associated kinds array, -1 if the kind is not present. */
250 validate_integer (int kind
)
254 for (i
= 0; gfc_integer_kinds
[i
].kind
!= 0; i
++)
255 if (gfc_integer_kinds
[i
].kind
== kind
)
262 validate_real (int kind
)
266 for (i
= 0; gfc_real_kinds
[i
].kind
!= 0; i
++)
267 if (gfc_real_kinds
[i
].kind
== kind
)
274 validate_logical (int kind
)
278 for (i
= 0; gfc_logical_kinds
[i
].kind
; i
++)
279 if (gfc_logical_kinds
[i
].kind
== kind
)
286 validate_character (int kind
)
288 return kind
== gfc_default_character_kind
? 0 : -1;
291 /* Validate a kind given a basic type. The return value is the same
292 for the child functions, with -1 indicating nonexistence of the
293 type. If MAY_FAIL is false, then -1 is never returned, and we ICE. */
296 gfc_validate_kind (bt type
, int kind
, bool may_fail
)
302 case BT_REAL
: /* Fall through */
304 rc
= validate_real (kind
);
307 rc
= validate_integer (kind
);
310 rc
= validate_logical (kind
);
313 rc
= validate_character (kind
);
317 gfc_internal_error ("gfc_validate_kind(): Got bad type");
320 if (rc
< 0 && !may_fail
)
321 gfc_internal_error ("gfc_validate_kind(): Got bad kind");
327 /* Four subroutines of gfc_init_types. Create type nodes for the given kind.
328 Reuse common type nodes where possible. Recognize if the kind matches up
329 with a C type. This will be used later in determining which routines may
330 be scarfed from libm. */
333 gfc_build_int_type (gfc_integer_info
*info
)
335 int mode_precision
= info
->bit_size
;
337 if (mode_precision
== CHAR_TYPE_SIZE
)
339 if (mode_precision
== SHORT_TYPE_SIZE
)
341 if (mode_precision
== INT_TYPE_SIZE
)
343 if (mode_precision
== LONG_TYPE_SIZE
)
345 if (mode_precision
== LONG_LONG_TYPE_SIZE
)
346 info
->c_long_long
= 1;
348 if (TYPE_PRECISION (intQI_type_node
) == mode_precision
)
349 return intQI_type_node
;
350 if (TYPE_PRECISION (intHI_type_node
) == mode_precision
)
351 return intHI_type_node
;
352 if (TYPE_PRECISION (intSI_type_node
) == mode_precision
)
353 return intSI_type_node
;
354 if (TYPE_PRECISION (intDI_type_node
) == mode_precision
)
355 return intDI_type_node
;
356 if (TYPE_PRECISION (intTI_type_node
) == mode_precision
)
357 return intTI_type_node
;
359 return make_signed_type (mode_precision
);
363 gfc_build_real_type (gfc_real_info
*info
)
365 int mode_precision
= info
->mode_precision
;
368 if (mode_precision
== FLOAT_TYPE_SIZE
)
370 if (mode_precision
== DOUBLE_TYPE_SIZE
)
372 if (mode_precision
== LONG_DOUBLE_TYPE_SIZE
)
373 info
->c_long_double
= 1;
375 if (TYPE_PRECISION (float_type_node
) == mode_precision
)
376 return float_type_node
;
377 if (TYPE_PRECISION (double_type_node
) == mode_precision
)
378 return double_type_node
;
379 if (TYPE_PRECISION (long_double_type_node
) == mode_precision
)
380 return long_double_type_node
;
382 new_type
= make_node (REAL_TYPE
);
383 TYPE_PRECISION (new_type
) = mode_precision
;
384 layout_type (new_type
);
389 gfc_build_complex_type (tree scalar_type
)
393 if (scalar_type
== NULL
)
395 if (scalar_type
== float_type_node
)
396 return complex_float_type_node
;
397 if (scalar_type
== double_type_node
)
398 return complex_double_type_node
;
399 if (scalar_type
== long_double_type_node
)
400 return complex_long_double_type_node
;
402 new_type
= make_node (COMPLEX_TYPE
);
403 TREE_TYPE (new_type
) = scalar_type
;
404 layout_type (new_type
);
409 gfc_build_logical_type (gfc_logical_info
*info
)
411 int bit_size
= info
->bit_size
;
414 if (bit_size
== BOOL_TYPE_SIZE
)
417 return boolean_type_node
;
420 new_type
= make_unsigned_type (bit_size
);
421 TREE_SET_CODE (new_type
, BOOLEAN_TYPE
);
422 TYPE_MAX_VALUE (new_type
) = build_int_cst (new_type
, 1);
423 TYPE_PRECISION (new_type
) = 1;
429 /* Return the bit size of the C "size_t". */
435 if (strcmp (SIZE_TYPE
, "unsigned int") == 0)
436 return INT_TYPE_SIZE
;
437 if (strcmp (SIZE_TYPE
, "long unsigned int") == 0)
438 return LONG_TYPE_SIZE
;
439 if (strcmp (SIZE_TYPE
, "short unsigned int") == 0)
440 return SHORT_TYPE_SIZE
;
443 return LONG_TYPE_SIZE
;
448 /* Create the backend type nodes. We map them to their
449 equivalent C type, at least for now. We also give
450 names to the types here, and we push them in the
451 global binding level context.*/
454 gfc_init_types (void)
460 unsigned HOST_WIDE_INT hi
;
461 unsigned HOST_WIDE_INT lo
;
463 /* Create and name the types. */
464 #define PUSH_TYPE(name, node) \
465 pushdecl (build_decl (TYPE_DECL, get_identifier (name), node))
467 for (index
= 0; gfc_integer_kinds
[index
].kind
!= 0; ++index
)
469 type
= gfc_build_int_type (&gfc_integer_kinds
[index
]);
470 gfc_integer_types
[index
] = type
;
471 snprintf (name_buf
, sizeof(name_buf
), "int%d",
472 gfc_integer_kinds
[index
].kind
);
473 PUSH_TYPE (name_buf
, type
);
476 for (index
= 0; gfc_logical_kinds
[index
].kind
!= 0; ++index
)
478 type
= gfc_build_logical_type (&gfc_logical_kinds
[index
]);
479 gfc_logical_types
[index
] = type
;
480 snprintf (name_buf
, sizeof(name_buf
), "logical%d",
481 gfc_logical_kinds
[index
].kind
);
482 PUSH_TYPE (name_buf
, type
);
485 for (index
= 0; gfc_real_kinds
[index
].kind
!= 0; index
++)
487 type
= gfc_build_real_type (&gfc_real_kinds
[index
]);
488 gfc_real_types
[index
] = type
;
489 snprintf (name_buf
, sizeof(name_buf
), "real%d",
490 gfc_real_kinds
[index
].kind
);
491 PUSH_TYPE (name_buf
, type
);
493 type
= gfc_build_complex_type (type
);
494 gfc_complex_types
[index
] = type
;
495 snprintf (name_buf
, sizeof(name_buf
), "complex%d",
496 gfc_real_kinds
[index
].kind
);
497 PUSH_TYPE (name_buf
, type
);
500 gfc_character1_type_node
= build_type_variant (unsigned_char_type_node
,
502 PUSH_TYPE ("char", gfc_character1_type_node
);
504 PUSH_TYPE ("byte", unsigned_char_type_node
);
505 PUSH_TYPE ("void", void_type_node
);
507 /* DBX debugging output gets upset if these aren't set. */
508 if (!TYPE_NAME (integer_type_node
))
509 PUSH_TYPE ("c_integer", integer_type_node
);
510 if (!TYPE_NAME (char_type_node
))
511 PUSH_TYPE ("c_char", char_type_node
);
515 pvoid_type_node
= build_pointer_type (void_type_node
);
516 ppvoid_type_node
= build_pointer_type (pvoid_type_node
);
517 pchar_type_node
= build_pointer_type (gfc_character1_type_node
);
519 gfc_array_index_type
= gfc_get_int_type (gfc_index_integer_kind
);
521 /* The maximum array element size that can be handled is determined
522 by the number of bits available to store this field in the array
525 n
= TYPE_PRECISION (gfc_array_index_type
) - GFC_DTYPE_SIZE_SHIFT
;
526 lo
= ~ (unsigned HOST_WIDE_INT
) 0;
527 if (n
> HOST_BITS_PER_WIDE_INT
)
528 hi
= lo
>> (2*HOST_BITS_PER_WIDE_INT
- n
);
530 hi
= 0, lo
>>= HOST_BITS_PER_WIDE_INT
- n
;
531 gfc_max_array_element_size
532 = build_int_cst_wide (long_unsigned_type_node
, lo
, hi
);
534 size_type_node
= gfc_array_index_type
;
536 boolean_type_node
= gfc_get_logical_type (gfc_default_logical_kind
);
537 boolean_true_node
= build_int_cst (boolean_type_node
, 1);
538 boolean_false_node
= build_int_cst (boolean_type_node
, 0);
540 /* ??? Shouldn't this be based on gfc_index_integer_kind or so? */
541 gfc_charlen_type_node
= gfc_get_int_type (4);
544 /* Get the type node for the given type and kind. */
547 gfc_get_int_type (int kind
)
549 int index
= gfc_validate_kind (BT_INTEGER
, kind
, false);
550 return gfc_integer_types
[index
];
554 gfc_get_real_type (int kind
)
556 int index
= gfc_validate_kind (BT_REAL
, kind
, false);
557 return gfc_real_types
[index
];
561 gfc_get_complex_type (int kind
)
563 int index
= gfc_validate_kind (BT_COMPLEX
, kind
, false);
564 return gfc_complex_types
[index
];
568 gfc_get_logical_type (int kind
)
570 int index
= gfc_validate_kind (BT_LOGICAL
, kind
, false);
571 return gfc_logical_types
[index
];
574 /* Create a character type with the given kind and length. */
577 gfc_get_character_type_len (int kind
, tree len
)
581 gfc_validate_kind (BT_CHARACTER
, kind
, false);
583 bounds
= build_range_type (gfc_charlen_type_node
, gfc_index_one_node
, len
);
584 type
= build_array_type (gfc_character1_type_node
, bounds
);
585 TYPE_STRING_FLAG (type
) = 1;
591 /* Get a type node for a character kind. */
594 gfc_get_character_type (int kind
, gfc_charlen
* cl
)
598 len
= (cl
== NULL
) ? NULL_TREE
: cl
->backend_decl
;
600 return gfc_get_character_type_len (kind
, len
);
603 /* Covert a basic type. This will be an array for character types. */
606 gfc_typenode_for_spec (gfc_typespec
* spec
)
616 basetype
= gfc_get_int_type (spec
->kind
);
620 basetype
= gfc_get_real_type (spec
->kind
);
624 basetype
= gfc_get_complex_type (spec
->kind
);
628 basetype
= gfc_get_logical_type (spec
->kind
);
632 basetype
= gfc_get_character_type (spec
->kind
, spec
->cl
);
636 basetype
= gfc_get_derived_type (spec
->derived
);
645 /* Build an INT_CST for constant expressions, otherwise return NULL_TREE. */
648 gfc_conv_array_bound (gfc_expr
* expr
)
650 /* If expr is an integer constant, return that. */
651 if (expr
!= NULL
&& expr
->expr_type
== EXPR_CONSTANT
)
652 return gfc_conv_mpz_to_tree (expr
->value
.integer
, gfc_index_integer_kind
);
654 /* Otherwise return NULL. */
659 gfc_get_element_type (tree type
)
663 if (GFC_ARRAY_TYPE_P (type
))
665 if (TREE_CODE (type
) == POINTER_TYPE
)
666 type
= TREE_TYPE (type
);
667 gcc_assert (TREE_CODE (type
) == ARRAY_TYPE
);
668 element
= TREE_TYPE (type
);
672 gcc_assert (GFC_DESCRIPTOR_TYPE_P (type
));
673 element
= TREE_TYPE (TYPE_FIELDS (type
));
675 gcc_assert (TREE_CODE (element
) == POINTER_TYPE
);
676 element
= TREE_TYPE (element
);
678 gcc_assert (TREE_CODE (element
) == ARRAY_TYPE
);
679 element
= TREE_TYPE (element
);
685 /* Build an array. This function is called from gfc_sym_type().
686 Actually returns array descriptor type.
688 Format of array descriptors is as follows:
690 struct gfc_array_descriptor
695 struct descriptor_dimension dimension[N_DIM];
698 struct descriptor_dimension
705 Translation code should use gfc_conv_descriptor_* rather than accessing
706 the descriptor directly. Any changes to the array descriptor type will
707 require changes in gfc_conv_descriptor_* and gfc_build_array_initializer.
709 This is represented internally as a RECORD_TYPE. The index nodes are
710 gfc_array_index_type and the data node is a pointer to the data. See below
711 for the handling of character types.
713 The dtype member is formatted as follows:
714 rank = dtype & GFC_DTYPE_RANK_MASK // 3 bits
715 type = (dtype & GFC_DTYPE_TYPE_MASK) >> GFC_DTYPE_TYPE_SHIFT // 3 bits
716 size = dtype >> GFC_DTYPE_SIZE_SHIFT
718 I originally used nested ARRAY_TYPE nodes to represent arrays, but this
719 generated poor code for assumed/deferred size arrays. These require
720 use of PLACEHOLDER_EXPR/WITH_RECORD_EXPR, which isn't part of the GENERIC
721 grammar. Also, there is no way to explicitly set the array stride, so
722 all data must be packed(1). I've tried to mark all the functions which
723 would require modification with a GCC ARRAYS comment.
725 The data component points to the first element in the array.
726 The offset field is the position of the origin of the array
727 (ie element (0, 0 ...)). This may be outsite the bounds of the array.
729 An element is accessed by
730 data[offset + index0*stride0 + index1*stride1 + index2*stride2]
731 This gives good performance as the computation does not involve the
732 bounds of the array. For packed arrays, this is optimized further by
733 substituting the known strides.
735 This system has one problem: all array bounds must be withing 2^31 elements
736 of the origin (2^63 on 64-bit machines). For example
737 integer, dimension (80000:90000, 80000:90000, 2) :: array
738 may not work properly on 32-bit machines because 80000*80000 > 2^31, so
739 the calculation for stride02 would overflow. This may still work, but
740 I haven't checked, and it relies on the overflow doing the right thing.
742 The way to fix this problem is to access elements as follows:
743 data[(index0-lbound0)*stride0 + (index1-lbound1)*stride1]
744 Obviously this is much slower. I will make this a compile time option,
745 something like -fsmall-array-offsets. Mixing code compiled with and without
746 this switch will work.
748 (1) This can be worked around by modifying the upper bound of the previous
749 dimension. This requires extra fields in the descriptor (both real_ubound
750 and fake_ubound). In tree.def there is mention of TYPE_SEP, which
751 may allow us to do this. However I can't find mention of this anywhere
755 /* Returns true if the array sym does not require a descriptor. */
758 gfc_is_nodesc_array (gfc_symbol
* sym
)
760 gcc_assert (sym
->attr
.dimension
);
762 /* We only want local arrays. */
763 if (sym
->attr
.pointer
|| sym
->attr
.allocatable
)
768 if (sym
->as
->type
!= AS_ASSUMED_SHAPE
)
774 if (sym
->attr
.result
|| sym
->attr
.function
)
777 if (sym
->attr
.pointer
|| sym
->attr
.allocatable
)
780 gcc_assert (sym
->as
->type
== AS_EXPLICIT
);
786 /* Create an array descriptor type. */
789 gfc_build_array_type (tree type
, gfc_array_spec
* as
)
791 tree lbound
[GFC_MAX_DIMENSIONS
];
792 tree ubound
[GFC_MAX_DIMENSIONS
];
795 for (n
= 0; n
< as
->rank
; n
++)
797 /* Create expressions for the known bounds of the array. */
798 if (as
->type
== AS_ASSUMED_SHAPE
&& as
->lower
[n
] == NULL
)
799 lbound
[n
] = gfc_index_one_node
;
801 lbound
[n
] = gfc_conv_array_bound (as
->lower
[n
]);
802 ubound
[n
] = gfc_conv_array_bound (as
->upper
[n
]);
805 return gfc_get_array_type_bounds (type
, as
->rank
, lbound
, ubound
, 0);
808 /* Returns the struct descriptor_dimension type. */
811 gfc_get_desc_dim_type (void)
817 if (gfc_desc_dim_type
)
818 return gfc_desc_dim_type
;
820 /* Build the type node. */
821 type
= make_node (RECORD_TYPE
);
823 TYPE_NAME (type
) = get_identifier ("descriptor_dimension");
824 TYPE_PACKED (type
) = 1;
826 /* Consists of the stride, lbound and ubound members. */
827 decl
= build_decl (FIELD_DECL
,
828 get_identifier ("stride"), gfc_array_index_type
);
829 DECL_CONTEXT (decl
) = type
;
832 decl
= build_decl (FIELD_DECL
,
833 get_identifier ("lbound"), gfc_array_index_type
);
834 DECL_CONTEXT (decl
) = type
;
835 fieldlist
= chainon (fieldlist
, decl
);
837 decl
= build_decl (FIELD_DECL
,
838 get_identifier ("ubound"), gfc_array_index_type
);
839 DECL_CONTEXT (decl
) = type
;
840 fieldlist
= chainon (fieldlist
, decl
);
842 /* Finish off the type. */
843 TYPE_FIELDS (type
) = fieldlist
;
845 gfc_finish_type (type
);
847 gfc_desc_dim_type
= type
;
852 /* Return the DTYPE for an array. This describes the type and type parameters
854 /* TODO: Only call this when the value is actually used, and make all the
855 unknown cases abort. */
858 gfc_get_dtype (tree type
)
868 gcc_assert (GFC_DESCRIPTOR_TYPE_P (type
) || GFC_ARRAY_TYPE_P (type
));
870 if (GFC_TYPE_ARRAY_DTYPE (type
))
871 return GFC_TYPE_ARRAY_DTYPE (type
);
873 rank
= GFC_TYPE_ARRAY_RANK (type
);
874 etype
= gfc_get_element_type (type
);
876 switch (TREE_CODE (etype
))
879 n
= GFC_DTYPE_INTEGER
;
883 n
= GFC_DTYPE_LOGICAL
;
891 n
= GFC_DTYPE_COMPLEX
;
894 /* We will never have arrays of arrays. */
896 n
= GFC_DTYPE_DERIVED
;
900 n
= GFC_DTYPE_CHARACTER
;
904 /* TODO: Don't do dtype for temporary descriptorless arrays. */
905 /* We can strange array types for temporary arrays. */
906 return gfc_index_zero_node
;
909 gcc_assert (rank
<= GFC_DTYPE_RANK_MASK
);
910 size
= TYPE_SIZE_UNIT (etype
);
912 i
= rank
| (n
<< GFC_DTYPE_TYPE_SHIFT
);
913 if (size
&& INTEGER_CST_P (size
))
915 if (tree_int_cst_lt (gfc_max_array_element_size
, size
))
916 internal_error ("Array element size too big");
918 i
+= TREE_INT_CST_LOW (size
) << GFC_DTYPE_SIZE_SHIFT
;
920 dtype
= build_int_cst (gfc_array_index_type
, i
);
922 if (size
&& !INTEGER_CST_P (size
))
924 tmp
= build_int_cst (gfc_array_index_type
, GFC_DTYPE_SIZE_SHIFT
);
925 tmp
= fold (build2 (LSHIFT_EXPR
, gfc_array_index_type
, size
, tmp
));
926 dtype
= fold (build2 (PLUS_EXPR
, gfc_array_index_type
, tmp
, dtype
));
928 /* If we don't know the size we leave it as zero. This should never happen
929 for anything that is actually used. */
930 /* TODO: Check this is actually true, particularly when repacking
931 assumed size parameters. */
933 GFC_TYPE_ARRAY_DTYPE (type
) = dtype
;
938 /* Build an array type for use without a descriptor. Valid values of packed
939 are 0=no, 1=partial, 2=full, 3=static. */
942 gfc_get_nodesc_array_type (tree etype
, gfc_array_spec
* as
, int packed
)
955 mpz_init_set_ui (offset
, 0);
956 mpz_init_set_ui (stride
, 1);
959 /* We don't use build_array_type because this does not include include
960 lang-specific information (i.e. the bounds of the array) when checking
962 type
= make_node (ARRAY_TYPE
);
964 GFC_ARRAY_TYPE_P (type
) = 1;
965 TYPE_LANG_SPECIFIC (type
) = (struct lang_type
*)
966 ggc_alloc_cleared (sizeof (struct lang_type
));
968 known_stride
= (packed
!= 0);
970 for (n
= 0; n
< as
->rank
; n
++)
972 /* Fill in the stride and bound components of the type. */
974 tmp
= gfc_conv_mpz_to_tree (stride
, gfc_index_integer_kind
);
977 GFC_TYPE_ARRAY_STRIDE (type
, n
) = tmp
;
980 if (expr
->expr_type
== EXPR_CONSTANT
)
982 tmp
= gfc_conv_mpz_to_tree (expr
->value
.integer
,
983 gfc_index_integer_kind
);
990 GFC_TYPE_ARRAY_LBOUND (type
, n
) = tmp
;
994 /* Calculate the offset. */
995 mpz_mul (delta
, stride
, as
->lower
[n
]->value
.integer
);
996 mpz_sub (offset
, offset
, delta
);
1001 expr
= as
->upper
[n
];
1002 if (expr
&& expr
->expr_type
== EXPR_CONSTANT
)
1004 tmp
= gfc_conv_mpz_to_tree (expr
->value
.integer
,
1005 gfc_index_integer_kind
);
1012 GFC_TYPE_ARRAY_UBOUND (type
, n
) = tmp
;
1016 /* Calculate the stride. */
1017 mpz_sub (delta
, as
->upper
[n
]->value
.integer
,
1018 as
->lower
[n
]->value
.integer
);
1019 mpz_add_ui (delta
, delta
, 1);
1020 mpz_mul (stride
, stride
, delta
);
1023 /* Only the first stride is known for partial packed arrays. */
1030 GFC_TYPE_ARRAY_OFFSET (type
) =
1031 gfc_conv_mpz_to_tree (offset
, gfc_index_integer_kind
);
1034 GFC_TYPE_ARRAY_OFFSET (type
) = NULL_TREE
;
1038 GFC_TYPE_ARRAY_SIZE (type
) =
1039 gfc_conv_mpz_to_tree (stride
, gfc_index_integer_kind
);
1042 GFC_TYPE_ARRAY_SIZE (type
) = NULL_TREE
;
1044 GFC_TYPE_ARRAY_RANK (type
) = as
->rank
;
1045 GFC_TYPE_ARRAY_DTYPE (type
) = NULL_TREE
;
1046 range
= build_range_type (gfc_array_index_type
, gfc_index_zero_node
,
1048 /* TODO: use main type if it is unbounded. */
1049 GFC_TYPE_ARRAY_DATAPTR_TYPE (type
) =
1050 build_pointer_type (build_array_type (etype
, range
));
1054 mpz_sub_ui (stride
, stride
, 1);
1055 range
= gfc_conv_mpz_to_tree (stride
, gfc_index_integer_kind
);
1060 range
= build_range_type (gfc_array_index_type
, gfc_index_zero_node
, range
);
1061 TYPE_DOMAIN (type
) = range
;
1063 build_pointer_type (etype
);
1064 TREE_TYPE (type
) = etype
;
1072 if (packed
< 3 || !known_stride
)
1074 /* For dummy arrays and automatic (heap allocated) arrays we
1075 want a pointer to the array. */
1076 type
= build_pointer_type (type
);
1077 GFC_ARRAY_TYPE_P (type
) = 1;
1078 TYPE_LANG_SPECIFIC (type
) = TYPE_LANG_SPECIFIC (TREE_TYPE (type
));
1084 /* Build an array (descriptor) type with given bounds. */
1087 gfc_get_array_type_bounds (tree etype
, int dimen
, tree
* lbound
,
1088 tree
* ubound
, int packed
)
1090 tree fat_type
, fat_pointer_type
;
1095 char name
[8 + GFC_RANK_DIGITS
+ GFC_MAX_SYMBOL_LEN
];
1096 const char *typename
;
1102 /* Build the type node. */
1103 fat_type
= make_node (RECORD_TYPE
);
1104 GFC_DESCRIPTOR_TYPE_P (fat_type
) = 1;
1105 TYPE_LANG_SPECIFIC (fat_type
) = (struct lang_type
*)
1106 ggc_alloc_cleared (sizeof (struct lang_type
));
1107 GFC_TYPE_ARRAY_RANK (fat_type
) = dimen
;
1108 GFC_TYPE_ARRAY_DTYPE (fat_type
) = NULL_TREE
;
1110 tmp
= TYPE_NAME (etype
);
1111 if (tmp
&& TREE_CODE (tmp
) == TYPE_DECL
)
1112 tmp
= DECL_NAME (tmp
);
1114 typename
= IDENTIFIER_POINTER (tmp
);
1116 typename
= "unknown";
1118 sprintf (name
, "array" GFC_RANK_PRINTF_FORMAT
"_%.*s", dimen
,
1119 GFC_MAX_SYMBOL_LEN
, typename
);
1120 TYPE_NAME (fat_type
) = get_identifier (name
);
1121 TYPE_PACKED (fat_type
) = 0;
1123 fat_pointer_type
= build_pointer_type (fat_type
);
1125 /* Build an array descriptor record type. */
1127 stride
= gfc_index_one_node
;
1131 for (n
= 0; n
< dimen
; n
++)
1133 GFC_TYPE_ARRAY_STRIDE (fat_type
, n
) = stride
;
1140 if (lower
!= NULL_TREE
)
1142 if (INTEGER_CST_P (lower
))
1143 GFC_TYPE_ARRAY_LBOUND (fat_type
, n
) = lower
;
1149 if (upper
!= NULL_TREE
)
1151 if (INTEGER_CST_P (upper
))
1152 GFC_TYPE_ARRAY_UBOUND (fat_type
, n
) = upper
;
1157 if (upper
!= NULL_TREE
&& lower
!= NULL_TREE
&& stride
!= NULL_TREE
)
1159 tmp
= fold (build2 (MINUS_EXPR
, gfc_array_index_type
, upper
, lower
));
1160 tmp
= fold (build2 (PLUS_EXPR
, gfc_array_index_type
, tmp
,
1161 gfc_index_one_node
));
1163 fold (build2 (MULT_EXPR
, gfc_array_index_type
, tmp
, stride
));
1164 /* Check the folding worked. */
1165 gcc_assert (INTEGER_CST_P (stride
));
1170 GFC_TYPE_ARRAY_SIZE (fat_type
) = stride
;
1171 /* TODO: known offsets for descriptors. */
1172 GFC_TYPE_ARRAY_OFFSET (fat_type
) = NULL_TREE
;
1174 /* We define data as an unknown size array. Much better than doing
1175 pointer arithmetic. */
1177 build_array_type (etype
,
1178 build_range_type (gfc_array_index_type
,
1179 gfc_index_zero_node
, NULL_TREE
));
1180 arraytype
= build_pointer_type (arraytype
);
1181 GFC_TYPE_ARRAY_DATAPTR_TYPE (fat_type
) = arraytype
;
1183 /* The pointer to the array data. */
1184 decl
= build_decl (FIELD_DECL
, get_identifier ("data"), arraytype
);
1186 DECL_CONTEXT (decl
) = fat_type
;
1187 /* Add the data member as the first element of the descriptor. */
1190 /* Add the base component. */
1191 decl
= build_decl (FIELD_DECL
, get_identifier ("offset"),
1192 gfc_array_index_type
);
1193 DECL_CONTEXT (decl
) = fat_type
;
1194 fieldlist
= chainon (fieldlist
, decl
);
1196 /* Add the dtype component. */
1197 decl
= build_decl (FIELD_DECL
, get_identifier ("dtype"),
1198 gfc_array_index_type
);
1199 DECL_CONTEXT (decl
) = fat_type
;
1200 fieldlist
= chainon (fieldlist
, decl
);
1202 /* Build the array type for the stride and bound components. */
1204 build_array_type (gfc_get_desc_dim_type (),
1205 build_range_type (gfc_array_index_type
,
1206 gfc_index_zero_node
,
1207 gfc_rank_cst
[dimen
- 1]));
1209 decl
= build_decl (FIELD_DECL
, get_identifier ("dim"), arraytype
);
1210 DECL_CONTEXT (decl
) = fat_type
;
1211 DECL_INITIAL (decl
) = NULL_TREE
;
1212 fieldlist
= chainon (fieldlist
, decl
);
1214 /* Finish off the type. */
1215 TYPE_FIELDS (fat_type
) = fieldlist
;
1217 gfc_finish_type (fat_type
);
1222 /* Build a pointer type. This function is called from gfc_sym_type(). */
1225 gfc_build_pointer_type (gfc_symbol
* sym
, tree type
)
1227 /* Array pointer types aren't actually pointers. */
1228 if (sym
->attr
.dimension
)
1231 return build_pointer_type (type
);
1234 /* Return the type for a symbol. Special handling is required for character
1235 types to get the correct level of indirection.
1236 For functions return the return type.
1237 For subroutines return void_type_node.
1238 Calling this multiple times for the same symbol should be avoided,
1239 especially for character and array types. */
1242 gfc_sym_type (gfc_symbol
* sym
)
1247 if (sym
->attr
.flavor
== FL_PROCEDURE
&& !sym
->attr
.function
)
1248 return void_type_node
;
1250 if (sym
->backend_decl
)
1252 if (sym
->attr
.function
)
1253 return TREE_TYPE (TREE_TYPE (sym
->backend_decl
));
1255 return TREE_TYPE (sym
->backend_decl
);
1258 /* The frontend doesn't set all the attributes for a function with an
1259 explicit result value, so we use that instead when present. */
1260 if (sym
->attr
.function
&& sym
->result
)
1263 type
= gfc_typenode_for_spec (&sym
->ts
);
1265 if (sym
->attr
.dummy
&& !sym
->attr
.function
)
1270 if (sym
->attr
.dimension
)
1272 if (gfc_is_nodesc_array (sym
))
1274 /* If this is a character argument of unknown length, just use the
1276 if (sym
->ts
.type
!= BT_CHARACTER
1277 || !(sym
->attr
.dummy
|| sym
->attr
.function
|| sym
->attr
.result
)
1278 || sym
->ts
.cl
->backend_decl
)
1280 type
= gfc_get_nodesc_array_type (type
, sym
->as
,
1286 type
= gfc_build_array_type (type
, sym
->as
);
1290 if (sym
->attr
.allocatable
|| sym
->attr
.pointer
)
1291 type
= gfc_build_pointer_type (sym
, type
);
1294 /* We currently pass all parameters by reference.
1295 See f95_get_function_decl. For dummy function parameters return the
1299 /* We must use pointer types for potentially absent variables. The
1300 optimizers assume a reference type argument is never NULL. */
1301 if (sym
->attr
.optional
|| sym
->ns
->proc_name
->attr
.entry_master
)
1302 type
= build_pointer_type (type
);
1304 type
= build_reference_type (type
);
1310 /* Layout and output debug info for a record type. */
1313 gfc_finish_type (tree type
)
1317 decl
= build_decl (TYPE_DECL
, NULL_TREE
, type
);
1318 TYPE_STUB_DECL (type
) = decl
;
1320 rest_of_type_compilation (type
, 1);
1321 rest_of_decl_compilation (decl
, 1, 0);
1324 /* Add a field of given NAME and TYPE to the context of a UNION_TYPE
1325 or RECORD_TYPE pointed to by STYPE. The new field is chained
1326 to the fieldlist pointed to by FIELDLIST.
1328 Returns a pointer to the new field. */
1331 gfc_add_field_to_struct (tree
*fieldlist
, tree context
,
1332 tree name
, tree type
)
1336 decl
= build_decl (FIELD_DECL
, name
, type
);
1338 DECL_CONTEXT (decl
) = context
;
1339 DECL_INITIAL (decl
) = 0;
1340 DECL_ALIGN (decl
) = 0;
1341 DECL_USER_ALIGN (decl
) = 0;
1342 TREE_CHAIN (decl
) = NULL_TREE
;
1343 *fieldlist
= chainon (*fieldlist
, decl
);
1349 /* Build a tree node for a derived type. */
1352 gfc_get_derived_type (gfc_symbol
* derived
)
1354 tree typenode
, field
, field_type
, fieldlist
;
1357 gcc_assert (derived
&& derived
->attr
.flavor
== FL_DERIVED
);
1359 /* derived->backend_decl != 0 means we saw it before, but its
1360 components' backend_decl may have not been built. */
1361 if (derived
->backend_decl
)
1363 /* Its components' backend_decl have been built. */
1364 if (TYPE_FIELDS (derived
->backend_decl
))
1365 return derived
->backend_decl
;
1367 typenode
= derived
->backend_decl
;
1371 /* We see this derived type first time, so build the type node. */
1372 typenode
= make_node (RECORD_TYPE
);
1373 TYPE_NAME (typenode
) = get_identifier (derived
->name
);
1374 TYPE_PACKED (typenode
) = gfc_option
.flag_pack_derived
;
1375 derived
->backend_decl
= typenode
;
1378 /* Build the type member list. Install the newly created RECORD_TYPE
1379 node as DECL_CONTEXT of each FIELD_DECL. */
1380 fieldlist
= NULL_TREE
;
1381 for (c
= derived
->components
; c
; c
= c
->next
)
1383 if (c
->ts
.type
== BT_DERIVED
&& c
->pointer
)
1385 if (c
->ts
.derived
->backend_decl
)
1386 /* We already saw this derived type so use the exiting type.
1387 It doesn't matter if it is incomplete. */
1388 field_type
= c
->ts
.derived
->backend_decl
;
1390 /* Recurse into the type. */
1391 field_type
= gfc_get_derived_type (c
->ts
.derived
);
1395 if (c
->ts
.type
== BT_CHARACTER
)
1397 /* Evaluate the string length. */
1398 gfc_conv_const_charlen (c
->ts
.cl
);
1399 gcc_assert (c
->ts
.cl
->backend_decl
);
1402 field_type
= gfc_typenode_for_spec (&c
->ts
);
1405 /* This returns an array descriptor type. Initialization may be
1411 /* Pointers to arrays aren't actually pointer types. The
1412 descriptors are separate, but the data is common. */
1413 field_type
= gfc_build_array_type (field_type
, c
->as
);
1416 field_type
= gfc_get_nodesc_array_type (field_type
, c
->as
, 3);
1418 else if (c
->pointer
)
1419 field_type
= build_pointer_type (field_type
);
1421 field
= gfc_add_field_to_struct (&fieldlist
, typenode
,
1422 get_identifier (c
->name
),
1425 DECL_PACKED (field
) |= TYPE_PACKED (typenode
);
1427 gcc_assert (!c
->backend_decl
);
1428 c
->backend_decl
= field
;
1431 /* Now we have the final fieldlist. Record it, then lay out the
1432 derived type, including the fields. */
1433 TYPE_FIELDS (typenode
) = fieldlist
;
1435 gfc_finish_type (typenode
);
1437 derived
->backend_decl
= typenode
;
1443 gfc_return_by_reference (gfc_symbol
* sym
)
1445 if (!sym
->attr
.function
)
1451 if (sym
->attr
.dimension
)
1454 if (sym
->ts
.type
== BT_CHARACTER
)
1457 /* Possibly return complex numbers by reference for g77 compatibility. */
1462 gfc_get_function_type (gfc_symbol
* sym
)
1466 gfc_formal_arglist
*f
;
1469 int alternate_return
;
1471 /* Make sure this symbol is a function or a subroutine. */
1472 gcc_assert (sym
->attr
.flavor
== FL_PROCEDURE
);
1474 if (sym
->backend_decl
)
1475 return TREE_TYPE (sym
->backend_decl
);
1478 alternate_return
= 0;
1479 typelist
= NULL_TREE
;
1481 if (sym
->attr
.entry_master
)
1483 /* Additional parameter for selecting an entry point. */
1484 typelist
= gfc_chainon_list (typelist
, gfc_array_index_type
);
1487 /* Some functions we use an extra parameter for the return value. */
1488 if (gfc_return_by_reference (sym
))
1495 if (arg
->ts
.type
== BT_CHARACTER
)
1496 gfc_conv_const_charlen (arg
->ts
.cl
);
1498 type
= gfc_sym_type (arg
);
1499 if (arg
->ts
.type
== BT_DERIVED
1500 || arg
->attr
.dimension
1501 || arg
->ts
.type
== BT_CHARACTER
)
1502 type
= build_reference_type (type
);
1504 typelist
= gfc_chainon_list (typelist
, type
);
1505 if (arg
->ts
.type
== BT_CHARACTER
)
1506 typelist
= gfc_chainon_list (typelist
, gfc_charlen_type_node
);
1509 /* Build the argument types for the function. */
1510 for (f
= sym
->formal
; f
; f
= f
->next
)
1515 /* Evaluate constant character lengths here so that they can be
1516 included in the type. */
1517 if (arg
->ts
.type
== BT_CHARACTER
)
1518 gfc_conv_const_charlen (arg
->ts
.cl
);
1520 if (arg
->attr
.flavor
== FL_PROCEDURE
)
1522 type
= gfc_get_function_type (arg
);
1523 type
= build_pointer_type (type
);
1526 type
= gfc_sym_type (arg
);
1528 /* Parameter Passing Convention
1530 We currently pass all parameters by reference.
1531 Parameters with INTENT(IN) could be passed by value.
1532 The problem arises if a function is called via an implicit
1533 prototype. In this situation the INTENT is not known.
1534 For this reason all parameters to global functions must be
1535 passed by reference. Passing by value would potentialy
1536 generate bad code. Worse there would be no way of telling that
1537 this code was bad, except that it would give incorrect results.
1539 Contained procedures could pass by value as these are never
1540 used without an explicit interface, and connot be passed as
1541 actual parameters for a dummy procedure. */
1542 if (arg
->ts
.type
== BT_CHARACTER
)
1544 typelist
= gfc_chainon_list (typelist
, type
);
1548 if (sym
->attr
.subroutine
)
1549 alternate_return
= 1;
1553 /* Add hidden string length parameters. */
1555 typelist
= gfc_chainon_list (typelist
, gfc_charlen_type_node
);
1557 typelist
= gfc_chainon_list (typelist
, void_type_node
);
1559 if (alternate_return
)
1560 type
= integer_type_node
;
1561 else if (!sym
->attr
.function
|| gfc_return_by_reference (sym
))
1562 type
= void_type_node
;
1564 type
= gfc_sym_type (sym
);
1566 type
= build_function_type (type
, typelist
);
1571 /* Language hooks for middle-end access to type nodes. */
1573 /* Return an integer type with BITS bits of precision,
1574 that is unsigned if UNSIGNEDP is nonzero, otherwise signed. */
1577 gfc_type_for_size (unsigned bits
, int unsignedp
)
1582 for (i
= 0; i
<= MAX_INT_KINDS
; ++i
)
1584 tree type
= gfc_integer_types
[i
];
1585 if (type
&& bits
== TYPE_PRECISION (type
))
1591 if (bits
== TYPE_PRECISION (unsigned_intQI_type_node
))
1592 return unsigned_intQI_type_node
;
1593 if (bits
== TYPE_PRECISION (unsigned_intHI_type_node
))
1594 return unsigned_intHI_type_node
;
1595 if (bits
== TYPE_PRECISION (unsigned_intSI_type_node
))
1596 return unsigned_intSI_type_node
;
1597 if (bits
== TYPE_PRECISION (unsigned_intDI_type_node
))
1598 return unsigned_intDI_type_node
;
1599 if (bits
== TYPE_PRECISION (unsigned_intTI_type_node
))
1600 return unsigned_intTI_type_node
;
1606 /* Return a data type that has machine mode MODE. If the mode is an
1607 integer, then UNSIGNEDP selects between signed and unsigned types. */
1610 gfc_type_for_mode (enum machine_mode mode
, int unsignedp
)
1615 if (GET_MODE_CLASS (mode
) == MODE_FLOAT
)
1616 base
= gfc_real_types
;
1617 else if (GET_MODE_CLASS (mode
) == MODE_COMPLEX_FLOAT
)
1618 base
= gfc_complex_types
;
1619 else if (SCALAR_INT_MODE_P (mode
))
1620 return gfc_type_for_size (GET_MODE_PRECISION (mode
), unsignedp
);
1621 else if (VECTOR_MODE_P (mode
))
1623 enum machine_mode inner_mode
= GET_MODE_INNER (mode
);
1624 tree inner_type
= gfc_type_for_mode (inner_mode
, unsignedp
);
1625 if (inner_type
!= NULL_TREE
)
1626 return build_vector_type_for_mode (inner_type
, mode
);
1632 for (i
= 0; i
<= MAX_REAL_KINDS
; ++i
)
1634 tree type
= base
[i
];
1635 if (type
&& mode
== TYPE_MODE (type
))
1642 /* Return a type the same as TYPE except unsigned or
1643 signed according to UNSIGNEDP. */
1646 gfc_signed_or_unsigned_type (int unsignedp
, tree type
)
1648 if (TREE_CODE (type
) != INTEGER_TYPE
|| TYPE_UNSIGNED (type
) == unsignedp
)
1651 return gfc_type_for_size (TYPE_PRECISION (type
), unsignedp
);
1654 /* Return an unsigned type the same as TYPE in other respects. */
1657 gfc_unsigned_type (tree type
)
1659 return gfc_signed_or_unsigned_type (1, type
);
1662 /* Return a signed type the same as TYPE in other respects. */
1665 gfc_signed_type (tree type
)
1667 return gfc_signed_or_unsigned_type (0, type
);
1670 #include "gt-fortran-trans-types.h"