Skip to content

R
riscv-gcc-1
Commit 5b47742c by Richard Kenner Committed by Arnaud Charlet
Options

re PR ada/26096 (Ada bootstrap fails in g-alleve.adb) 

2006-02-13  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
	    Olivier Hainque  <hainque@adacore.com>
	    Eric Botcazou  <ebotcazou@adacore.com>

	* ada-tree.h: (TYPE_UNCHECKED_UNION_P): Deleted.
	
	* gigi.h (value_factor_p): Add prototype and description, now public.

	* decl.c (gnat_to_gnu_field): Don't attempt BLKmode to integral type
	promotion for field with rep clause if the associated size was proven
	to be in error.
	Expand comments describing attempts to use a packable type.
	(gnat_to_gnu_entity) <E_Signed_Integer_Subtype,
	E_Floating_Point_Subtype>: Inherit alias set of what we are making a
	subtype of to ensure conflicts amongst all subtypes in a hierarchy,
	necessary since these are not different types and pointers may
	actually designate any subtype in this hierarchy.
	(gnat_to_gnu_entity, case E_Record_Type): Always make fields for
	discriminants but put them into record only if not Unchecked_Union;
	pass flag to components_to_record showing Unchecked_Union.
	(make_dummy_type): Use UNION_TYPE only if Unchecked_Union and no
	components before variants; don't set TYPE_UNCHECKED_UNION_P.
	(components_to_record): New argument UNCHECKED_UNION.
	Remove special case code for Unchecked_Union and instead use main code
	with small changes.

	PR ada/26096
	(gnat_to_gnu_entity) <E_Variable>: Do not initialize the
	aligning variable with the expression being built, only its inner
	field.

	* trans.c (Handled_Sequence_Of_Statements_to_gnu): Remove call to
	emit_sequence_entry_statements.
	(emit_sequence_entry_statements, body_with_handlers_p): Delete.
	(establish_gnat_vms_condition_handler): Move before
	Subprogram_Body_to_gnu.
	(Subprogram_Body_to_gnu): On VMS, establish_gnat_vms_condition_handler
	for a subprogram if it has a foreign convention or is exported.
	(Identifier_to_gnu): Manually unshare the DECL_INITIAL tree when it is
	substituted for a CONST_DECL.
	(tree_transform, case N_Aggregate): Remove code for UNION_TYPE and pass
	Etype to assoc_to_constructor.
	(assoc_to_constructor): New argument, GNAT_ENTITY; use it to ignore
	discriminants of Unchecked_Union.
	(TARGET_ABI_OPEN_VMS): Define to 0 if not defined, so that later uses
	don't need cluttering preprocessor directives.
	(establish_gnat_vms_condition_handler): New function. Establish the GNAT
	condition handler as current in the compiled function.
	(body_with_handlers_p): New function. Tell whether a given sequence of
	statements node is attached to a package or subprogram body and involves
	exception handlers possibly nested within inner block statements.
	(emit_sequence_entry_statements): New function, to emit special
	statements on entry of sequences when necessary. Establish GNAT
	condition handler in the proper cases for VMS.
	(Handled_Sequence_Of_Statements_to_gnu): Start block code with
	emit_sequence_entry_statements.

	* utils2.c (find_common_type): If both input types are BLKmode and
	have a constant size, use the smaller one.
	(build_simple_component_ref): Also match if FIELD and NEW_FIELD are
	the same.

	* utils.c (value_factor_p): Make public, to allow uses from other gigi
	units.
	(create_type_decl): Do not set the flag DECL_IGNORED_P for dummy types.
	(convert, case UNION_TYPE): Remove special treatment for unchecked
	unions.

	PR ada/18659
	(update_pointer_to): Update variants of pointer types to
	unconstrained arrays by attaching the list of fields of the main
	variant.

