diff options
Diffstat (limited to 'gcc/ada/decl.c')
| -rw-r--r-- | gcc/ada/decl.c | 263 |
1 files changed, 154 insertions, 109 deletions
diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c index 6edda45..098d485 100644 --- a/gcc/ada/decl.c +++ b/gcc/ada/decl.c @@ -80,6 +80,12 @@ static struct incomplete Entity_Id full_type; } *defer_incomplete_list = 0; +/* These two variables are used to defer emission of debug information for + nested incomplete record types */ + +static int defer_debug_level = 0; +static tree defer_debug_incomplete_list; + static void copy_alias_set (tree, tree); static tree substitution_list (Entity_Id, Entity_Id, tree, bool); static bool allocatable_size_p (tree, bool); @@ -91,7 +97,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); static int compare_field_bitpos (const PTR, const PTR); static Uint annotate_value (tree); static void annotate_rep (Entity_Id, tree); @@ -151,6 +157,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) bool saved = false; /* Nonzero if we incremented defer_incomplete_level. */ bool this_deferred = false; + /* Nonzero if we incremented defer_debug_level. */ + bool debug_deferred = false; /* Nonzero if we incremented force_global. */ bool this_global = false; /* Nonzero if we should check to see if elaborated during processing. */ @@ -390,11 +398,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) stored discriminant. Also use Original_Record_Component if the record has a private extension. */ - if ((Base_Type (gnat_record) == gnat_record - || Ekind (Scope (gnat_entity)) == E_Private_Subtype - || Ekind (Scope (gnat_entity)) == E_Record_Subtype_With_Private - || Ekind (Scope (gnat_entity)) == E_Record_Type_With_Private) - && Present (Original_Record_Component (gnat_entity)) + if (Present (Original_Record_Component (gnat_entity)) && Original_Record_Component (gnat_entity) != gnat_entity) { gnu_decl @@ -1011,6 +1015,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) const_flag = true; } + if (const_flag) + gnu_type = build_qualified_type (gnu_type, (TYPE_QUALS (gnu_type) + | TYPE_QUAL_CONST)); + /* Convert the expression to the type of the object except in the case where the object's type is unconstrained or the object's type is a padded record whose field is of self-referential size. In @@ -1038,14 +1046,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) || Is_Exported (gnat_entity))))) gnu_ext_name = create_concat_name (gnat_entity, 0); - if (const_flag) - { - gnu_type = build_qualified_type (gnu_type, (TYPE_QUALS (gnu_type) - | TYPE_QUAL_CONST)); - if (gnu_expr) - gnu_expr = convert (gnu_type, gnu_expr); - } - /* If this is constant initialized to a static constant and the object has an aggregrate type, force it to be statically allocated. */ @@ -1113,7 +1113,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Back-annotate the Alignment of the object if not already in the tree. Likewise for Esize if the object is of a constant size. But if the "object" is actually a pointer to an object, the - alignment and size are the same as teh type, so don't back-annotate + alignment and size are the same as the type, so don't back-annotate the values for the pointer. */ if (!used_by_ref && Unknown_Alignment (gnat_entity)) Set_Alignment (gnat_entity, @@ -2221,6 +2221,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_type = build_array_type (gnat_to_gnu_type (Component_Type (gnat_entity)), gnu_index_type); + copy_alias_set (gnu_type, gnu_string_type); } break; @@ -2355,7 +2356,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) else if (Is_Atomic (gnat_entity)) TYPE_ALIGN (gnu_type) = (esize >= BITS_PER_WORD ? BITS_PER_WORD - : 1 << ((floor_log2 (esize) - 1) + 1)); + : 1 << (floor_log2 (esize - 1) + 1)); /* If we have a Parent_Subtype, make a field for the parent. If this record has rep clauses, force the position to zero. */ @@ -2387,9 +2388,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) build3 (COMPONENT_REF, get_unpadded_type (Etype (gnat_field)), gnu_get_parent, - gnat_to_gnu_entity (Corresponding_Discriminant - (gnat_field), - NULL_TREE, 0), + gnat_to_gnu_field_decl (Corresponding_Discriminant + (gnat_field)), NULL_TREE), true); @@ -2447,32 +2447,25 @@ 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); + false, all_rep, this_deferred); + + if (this_deferred) + { + debug_deferred = true; + defer_debug_level++; + + defer_debug_incomplete_list + = tree_cons (NULL_TREE, gnu_type, + defer_debug_incomplete_list); + } + + /* We used to remove the associations of the discriminants and + _Parent for validity checking, but we may need them if there's + Freeze_Node for a subtype used in this record. */ TYPE_VOLATILE (gnu_type) = Treat_As_Volatile (gnat_entity); TYPE_BY_REFERENCE_P (gnu_type) = Is_By_Reference_Type (gnat_entity); - /* If this is an extension type, reset the tree for any - inherited discriminants. Also remove the PLACEHOLDER_EXPR - for non-inherited discriminants. */ - if (!Is_Unchecked_Union (gnat_entity) - && Has_Discriminants (gnat_entity)) - for (gnat_field = First_Stored_Discriminant (gnat_entity); - Present (gnat_field); - gnat_field = Next_Stored_Discriminant (gnat_field)) - { - if (Present (Parent_Subtype (gnat_entity)) - && Present (Corresponding_Discriminant (gnat_field))) - save_gnu_tree (gnat_field, NULL_TREE, false); - else - { - gnu_field = get_gnu_tree (gnat_field); - save_gnu_tree (gnat_field, NULL_TREE, false); - save_gnu_tree (gnat_field, TREE_OPERAND (gnu_field, 1), - false); - } - } - /* If it is a tagged record force the type to BLKmode to insure that these objects will always be placed in memory. Do the same thing for limited record types. */ @@ -2581,7 +2574,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && Present (Discriminant_Constraint (gnat_entity))) { Entity_Id gnat_field; - Entity_Id gnat_root_type; tree gnu_field_list = 0; tree gnu_pos_list = compute_field_positions (gnu_orig_type, NULL_TREE, @@ -2590,41 +2582,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) tree gnu_subst_list = substitution_list (gnat_entity, gnat_base_type, NULL_TREE, definition); - bool possibly_overlapping_fields = false; tree gnu_temp; - /* If this is a derived type, we may be seeing fields from any - original records, so add those positions and discriminant - substitutions to our lists. */ - for (gnat_root_type = gnat_base_type; - Underlying_Type (Etype (gnat_root_type)) != gnat_root_type; - gnat_root_type = Underlying_Type (Etype (gnat_root_type))) - { - gnu_pos_list - = compute_field_positions - (gnat_to_gnu_type (Etype (gnat_root_type)), - gnu_pos_list, size_zero_node, bitsize_zero_node, - BIGGEST_ALIGNMENT); - - if (Present (Parent_Subtype (gnat_root_type))) - { - gnu_subst_list - = substitution_list (Parent_Subtype (gnat_root_type), - Empty, gnu_subst_list, - definition); - - /* If there's a _Parent field, it may overlap the - fields we have that appear to be in this record but - actually are from the parent. So make note of that - fact and later we'll make a UNION_TYPE instead of - a RECORD_TYPE, since the latter may not have - overlapping fields. */ - possibly_overlapping_fields = true; - } - } - - gnu_type = make_node (possibly_overlapping_fields - ? UNION_TYPE : RECORD_TYPE); + gnu_type = make_node (RECORD_TYPE); TYPE_NAME (gnu_type) = gnu_entity_id; TYPE_STUB_DECL (gnu_type) = create_type_decl (NULL_TREE, gnu_type, NULL, false, false, @@ -2633,12 +2593,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) for (gnat_field = First_Entity (gnat_entity); Present (gnat_field); gnat_field = Next_Entity (gnat_field)) - if (Ekind (gnat_field) == E_Component - || Ekind (gnat_field) == E_Discriminant) + if ((Ekind (gnat_field) == E_Component + || Ekind (gnat_field) == E_Discriminant) + && (Underlying_Type (Scope (Original_Record_Component + (gnat_field))) + == gnat_base_type) + && (No (Corresponding_Discriminant (gnat_field)) + || !Is_Tagged_Type (gnat_base_type))) { tree gnu_old_field - = gnat_to_gnu_entity - (Original_Record_Component (gnat_field), NULL_TREE, 0); + = gnat_to_gnu_field_decl (Original_Record_Component + (gnat_field)); tree gnu_offset = TREE_VALUE (purpose_member (gnu_old_field, gnu_pos_list)); @@ -2728,6 +2693,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) save_gnu_tree (gnat_field, gnu_field, false); } + /* Now go through the entities again looking for Itypes that + we have not elaborated but should (e.g., Etypes of fields + that have Original_Components). */ + for (gnat_field = First_Entity (gnat_entity); + Present (gnat_field); gnat_field = Next_Entity (gnat_field)) + if ((Ekind (gnat_field) == E_Discriminant + || Ekind (gnat_field) == E_Component) + && !present_gnu_tree (Etype (gnat_field))) + gnat_to_gnu_entity (Etype (gnat_field), NULL_TREE, 0); + finish_record_type (gnu_type, nreverse (gnu_field_list), true, false); @@ -2812,7 +2787,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && !Is_Unchecked_Union (gnat_base_type)) || Ekind (gnat_temp) == E_Component) save_gnu_tree (gnat_temp, - get_gnu_tree + gnat_to_gnu_field_decl (Original_Record_Component (gnat_temp)), false); } break; @@ -3633,8 +3608,24 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) stubbed since structures are incomplete for the back-end. */ if (gnu_field_list && Convention (gnat_entity) != Convention_Stubbed) - finish_record_type (gnu_return_type, nreverse (gnu_field_list), - false, false); + { + /* If all types are not complete, defer emission of debug + information for this record types. Otherwise, we risk emitting + debug information for a dummy type contained in the fields + for that record. */ + finish_record_type (gnu_return_type, nreverse (gnu_field_list), + false, defer_incomplete_level); + + if (defer_incomplete_level) + { + debug_deferred = true; + defer_debug_level++; + + defer_debug_incomplete_list + = tree_cons (NULL_TREE, gnu_return_type, + defer_debug_incomplete_list); + } + } /* If we have a CICO list but it has only one entry, we convert this function into a function that simply returns that one @@ -3739,7 +3730,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) else if (kind == E_Subprogram_Type) gnu_decl = create_type_decl (gnu_entity_id, gnu_type, attr_list, !Comes_From_Source (gnat_entity), - debug_info_p, gnat_entity); + debug_info_p && !defer_incomplete_level, + gnat_entity); else { gnu_decl = create_subprog_decl (gnu_entity_id, gnu_ext_name, @@ -4165,6 +4157,31 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) } } + /* If there are no incomplete types and we have deferred emission + of debug information, check whether we have finished defining + all nested records. + If so, handle the list now. */ + + if (debug_deferred) + defer_debug_level--; + + if (defer_debug_incomplete_list + && !defer_incomplete_level + && !defer_debug_level) + { + tree c, n; + + defer_debug_incomplete_list = nreverse (defer_debug_incomplete_list); + + for (c = defer_debug_incomplete_list; c; c = n) + { + n = TREE_CHAIN (c); + write_record_type_debug_info (TREE_VALUE (c)); + } + + defer_debug_incomplete_list = 0; + } + if (this_global) force_global--; @@ -4176,6 +4193,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) return gnu_decl; } + +/* Similar, but if the returned value is a COMPONENT_REF, return the + FIELD_DECL. */ + +tree +gnat_to_gnu_field_decl (Entity_Id gnat_entity) +{ + tree gnu_field = gnat_to_gnu_entity (gnat_entity, NULL_TREE, 0); + + if (TREE_CODE (gnu_field) == COMPONENT_REF) + gnu_field = TREE_OPERAND (gnu_field, 1); + + return gnu_field; +} /* Given GNAT_ENTITY, elaborate all expressions that are required to be elaborated at the point of its definition, but do nothing else. */ @@ -4292,19 +4323,26 @@ mark_out_of_scope (Entity_Id gnat_entity) static void copy_alias_set (tree gnu_new_type, tree gnu_old_type) { + /* Remove any padding from GNU_OLD_TYPE. It doesn't matter in the case + of a one-dimensional array, since the padding has the same alias set + as the field type, but if it's a multi-dimensional array, we need to + see the inner types. */ + while (TREE_CODE (gnu_old_type) == RECORD_TYPE + && (TYPE_JUSTIFIED_MODULAR_P (gnu_old_type) + || TYPE_IS_PADDING_P (gnu_old_type))) + gnu_old_type = TREE_TYPE (TYPE_FIELDS (gnu_old_type)); + + /* We need to be careful here in case GNU_OLD_TYPE is an unconstrained + array. In that case, it doesn't have the same shape as GNU_NEW_TYPE, + so we need to go down to what does. */ + if (TREE_CODE (gnu_old_type) == UNCONSTRAINED_ARRAY_TYPE) + gnu_old_type + = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_old_type)))); + if (TREE_CODE (gnu_new_type) == ARRAY_TYPE && TREE_CODE (TREE_TYPE (gnu_new_type)) == ARRAY_TYPE && TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_new_type))) - { - /* We need to be careful here in case GNU_OLD_TYPE is an unconstrained - array. In that case, it doesn't have the same shape as GNU_NEW_TYPE, - so we need to go down to what does. */ - if (TREE_CODE (gnu_old_type) == UNCONSTRAINED_ARRAY_TYPE) - gnu_old_type - = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_old_type)))); - - copy_alias_set (TREE_TYPE (gnu_new_type), TREE_TYPE (gnu_old_type)); - } + copy_alias_set (TREE_TYPE (gnu_new_type), TREE_TYPE (gnu_old_type)); TYPE_ALIAS_SET (gnu_new_type) = get_alias_set (gnu_old_type); record_component_aliases (gnu_new_type); @@ -4336,8 +4374,8 @@ substitution_list (Entity_Id gnat_subtype, Entity_Id gnat_type, gnat_value = Next_Elmt (gnat_value)) /* Ignore access discriminants. */ if (!Is_Access_Type (Etype (Node (gnat_value)))) - gnu_list = tree_cons (gnat_to_gnu_entity (gnat_discrim, NULL_TREE, 0), - elaborate_expression + gnu_list = tree_cons (gnat_to_gnu_field_decl (gnat_discrim), + elaborate_expression (Node (gnat_value), gnat_subtype, get_entity_name (gnat_discrim), definition, 1, 0), @@ -5168,14 +5206,13 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, consistent with the alignment. */ if (needs_strict_alignment) { - tree gnu_min_size = round_up (rm_size (gnu_field_type), - TYPE_ALIGN (gnu_field_type)); + tree gnu_rounded_size = round_up (rm_size (gnu_field_type), + TYPE_ALIGN (gnu_field_type)); TYPE_ALIGN (gnu_record_type) = MAX (TYPE_ALIGN (gnu_record_type), TYPE_ALIGN (gnu_field_type)); - /* If Atomic, the size must match exactly and if aliased, the size - must not be less than the rounded size. */ + /* If Atomic, the size must match exactly that of the field. */ if ((Is_Atomic (gnat_field) || Is_Atomic (Etype (gnat_field))) && !operand_equal_p (gnu_size, TYPE_SIZE (gnu_field_type), 0)) { @@ -5187,13 +5224,18 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, gnu_size = NULL_TREE; } + /* If Aliased, the size must match exactly the rounded size. We + used to be more accomodating here and accept greater sizes, but + fully supporting this case on big-endian platforms would require + switching to a more involved layout for the field. */ else if (Is_Aliased (gnat_field) - && gnu_size && tree_int_cst_lt (gnu_size, gnu_min_size)) + && gnu_size + && ! operand_equal_p (gnu_size, gnu_rounded_size, 0)) { post_error_ne_tree - ("size of aliased field& too small{, minimum required is ^}", + ("size of aliased field& must be ^ bits", Last_Bit (Component_Clause (gnat_field)), gnat_field, - gnu_min_size); + gnu_rounded_size); gnu_size = NULL_TREE; } @@ -5345,6 +5387,9 @@ is_variable_size (tree type) ALL_REP, if true, means a rep clause was found for all the fields. This simplifies the logic since we know we're not in the mixed case. + DEFER_DEBUG, if true, means that the debugging routines should not be + called when finishing constructing the record type. + 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. */ @@ -5352,7 +5397,7 @@ 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 all_rep, bool defer_debug) { Node_Id component_decl; Entity_Id gnat_field; @@ -5474,7 +5519,8 @@ 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); + &gnu_our_rep_list, !all_rep_and_size, all_rep, + false); gnu_qual = choices_to_gnu (gnu_discriminant, Discrete_Choices (variant)); @@ -5611,7 +5657,7 @@ components_to_record (tree gnu_record_type, Node_Id component_list, TYPE_ALIGN (gnu_record_type) = 0; finish_record_type (gnu_record_type, nreverse (gnu_field_list), - layout_with_rep, false); + layout_with_rep, defer_debug); } /* Called via qsort from the above. Returns -1, 1, depending on the @@ -5781,7 +5827,7 @@ annotate_rep (Entity_Id gnat_entity, tree gnu_type) tree gnu_entry; Entity_Id gnat_field; - /* We operate by first making a list of all field and their positions + /* We operate by first making a list of all fields and their positions (we can get the sizes easily at any time) by a recursive call and then update all the sizes into the tree. */ gnu_list = compute_field_positions (gnu_type, NULL_TREE, @@ -5796,9 +5842,8 @@ annotate_rep (Entity_Id gnat_entity, tree gnu_type) { tree parent_offset = bitsize_zero_node; - gnu_entry - = purpose_member (gnat_to_gnu_entity (gnat_field, NULL_TREE, 0), - gnu_list); + gnu_entry = purpose_member (gnat_to_gnu_field_decl (gnat_field), + gnu_list); if (gnu_entry) { |