diff options
author | Richard Kenner <kenner@vlsi1.ultra.nyu.edu> | 2006-02-15 10:31:40 +0100 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2006-02-15 10:31:40 +0100 |
commit | 5b47742c2d278f8f8a4b1e02c6e1f786340da38f (patch) | |
tree | 1fd44711246a1ea895cf60b81987968b22bb417e /gcc/ada/decl.c | |
parent | 0022d9e31d01f2a31808ff38f66dd3e3ac96927a (diff) | |
download | gcc-5b47742c2d278f8f8a4b1e02c6e1f786340da38f.zip gcc-5b47742c2d278f8f8a4b1e02c6e1f786340da38f.tar.gz gcc-5b47742c2d278f8f8a4b1e02c6e1f786340da38f.tar.bz2 |
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
Diffstat (limited to 'gcc/ada/decl.c')
-rw-r--r-- | gcc/ada/decl.c | 218 |
1 files changed, 147 insertions, 71 deletions
diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c index 3dd14f4..1a17c37 100644 --- a/gcc/ada/decl.c +++ b/gcc/ada/decl.c @@ -6,7 +6,7 @@ * * * 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 * * 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, static tree make_packable_type (tree); static tree gnat_to_gnu_field (Entity_Id, tree, int, bool); 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 Uint annotate_value (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) gnu_new_var = 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); if (gnu_expr) @@ -1416,6 +1416,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) 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, we need to have the bits left justified on big-endian targets 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) finish_record_type (gnu_type, gnu_field, false, false); TYPE_JUSTIFIED_MODULAR_P (gnu_type) = 1; SET_TYPE_ADA_SIZE (gnu_type, bitsize_int (esize)); + + copy_alias_set (gnu_type, gnu_field_type); } break; @@ -1516,6 +1523,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) } 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; @@ -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; } - /* Add the fields for the discriminants into the record. */ - if (!Is_Unchecked_Union (gnat_entity) - && Has_Discriminants (gnat_entity)) + /* Make the fields for the discriminants and put them into the record + unless it's an Unchecked_Union. */ + if (Has_Discriminants (gnat_entity)) for (gnat_field = First_Stored_Discriminant (gnat_entity); Present (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) gnu_field, NULL_TREE), true); - TREE_CHAIN (gnu_field) = gnu_field_list; - gnu_field_list = gnu_field; + if (!Is_Unchecked_Union (gnat_entity)) + { + TREE_CHAIN (gnu_field) = gnu_field_list; + gnu_field_list = gnu_field; + } } /* 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) /* Add the listed fields into the record and finish up. */ components_to_record (gnu_type, Component_List (record_definition), gnu_field_list, packed, definition, NULL, - false, all_rep, this_deferred); + false, all_rep, this_deferred, + Is_Unchecked_Union (gnat_entity)); if (this_deferred) { @@ -4479,6 +4494,7 @@ make_dummy_type (Entity_Id gnat_type) { Entity_Id gnat_underlying; tree gnu_type; + enum tree_code code; /* Find a full type for GNAT_TYPE, taking into account any class wide types. */ @@ -4498,17 +4514,31 @@ make_dummy_type (Entity_Id gnat_type) return dummy_node_table[gnat_underlying]; /* If this is a record, make this a RECORD_TYPE or UNION_TYPE; else make - it a VOID_TYPE. */ - if (Is_Unchecked_Union (gnat_underlying)) + it an ENUMERAL_TYPE. */ + if (Is_Record_Type (gnat_underlying)) { - gnu_type = make_node (UNION_TYPE); - TYPE_UNCHECKED_UNION_P (gnu_type) = 1; + Node_Id component_list + = 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 - gnu_type = make_node (ENUMERAL_TYPE); + code = ENUMERAL_TYPE; + gnu_type = make_node (code); TYPE_NAME (gnu_type) = get_entity_name (gnat_type); TYPE_DUMMY_P (gnu_type) = 1; if (AGGREGATE_TYPE_P (gnu_type)) @@ -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, gnat_field, FIELD_DECL, false, true); - /* If we are packing this record, have a specified size that's smaller than - that of the field type, or a position is specified, and the field type is - also a record that's BLKmode and with a small constant size, see if we - can get a better form of the type that allows more packing. If we can, - show a size was specified for it if there wasn't one so we know to make - this a bitfield and avoid making things wider. */ + /* If we have a specified size that's smaller than that of the field type, + or a position is specified, and the field type is also a record that's + BLKmode and with a small constant size, see if we can get an integral + mode form of the type when appropriate. If we can, show a size was + specified for the field if there wasn't one already, so we know to make + 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 && TYPE_MODE (gnu_field_type) == BLKmode && 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, && (packed == 1 || (gnu_size && 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. */ 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. */ int reject = /* There is no point substituting if there is no change. */ (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 type's alignment, which the substitution might increase. Reject substitutions that would so invalidate a component clause when the specified position is byte aligned, as the change would have no real benefit from the packing standpoint anyway. */ (Is_Aliased (gnat_field) - && Present (Component_Clause (gnat_field)) - && UI_To_Int (Component_Bit_Offset (gnat_field)) % BITS_PER_UNIT == 0 - && tree_low_cst (gnu_size, 1) % TYPE_ALIGN (gnu_packable_type) != 0) - ); + && has_byte_aligned_clause + && ! value_factor_p (gnu_size, TYPE_ALIGN (gnu_packable_type))) + ); /* Substitute unless told otherwise. */ if (!reject) @@ -5477,6 +5534,9 @@ is_variable_size (tree type) DEFER_DEBUG, if true, means that the debugging routines should not be 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 fields of the record and then the record type is finished. */ @@ -5484,12 +5544,11 @@ static void components_to_record (tree gnu_record_type, Node_Id component_list, tree gnu_field_list, int packed, bool definition, 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; Entity_Id gnat_field; Node_Id variant_part; - Node_Id variant; tree gnu_our_rep_list = NULL_TREE; tree gnu_field, gnu_last; bool layout_with_rep = false; @@ -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. */ 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 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 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. */ - else if (Present (variant_part)) + lists for the variants and put them all into the QUAL_UNION_TYPE. + 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)); 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_var_name - = concat_id_with_name - (get_identifier (Get_Name_String (Chars (Name (variant_part)))), - "XVN"); + = concat_id_with_name (get_identifier (Get_Name_String + (Chars (Name (variant_part)))), + "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) gnu_name = DECL_NAME (gnu_name); - TYPE_NAME (gnu_union_type) - = concat_id_with_name (gnu_name, IDENTIFIER_POINTER (gnu_var_name)); - TYPE_PACKED (gnu_union_type) = TYPE_PACKED (gnu_record_type); + gnu_union_name = concat_id_with_name (gnu_name, + IDENTIFIER_POINTER (gnu_var_name)); + + 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)); Present (variant); @@ -5585,7 +5639,7 @@ components_to_record (tree gnu_record_type, Node_Id component_list, Get_Variant_Encoding (variant); gnu_inner_name = get_identifier (Name_Buffer); 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)); /* 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, components_to_record (gnu_variant_type, Component_List (variant), NULL_TREE, packed, definition, &gnu_our_rep_list, !all_rep_and_size, all_rep, - false); + false, unchecked_union); gnu_qual = choices_to_gnu (gnu_discriminant, Discrete_Choices (variant)); 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; - DECL_QUALIFIER (gnu_field) = gnu_qual; + /* If this is an Unchecked_Union and we have exactly one field, + 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; 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 debugging information for the variant record. Otherwise, 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, finish_record_type (gnu_union_type, nreverse (gnu_variant_list), 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 = create_field_decl (gnu_var_name, gnu_union_type, gnu_record_type, packed, |