From-SVN: r111030
parent 0022d9e3
Showing with 284 additions and 140 deletions
gcc/ada/ada-tree.h
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
* * * *
* C Header File * * C Header File *
* * * *
* Copyright (C) 1992-2005 Free Software Foundation, Inc. * * Copyright (C) 1992-2006 Free Software Foundation, Inc. *
* * * *
* GNAT is free software; you can redistribute it and/or modify it under * * 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- * * terms of the GNU General Public License as published by the Free Soft- *
...@@ -160,9 +160,6 @@ struct lang_type GTY(()) {tree t; }; ...@@ -160,9 +160,6 @@ struct lang_type GTY(()) {tree t; };
padding or alignment. */ padding or alignment. */
#define TYPE_IS_PADDING_P(NODE) TYPE_LANG_FLAG_5 (RECORD_TYPE_CHECK (NODE)) #define TYPE_IS_PADDING_P(NODE) TYPE_LANG_FLAG_5 (RECORD_TYPE_CHECK (NODE))
/* For a UNION_TYPE, nonzero if this is an unchecked union. */
#define TYPE_UNCHECKED_UNION_P(NODE) TYPE_LANG_FLAG_6 (UNION_TYPE_CHECK (NODE))
/* This field is only defined for FUNCTION_TYPE nodes. If the Ada /* This field is only defined for FUNCTION_TYPE nodes. If the Ada
subprogram contains no parameters passed by copy in/copy out then this subprogram contains no parameters passed by copy in/copy out then this
field is 0. Otherwise it points to a list of nodes used to specify the field is 0. Otherwise it points to a list of nodes used to specify the
......
gcc/ada/decl.c
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
* * * *
* C Implementation File * * C Implementation File *
* * * *
* Copyright (C) 1992-2005, Free Software Foundation, Inc. * * Copyright (C) 1992-2006, Free Software Foundation, Inc. *
* * * *
* GNAT is free software; you can redistribute it and/or modify it under * * 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- * * terms of the GNU General Public License as published by the Free Soft- *
...@@ -91,7 +91,7 @@ static tree elaborate_expression_1 (Node_Id, Entity_Id, tree, tree, ...@@ -91,7 +91,7 @@ static tree elaborate_expression_1 (Node_Id, Entity_Id, tree, tree,
static tree make_packable_type (tree); static tree make_packable_type (tree);
static tree gnat_to_gnu_field (Entity_Id, tree, int, bool); static tree gnat_to_gnu_field (Entity_Id, tree, int, bool);
static void components_to_record (tree, Node_Id, tree, int, bool, tree *, static void components_to_record (tree, Node_Id, tree, int, bool, tree *,
bool, bool, bool); bool, bool, bool, bool);
static int compare_field_bitpos (const PTR, const PTR); static int compare_field_bitpos (const PTR, const PTR);
static Uint annotate_value (tree); static Uint annotate_value (tree);
static void annotate_rep (Entity_Id, tree); static void annotate_rep (Entity_Id, tree);
...@@ -1058,7 +1058,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1058,7 +1058,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_new_var gnu_new_var
= create_var_decl (create_concat_name (gnat_entity, "ALIGN"), = create_var_decl (create_concat_name (gnat_entity, "ALIGN"),
NULL_TREE, gnu_new_type, gnu_expr, false, NULL_TREE, gnu_new_type, NULL_TREE, false,
false, false, false, NULL, gnat_entity); false, false, false, NULL, gnat_entity);
if (gnu_expr) if (gnu_expr)
...@@ -1416,6 +1416,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1416,6 +1416,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
layout_type (gnu_type); layout_type (gnu_type);
/* Inherit our alias set from what we're a subtype of. Subtypes
are not different types and a pointer can designate any instance
within a subtype hierarchy. */
copy_alias_set (gnu_type, TREE_TYPE (gnu_type));
/* If the type we are dealing with is to represent a packed array, /* If the type we are dealing with is to represent a packed array,
we need to have the bits left justified on big-endian targets we need to have the bits left justified on big-endian targets
and right justified on little-endian targets. We also need to and right justified on little-endian targets. We also need to
...@@ -1449,6 +1454,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1449,6 +1454,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
finish_record_type (gnu_type, gnu_field, false, false); finish_record_type (gnu_type, gnu_field, false, false);
TYPE_JUSTIFIED_MODULAR_P (gnu_type) = 1; TYPE_JUSTIFIED_MODULAR_P (gnu_type) = 1;
SET_TYPE_ADA_SIZE (gnu_type, bitsize_int (esize)); SET_TYPE_ADA_SIZE (gnu_type, bitsize_int (esize));
copy_alias_set (gnu_type, gnu_field_type);
} }
break; break;
...@@ -1516,6 +1523,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -1516,6 +1523,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
} }
layout_type (gnu_type); layout_type (gnu_type);
/* Inherit our alias set from what we're a subtype of, as for
integer subtypes. */
copy_alias_set (gnu_type, TREE_TYPE (gnu_type));
} }
break; break;
...@@ -2463,9 +2474,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2463,9 +2474,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
TREE_OPERAND (gnu_get_parent, 1) = gnu_field_list; TREE_OPERAND (gnu_get_parent, 1) = gnu_field_list;
} }
/* Add the fields for the discriminants into the record. */ /* Make the fields for the discriminants and put them into the record
if (!Is_Unchecked_Union (gnat_entity) unless it's an Unchecked_Union. */
&& Has_Discriminants (gnat_entity)) if (Has_Discriminants (gnat_entity))
for (gnat_field = First_Stored_Discriminant (gnat_entity); for (gnat_field = First_Stored_Discriminant (gnat_entity);
Present (gnat_field); Present (gnat_field);
gnat_field = Next_Stored_Discriminant (gnat_field)) gnat_field = Next_Stored_Discriminant (gnat_field))
...@@ -2491,8 +2502,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2491,8 +2502,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_field, NULL_TREE), gnu_field, NULL_TREE),
true); true);
TREE_CHAIN (gnu_field) = gnu_field_list; if (!Is_Unchecked_Union (gnat_entity))
gnu_field_list = gnu_field; {
TREE_CHAIN (gnu_field) = gnu_field_list;
gnu_field_list = gnu_field;
}
} }
/* Put the discriminants into the record (backwards), so we can /* Put the discriminants into the record (backwards), so we can
...@@ -2503,7 +2517,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -2503,7 +2517,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* Add the listed fields into the record and finish up. */ /* Add the listed fields into the record and finish up. */
components_to_record (gnu_type, Component_List (record_definition), components_to_record (gnu_type, Component_List (record_definition),
gnu_field_list, packed, definition, NULL, gnu_field_list, packed, definition, NULL,
false, all_rep, this_deferred); false, all_rep, this_deferred,
Is_Unchecked_Union (gnat_entity));
if (this_deferred) if (this_deferred)
{ {
...@@ -4479,6 +4494,7 @@ make_dummy_type (Entity_Id gnat_type) ...@@ -4479,6 +4494,7 @@ make_dummy_type (Entity_Id gnat_type)
{ {
Entity_Id gnat_underlying; Entity_Id gnat_underlying;
tree gnu_type; tree gnu_type;
enum tree_code code;
/* Find a full type for GNAT_TYPE, taking into account any class wide /* Find a full type for GNAT_TYPE, taking into account any class wide
types. */ types. */
...@@ -4498,17 +4514,31 @@ make_dummy_type (Entity_Id gnat_type) ...@@ -4498,17 +4514,31 @@ make_dummy_type (Entity_Id gnat_type)
return dummy_node_table[gnat_underlying]; return dummy_node_table[gnat_underlying];
/* If this is a record, make this a RECORD_TYPE or UNION_TYPE; else make /* If this is a record, make this a RECORD_TYPE or UNION_TYPE; else make
it a VOID_TYPE. */ it an ENUMERAL_TYPE. */
if (Is_Unchecked_Union (gnat_underlying)) if (Is_Record_Type (gnat_underlying))
{ {
gnu_type = make_node (UNION_TYPE); Node_Id component_list
TYPE_UNCHECKED_UNION_P (gnu_type) = 1; = Component_List (Type_Definition
(Declaration_Node
(Implementation_Base_Type (gnat_underlying))));
Node_Id component;
/* Make this a UNION_TYPE unless it's either not an Unchecked_Union or
we have a non-discriminant field outside a variant. In either case,
it's a RECORD_TYPE. */
code = UNION_TYPE;
if (!Is_Unchecked_Union (gnat_underlying))
code = RECORD_TYPE;
else
for (component = First_Non_Pragma (Component_Items (component_list));
Present (component); component = Next_Non_Pragma (component))
if (Ekind (Defining_Entity (component)) == E_Component)
code = RECORD_TYPE;
} }
else if (Is_Record_Type (gnat_underlying))
gnu_type = make_node (RECORD_TYPE);
else else
gnu_type = make_node (ENUMERAL_TYPE); code = ENUMERAL_TYPE;
gnu_type = make_node (code);
TYPE_NAME (gnu_type) = get_entity_name (gnat_type); TYPE_NAME (gnu_type) = get_entity_name (gnat_type);
TYPE_DUMMY_P (gnu_type) = 1; TYPE_DUMMY_P (gnu_type) = 1;
if (AGGREGATE_TYPE_P (gnu_type)) if (AGGREGATE_TYPE_P (gnu_type))
...@@ -5215,12 +5245,30 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, ...@@ -5215,12 +5245,30 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
gnu_size = validate_size (Esize (gnat_field), gnu_field_type, gnu_size = validate_size (Esize (gnat_field), gnu_field_type,
gnat_field, FIELD_DECL, false, true); gnat_field, FIELD_DECL, false, true);
/* If we are packing this record, have a specified size that's smaller than /* If we have a specified size that's smaller than that of the field type,
that of the field type, or a position is specified, and the field type is or a position is specified, and the field type is also a record that's
also a record that's BLKmode and with a small constant size, see if we BLKmode and with a small constant size, see if we can get an integral
can get a better form of the type that allows more packing. If we can, mode form of the type when appropriate. If we can, show a size was
show a size was specified for it if there wasn't one so we know to make specified for the field if there wasn't one already, so we know to make
this a bitfield and avoid making things wider. */ this a bitfield and avoid making things wider.
Doing this is first useful if the record is packed because we can then
place the field at a non-byte-aligned position and so achieve tigther
packing.
This is in addition *required* if the field shares a byte with another
field and the front-end lets the back-end handle the references, because
GCC does not handle BLKmode bitfields properly.
We avoid the transformation if it is not required or potentially useful,
as it might entail an increase of the field's alignment and have ripple
effects on the outer record type. A typical case is a field known to be
byte aligned and not to share a byte with another field.
Besides, we don't even look the possibility of a transformation in cases
known to be in error already, for instance when an invalid size results
from a component clause. */
if (TREE_CODE (gnu_field_type) == RECORD_TYPE if (TREE_CODE (gnu_field_type) == RECORD_TYPE
&& TYPE_MODE (gnu_field_type) == BLKmode && TYPE_MODE (gnu_field_type) == BLKmode
&& host_integerp (TYPE_SIZE (gnu_field_type), 1) && host_integerp (TYPE_SIZE (gnu_field_type), 1)
...@@ -5228,26 +5276,35 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, ...@@ -5228,26 +5276,35 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
&& (packed == 1 && (packed == 1
|| (gnu_size || (gnu_size
&& tree_int_cst_lt (gnu_size, TYPE_SIZE (gnu_field_type))) && tree_int_cst_lt (gnu_size, TYPE_SIZE (gnu_field_type)))
|| Present (Component_Clause (gnat_field)))) || (Present (Component_Clause (gnat_field)) && gnu_size != 0)))
{ {
/* See what the alternate type and size would be. */ /* See what the alternate type and size would be. */
tree gnu_packable_type = make_packable_type (gnu_field_type); tree gnu_packable_type = make_packable_type (gnu_field_type);
bool has_byte_aligned_clause
= Present (Component_Clause (gnat_field))
&& (UI_To_Int (Component_Bit_Offset (gnat_field))
% BITS_PER_UNIT == 0);
/* Compute whether we should avoid the substitution. */ /* Compute whether we should avoid the substitution. */
int reject = int reject =
/* There is no point substituting if there is no change. */ /* There is no point substituting if there is no change. */
(gnu_packable_type == gnu_field_type (gnu_packable_type == gnu_field_type
|| ||
/* ... nor when the field is known to be byte aligned and not to
share a byte with another field. */
(has_byte_aligned_clause
&& value_factor_p (gnu_size, BITS_PER_UNIT))
||
/* The size of an aliased field must be an exact multiple of the /* The size of an aliased field must be an exact multiple of the
type's alignment, which the substitution might increase. Reject type's alignment, which the substitution might increase. Reject
substitutions that would so invalidate a component clause when the substitutions that would so invalidate a component clause when the
specified position is byte aligned, as the change would have no specified position is byte aligned, as the change would have no
real benefit from the packing standpoint anyway. */ real benefit from the packing standpoint anyway. */
(Is_Aliased (gnat_field) (Is_Aliased (gnat_field)
&& Present (Component_Clause (gnat_field)) && has_byte_aligned_clause
&& UI_To_Int (Component_Bit_Offset (gnat_field)) % BITS_PER_UNIT == 0 && ! value_factor_p (gnu_size, TYPE_ALIGN (gnu_packable_type)))
&& tree_low_cst (gnu_size, 1) % TYPE_ALIGN (gnu_packable_type) != 0) );
);
/* Substitute unless told otherwise. */ /* Substitute unless told otherwise. */
if (!reject) if (!reject)
...@@ -5477,6 +5534,9 @@ is_variable_size (tree type) ...@@ -5477,6 +5534,9 @@ is_variable_size (tree type)
DEFER_DEBUG, if true, means that the debugging routines should not be DEFER_DEBUG, if true, means that the debugging routines should not be
called when finishing constructing the record type. called when finishing constructing the record type.
UNCHECKED_UNION, if tree, means that we are building a type for a record
with a Pragma Unchecked_Union.
The processing of the component list fills in the chain with all of the The processing of the component list fills in the chain with all of the
fields of the record and then the record type is finished. */ fields of the record and then the record type is finished. */
...@@ -5484,12 +5544,11 @@ static void ...@@ -5484,12 +5544,11 @@ static void
components_to_record (tree gnu_record_type, Node_Id component_list, components_to_record (tree gnu_record_type, Node_Id component_list,
tree gnu_field_list, int packed, bool definition, tree gnu_field_list, int packed, bool definition,
tree *p_gnu_rep_list, bool cancel_alignment, tree *p_gnu_rep_list, bool cancel_alignment,
bool all_rep, bool defer_debug) bool all_rep, bool defer_debug, bool unchecked_union)
{ {
Node_Id component_decl; Node_Id component_decl;
Entity_Id gnat_field; Entity_Id gnat_field;
Node_Id variant_part; Node_Id variant_part;
Node_Id variant;
tree gnu_our_rep_list = NULL_TREE; tree gnu_our_rep_list = NULL_TREE;
tree gnu_field, gnu_last; tree gnu_field, gnu_last;
bool layout_with_rep = false; bool layout_with_rep = false;
...@@ -5530,49 +5589,44 @@ components_to_record (tree gnu_record_type, Node_Id component_list, ...@@ -5530,49 +5589,44 @@ components_to_record (tree gnu_record_type, Node_Id component_list,
/* At the end of the component list there may be a variant part. */ /* At the end of the component list there may be a variant part. */
variant_part = Variant_Part (component_list); variant_part = Variant_Part (component_list);
/* If this is an unchecked union, each variant must have exactly one
component, each of which becomes one component of this union. */
if (TREE_CODE (gnu_record_type) == UNION_TYPE
&& TYPE_UNCHECKED_UNION_P (gnu_record_type)
&& Present (variant_part))
for (variant = First_Non_Pragma (Variants (variant_part));
Present (variant);
variant = Next_Non_Pragma (variant))
{
component_decl
= First_Non_Pragma (Component_Items (Component_List (variant)));
gnat_field = Defining_Entity (component_decl);
gnu_field = gnat_to_gnu_field (gnat_field, gnu_record_type, packed,
definition);
TREE_CHAIN (gnu_field) = gnu_field_list;
gnu_field_list = gnu_field;
save_gnu_tree (gnat_field, gnu_field, false);
}
/* We create a QUAL_UNION_TYPE for the variant part since the variants are /* We create a QUAL_UNION_TYPE for the variant part since the variants are
mutually exclusive and should go in the same memory. To do this we need mutually exclusive and should go in the same memory. To do this we need
to treat each variant as a record whose elements are created from the to treat each variant as a record whose elements are created from the
component list for the variant. So here we create the records from the component list for the variant. So here we create the records from the
lists for the variants and put them all into the QUAL_UNION_TYPE. */ lists for the variants and put them all into the QUAL_UNION_TYPE.
else if (Present (variant_part)) If this is an Unchecked_Union, we make a UNION_TYPE instead or
use GNU_RECORD_TYPE if there are no fields so far. */
if (Present (variant_part))
{ {
tree gnu_discriminant = gnat_to_gnu (Name (variant_part)); tree gnu_discriminant = gnat_to_gnu (Name (variant_part));
Node_Id variant; Node_Id variant;
tree gnu_union_type = make_node (QUAL_UNION_TYPE);
tree gnu_union_field;
tree gnu_variant_list = NULL_TREE;
tree gnu_name = TYPE_NAME (gnu_record_type); tree gnu_name = TYPE_NAME (gnu_record_type);
tree gnu_var_name tree gnu_var_name
= concat_id_with_name = concat_id_with_name (get_identifier (Get_Name_String
(get_identifier (Get_Name_String (Chars (Name (variant_part)))), (Chars (Name (variant_part)))),
"XVN"); "XVN");
tree gnu_union_type;
tree gnu_union_name;
tree gnu_union_field;
tree gnu_variant_list = NULL_TREE;
if (TREE_CODE (gnu_name) == TYPE_DECL) if (TREE_CODE (gnu_name) == TYPE_DECL)
gnu_name = DECL_NAME (gnu_name); gnu_name = DECL_NAME (gnu_name);
TYPE_NAME (gnu_union_type) gnu_union_name = concat_id_with_name (gnu_name,
= concat_id_with_name (gnu_name, IDENTIFIER_POINTER (gnu_var_name)); IDENTIFIER_POINTER (gnu_var_name));
TYPE_PACKED (gnu_union_type) = TYPE_PACKED (gnu_record_type);
if (!gnu_field_list && TREE_CODE (gnu_record_type) == UNION_TYPE)
gnu_union_type = gnu_record_type;
else
{
gnu_union_type
= make_node (unchecked_union ? UNION_TYPE : QUAL_UNION_TYPE);
TYPE_NAME (gnu_union_type) = gnu_union_name;
TYPE_PACKED (gnu_union_type) = TYPE_PACKED (gnu_record_type);
}
for (variant = First_Non_Pragma (Variants (variant_part)); for (variant = First_Non_Pragma (Variants (variant_part));
Present (variant); Present (variant);
...@@ -5585,7 +5639,7 @@ components_to_record (tree gnu_record_type, Node_Id component_list, ...@@ -5585,7 +5639,7 @@ components_to_record (tree gnu_record_type, Node_Id component_list,
Get_Variant_Encoding (variant); Get_Variant_Encoding (variant);
gnu_inner_name = get_identifier (Name_Buffer); gnu_inner_name = get_identifier (Name_Buffer);
TYPE_NAME (gnu_variant_type) TYPE_NAME (gnu_variant_type)
= concat_id_with_name (TYPE_NAME (gnu_union_type), = concat_id_with_name (gnu_union_name,
IDENTIFIER_POINTER (gnu_inner_name)); IDENTIFIER_POINTER (gnu_inner_name));
/* Set the alignment of the inner type in case we need to make /* Set the alignment of the inner type in case we need to make
...@@ -5607,27 +5661,40 @@ components_to_record (tree gnu_record_type, Node_Id component_list, ...@@ -5607,27 +5661,40 @@ components_to_record (tree gnu_record_type, Node_Id component_list,
components_to_record (gnu_variant_type, Component_List (variant), components_to_record (gnu_variant_type, Component_List (variant),
NULL_TREE, packed, definition, NULL_TREE, packed, definition,
&gnu_our_rep_list, !all_rep_and_size, all_rep, &gnu_our_rep_list, !all_rep_and_size, all_rep,
false); false, unchecked_union);
gnu_qual = choices_to_gnu (gnu_discriminant, gnu_qual = choices_to_gnu (gnu_discriminant,
Discrete_Choices (variant)); Discrete_Choices (variant));
Set_Present_Expr (variant, annotate_value (gnu_qual)); Set_Present_Expr (variant, annotate_value (gnu_qual));
gnu_field = create_field_decl (gnu_inner_name, gnu_variant_type,
gnu_union_type, 0,
(all_rep_and_size
? TYPE_SIZE (gnu_record_type) : 0),
(all_rep_and_size
? bitsize_zero_node : 0),
0);
DECL_INTERNAL_P (gnu_field) = 1; /* If this is an Unchecked_Union and we have exactly one field,
DECL_QUALIFIER (gnu_field) = gnu_qual; use that field here. */
if (unchecked_union && TYPE_FIELDS (gnu_variant_type)
&& !TREE_CHAIN (TYPE_FIELDS (gnu_variant_type)))
gnu_field = TYPE_FIELDS (gnu_variant_type);
else
{
gnu_field = create_field_decl (gnu_inner_name, gnu_variant_type,
gnu_union_type, 0,
(all_rep_and_size
? TYPE_SIZE (gnu_record_type)
: 0),
(all_rep_and_size
? bitsize_zero_node : 0),
0);
DECL_INTERNAL_P (gnu_field) = 1;
if (!unchecked_union)
DECL_QUALIFIER (gnu_field) = gnu_qual;
}
TREE_CHAIN (gnu_field) = gnu_variant_list; TREE_CHAIN (gnu_field) = gnu_variant_list;
gnu_variant_list = gnu_field; gnu_variant_list = gnu_field;
} }
/* We use to delete the empty variants from the end. However, /* We used to delete the empty variants from the end. However,
we no longer do that because we need them to generate complete we no longer do that because we need them to generate complete
debugging information for the variant record. Otherwise, debugging information for the variant record. Otherwise,
the union type definition will be missing the fields associated the union type definition will be missing the fields associated
...@@ -5646,6 +5713,15 @@ components_to_record (tree gnu_record_type, Node_Id component_list, ...@@ -5646,6 +5713,15 @@ components_to_record (tree gnu_record_type, Node_Id component_list,
finish_record_type (gnu_union_type, nreverse (gnu_variant_list), finish_record_type (gnu_union_type, nreverse (gnu_variant_list),
all_rep_and_size, false); all_rep_and_size, false);
/* If GNU_UNION_TYPE is our record type, it means we must have an
Unchecked_Union with no fields. Verify that and, if so, just
return. */
if (gnu_union_type == gnu_record_type)
{
gcc_assert (!gnu_field_list && unchecked_union);
return;
}
gnu_union_field gnu_union_field
= create_field_decl (gnu_var_name, gnu_union_type, gnu_record_type, = create_field_decl (gnu_var_name, gnu_union_type, gnu_record_type,
packed, packed,
......
gcc/ada/gigi.h
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
* * * *
* C Header File * * C Header File *
* * * *
* Copyright (C) 1992-2005 Free Software Foundation, Inc. * * Copyright (C) 1992-2006 Free Software Foundation, Inc. *
* * * *
* GNAT is free software; you can redistribute it and/or modify it under * * 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- * * terms of the GNU General Public License as published by the Free Soft- *
...@@ -680,6 +680,10 @@ extern tree get_ada_base_type (tree type); ...@@ -680,6 +680,10 @@ extern tree get_ada_base_type (tree type);
in bits. If we don't know anything about the alignment, return 0. */ in bits. If we don't know anything about the alignment, return 0. */
extern unsigned int known_alignment (tree exp); extern unsigned int known_alignment (tree exp);
/* Return true if VALUE is a multiple of FACTOR. FACTOR must be a power
of 2. */
extern bool value_factor_p (tree value, HOST_WIDE_INT factor);
/* Make a binary operation of kind OP_CODE. RESULT_TYPE is the type /* Make a binary operation of kind OP_CODE. RESULT_TYPE is the type
desired for the result. Usually the operation is to be performed desired for the result. Usually the operation is to be performed
in that type. For MODIFY_EXPR and ARRAY_REF, RESULT_TYPE may be 0 in that type. For MODIFY_EXPR and ARRAY_REF, RESULT_TYPE may be 0
......
gcc/ada/trans.c
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
* * * *
* C Implementation File * * C Implementation File *
* * * *
* Copyright (C) 1992-2005, Free Software Foundation, Inc. * * Copyright (C) 1992-2006, Free Software Foundation, Inc. *
* * * *
* GNAT is free software; you can redistribute it and/or modify it under * * 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- * * terms of the GNU General Public License as published by the Free Soft- *
...@@ -57,6 +57,12 @@ ...@@ -57,6 +57,12 @@
#include "ada-tree.h" #include "ada-tree.h"
#include "gigi.h" #include "gigi.h"
/* Let code below know whether we are targetting VMS without need of
intrusive preprocessor directives. */
#ifndef TARGET_ABI_OPEN_VMS
#define TARGET_ABI_OPEN_VMS 0
#endif
int max_gnat_nodes; int max_gnat_nodes;
int number_names; int number_names;
struct Node *Nodes_Ptr; struct Node *Nodes_Ptr;
...@@ -159,7 +165,7 @@ static tree emit_index_check (tree, tree, tree, tree); ...@@ -159,7 +165,7 @@ static tree emit_index_check (tree, tree, tree, tree);
static tree emit_check (tree, tree, int); static tree emit_check (tree, tree, int);
static tree convert_with_check (Entity_Id, tree, bool, bool, bool); static tree convert_with_check (Entity_Id, tree, bool, bool, bool);
static bool addressable_p (tree); static bool addressable_p (tree);
static tree assoc_to_constructor (Node_Id, tree); static tree assoc_to_constructor (Entity_Id, Node_Id, tree);
static tree extract_values (tree, tree); static tree extract_values (tree, tree);
static tree pos_to_constructor (Node_Id, tree, Entity_Id); static tree pos_to_constructor (Node_Id, tree, Entity_Id);
static tree maybe_implicit_deref (tree); static tree maybe_implicit_deref (tree);
...@@ -446,7 +452,18 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) ...@@ -446,7 +452,18 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
== Attr_Unchecked_Access) == Attr_Unchecked_Access)
|| (Get_Attribute_Id (Attribute_Name (gnat_temp)) || (Get_Attribute_Id (Attribute_Name (gnat_temp))
== Attr_Unrestricted_Access))))) == Attr_Unrestricted_Access)))))
gnu_result = DECL_INITIAL (gnu_result); {
gnu_result = DECL_INITIAL (gnu_result);
/* ??? The mark/unmark mechanism implemented in Gigi to prevent tree
sharing between global level and subprogram level doesn't apply
to elaboration routines. As a result, the DECL_INITIAL tree may
be shared between the static initializer of a global object and
the elaboration routine, thus wreaking havoc if a local temporary
is created in place during gimplification of the latter and the
former is emitted afterwards. Manually unshare for now. */
if (TREE_VISITED (gnu_result))
gnu_result = unshare_expr (gnu_result);
}
} }
*gnu_result_type_p = gnu_result_type; *gnu_result_type_p = gnu_result_type;
...@@ -1340,6 +1357,57 @@ Loop_Statement_to_gnu (Node_Id gnat_node) ...@@ -1340,6 +1357,57 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
return gnu_result; return gnu_result;
} }
/* Emit statements to establish __gnat_handle_vms_condition as a VMS condition
handler for the current function. */
/* This is implemented by issuing a call to the appropriate VMS specific
builtin. To avoid having VMS specific sections in the global gigi decls
array, we maintain the decls of interest here. We can't declare them
inside the function because we must mark them never to be GC'd, which we
can only do at the global level. */
static GTY(()) tree vms_builtin_establish_handler_decl = NULL_TREE;
static GTY(()) tree gnat_vms_condition_handler_decl = NULL_TREE;
static void
establish_gnat_vms_condition_handler (void)
{
tree establish_stmt;
/* Elaborate the required decls on the first call. Check on the decl for
the gnat condition handler to decide, as this is one we create so we are
sure that it will be non null on subsequent calls. The builtin decl is
looked up so remains null on targets where it is not implemented yet. */
if (gnat_vms_condition_handler_decl == NULL_TREE)
{
vms_builtin_establish_handler_decl
= builtin_decl_for
(get_identifier ("__builtin_establish_vms_condition_handler"));
gnat_vms_condition_handler_decl
= create_subprog_decl (get_identifier ("__gnat_handle_vms_condition"),
NULL_TREE,
build_function_type_list (integer_type_node,
ptr_void_type_node,
ptr_void_type_node,
NULL_TREE),
NULL_TREE, 0, 1, 1, 0, Empty);
}
/* Do nothing if the establish builtin is not available, which might happen
on targets where the facility is not implemented. */
if (vms_builtin_establish_handler_decl == NULL_TREE)
return;
establish_stmt
= build_call_1_expr (vms_builtin_establish_handler_decl,
build_unary_op
(ADDR_EXPR, NULL_TREE,
gnat_vms_condition_handler_decl));
add_stmt (establish_stmt);
}
/* Subroutine of gnat_to_gnu to process gnat_node, an N_Subprogram_Body. We /* Subroutine of gnat_to_gnu to process gnat_node, an N_Subprogram_Body. We
don't return anything. */ don't return anything. */
...@@ -1433,6 +1501,22 @@ Subprogram_Body_to_gnu (Node_Id gnat_node) ...@@ -1433,6 +1501,22 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
gnat_to_gnu_entity (gnat_param, NULL_TREE, 1)); gnat_to_gnu_entity (gnat_param, NULL_TREE, 1));
} }
/* On VMS, establish our condition handler to possibly turn a condition into
the corresponding exception if the subprogram has a foreign convention or
is exported.
To ensure proper execution of local finalizations on condition instances,
we must turn a condition into the corresponding exception even if there
is no applicable Ada handler, and need at least one condition handler per
possible call chain involving GNAT code. OTOH, establishing the handler
has a cost so we want to mimize the number of subprograms into which this
happens. The foreign or exported condition is expected to satisfy all
the constraints. */
if (TARGET_ABI_OPEN_VMS
&& (Has_Foreign_Convention (gnat_node) || Is_Exported (gnat_node)))
establish_gnat_vms_condition_handler ();
process_decls (Declarations (gnat_node), Empty, Empty, true, true); process_decls (Declarations (gnat_node), Empty, Empty, true, true);
/* Generate the code of the subprogram itself. A return statement will be /* Generate the code of the subprogram itself. A return statement will be
...@@ -3082,25 +3166,11 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -3082,25 +3166,11 @@ gnat_to_gnu (Node_Id gnat_node)
if (Null_Record_Present (gnat_node)) if (Null_Record_Present (gnat_node))
gnu_result = gnat_build_constructor (gnu_aggr_type, NULL_TREE); gnu_result = gnat_build_constructor (gnu_aggr_type, NULL_TREE);
else if (TREE_CODE (gnu_aggr_type) == UNION_TYPE
&& TYPE_UNCHECKED_UNION_P (gnu_aggr_type))
{
/* The first element is the discrimant, which we ignore. The
next is the field we're building. Convert the expression
to the type of the field and then to the union type. */
Node_Id gnat_assoc
= Next (First (Component_Associations (gnat_node)));
Entity_Id gnat_field = Entity (First (Choices (gnat_assoc)));
tree gnu_field_type
= TREE_TYPE (gnat_to_gnu_entity (gnat_field, NULL_TREE, 0));
gnu_result = convert (gnu_field_type,
gnat_to_gnu (Expression (gnat_assoc)));
}
else if (TREE_CODE (gnu_aggr_type) == RECORD_TYPE else if (TREE_CODE (gnu_aggr_type) == RECORD_TYPE
|| TREE_CODE (gnu_aggr_type) == UNION_TYPE) || TREE_CODE (gnu_aggr_type) == UNION_TYPE)
gnu_result gnu_result
= assoc_to_constructor (First (Component_Associations (gnat_node)), = assoc_to_constructor (Etype (gnat_node),
First (Component_Associations (gnat_node)),
gnu_aggr_type); gnu_aggr_type);
else if (TREE_CODE (gnu_aggr_type) == ARRAY_TYPE) else if (TREE_CODE (gnu_aggr_type) == ARRAY_TYPE)
gnu_result = pos_to_constructor (First (Expressions (gnat_node)), gnu_result = pos_to_constructor (First (Expressions (gnat_node)),
...@@ -3996,7 +4066,8 @@ gnat_to_gnu (Node_Id gnat_node) ...@@ -3996,7 +4066,8 @@ gnat_to_gnu (Node_Id gnat_node)
if (Present (Actual_Designated_Subtype (gnat_node))) if (Present (Actual_Designated_Subtype (gnat_node)))
{ {
gnu_actual_obj_type = gnat_to_gnu_type (Actual_Designated_Subtype (gnat_node)); gnu_actual_obj_type
= gnat_to_gnu_type (Actual_Designated_Subtype (gnat_node));
if (TYPE_FAT_OR_THIN_POINTER_P (gnu_ptr_type)) if (TYPE_FAT_OR_THIN_POINTER_P (gnu_ptr_type))
gnu_actual_obj_type gnu_actual_obj_type
...@@ -5582,13 +5653,14 @@ process_type (Entity_Id gnat_entity) ...@@ -5582,13 +5653,14 @@ process_type (Entity_Id gnat_entity)
} }
} }
/* GNAT_ASSOC is the front of the Component_Associations of an N_Aggregate. /* GNAT_ENTITY is the type of the resulting constructors,
GNU_TYPE is the GCC type of the corresponding record. GNAT_ASSOC is the front of the Component_Associations of an N_Aggregate,
and GNU_TYPE is the GCC type of the corresponding record.
Return a CONSTRUCTOR to build the record. */ Return a CONSTRUCTOR to build the record. */
static tree static tree
assoc_to_constructor (Node_Id gnat_assoc, tree gnu_type) assoc_to_constructor (Entity_Id gnat_entity, Node_Id gnat_assoc, tree gnu_type)
{ {
tree gnu_list, gnu_result; tree gnu_list, gnu_result;
...@@ -5614,6 +5686,11 @@ assoc_to_constructor (Node_Id gnat_assoc, tree gnu_type) ...@@ -5614,6 +5686,11 @@ assoc_to_constructor (Node_Id gnat_assoc, tree gnu_type)
&& Is_Tagged_Type (Scope (Entity (gnat_field)))) && Is_Tagged_Type (Scope (Entity (gnat_field))))
continue; continue;
/* Also ignore discriminants of Unchecked_Unions. */
else if (Is_Unchecked_Union (gnat_entity)
&& Ekind (Entity (gnat_field)) == E_Discriminant)
continue;
/* Before assigning a value in an aggregate make sure range checks /* Before assigning a value in an aggregate make sure range checks
are done if required. Then convert to the type of the field. */ are done if required. Then convert to the type of the field. */
if (Do_Range_Check (Expression (gnat_assoc))) if (Do_Range_Check (Expression (gnat_assoc)))
......
gcc/ada/utils.c
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
* * * *
* C Implementation File * * C Implementation File *
* * * *
* Copyright (C) 1992-2005, Free Software Foundation, Inc. * * Copyright (C) 1992-2006, Free Software Foundation, Inc. *
* * * *
* GNAT is free software; you can redistribute it and/or modify it under * * 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- * * terms of the GNU General Public License as published by the Free Soft- *
...@@ -133,7 +133,6 @@ static tree float_type_for_precision (int, enum machine_mode); ...@@ -133,7 +133,6 @@ static tree float_type_for_precision (int, enum machine_mode);
static tree convert_to_fat_pointer (tree, tree); static tree convert_to_fat_pointer (tree, tree);
static tree convert_to_thin_pointer (tree, tree); static tree convert_to_thin_pointer (tree, tree);
static tree make_descriptor_field (const char *,tree, tree, tree); static tree make_descriptor_field (const char *,tree, tree, tree);
static bool value_factor_p (tree, HOST_WIDE_INT);
static bool potential_alignment_gap (tree, tree, tree); static bool potential_alignment_gap (tree, tree, tree);
/* Initialize the association of GNAT nodes to GCC trees. */ /* Initialize the association of GNAT nodes to GCC trees. */
...@@ -1215,9 +1214,10 @@ create_type_decl (tree type_name, tree type, struct attrib *attr_list, ...@@ -1215,9 +1214,10 @@ create_type_decl (tree type_name, tree type, struct attrib *attr_list,
/* Pass type declaration information to the debugger unless this is an /* Pass type declaration information to the debugger unless this is an
UNCONSTRAINED_ARRAY_TYPE, which the debugger does not support, UNCONSTRAINED_ARRAY_TYPE, which the debugger does not support,
and ENUMERAL_TYPE or RECORD_TYPE which is handled separately, and ENUMERAL_TYPE or RECORD_TYPE which is handled separately, or
a dummy type, which will be completed later, or a type for which type for which debugging information was not requested. */
debugging information was not requested. */ if (code == UNCONSTRAINED_ARRAY_TYPE || ! debug_info_p)
DECL_IGNORED_P (type_decl) = 1;
if (code == UNCONSTRAINED_ARRAY_TYPE || TYPE_IS_DUMMY_P (type) if (code == UNCONSTRAINED_ARRAY_TYPE || TYPE_IS_DUMMY_P (type)
|| !debug_info_p) || !debug_info_p)
DECL_IGNORED_P (type_decl) = 1; DECL_IGNORED_P (type_decl) = 1;
...@@ -1573,7 +1573,7 @@ process_attributes (tree decl, struct attrib *attr_list) ...@@ -1573,7 +1573,7 @@ process_attributes (tree decl, struct attrib *attr_list)
/* Return true if VALUE is a known to be a multiple of FACTOR, which must be /* Return true if VALUE is a known to be a multiple of FACTOR, which must be
a power of 2. */ a power of 2. */
static bool bool
value_factor_p (tree value, HOST_WIDE_INT factor) value_factor_p (tree value, HOST_WIDE_INT factor)
{ {
if (host_integerp (value, 1)) if (host_integerp (value, 1))
...@@ -2471,7 +2471,8 @@ build_unc_object_type (tree template_type, tree object_type, tree name) ...@@ -2471,7 +2471,8 @@ build_unc_object_type (tree template_type, tree object_type, tree name)
/* Same, taking a thin or fat pointer type instead of a template type. */ /* Same, taking a thin or fat pointer type instead of a template type. */
tree tree
build_unc_object_type_from_ptr (tree thin_fat_ptr_type, tree object_type, tree name) build_unc_object_type_from_ptr (tree thin_fat_ptr_type, tree object_type,
tree name)
{ {
tree template_type; tree template_type;
...@@ -2592,7 +2593,13 @@ update_pointer_to (tree old_type, tree new_type) ...@@ -2592,7 +2593,13 @@ update_pointer_to (tree old_type, tree new_type)
TREE_CHAIN (TYPE_FIELDS (ptr)), new_ref)); TREE_CHAIN (TYPE_FIELDS (ptr)), new_ref));
for (var = TYPE_MAIN_VARIANT (ptr); var; var = TYPE_NEXT_VARIANT (var)) for (var = TYPE_MAIN_VARIANT (ptr); var; var = TYPE_NEXT_VARIANT (var))
SET_TYPE_UNCONSTRAINED_ARRAY (var, new_type); {
SET_TYPE_UNCONSTRAINED_ARRAY (var, new_type);
/* This may seem a bit gross, in particular wrt DECL_CONTEXT, but
actually is in keeping with what build_qualified_type does. */
TYPE_FIELDS (var) = TYPE_FIELDS (ptr);
}
TYPE_POINTER_TO (new_type) = TYPE_REFERENCE_TO (new_type) TYPE_POINTER_TO (new_type) = TYPE_REFERENCE_TO (new_type)
= TREE_TYPE (new_type) = ptr; = TREE_TYPE (new_type) = ptr;
...@@ -2722,7 +2729,6 @@ convert (tree type, tree expr) ...@@ -2722,7 +2729,6 @@ convert (tree type, tree expr)
enum tree_code code = TREE_CODE (type); enum tree_code code = TREE_CODE (type);
tree etype = TREE_TYPE (expr); tree etype = TREE_TYPE (expr);
enum tree_code ecode = TREE_CODE (etype); enum tree_code ecode = TREE_CODE (etype);
tree tem;
/* If EXPR is already the right type, we are done. */ /* If EXPR is already the right type, we are done. */
if (type == etype) if (type == etype)
...@@ -2892,11 +2898,9 @@ convert (tree type, tree expr) ...@@ -2892,11 +2898,9 @@ convert (tree type, tree expr)
return build1 (VIEW_CONVERT_EXPR, type, op0); return build1 (VIEW_CONVERT_EXPR, type, op0);
/* Otherwise, we may just bypass the input view conversion unless /* Otherwise, we may just bypass the input view conversion unless
one of the types is a fat pointer, or we're converting to an one of the types is a fat pointer, which is handled by
unchecked union type. Both are handled by specialized code specialized code below which relies on exact type matching. */
below and the latter relies on exact type matching. */ else if (!TYPE_FAT_POINTER_P (type) && !TYPE_FAT_POINTER_P (etype))
else if (!TYPE_FAT_POINTER_P (type) && !TYPE_FAT_POINTER_P (etype)
&& !(code == UNION_TYPE && TYPE_UNCHECKED_UNION_P (type)))
return convert (type, op0); return convert (type, op0);
} }
} }
...@@ -3020,29 +3024,10 @@ convert (tree type, tree expr) ...@@ -3020,29 +3024,10 @@ convert (tree type, tree expr)
return unchecked_convert (type, expr, false); return unchecked_convert (type, expr, false);
case UNION_TYPE: case UNION_TYPE:
/* For unchecked unions, just validate that the type is indeed that of /* This is a either a conversion between a tagged type and some
a field of the type. Then make the simple conversion. */ subtype, which we have to mark as a UNION_TYPE because of
if (TYPE_UNCHECKED_UNION_P (type)) overlapping fields or a conversion of an Unchecked_Union. */
{ return unchecked_convert (type, expr, false);
for (tem = TYPE_FIELDS (type); tem; tem = TREE_CHAIN (tem))
{
if (TREE_TYPE (tem) == etype)
return build1 (CONVERT_EXPR, type, expr);
else if (TREE_CODE (TREE_TYPE (tem)) == RECORD_TYPE
&& (TYPE_JUSTIFIED_MODULAR_P (TREE_TYPE (tem))
|| TYPE_IS_PADDING_P (TREE_TYPE (tem)))
&& TREE_TYPE (TYPE_FIELDS (TREE_TYPE (tem))) == etype)
return build1 (CONVERT_EXPR, type,
convert (TREE_TYPE (tem), expr));
}
gcc_unreachable ();
}
else
/* Otherwise, this is a conversion between a tagged type and some
subtype, which we have to mark as a UNION_TYPE because of
overlapping fields. */
return unchecked_convert (type, expr, false);
case UNCONSTRAINED_ARRAY_TYPE: case UNCONSTRAINED_ARRAY_TYPE:
/* If EXPR is a constrained array, take its address, convert it to a /* If EXPR is a constrained array, take its address, convert it to a
......
gcc/ada/utils2.c
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
* * * *
* C Implementation File * * C Implementation File *
* * * *
* Copyright (C) 1992-2005, Free Software Foundation, Inc. * * Copyright (C) 1992-2006, Free Software Foundation, Inc. *
* * * *
* GNAT is free software; you can redistribute it and/or modify it under * * 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- * * terms of the GNU General Public License as published by the Free Soft- *
...@@ -232,8 +232,12 @@ find_common_type (tree t1, tree t2) ...@@ -232,8 +232,12 @@ find_common_type (tree t1, tree t2)
else if (TYPE_MODE (t2) != BLKmode) else if (TYPE_MODE (t2) != BLKmode)
return t2; return t2;
/* Otherwise, return the type that has a constant size. */ /* If both types have constant size, use the smaller one. */
if (TREE_CONSTANT (TYPE_SIZE (t1))) if (TREE_CONSTANT (TYPE_SIZE (t1)) && TREE_CONSTANT (TYPE_SIZE (t2)))
return tree_int_cst_lt (TYPE_SIZE (t1), TYPE_SIZE (t2)) ? t1 : t2;
/* Otherwise, if either type has a constant size, use it. */
else if (TREE_CONSTANT (TYPE_SIZE (t1)))
return t1; return t1;
else if (TREE_CONSTANT (TYPE_SIZE (t2))) else if (TREE_CONSTANT (TYPE_SIZE (t2)))
return t2; return t2;
...@@ -1617,7 +1621,8 @@ build_simple_component_ref (tree record_variable, tree component, ...@@ -1617,7 +1621,8 @@ build_simple_component_ref (tree record_variable, tree component,
for (new_field = TYPE_FIELDS (record_type); new_field; for (new_field = TYPE_FIELDS (record_type); new_field;
new_field = TREE_CHAIN (new_field)) new_field = TREE_CHAIN (new_field))
if (DECL_ORIGINAL_FIELD (new_field) == field if (field == new_field
|| DECL_ORIGINAL_FIELD (new_field) == field
|| new_field == DECL_ORIGINAL_FIELD (field) || new_field == DECL_ORIGINAL_FIELD (field)
|| (DECL_ORIGINAL_FIELD (field) || (DECL_ORIGINAL_FIELD (field)
&& (DECL_ORIGINAL_FIELD (field) && (DECL_ORIGINAL_FIELD (field)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment