* *
* C Implementation File *
* *
- * Copyright (C) 1992-2007, Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2008, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
if (free_block_chain)
{
newlevel->block = free_block_chain;
- free_block_chain = TREE_CHAIN (free_block_chain);
- TREE_CHAIN (newlevel->block) = NULL_TREE;
+ free_block_chain = BLOCK_CHAIN (free_block_chain);
+ BLOCK_CHAIN (newlevel->block) = NULL_TREE;
}
else
newlevel->block = make_node (BLOCK);
BLOCK_SUBBLOCKS (level->chain->block)
= chainon (BLOCK_SUBBLOCKS (block),
BLOCK_SUBBLOCKS (level->chain->block));
- TREE_CHAIN (block) = free_block_chain;
+ BLOCK_CHAIN (block) = free_block_chain;
free_block_chain = block;
}
else
{
- TREE_CHAIN (block) = BLOCK_SUBBLOCKS (level->chain->block);
+ BLOCK_CHAIN (block) = BLOCK_SUBBLOCKS (level->chain->block);
BLOCK_SUBBLOCKS (level->chain->block) = block;
TREE_USED (block) = 1;
set_block_for_group (block);
free_binding_level = level;
}
-/* Insert BLOCK at the end of the list of subblocks of the
- current binding level. This is used when a BIND_EXPR is expanded,
- to handle the BLOCK node inside the BIND_EXPR. */
-
-void
-insert_block (tree block)
-{
- TREE_USED (block) = 1;
- TREE_CHAIN (block) = BLOCK_SUBBLOCKS (current_binding_level->block);
- BLOCK_SUBBLOCKS (current_binding_level->block) = block;
-}
\f
/* Records a ..._DECL node DECL as belonging to the current lexical scope
and uses GNAT_NODE for location information and propagating flags. */
tree t = TREE_TYPE (decl);
if (!TYPE_NAME (t) || TREE_CODE (TYPE_NAME (t)) == IDENTIFIER_NODE)
- TYPE_NAME (t) = decl;
+ ;
else if (TYPE_FAT_POINTER_P (t))
{
tree tt = build_variant_type_copy (t);
TREE_USED (tt) = TREE_USED (t);
TREE_TYPE (decl) = tt;
DECL_ORIGINAL_TYPE (decl) = t;
+ t = NULL_TREE;
}
else if (DECL_ARTIFICIAL (TYPE_NAME (t)) && !DECL_ARTIFICIAL (decl))
- TYPE_NAME (t) = decl;
+ ;
+ else
+ t = NULL_TREE;
+
+ /* Propagate the name to all the variants. This is needed for
+ the type qualifiers machinery to work properly. */
+ if (t)
+ for (t = TYPE_MAIN_VARIANT (t); t; t = TYPE_NEXT_VARIANT (t))
+ TYPE_NAME (t) = decl;
}
}
\f
set_sizetype (size_type_node);
build_common_tree_nodes_2 (0);
- /* Give names and make TYPE_DECLs for common types. */
- create_type_decl (get_identifier (SIZE_TYPE), sizetype,
- NULL, false, true, Empty);
- create_type_decl (get_identifier ("integer"), integer_type_node,
- NULL, false, true, Empty);
- create_type_decl (get_identifier ("unsigned char"), char_type_node,
- NULL, false, true, Empty);
- create_type_decl (get_identifier ("long integer"), long_integer_type_node,
- NULL, false, true, Empty);
-
ptr_void_type_node = build_pointer_type (void_type_node);
gnat_install_builtins ();
void_ftype = build_function_type (void_type_node, NULL_TREE);
ptr_void_ftype = build_pointer_type (void_ftype);
+ /* Build the special descriptor type and its null node if needed. */
+ if (TARGET_VTABLE_USES_DESCRIPTORS)
+ {
+ tree field_list = NULL_TREE, null_list = NULL_TREE;
+ int j;
+
+ fdesc_type_node = make_node (RECORD_TYPE);
+
+ for (j = 0; j < TARGET_VTABLE_USES_DESCRIPTORS; j++)
+ {
+ tree field = create_field_decl (NULL_TREE, ptr_void_ftype,
+ fdesc_type_node, 0, 0, 0, 1);
+ TREE_CHAIN (field) = field_list;
+ field_list = field;
+ null_list = tree_cons (field, null_pointer_node, null_list);
+ }
+
+ finish_record_type (fdesc_type_node, nreverse (field_list), 0, false);
+ null_fdesc_node = gnat_build_constructor (fdesc_type_node, null_list);
+ }
+
/* Now declare runtime functions. */
endlink = tree_cons (NULL_TREE, void_type_node, NULL_TREE);
bool do_not_finalize)
{
enum tree_code code = TREE_CODE (record_type);
+ tree name = TYPE_NAME (record_type);
tree ada_size = bitsize_zero_node;
tree size = bitsize_zero_node;
- bool var_size = false;
bool had_size = TYPE_SIZE (record_type) != 0;
bool had_size_unit = TYPE_SIZE_UNIT (record_type) != 0;
+ bool had_align = TYPE_ALIGN (record_type) != 0;
tree field;
+ if (name && TREE_CODE (name) == TYPE_DECL)
+ name = DECL_NAME (name);
+
TYPE_FIELDS (record_type) = fieldlist;
- TYPE_STUB_DECL (record_type)
- = build_decl (TYPE_DECL, TYPE_NAME (record_type), record_type);
+ TYPE_STUB_DECL (record_type) = build_decl (TYPE_DECL, name, record_type);
/* We don't need both the typedef name and the record name output in
the debugging information, since they are the same. */
for (field = fieldlist; field; field = TREE_CHAIN (field))
{
- tree pos = bit_position (field);
-
tree type = TREE_TYPE (field);
+ tree pos = bit_position (field);
tree this_size = DECL_SIZE (field);
- tree this_ada_size = DECL_SIZE (field);
+ tree this_ada_size;
- /* We need to make an XVE/XVU record if any field has variable size,
- whether or not the record does. For example, if we have a union,
- it may be that all fields, rounded up to the alignment, have the
- same size, in which case we'll use that size. But the debug
- output routines (except Dwarf2) won't be able to output the fields,
- so we need to make the special record. */
- if (TREE_CODE (this_size) != INTEGER_CST)
- var_size = true;
-
- if ((TREE_CODE (type) == RECORD_TYPE || TREE_CODE (type) == UNION_TYPE
- || TREE_CODE (type) == QUAL_UNION_TYPE)
+ if ((TREE_CODE (type) == RECORD_TYPE
+ || TREE_CODE (type) == UNION_TYPE
+ || TREE_CODE (type) == QUAL_UNION_TYPE)
&& !TYPE_IS_FAT_POINTER_P (type)
&& !TYPE_CONTAINS_TEMPLATE_P (type)
&& TYPE_ADA_SIZE (type))
this_ada_size = TYPE_ADA_SIZE (type);
+ else
+ this_ada_size = this_size;
/* Clear DECL_BIT_FIELD for the cases layout_decl does not handle. */
- if (DECL_BIT_FIELD (field) && !STRICT_ALIGNMENT
- && value_factor_p (pos, BITS_PER_UNIT)
+ if (DECL_BIT_FIELD (field)
&& operand_equal_p (this_size, TYPE_SIZE (type), 0))
- DECL_BIT_FIELD (field) = 0;
+ {
+ unsigned int align = TYPE_ALIGN (type);
+
+ /* In the general case, type alignment is required. */
+ if (value_factor_p (pos, align))
+ {
+ /* The enclosing record type must be sufficiently aligned.
+ Otherwise, if no alignment was specified for it and it
+ has been laid out already, bump its alignment to the
+ desired one if this is compatible with its size. */
+ if (TYPE_ALIGN (record_type) >= align)
+ {
+ DECL_ALIGN (field) = MAX (DECL_ALIGN (field), align);
+ DECL_BIT_FIELD (field) = 0;
+ }
+ else if (!had_align
+ && rep_level == 0
+ && value_factor_p (TYPE_SIZE (record_type), align))
+ {
+ TYPE_ALIGN (record_type) = align;
+ DECL_ALIGN (field) = MAX (DECL_ALIGN (field), align);
+ DECL_BIT_FIELD (field) = 0;
+ }
+ }
+
+ /* In the non-strict alignment case, only byte alignment is. */
+ if (!STRICT_ALIGNMENT
+ && DECL_BIT_FIELD (field)
+ && value_factor_p (pos, BITS_PER_UNIT))
+ DECL_BIT_FIELD (field) = 0;
+ }
/* If we still have DECL_BIT_FIELD set at this point, we know the field
is technically not addressable. Except that it can actually be
DECL_NONADDRESSABLE_P (field)
|= DECL_BIT_FIELD (field) && DECL_MODE (field) != BLKmode;
- if ((rep_level > 0) && !DECL_BIT_FIELD (field))
+ /* A type must be as aligned as its most aligned field that is not
+ a bit-field. But this is already enforced by layout_type. */
+ if (rep_level > 0 && !DECL_BIT_FIELD (field))
TYPE_ALIGN (record_type)
= MAX (TYPE_ALIGN (record_type), DECL_ALIGN (field));
otherwise we are dealing with a function. PARAM_DECL_LIST is a list of
PARM_DECL nodes that are the subprogram arguments. CICO_LIST is the
copy-in/copy-out list to be stored into TYPE_CICO_LIST.
- RETURNS_UNCONSTRAINED is nonzero if the function returns an unconstrained
- object. RETURNS_BY_REF is nonzero if the function returns by reference.
- RETURNS_WITH_DSP is nonzero if the function is to return with a
- depressed stack pointer. RETURNS_BY_TARGET_PTR is true if the function
- is to be passed (as its first parameter) the address of the place to copy
- its result. */
+ RETURNS_UNCONSTRAINED is true if the function returns an unconstrained
+ object. RETURNS_BY_REF is true if the function returns by reference.
+ RETURNS_BY_TARGET_PTR is true if the function is to be passed (as its
+ first parameter) the address of the place to copy its result. */
tree
create_subprog_type (tree return_type, tree param_decl_list, tree cico_list,
bool returns_unconstrained, bool returns_by_ref,
- bool returns_with_dsp, bool returns_by_target_ptr)
+ bool returns_by_target_ptr)
{
/* A chain of TREE_LIST nodes whose TREE_VALUEs are the data type nodes of
the subprogram formal parameters. This list is generated by traversing the
TYPE_CI_CO_LIST (type) = cico_list;
TYPE_RETURNS_UNCONSTRAINED_P (type) = returns_unconstrained;
- TYPE_RETURNS_STACK_DEPRESSED (type) = returns_with_dsp;
TYPE_RETURNS_BY_REF_P (type) = returns_by_ref;
TYPE_RETURNS_BY_TARGET_PTR_P (type) = returns_by_target_ptr;
return type;
TREE_ADDRESSABLE (var_decl) = 1;
if (TREE_CODE (var_decl) != CONST_DECL)
- rest_of_decl_compilation (var_decl, global_bindings_p (), 0);
+ {
+ if (global_bindings_p ())
+ rest_of_decl_compilation (var_decl, true, 0);
+ }
else
expand_decl (var_decl);
attr_list, gnat_node);
}
\f
+/* Return true if TYPE, an aggregate type, contains (or is) an array. */
+
+static bool
+aggregate_type_contains_array_p (tree type)
+{
+ switch (TREE_CODE (type))
+ {
+ case RECORD_TYPE:
+ case UNION_TYPE:
+ case QUAL_UNION_TYPE:
+ {
+ tree field;
+ for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field))
+ if (AGGREGATE_TYPE_P (TREE_TYPE (field))
+ && aggregate_type_contains_array_p (TREE_TYPE (field)))
+ return true;
+ return false;
+ }
+
+ case ARRAY_TYPE:
+ return true;
+
+ default:
+ gcc_unreachable ();
+ }
+}
+
/* Returns a FIELD_DECL node. FIELD_NAME the field name, FIELD_TYPE is its
type, and RECORD_TYPE is the type of the parent. PACKED is nonzero if
this field is in a record type with a "pragma pack". If SIZE is nonzero
TREE_READONLY (field_decl) = TYPE_READONLY (field_type);
/* If FIELD_TYPE is BLKmode, we must ensure this is aligned to at least a
- byte boundary since GCC cannot handle less-aligned BLKmode bitfields. */
- if (packed && TYPE_MODE (field_type) == BLKmode)
+ byte boundary since GCC cannot handle less-aligned BLKmode bitfields.
+ Likewise for an aggregate without specified position that contains an
+ array, because in this case slices of variable length of this array
+ must be handled by GCC and variable-sized objects need to be aligned
+ to at least a byte boundary. */
+ if (packed && (TYPE_MODE (field_type) == BLKmode
+ || (!pos
+ && AGGREGATE_TYPE_P (field_type)
+ && aggregate_type_contains_array_p (field_type))))
DECL_ALIGN (field_decl) = BITS_PER_UNIT;
/* If a size is specified, use it. Otherwise, if the record type is packed
}
DECL_PACKED (field_decl) = pos ? DECL_BIT_FIELD (field_decl) : packed;
- DECL_ALIGN (field_decl)
- = MAX (DECL_ALIGN (field_decl),
- DECL_BIT_FIELD (field_decl) ? 1
- : packed && TYPE_MODE (field_type) != BLKmode ? BITS_PER_UNIT
- : TYPE_ALIGN (field_type));
+
+ /* Bump the alignment if need be, either for bitfield/packing purposes or
+ to satisfy the type requirements if no such consideration applies. When
+ we get the alignment from the type, indicate if this is from an explicit
+ user request, which prevents stor-layout from lowering it later on. */
+ {
+ int bit_align
+ = (DECL_BIT_FIELD (field_decl) ? 1
+ : packed && TYPE_MODE (field_type) != BLKmode ? BITS_PER_UNIT : 0);
+
+ if (bit_align > DECL_ALIGN (field_decl))
+ DECL_ALIGN (field_decl) = bit_align;
+ else if (!bit_align && TYPE_ALIGN (field_type) > DECL_ALIGN (field_decl))
+ {
+ DECL_ALIGN (field_decl) = TYPE_ALIGN (field_type);
+ DECL_USER_ALIGN (field_decl) = TYPE_USER_ALIGN (field_type);
+ }
+ }
if (pos)
{
\f
/* Returns a PARM_DECL node. PARAM_NAME is the name of the parameter,
PARAM_TYPE is its type. READONLY is true if the parameter is
- readonly (either an IN parameter or an address of a pass-by-ref
+ readonly (either an In parameter or an address of a pass-by-ref
parameter). */
tree
return (value_factor_p (TREE_OPERAND (value, 0), factor)
|| value_factor_p (TREE_OPERAND (value, 1), factor));
- return 0;
+ return false;
}
/* Given 2 consecutive field decls PREV_FIELD and CURR_FIELD, return true
DECL_ARTIFICIAL (DECL_RESULT (subprog_decl)) = 1;
DECL_IGNORED_P (DECL_RESULT (subprog_decl)) = 1;
- /* TREE_ADDRESSABLE is set on the result type to request the use of the
- target by-reference return mechanism. This is not supported all the
- way down to RTL expansion with GCC 4, which ICEs on temporary creation
- attempts with such a type and expects DECL_BY_REFERENCE to be set on
- the RESULT_DECL instead - see gnat_genericize for more details. */
- if (TREE_ADDRESSABLE (TREE_TYPE (DECL_RESULT (subprog_decl))))
- {
- tree result_decl = DECL_RESULT (subprog_decl);
+ /* TREE_ADDRESSABLE is set on the result type to request the use of the
+ target by-reference return mechanism. This is not supported all the
+ way down to RTL expansion with GCC 4, which ICEs on temporary creation
+ attempts with such a type and expects DECL_BY_REFERENCE to be set on
+ the RESULT_DECL instead - see gnat_genericize for more details. */
+ if (TREE_ADDRESSABLE (TREE_TYPE (DECL_RESULT (subprog_decl))))
+ {
+ tree result_decl = DECL_RESULT (subprog_decl);
- TREE_ADDRESSABLE (TREE_TYPE (result_decl)) = 0;
- DECL_BY_REFERENCE (result_decl) = 1;
- }
+ TREE_ADDRESSABLE (TREE_TYPE (result_decl)) = 0;
+ DECL_BY_REFERENCE (result_decl) = 1;
+ }
if (inline_flag)
DECL_DECLARED_INLINE_P (subprog_decl) = 1;
type, and the gimplifier ICEs on such attempts. Second, the middle-end
now relies on a different attribute for such cases (DECL_BY_REFERENCE on
RESULT/PARM_DECLs), and expects the user invisible by-reference-ness to
- be explicitely accounted for by the front-end in the function body.
+ be explicitly accounted for by the front-end in the function body.
We achieve the complete transformation in two steps:
strategy, which escapes the gimplifier temporary creation issues by
creating it's own temporaries using TARGET_EXPR nodes. Our way relies
on simple specific support code in aggregate_value_p to look at the
- target function result decl explicitely. */
+ target function result decl explicitly. */
struct pointer_set_t *p_set;
tree decl_result = DECL_RESULT (fndecl);
if (!DECL_BY_REFERENCE (decl_result))
return;
- /* Make the DECL_RESULT explicitely by-reference and adjust all the
+ /* Make the DECL_RESULT explicitly by-reference and adjust all the
occurrences in the function body using the common tree-walking facility.
We want to see every occurrence of the result decl to adjust the
referencing tree, so need to use our own pointer set to control which
return type;
}
+/* Return 1 if the types T1 and T2 are compatible, i.e. if they can be
+ transparently converted to each other. */
+
+int
+gnat_types_compatible_p (tree t1, tree t2)
+{
+ enum tree_code code;
+
+ /* This is the default criterion. */
+ if (TYPE_MAIN_VARIANT (t1) == TYPE_MAIN_VARIANT (t2))
+ return 1;
+
+ /* We only check structural equivalence here. */
+ if ((code = TREE_CODE (t1)) != TREE_CODE (t2))
+ return 0;
+
+ /* Array types are also compatible if they are constrained and have
+ the same component type and the same domain. */
+ if (code == ARRAY_TYPE
+ && TREE_TYPE (t1) == TREE_TYPE (t2)
+ && tree_int_cst_equal (TYPE_MIN_VALUE (TYPE_DOMAIN (t1)),
+ TYPE_MIN_VALUE (TYPE_DOMAIN (t2)))
+ && tree_int_cst_equal (TYPE_MAX_VALUE (TYPE_DOMAIN (t1)),
+ TYPE_MAX_VALUE (TYPE_DOMAIN (t2))))
+ return 1;
+
+ /* Padding record types are also compatible if they pad the same
+ type and have the same constant size. */
+ if (code == RECORD_TYPE
+ && TYPE_IS_PADDING_P (t1) && TYPE_IS_PADDING_P (t2)
+ && TREE_TYPE (TYPE_FIELDS (t1)) == TREE_TYPE (TYPE_FIELDS (t2))
+ && tree_int_cst_equal (TYPE_SIZE (t1), TYPE_SIZE (t2)))
+ return 1;
+
+ return 0;
+}
\f
/* EXP is an expression for the size of an object. If this size contains
discriminant references, replace them with the maximum (if MAX_P) or
tree bound_list = NULL_TREE;
tree field;
- if (TREE_CODE (array_type) == RECORD_TYPE
- && (TYPE_IS_PADDING_P (array_type)
- || TYPE_JUSTIFIED_MODULAR_P (array_type)))
+ while (TREE_CODE (array_type) == RECORD_TYPE
+ && (TYPE_IS_PADDING_P (array_type)
+ || TYPE_JUSTIFIED_MODULAR_P (array_type)))
array_type = TREE_TYPE (TYPE_FIELDS (array_type));
if (TREE_CODE (array_type) == ARRAY_TYPE
/* Invoke the internal subprogram. */
gnu_subprog_addr = build1 (ADDR_EXPR, build_pointer_type (gnu_subprog_type),
gnu_subprog);
- gnu_subprog_call = build3 (CALL_EXPR, TREE_TYPE (gnu_subprog_type),
- gnu_subprog_addr, nreverse (gnu_param_list),
- NULL_TREE);
+ gnu_subprog_call = build_call_list (TREE_TYPE (gnu_subprog_type),
+ gnu_subprog_addr,
+ nreverse (gnu_param_list));
/* Propagate the return value, if any. */
if (VOID_TYPE_P (TREE_TYPE (gnu_subprog_type)))
gnat_poplevel ();
- allocate_struct_function (gnu_stub_decl);
+ allocate_struct_function (gnu_stub_decl, false);
end_subprog_body (gnu_body);
}
\f
/* If both input and output have padding and are of variable size, do this
as an unchecked conversion. Likewise if one is a mere variant of the
other, so we avoid a pointless unpad/repad sequence. */
- else if (ecode == RECORD_TYPE && code == RECORD_TYPE
+ else if (code == RECORD_TYPE && ecode == RECORD_TYPE
&& TYPE_IS_PADDING_P (type) && TYPE_IS_PADDING_P (etype)
&& (!TREE_CONSTANT (TYPE_SIZE (type))
|| !TREE_CONSTANT (TYPE_SIZE (etype))
- || TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype)))
+ || gnat_types_compatible_p (type, etype)))
;
- /* If the output type has padding, make a constructor to build the
- record. */
+ /* If the output type has padding, convert to the inner type and
+ make a constructor to build the record. */
else if (code == RECORD_TYPE && TYPE_IS_PADDING_P (type))
{
/* If we previously converted from another type and our type is
expr = TREE_OPERAND (expr, 0);
/* If we are just removing the padding from expr, convert the original
- object if we have variable size. That will avoid the need
- for some variable-size temporaries. */
+ object if we have variable size in order to avoid the need for some
+ variable-size temporaries. Likewise if the padding is a mere variant
+ of the other, so we avoid a pointless unpad/repad sequence. */
if (TREE_CODE (expr) == COMPONENT_REF
&& TREE_CODE (TREE_TYPE (TREE_OPERAND (expr, 0))) == RECORD_TYPE
&& TYPE_IS_PADDING_P (TREE_TYPE (TREE_OPERAND (expr, 0)))
- && !TREE_CONSTANT (TYPE_SIZE (type)))
+ && (!TREE_CONSTANT (TYPE_SIZE (type))
+ || gnat_types_compatible_p (type,
+ TREE_TYPE (TREE_OPERAND (expr, 0)))))
return convert (type, TREE_OPERAND (expr, 0));
/* If the result type is a padded type with a self-referentially-sized
break;
case CONSTRUCTOR:
- /* If we are converting a CONSTRUCTOR to another constrained array type
- with the same domain, just make a new one in the proper type. */
- if (code == ecode && code == ARRAY_TYPE
- && TREE_TYPE (type) == TREE_TYPE (etype)
- && tree_int_cst_equal (TYPE_MIN_VALUE (TYPE_DOMAIN (type)),
- TYPE_MIN_VALUE (TYPE_DOMAIN (etype)))
- && tree_int_cst_equal (TYPE_MAX_VALUE (TYPE_DOMAIN (type)),
- TYPE_MAX_VALUE (TYPE_DOMAIN (etype))))
+ /* If we are converting a CONSTRUCTOR to a mere variant type, just make
+ a new one in the proper type. */
+ if (gnat_types_compatible_p (type, etype))
{
expr = copy_node (expr);
TREE_TYPE (expr) = type;
the inner operand to the output type is fine in most cases, it
might expose unexpected input/output type mismatches in special
circumstances so we avoid such recursive calls when we can. */
-
tree op0 = TREE_OPERAND (expr, 0);
/* If we are converting back to the original type, we can just
return op0;
/* Otherwise, if we're converting between two aggregate types, we
- might be allowed to substitute the VIEW_CONVERT target type in
- place or to just convert the inner expression. */
+ might be allowed to substitute the VIEW_CONVERT_EXPR target type
+ in place or to just convert the inner expression. */
if (AGGREGATE_TYPE_P (type) && AGGREGATE_TYPE_P (etype))
{
- /* If we are converting between type variants, we can just
- substitute the VIEW_CONVERT in place. */
- if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype))
+ /* If we are converting between mere variants, we can just
+ substitute the VIEW_CONVERT_EXPR in place. */
+ if (gnat_types_compatible_p (type, etype))
return build1 (VIEW_CONVERT_EXPR, type, op0);
/* Otherwise, we may just bypass the input view conversion unless
if (TYPE_FAT_POINTER_P (type) && !TYPE_FAT_POINTER_P (etype))
return convert_to_fat_pointer (type, expr);
- /* If we're converting between two aggregate types that have the same main
- variant, just make a VIEW_CONVER_EXPR. */
+ /* If we're converting between two aggregate types that are mere
+ variants, just make a VIEW_CONVERT_EXPR. */
else if (AGGREGATE_TYPE_P (type)
- && TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype))
+ && gnat_types_compatible_p (type, etype))
return build1 (VIEW_CONVERT_EXPR, type, expr);
/* In all other cases of related types, make a NOP_EXPR. */
expr = convert (rtype, expr);
if (type != rtype)
- expr = build1 (final_unchecked ? VIEW_CONVERT_EXPR : NOP_EXPR,
- type, expr);
+ expr = fold_build1 (final_unchecked ? VIEW_CONVERT_EXPR : NOP_EXPR,
+ type, expr);
}
/* If we are converting TO an integral type whose precision is not the
else
{
expr = maybe_unconstrained_array (expr);
-
- /* There's no point in doing two unchecked conversions in a row. */
- if (TREE_CODE (expr) == VIEW_CONVERT_EXPR)
- expr = TREE_OPERAND (expr, 0);
-
etype = TREE_TYPE (expr);
- expr = build1 (VIEW_CONVERT_EXPR, type, expr);
+ expr = fold_build1 (VIEW_CONVERT_EXPR, type, expr);
}
/* If the result is an integral type whose size is not equal to