From: Eric Botcazou Date: Sun, 27 Jan 2019 19:14:14 +0000 (+0000) Subject: repinfo.adb (List_Component_Layout): Remove superfluous space for zero-sized field. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=683ccd0568569c67b117e87638782c6d870791b2;p=gcc.git repinfo.adb (List_Component_Layout): Remove superfluous space for zero-sized field. * repinfo.adb (List_Component_Layout): Remove superfluous space for zero-sized field. * gcc-interface/ada-tree.h (TYPE_IS_EXTRA_SUBTYPE_P): New macro. * gcc-interface/gigi.h (create_extra_subtype): Declare. * gcc-interface/decl.c (TYPE_ARRAY_SIZE_LIMIT): Likewise. (update_n_elem): New function. (gnat_to_gnu_entity): Use create_extra_subtype to create extra subtypes instead of doing it manually. : Use update_n_elem to compute the maximum size. Use the index type instead of base type for the bounds. Set TYPE_ARRAY_MAX_SIZE of the array to the maximum size. : Create an extra subtype using the index type of the base array type for self-referential bounds. Use update_n_elem to compute the maximum size. Set TYPE_ARRAY_MAX_SIZE of the array to the maximum size. (gnat_to_gnu_field): Clear DECL_NONADDRESSABLE_P on discriminants. * gcc-interface/misc.c (gnat_get_alias_set): Return the alias set of the base type for an extra subtype. (gnat_type_max_size): Remove obsolete code. * gcc-interface/trans.c (Attribute_to_gnu): Minor tweak. (can_be_lower_p): Deal with pathological types. * gcc-interface/utils.c (create_extra_subtype): New function. (create_field_decl): Minor tweak. (max_size) : Compute a better value by using the extra subtypes on the self-referential bounds. : Rewrite. Deal with "negative value" in unsigned types. : Likewise. * gcc-interface/utils2.c (compare_arrays): Retrieve the original bounds of the arrays upfront. Swap only if the second length is not constant. Use comparisons on the original bounds consistently for the null tests. (build_binary_op): Use TYPE_IS_EXTRA_SUBTYPE_P macro. (build_allocator): Minor tweak. From-SVN: r268318 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4a147775625..123da2f1623 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,38 @@ +2019-01-27 Eric Botcazou + + * repinfo.adb (List_Component_Layout): Remove superfluous space for + zero-sized field. + * gcc-interface/ada-tree.h (TYPE_IS_EXTRA_SUBTYPE_P): New macro. + * gcc-interface/gigi.h (create_extra_subtype): Declare. + * gcc-interface/decl.c (TYPE_ARRAY_SIZE_LIMIT): Likewise. + (update_n_elem): New function. + (gnat_to_gnu_entity): Use create_extra_subtype to create extra subtypes + instead of doing it manually. + : Use update_n_elem to compute the maximum size. Use the + index type instead of base type for the bounds. Set TYPE_ARRAY_MAX_SIZE + of the array to the maximum size. + : Create an extra subtype using the index type of the + base array type for self-referential bounds. Use update_n_elem to + compute the maximum size. Set TYPE_ARRAY_MAX_SIZE of the array to the + maximum size. + (gnat_to_gnu_field): Clear DECL_NONADDRESSABLE_P on discriminants. + * gcc-interface/misc.c (gnat_get_alias_set): Return the alias set of + the base type for an extra subtype. + (gnat_type_max_size): Remove obsolete code. + * gcc-interface/trans.c (Attribute_to_gnu): Minor tweak. + (can_be_lower_p): Deal with pathological types. + * gcc-interface/utils.c (create_extra_subtype): New function. + (create_field_decl): Minor tweak. + (max_size) : Compute a better value by using the extra + subtypes on the self-referential bounds. + : Rewrite. Deal with "negative value" in unsigned types. + : Likewise. + * gcc-interface/utils2.c (compare_arrays): Retrieve the original bounds + of the arrays upfront. Swap only if the second length is not constant. + Use comparisons on the original bounds consistently for the null tests. + (build_binary_op): Use TYPE_IS_EXTRA_SUBTYPE_P macro. + (build_allocator): Minor tweak. + 2019-01-27 Eric Botcazou * gcc-interface/decl.c (array_type_has_nonaliased_component): Return diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h index 77e6bac05ba..ea2c9455992 100644 --- a/gcc/ada/gcc-interface/ada-tree.h +++ b/gcc/ada/gcc-interface/ada-tree.h @@ -111,6 +111,9 @@ do { \ front-end. */ #define TYPE_EXTRA_SUBTYPE_P(NODE) TYPE_LANG_FLAG_2 (INTEGER_TYPE_CHECK (NODE)) +#define TYPE_IS_EXTRA_SUBTYPE_P(NODE) \ + (TREE_CODE (NODE) == INTEGER_TYPE && TYPE_EXTRA_SUBTYPE_P (NODE)) + /* Nonzero for an aggregate type if this is a by-reference type. We also set this on an ENUMERAL_TYPE that is dummy. */ #define TYPE_BY_REFERENCE_P(NODE) \ diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index a1cd6949a9d..ed015baa57f 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -85,6 +85,12 @@ #define FOREIGN_FORCE_REALIGN_STACK 0 #endif +/* The largest TYPE_ARRAY_MAX_SIZE value we set on an array type. + It's an artibrary limit (256 MB) above which we consider that + the allocation is essentially unbounded. */ + +#define TYPE_ARRAY_SIZE_LIMIT (1 << 28) + struct incomplete { struct incomplete *next; @@ -216,6 +222,7 @@ static bool cannot_be_superflat (Node_Id); static bool constructor_address_p (tree); static bool allocatable_size_p (tree, bool); static bool initial_value_needs_conversion (tree, tree); +static tree update_n_elem (tree, tree, tree); static int compare_field_bitpos (const PTR, const PTR); static bool components_to_record (Node_Id, Entity_Id, tree, tree, int, bool, bool, bool, bool, bool, bool, bool, tree, @@ -1760,12 +1767,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) if (gnu_high && !tree_int_cst_equal (gnu_high, TYPE_MAX_VALUE (gnu_type))) { - tree gnu_subtype = make_unsigned_type (esize); - SET_TYPE_RM_MAX_VALUE (gnu_subtype, gnu_high); - TREE_TYPE (gnu_subtype) = gnu_type; - TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1; TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "UMT"); - gnu_type = gnu_subtype; + gnu_type + = create_extra_subtype (gnu_type, TYPE_MIN_VALUE (gnu_type), + gnu_high); } } goto discrete_type; @@ -2052,7 +2057,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) tree gnu_template_reference, gnu_template_fields, gnu_fat_type; tree *gnu_index_types = XALLOCAVEC (tree, ndim); tree *gnu_temp_fields = XALLOCAVEC (tree, ndim); - tree gnu_max_size = size_one_node, gnu_max_size_unit, tem, t; + tree gnu_max_size = size_one_node, tem, t; Entity_Id gnat_index, gnat_name; int index; tree comp_type; @@ -2165,17 +2170,27 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) { char field_name[16]; tree gnu_index_type = get_unpadded_type (Etype (gnat_index)); - tree gnu_index_base_type - = maybe_character_type (get_base_type (gnu_index_type)); - tree gnu_lb_field, gnu_hb_field, gnu_orig_min, gnu_orig_max; + tree gnu_orig_min = TYPE_MIN_VALUE (gnu_index_type); + tree gnu_orig_max = TYPE_MAX_VALUE (gnu_index_type); + tree gnu_index_base_type = get_base_type (gnu_index_type); + tree gnu_lb_field, gnu_hb_field; tree gnu_min, gnu_max, gnu_high; + /* Update the maximum size of the array in elements. */ + if (gnu_max_size) + gnu_max_size + = update_n_elem (gnu_max_size, gnu_orig_min, gnu_orig_max); + + /* Now build the self-referential bounds of the index type. */ + gnu_index_type = maybe_character_type (gnu_index_type); + gnu_index_base_type = maybe_character_type (gnu_index_base_type); + /* Make the FIELD_DECLs for the low and high bounds of this type and then make extractions of these fields from the template. */ sprintf (field_name, "LB%d", index); gnu_lb_field = create_field_decl (get_identifier (field_name), - gnu_index_base_type, + gnu_index_type, gnu_template_type, NULL_TREE, NULL_TREE, 0, 0); Sloc_to_locus (Sloc (gnat_entity), @@ -2183,7 +2198,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) field_name[0] = 'U'; gnu_hb_field = create_field_decl (get_identifier (field_name), - gnu_index_base_type, + gnu_index_type, gnu_template_type, NULL_TREE, NULL_TREE, 0, 0); Sloc_to_locus (Sloc (gnat_entity), @@ -2193,10 +2208,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) /* We can't use build_component_ref here since the template type isn't complete yet. */ - gnu_orig_min = build3 (COMPONENT_REF, gnu_index_base_type, + gnu_orig_min = build3 (COMPONENT_REF, TREE_TYPE (gnu_lb_field), gnu_template_reference, gnu_lb_field, NULL_TREE); - gnu_orig_max = build3 (COMPONENT_REF, gnu_index_base_type, + gnu_orig_max = build3 (COMPONENT_REF, TREE_TYPE (gnu_hb_field), gnu_template_reference, gnu_hb_field, NULL_TREE); TREE_READONLY (gnu_orig_min) = TREE_READONLY (gnu_orig_max) = 1; @@ -2222,25 +2237,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) gnu_orig_max), gnat_entity); - /* Update the maximum size of the array in elements. */ - if (gnu_max_size) - { - tree gnu_min - = convert (sizetype, TYPE_MIN_VALUE (gnu_index_type)); - tree gnu_max - = convert (sizetype, TYPE_MAX_VALUE (gnu_index_type)); - tree gnu_this_max - = size_binop (PLUS_EXPR, size_one_node, - size_binop (MINUS_EXPR, gnu_max, gnu_min)); - - if (TREE_CODE (gnu_this_max) == INTEGER_CST - && TREE_OVERFLOW (gnu_this_max)) - gnu_max_size = NULL_TREE; - else - gnu_max_size - = size_binop (MULT_EXPR, gnu_max_size, gnu_this_max); - } - TYPE_NAME (gnu_index_types[index]) = create_concat_name (gnat_entity, field_name); } @@ -2262,17 +2258,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) Set_Component_Size (gnat_entity, annotate_value (TYPE_SIZE (comp_type))); - /* Compute the maximum size of the array in units and bits. */ + /* Compute the maximum size of the array in units. */ if (gnu_max_size) - { - gnu_max_size_unit = size_binop (MULT_EXPR, gnu_max_size, - TYPE_SIZE_UNIT (comp_type)); - gnu_max_size = size_binop (MULT_EXPR, - convert (bitsizetype, gnu_max_size), - TYPE_SIZE (comp_type)); - } - else - gnu_max_size_unit = NULL_TREE; + gnu_max_size + = size_binop (MULT_EXPR, gnu_max_size, TYPE_SIZE_UNIT (comp_type)); /* Now build the array type. */ tem = comp_type; @@ -2329,14 +2318,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) if (gnu_max_size && TREE_CODE (gnu_max_size) == INTEGER_CST && !TREE_OVERFLOW (gnu_max_size) - && TREE_CODE (gnu_max_size_unit) == INTEGER_CST - && !TREE_OVERFLOW (gnu_max_size_unit)) - { - TYPE_SIZE (tem) = size_binop (MIN_EXPR, gnu_max_size, - TYPE_SIZE (tem)); - TYPE_SIZE_UNIT (tem) = size_binop (MIN_EXPR, gnu_max_size_unit, - TYPE_SIZE_UNIT (tem)); - } + && compare_tree_int (gnu_max_size, TYPE_ARRAY_SIZE_LIMIT) <= 0) + TYPE_ARRAY_MAX_SIZE (tem) = gnu_max_size; create_type_decl (create_concat_name (gnat_entity, "XUA"), tem, artificial_p, debug_info_p, gnat_entity); @@ -2400,7 +2383,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) const int ndim = Number_Dimensions (gnat_entity); tree gnu_base_type = gnu_type; tree *gnu_index_types = XALLOCAVEC (tree, ndim); - tree gnu_max_size = size_one_node, gnu_max_size_unit; + tree gnu_max_size = size_one_node; bool need_index_type_struct = false; int index; @@ -2416,27 +2399,83 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) gnat_base_index = Next_Index (gnat_base_index)) { tree gnu_index_type = get_unpadded_type (Etype (gnat_index)); - tree gnu_index_base_type - = maybe_character_type (get_base_type (gnu_index_type)); - tree gnu_orig_min - = convert (gnu_index_base_type, - TYPE_MIN_VALUE (gnu_index_type)); - tree gnu_orig_max - = convert (gnu_index_base_type, - TYPE_MAX_VALUE (gnu_index_type)); - tree gnu_min = convert (sizetype, gnu_orig_min); - tree gnu_max = convert (sizetype, gnu_orig_max); + tree gnu_orig_min = TYPE_MIN_VALUE (gnu_index_type); + tree gnu_orig_max = TYPE_MAX_VALUE (gnu_index_type); + tree gnu_index_base_type = get_base_type (gnu_index_type); tree gnu_base_index_type = get_unpadded_type (Etype (gnat_base_index)); - tree gnu_base_index_base_type - = maybe_character_type (get_base_type (gnu_base_index_type)); - tree gnu_base_orig_min - = convert (gnu_base_index_base_type, - TYPE_MIN_VALUE (gnu_base_index_type)); - tree gnu_base_orig_max - = convert (gnu_base_index_base_type, - TYPE_MAX_VALUE (gnu_base_index_type)); - tree gnu_high; + tree gnu_base_orig_min = TYPE_MIN_VALUE (gnu_base_index_type); + tree gnu_base_orig_max = TYPE_MAX_VALUE (gnu_base_index_type); + tree gnu_min, gnu_max, gnu_high; + + /* We try to define subtypes for discriminants used as bounds + that are more restrictive than those declared by using the + bounds of the index type of the base array type. This will + make it possible to calculate the maximum size of the record + type more conservatively. This may have already been done by + the front-end (Exp_Ch3.Adjust_Discriminants), in which case + there will be a conversion that needs to be removed first. */ + if (CONTAINS_PLACEHOLDER_P (gnu_orig_min) + && TYPE_RM_SIZE (gnu_base_index_type) + && !tree_int_cst_lt (TYPE_RM_SIZE (gnu_index_type), + TYPE_RM_SIZE (gnu_base_index_type))) + { + gnu_orig_min = remove_conversions (gnu_orig_min, false); + TREE_TYPE (gnu_orig_min) + = create_extra_subtype (TREE_TYPE (gnu_orig_min), + gnu_base_orig_min, + gnu_base_orig_max); + } + + if (CONTAINS_PLACEHOLDER_P (gnu_orig_max) + && TYPE_RM_SIZE (gnu_base_index_type) + && !tree_int_cst_lt (TYPE_RM_SIZE (gnu_index_type), + TYPE_RM_SIZE (gnu_base_index_type))) + { + gnu_orig_max = remove_conversions (gnu_orig_max, false); + TREE_TYPE (gnu_orig_max) + = create_extra_subtype (TREE_TYPE (gnu_orig_max), + gnu_base_orig_min, + gnu_base_orig_max); + } + + /* Update the maximum size of the array in elements. Here we + see if any constraint on the index type of the base type + can be used in the case of self-referential bounds on the + index type of the array type. We look for a non-"infinite" + and non-self-referential bound from any type involved and + handle each bound separately. */ + if (gnu_max_size) + { + if (CONTAINS_PLACEHOLDER_P (gnu_orig_min)) + gnu_min = gnu_base_orig_min; + else + gnu_min = gnu_orig_min; + + if (TREE_CODE (gnu_min) != INTEGER_CST + || TREE_OVERFLOW (gnu_min)) + gnu_min = TYPE_MIN_VALUE (TREE_TYPE (gnu_min)); + + if (CONTAINS_PLACEHOLDER_P (gnu_orig_max)) + gnu_max = gnu_base_orig_max; + else + gnu_max = gnu_orig_max; + + if (TREE_CODE (gnu_max) != INTEGER_CST + || TREE_OVERFLOW (gnu_max)) + gnu_max = TYPE_MAX_VALUE (TREE_TYPE (gnu_max)); + + gnu_max_size + = update_n_elem (gnu_max_size, gnu_min, gnu_max); + } + + /* Convert the bounds to the base type for consistency below. */ + gnu_index_base_type = maybe_character_type (gnu_index_base_type); + gnu_orig_min = convert (gnu_index_base_type, gnu_orig_min); + gnu_orig_max = convert (gnu_index_base_type, gnu_orig_max); + + gnu_min = convert (sizetype, gnu_orig_min); + gnu_max = convert (sizetype, gnu_orig_max); /* See if the base array type is already flat. If it is, we are probably compiling an ACATS test but it will cause the @@ -2470,7 +2509,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) && TREE_OVERFLOW (gnu_min) && TREE_OVERFLOW (gnu_max) && !TREE_OVERFLOW (convert (sizetype, - fold_build2 (MINUS_EXPR, gnu_index_type, + fold_build2 (MINUS_EXPR, + gnu_index_base_type, gnu_orig_max, gnu_orig_min)))) { @@ -2512,12 +2552,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) } /* Finally we use (hb >= lb) ? hb : lb - 1 for the upper bound - in all the other cases. Note that, here as well as above, - the condition used in the comparison must be equivalent to - the condition (length != 0). This is relied upon in order - to optimize array comparisons in compare_arrays. Moreover - we use int_const_binop for the shift by 1 if the bound is - constant to avoid any unwanted overflow. */ + in all the other cases. Note that we use int_const_binop for + the shift by 1 if the bound is constant to avoid any unwanted + overflow. */ else gnu_high = build_cond_expr (sizetype, @@ -2538,65 +2575,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) = create_index_type (gnu_min, gnu_high, gnu_index_type, gnat_entity); - /* Update the maximum size of the array in elements. Here we - see if any constraint on the index type of the base type - can be used in the case of self-referential bound on the - index type of the subtype. We look for a non-"infinite" - and non-self-referential bound from any type involved and - handle each bound separately. */ - if (gnu_max_size) - { - tree gnu_base_min = convert (sizetype, gnu_base_orig_min); - tree gnu_base_max = convert (sizetype, gnu_base_orig_max); - tree gnu_base_base_min - = convert (sizetype, - TYPE_MIN_VALUE (gnu_base_index_base_type)); - tree gnu_base_base_max - = convert (sizetype, - TYPE_MAX_VALUE (gnu_base_index_base_type)); - - if (!CONTAINS_PLACEHOLDER_P (gnu_min) - || !(TREE_CODE (gnu_base_min) == INTEGER_CST - && !TREE_OVERFLOW (gnu_base_min))) - gnu_base_min = gnu_min; - - if (!CONTAINS_PLACEHOLDER_P (gnu_max) - || !(TREE_CODE (gnu_base_max) == INTEGER_CST - && !TREE_OVERFLOW (gnu_base_max))) - gnu_base_max = gnu_max; - - if ((TREE_CODE (gnu_base_min) == INTEGER_CST - && TREE_OVERFLOW (gnu_base_min)) - || operand_equal_p (gnu_base_min, gnu_base_base_min, 0) - || (TREE_CODE (gnu_base_max) == INTEGER_CST - && TREE_OVERFLOW (gnu_base_max)) - || operand_equal_p (gnu_base_max, gnu_base_base_max, 0)) - gnu_max_size = NULL_TREE; - else - { - tree gnu_this_max; - - /* Use int_const_binop if the bounds are constant to - avoid any unwanted overflow. */ - if (TREE_CODE (gnu_base_min) == INTEGER_CST - && TREE_CODE (gnu_base_max) == INTEGER_CST) - gnu_this_max - = int_const_binop (PLUS_EXPR, size_one_node, - int_const_binop (MINUS_EXPR, - gnu_base_max, - gnu_base_min)); - else - gnu_this_max - = size_binop (PLUS_EXPR, size_one_node, - size_binop (MINUS_EXPR, - gnu_base_max, - gnu_base_min)); - - gnu_max_size - = size_binop (MULT_EXPR, gnu_max_size, gnu_this_max); - } - } - /* We need special types for debugging information to point to the index types if they have variable bounds, are not integer types, are biased or are wider than sizetype. These are GNAT @@ -2646,17 +2624,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) } } - /* Compute the maximum size of the array in units and bits. */ + /* Compute the maximum size of the array in units. */ if (gnu_max_size) - { - gnu_max_size_unit = size_binop (MULT_EXPR, gnu_max_size, - TYPE_SIZE_UNIT (gnu_type)); - gnu_max_size = size_binop (MULT_EXPR, - convert (bitsizetype, gnu_max_size), - TYPE_SIZE (gnu_type)); - } - else - gnu_max_size_unit = NULL_TREE; + gnu_max_size + = size_binop (MULT_EXPR, gnu_max_size, TYPE_SIZE_UNIT (gnu_type)); /* Now build the array type. */ for (index = ndim - 1; index >= 0; index --) @@ -2776,21 +2747,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) = (Is_Packed (gnat_entity) || Is_Packed_Array_Impl_Type (gnat_entity)); - /* If the size is self-referential and the maximum size doesn't - overflow, use it. */ - if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)) - && gnu_max_size - && !(TREE_CODE (gnu_max_size) == INTEGER_CST - && TREE_OVERFLOW (gnu_max_size)) - && !(TREE_CODE (gnu_max_size_unit) == INTEGER_CST - && TREE_OVERFLOW (gnu_max_size_unit))) - { - TYPE_SIZE (gnu_type) = size_binop (MIN_EXPR, gnu_max_size, - TYPE_SIZE (gnu_type)); - TYPE_SIZE_UNIT (gnu_type) - = size_binop (MIN_EXPR, gnu_max_size_unit, - TYPE_SIZE_UNIT (gnu_type)); - } + /* If the maximum size doesn't overflow, use it. */ + if (gnu_max_size + && TREE_CODE (gnu_max_size) == INTEGER_CST + && !TREE_OVERFLOW (gnu_max_size) + && compare_tree_int (gnu_max_size, TYPE_ARRAY_SIZE_LIMIT) <= 0) + TYPE_ARRAY_MAX_SIZE (gnu_type) = gnu_max_size; /* Set our alias set to that of our base type. This gives all array subtypes the same alias set. */ @@ -2850,17 +2812,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) TYPE_MODULUS for modular types so we make an extra subtype if necessary. */ if (TYPE_MODULAR_P (gnu_inner)) - { - tree gnu_subtype - = make_unsigned_type (TYPE_PRECISION (gnu_inner)); - TREE_TYPE (gnu_subtype) = gnu_inner; - TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1; - SET_TYPE_RM_MIN_VALUE (gnu_subtype, - TYPE_MIN_VALUE (gnu_inner)); - SET_TYPE_RM_MAX_VALUE (gnu_subtype, - TYPE_MAX_VALUE (gnu_inner)); - gnu_inner = gnu_subtype; - } + gnu_inner + = create_extra_subtype (gnu_inner, + TYPE_MIN_VALUE (gnu_inner), + TYPE_MAX_VALUE (gnu_inner)); TYPE_HAS_ACTUAL_BOUNDS_P (gnu_inner) = 1; @@ -3259,7 +3214,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) && !Is_Access_Type (Etype (Node (gnat_constr))) && Ekind (Entity (Node (gnat_constr))) == E_Discriminant) { - Entity_Id gnat_discr = Entity (Node (gnat_constr)); + const Entity_Id gnat_discr = Entity (Node (gnat_constr)); tree gnu_discr_type = gnat_to_gnu_type (Etype (gnat_discr)); tree gnu_ref = gnat_to_gnu_entity (Original_Record_Component (gnat_discr), @@ -3270,20 +3225,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) gcc_assert (TREE_TYPE (TREE_OPERAND (gnu_ref, 0)) == gnu_type); if (gnu_discr_type != TREE_TYPE (gnu_ref)) - { - const unsigned prec = TYPE_PRECISION (TREE_TYPE (gnu_ref)); - tree gnu_subtype - = TYPE_UNSIGNED (TREE_TYPE (gnu_ref)) - ? make_unsigned_type (prec) : make_signed_type (prec); - TREE_TYPE (gnu_subtype) = TREE_TYPE (gnu_ref); - TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1; - SET_TYPE_RM_MIN_VALUE (gnu_subtype, - TYPE_MIN_VALUE (gnu_discr_type)); - SET_TYPE_RM_MAX_VALUE (gnu_subtype, - TYPE_MAX_VALUE (gnu_discr_type)); - TREE_TYPE (gnu_ref) - = TREE_TYPE (TREE_OPERAND (gnu_ref, 1)) = gnu_subtype; - } + TREE_TYPE (gnu_ref) + = create_extra_subtype (TREE_TYPE (gnu_ref), + TYPE_MIN_VALUE (gnu_discr_type), + TYPE_MAX_VALUE (gnu_discr_type)); } /* If this is a derived type with discriminants and these discriminants @@ -6399,6 +6344,37 @@ initial_value_needs_conversion (tree gnu_type, tree gnu_expr) /* In all the other cases, convert the expression to the object's type. */ return true; } + +/* Add the contribution of [MIN, MAX] to the current number of elements N_ELEM + of an array type and return the result, or NULL_TREE if it overflowed. */ + +static tree +update_n_elem (tree n_elem, tree min, tree max) +{ + /* First deal with the empty case. */ + if (TREE_CODE (min) == INTEGER_CST + && TREE_CODE (max) == INTEGER_CST + && tree_int_cst_lt (max, min)) + return size_zero_node; + + min = convert (sizetype, min); + max = convert (sizetype, max); + + /* Compute the number of elements in this dimension. */ + tree this_n_elem + = size_binop (PLUS_EXPR, size_one_node, size_binop (MINUS_EXPR, max, min)); + + if (TREE_CODE (this_n_elem) == INTEGER_CST && TREE_OVERFLOW (this_n_elem)) + return NULL_TREE; + + /* Multiply the current number of elements by the result. */ + n_elem = size_binop (MULT_EXPR, n_elem, this_n_elem); + + if (TREE_CODE (n_elem) == INTEGER_CST && TREE_OVERFLOW (n_elem)) + return NULL_TREE; + + return n_elem; +} /* Given GNAT_ENTITY, elaborate all expressions that are required to be elaborated at the point of its definition, but do nothing else. */ @@ -7222,12 +7198,20 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, DECL_ALIASED_P (gnu_field) = is_aliased; TREE_SIDE_EFFECTS (gnu_field) = TREE_THIS_VOLATILE (gnu_field) = is_volatile; + /* If this is a discriminant, then we treat it specially: first, we set its + index number for the back-annotation; second, we record whether it cannot + be changed once it has been set for the computation of loop invariants; + third, we make it addressable in order for the optimizer to more easily + see that it cannot be modified by assignments to the other fields of the + record (see create_field_decl for a more detailed explanation), which is + crucial to hoist the offset and size computations of dynamic fields. */ if (Ekind (gnat_field) == E_Discriminant) { - DECL_INVARIANT_P (gnu_field) - = No (Discriminant_Default_Value (gnat_field)); DECL_DISCRIMINANT_NUMBER (gnu_field) = UI_To_gnu (Discriminant_Number (gnat_field), sizetype); + DECL_INVARIANT_P (gnu_field) + = No (Discriminant_Default_Value (gnat_field)); + DECL_NONADDRESSABLE_P (gnu_field) = 0; } return gnu_field; diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index f25c32879a3..191a017f606 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -637,6 +637,9 @@ extern tree create_index_type (tree min, tree max, tree index, sizetype is used. */ extern tree create_range_type (tree type, tree min, tree max); +/* Return an extra subtype of TYPE with range MIN to MAX. */ +extern tree create_extra_subtype (tree type, tree min, tree max); + /* Return a TYPE_DECL node suitable for the TYPE_STUB_DECL field of TYPE. NAME gives the name of the type to be used in the declaration. */ extern tree create_type_stub_decl (tree name, tree type); diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c index 623c48e2a93..38e33beea70 100644 --- a/gcc/ada/gcc-interface/misc.c +++ b/gcc/ada/gcc-interface/misc.c @@ -727,6 +727,10 @@ gnat_get_alias_set (tree type) if (TYPE_IS_PADDING_P (type)) return get_alias_set (TREE_TYPE (TYPE_FIELDS (type))); + /* If this is an extra subtype, use the base type. */ + else if (TYPE_IS_EXTRA_SUBTYPE_P (type)) + return get_alias_set (get_base_type (type)); + /* If the type is an unconstrained array, use the type of the self-referential array we make. */ else if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE) @@ -753,59 +757,22 @@ gnat_type_max_size (const_tree gnu_type) elaborated and possibly replaced by a VAR_DECL. */ tree max_size_unit = max_size (TYPE_SIZE_UNIT (gnu_type), true); - /* If we don't have a constant, try to look at attributes which should have - stayed untouched. */ - if (!tree_fits_uhwi_p (max_size_unit)) + /* If we don't have a constant, see what we can get from TYPE_ADA_SIZE, + which should stay untouched. */ + if (!tree_fits_uhwi_p (max_size_unit) + && RECORD_OR_UNION_TYPE_P (gnu_type) + && !TYPE_FAT_POINTER_P (gnu_type) + && TYPE_ADA_SIZE (gnu_type)) { - /* For record types, see what we can get from TYPE_ADA_SIZE. */ - if (RECORD_OR_UNION_TYPE_P (gnu_type) - && !TYPE_FAT_POINTER_P (gnu_type) - && TYPE_ADA_SIZE (gnu_type)) - { - tree max_ada_size = max_size (TYPE_ADA_SIZE (gnu_type), true); - - /* If we have succeeded in finding a constant, round it up to the - type's alignment and return the result in units. */ - if (tree_fits_uhwi_p (max_ada_size)) - max_size_unit - = size_binop (CEIL_DIV_EXPR, - round_up (max_ada_size, TYPE_ALIGN (gnu_type)), - bitsize_unit_node); - } - - /* For array types, see what we can get from TYPE_INDEX_TYPE. */ - else if (TREE_CODE (gnu_type) == ARRAY_TYPE - && TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type)) - && tree_fits_uhwi_p (TYPE_SIZE_UNIT (TREE_TYPE (gnu_type)))) - { - tree lb = TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type))); - tree hb = TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type))); - if (TREE_CODE (lb) != INTEGER_CST - && TYPE_RM_SIZE (TREE_TYPE (lb)) - && compare_tree_int (TYPE_RM_SIZE (TREE_TYPE (lb)), 16) <= 0) - lb = TYPE_MIN_VALUE (TREE_TYPE (lb)); - if (TREE_CODE (hb) != INTEGER_CST - && TYPE_RM_SIZE (TREE_TYPE (hb)) - && compare_tree_int (TYPE_RM_SIZE (TREE_TYPE (hb)), 16) <= 0) - hb = TYPE_MAX_VALUE (TREE_TYPE (hb)); - if (TREE_CODE (lb) == INTEGER_CST && TREE_CODE (hb) == INTEGER_CST) - { - tree ctype = get_base_type (TREE_TYPE (lb)); - lb = fold_convert (ctype, lb); - hb = fold_convert (ctype, hb); - if (tree_int_cst_le (lb, hb)) - { - tree length - = fold_build2 (PLUS_EXPR, ctype, - fold_build2 (MINUS_EXPR, ctype, hb, lb), - build_int_cst (ctype, 1)); - max_size_unit - = fold_build2 (MULT_EXPR, sizetype, - fold_convert (sizetype, length), - TYPE_SIZE_UNIT (TREE_TYPE (gnu_type))); - } - } - } + tree max_ada_size = max_size (TYPE_ADA_SIZE (gnu_type), true); + + /* If we have succeeded in finding a constant, round it up to the + type's alignment and return the result in units. */ + if (tree_fits_uhwi_p (max_ada_size)) + max_size_unit + = size_binop (CEIL_DIV_EXPR, + round_up (max_ada_size, TYPE_ALIGN (gnu_type)), + bitsize_unit_node); } return max_size_unit; diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 3e326b432ed..3b0093e1229 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -2374,15 +2374,12 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) else gnu_result = rm_size (gnu_type); - /* Deal with a self-referential size by returning the maximum size for - a type and by qualifying the size with the object otherwise. */ - if (CONTAINS_PLACEHOLDER_P (gnu_result)) - { - if (TREE_CODE (gnu_prefix) == TYPE_DECL) - gnu_result = max_size (gnu_result, true); - else - gnu_result = substitute_placeholder_in_expr (gnu_result, gnu_expr); - } + /* Deal with a self-referential size by qualifying the size with the + object or returning the maximum size for a type. */ + if (TREE_CODE (gnu_prefix) != TYPE_DECL) + gnu_result = SUBSTITUTE_PLACEHOLDER_IN_EXPR (gnu_result, gnu_expr); + else if (CONTAINS_PLACEHOLDER_P (gnu_result)) + gnu_result = max_size (gnu_result, true); /* If the type contains a template, subtract the padded size of the template, except for 'Max_Size_In_Storage_Elements because we need @@ -3227,13 +3224,25 @@ static bool can_be_lower_p (tree val1, tree val2) { if (TREE_CODE (val1) == NOP_EXPR) - val1 = TYPE_MIN_VALUE (TREE_TYPE (TREE_OPERAND (val1, 0))); + { + tree type = TREE_TYPE (TREE_OPERAND (val1, 0)); + if (can_be_lower_p (TYPE_MAX_VALUE (type), TYPE_MIN_VALUE (type))) + return true; + + val1 = TYPE_MIN_VALUE (type); + } if (TREE_CODE (val1) != INTEGER_CST) return true; if (TREE_CODE (val2) == NOP_EXPR) - val2 = TYPE_MAX_VALUE (TREE_TYPE (TREE_OPERAND (val2, 0))); + { + tree type = TREE_TYPE (TREE_OPERAND (val2, 0)); + if (can_be_lower_p (TYPE_MAX_VALUE (type), TYPE_MIN_VALUE (type))) + return true; + + val2 = TYPE_MAX_VALUE (type); + } if (TREE_CODE (val2) != INTEGER_CST) return true; diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 9bbb46f0512..2ff664ba04e 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -2260,7 +2260,7 @@ merge_sizes (tree last_size, tree first_bit, tree size, bool special, 1, has_rep)); /* We don't need any NON_VALUE_EXPRs and they can confuse us (especially - when fed through substitute_in_expr) into thinking that a constant + when fed through SUBSTITUTE_IN_EXPR) into thinking that a constant size is not constant. */ while (TREE_CODE (new_size) == NON_LVALUE_EXPR) new_size = TREE_OPERAND (new_size, 0); @@ -2429,6 +2429,24 @@ create_range_type (tree type, tree min, tree max) return range_type; } + /* Return an extra subtype of TYPE with range MIN to MAX. */ + +tree +create_extra_subtype (tree type, tree min, tree max) +{ + const bool uns = TYPE_UNSIGNED (type); + const unsigned prec = TYPE_PRECISION (type); + tree subtype = uns ? make_unsigned_type (prec) : make_signed_type (prec); + + TREE_TYPE (subtype) = type; + TYPE_EXTRA_SUBTYPE_P (subtype) = 1; + + SET_TYPE_RM_MIN_VALUE (subtype, min); + SET_TYPE_RM_MAX_VALUE (subtype, max); + + return subtype; +} + /* Return a TYPE_DECL node suitable for the TYPE_STUB_DECL field of TYPE. NAME gives the name of the type to be used in the declaration. */ @@ -2811,8 +2829,8 @@ create_field_decl (tree name, tree type, tree record_type, tree size, tree pos, layout_decl (field_decl, known_align); SET_DECL_OFFSET_ALIGN (field_decl, - tree_fits_uhwi_p (pos) ? BIGGEST_ALIGNMENT - : BITS_PER_UNIT); + tree_fits_uhwi_p (pos) + ? BIGGEST_ALIGNMENT : BITS_PER_UNIT); pos_from_bit (&DECL_FIELD_OFFSET (field_decl), &DECL_FIELD_BIT_OFFSET (field_decl), DECL_OFFSET_ALIGN (field_decl), pos); @@ -2829,6 +2847,15 @@ create_field_decl (tree name, tree type, tree record_type, tree size, tree pos, if (!addressable && !type_for_nonaliased_component_p (type)) addressable = 1; + /* Note that there is a trade-off in making a field nonaddressable because + this will cause type-based alias analysis to use the same alias set for + accesses to the field as for accesses to the whole record: while doing + so will make it more likely to disambiguate accesses to other objects + and accesses to the field, it will make it less likely to disambiguate + accesses to the other fields of the record and accesses to the field. + If the record is fully static, then the trade-off is irrelevant since + the fields of the record can always be disambiguated by their offsets + but, if the record is dynamic, then it can become problematic. */ DECL_NONADDRESSABLE_P (field_decl) = !addressable; return field_decl; @@ -3658,11 +3685,27 @@ max_size (tree exp, bool max_p) modify. Otherwise, we treat it like a variable. */ if (CONTAINS_PLACEHOLDER_P (exp)) { - tree val_type = TREE_TYPE (TREE_OPERAND (exp, 1)); - tree val = (max_p ? TYPE_MAX_VALUE (type) : TYPE_MIN_VALUE (type)); - return - convert (type, - max_size (convert (get_base_type (val_type), val), true)); + tree base_type = get_base_type (TREE_TYPE (TREE_OPERAND (exp, 1))); + tree val + = fold_convert (base_type, + max_p + ? TYPE_MAX_VALUE (type) : TYPE_MIN_VALUE (type)); + + /* Walk down the extra subtypes to get more restrictive bounds. */ + while (TYPE_IS_EXTRA_SUBTYPE_P (type)) + { + type = TREE_TYPE (type); + if (max_p) + val = fold_build2 (MIN_EXPR, base_type, val, + fold_convert (base_type, + TYPE_MAX_VALUE (type))); + else + val = fold_build2 (MAX_EXPR, base_type, val, + fold_convert (base_type, + TYPE_MIN_VALUE (type))); + } + + return fold_convert (type, max_size (val, max_p)); } return exp; @@ -3683,49 +3726,57 @@ max_size (tree exp, bool max_p) return fold_build1 (code, type, op0); case tcc_binary: - { - tree lhs = max_size (TREE_OPERAND (exp, 0), max_p); - tree rhs = max_size (TREE_OPERAND (exp, 1), - code == MINUS_EXPR ? !max_p : max_p); + op0 = TREE_OPERAND (exp, 0); + op1 = TREE_OPERAND (exp, 1); + + /* If we have a multiply-add with a "negative" value in an unsigned + type, do a multiply-subtract with the negated value, in order to + avoid creating a spurious overflow below. */ + if (code == PLUS_EXPR + && TREE_CODE (op0) == MULT_EXPR + && TYPE_UNSIGNED (type) + && TREE_CODE (TREE_OPERAND (op0, 1)) == INTEGER_CST + && !TREE_OVERFLOW (TREE_OPERAND (op0, 1)) + && tree_int_cst_sign_bit (TREE_OPERAND (op0, 1))) + { + tree tmp = op1; + op1 = build2 (MULT_EXPR, type, TREE_OPERAND (op0, 0), + fold_build1 (NEGATE_EXPR, type, + TREE_OPERAND (op0, 1))); + op0 = tmp; + code = MINUS_EXPR; + } - /* Special-case wanting the maximum value of a MIN_EXPR. - In that case, if one side overflows, return the other. */ - if (max_p && code == MIN_EXPR) - { - if (TREE_CODE (rhs) == INTEGER_CST && TREE_OVERFLOW (rhs)) - return lhs; + op0 = max_size (op0, max_p); + op1 = max_size (op1, code == MINUS_EXPR ? !max_p : max_p); - if (TREE_CODE (lhs) == INTEGER_CST && TREE_OVERFLOW (lhs)) - return rhs; - } - - /* Likewise, handle a MINUS_EXPR or PLUS_EXPR with the LHS - overflowing and the RHS a variable. */ - if ((code == MINUS_EXPR || code == PLUS_EXPR) - && TREE_CODE (lhs) == INTEGER_CST - && TREE_OVERFLOW (lhs) - && TREE_CODE (rhs) != INTEGER_CST) - return lhs; - - /* If we are going to subtract a "negative" value in an unsigned type, - do the operation as an addition of the negated value, in order to - avoid creating a spurious overflow below. */ - if (code == MINUS_EXPR - && TYPE_UNSIGNED (type) - && TREE_CODE (rhs) == INTEGER_CST - && !TREE_OVERFLOW (rhs) - && tree_int_cst_sign_bit (rhs) != 0) - { - rhs = fold_build1 (NEGATE_EXPR, type, rhs); - code = PLUS_EXPR; - } + if ((code == MINUS_EXPR || code == PLUS_EXPR)) + { + /* If the op0 has overflowed and the op1 is a variable, + propagate the overflow by returning the op0. */ + if (TREE_CODE (op0) == INTEGER_CST + && TREE_OVERFLOW (op0) + && TREE_CODE (op1) != INTEGER_CST) + return op0; + + /* If we have a "negative" value in an unsigned type, do the + opposite operation on the negated value, in order to avoid + creating a spurious overflow below. */ + if (TYPE_UNSIGNED (type) + && TREE_CODE (op1) == INTEGER_CST + && !TREE_OVERFLOW (op1) + && tree_int_cst_sign_bit (op1)) + { + op1 = fold_build1 (NEGATE_EXPR, type, op1); + code = (code == MINUS_EXPR ? PLUS_EXPR : MINUS_EXPR); + } + } - if (lhs == TREE_OPERAND (exp, 0) && rhs == TREE_OPERAND (exp, 1)) - return exp; + if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1)) + return exp; - /* We need to detect overflows so we call size_binop here. */ - return size_binop (code, lhs, rhs); - } + /* We need to detect overflows so we call size_binop here. */ + return size_binop (code, op0, op1); case tcc_expression: switch (TREE_CODE_LENGTH (code)) @@ -3757,15 +3808,28 @@ max_size (tree exp, bool max_p) case 3: if (code == COND_EXPR) { + op0 = TREE_OPERAND (exp, 0); op1 = TREE_OPERAND (exp, 1); op2 = TREE_OPERAND (exp, 2); if (!op1 || !op2) return exp; - return - fold_build2 (max_p ? MAX_EXPR : MIN_EXPR, type, - max_size (op1, max_p), max_size (op2, max_p)); + op1 = max_size (op1, max_p); + op2 = max_size (op2, max_p); + + /* If we have the MAX of a "negative" value in an unsigned type + and zero for a length expression, just return zero. */ + if (max_p + && TREE_CODE (op0) == LE_EXPR + && TYPE_UNSIGNED (type) + && TREE_CODE (op1) == INTEGER_CST + && !TREE_OVERFLOW (op1) + && tree_int_cst_sign_bit (op1) + && integer_zerop (op2)) + return op2; + + return fold_build2 (max_p ? MAX_EXPR : MIN_EXPR, type, op1, op2); } break; diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c index bb7889e5045..6ff1372899c 100644 --- a/gcc/ada/gcc-interface/utils2.c +++ b/gcc/ada/gcc-interface/utils2.c @@ -301,19 +301,31 @@ compare_arrays (location_t loc, tree result_type, tree a1, tree a2) in order to suppress the comparison of the data at the end. */ while (TREE_CODE (t1) == ARRAY_TYPE && TREE_CODE (t2) == ARRAY_TYPE) { - tree lb1 = TYPE_MIN_VALUE (TYPE_DOMAIN (t1)); - tree ub1 = TYPE_MAX_VALUE (TYPE_DOMAIN (t1)); - tree lb2 = TYPE_MIN_VALUE (TYPE_DOMAIN (t2)); - tree ub2 = TYPE_MAX_VALUE (TYPE_DOMAIN (t2)); - tree length1 = size_binop (PLUS_EXPR, size_binop (MINUS_EXPR, ub1, lb1), + tree dom1 = TYPE_DOMAIN (t1); + tree dom2 = TYPE_DOMAIN (t2); + tree length1 = size_binop (PLUS_EXPR, + size_binop (MINUS_EXPR, + TYPE_MAX_VALUE (dom1), + TYPE_MIN_VALUE (dom1)), size_one_node); - tree length2 = size_binop (PLUS_EXPR, size_binop (MINUS_EXPR, ub2, lb2), + tree length2 = size_binop (PLUS_EXPR, + size_binop (MINUS_EXPR, + TYPE_MAX_VALUE (dom2), + TYPE_MIN_VALUE (dom2)), size_one_node); + tree ind1 = TYPE_INDEX_TYPE (dom1); + tree ind2 = TYPE_INDEX_TYPE (dom2); + tree base_type = maybe_character_type (get_base_type (ind1)); + tree lb1 = convert (base_type, TYPE_MIN_VALUE (ind1)); + tree ub1 = convert (base_type, TYPE_MAX_VALUE (ind1)); + tree lb2 = convert (base_type, TYPE_MIN_VALUE (ind2)); + tree ub2 = convert (base_type, TYPE_MAX_VALUE (ind2)); tree comparison, this_a1_is_null, this_a2_is_null; - /* If the length of the first array is a constant, swap our operands - unless the length of the second array is the constant zero. */ - if (TREE_CODE (length1) == INTEGER_CST && !integer_zerop (length2)) + /* If the length of the first array is a constant and that of the second + array is not, swap our operands to have the constant second. */ + if (TREE_CODE (length1) == INTEGER_CST + && TREE_CODE (length2) != INTEGER_CST) { tree tem; bool btem; @@ -333,17 +345,12 @@ compare_arrays (location_t loc, tree result_type, tree a1, tree a2) last < first holds. */ if (integer_zerop (length2)) { - tree b = get_base_type (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1))); - length_zero_p = true; - ub1 - = convert (b, TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)))); - lb1 - = convert (b, TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)))); + lb1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (lb1, a1); + ub1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (ub1, a1); comparison = fold_build2_loc (loc, LT_EXPR, result_type, ub1, lb1); - comparison = SUBSTITUTE_PLACEHOLDER_IN_EXPR (comparison, a1); if (EXPR_P (comparison)) SET_EXPR_LOCATION (comparison, loc); @@ -356,24 +363,17 @@ compare_arrays (location_t loc, tree result_type, tree a1, tree a2) just use its length computed from the actual stored bounds. */ else if (TREE_CODE (length2) == INTEGER_CST) { - tree b = get_base_type (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1))); - - ub1 - = convert (b, TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)))); - lb1 - = convert (b, TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)))); - /* Note that we know that UB2 and LB2 are constant and hence + /* Note that we know that LB2 and UB2 are constant and hence cannot contain a PLACEHOLDER_EXPR. */ - ub2 - = convert (b, TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t2)))); - lb2 - = convert (b, TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t2)))); + lb1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (lb1, a1); + ub1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (ub1, a1); comparison = fold_build2_loc (loc, EQ_EXPR, result_type, - build_binary_op (MINUS_EXPR, b, ub1, lb1), - build_binary_op (MINUS_EXPR, b, ub2, lb2)); - comparison = SUBSTITUTE_PLACEHOLDER_IN_EXPR (comparison, a1); + build_binary_op (MINUS_EXPR, base_type, + ub1, lb1), + build_binary_op (MINUS_EXPR, base_type, + ub2, lb2)); if (EXPR_P (comparison)) SET_EXPR_LOCATION (comparison, loc); @@ -391,26 +391,20 @@ compare_arrays (location_t loc, tree result_type, tree a1, tree a2) comparison = fold_build2_loc (loc, EQ_EXPR, result_type, length1, length2); + if (EXPR_P (comparison)) + SET_EXPR_LOCATION (comparison, loc); - /* If the length expression is of the form (cond ? val : 0), assume - that cond is equivalent to (length != 0). That's guaranteed by - construction of the array types in gnat_to_gnu_entity. */ - if (TREE_CODE (length1) == COND_EXPR - && integer_zerop (TREE_OPERAND (length1, 2))) - this_a1_is_null - = invert_truthvalue_loc (loc, TREE_OPERAND (length1, 0)); - else - this_a1_is_null = fold_build2_loc (loc, EQ_EXPR, result_type, - length1, size_zero_node); - - /* Likewise for the second array. */ - if (TREE_CODE (length2) == COND_EXPR - && integer_zerop (TREE_OPERAND (length2, 2))) - this_a2_is_null - = invert_truthvalue_loc (loc, TREE_OPERAND (length2, 0)); - else - this_a2_is_null = fold_build2_loc (loc, EQ_EXPR, result_type, - length2, size_zero_node); + lb1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (lb1, a1); + ub1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (ub1, a1); + + this_a1_is_null + = fold_build2_loc (loc, LT_EXPR, result_type, ub1, lb1); + + lb2 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (lb2, a2); + ub2 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (ub2, a2); + + this_a2_is_null + = fold_build2_loc (loc, LT_EXPR, result_type, ub2, lb2); } /* Append expressions for this dimension to the final expressions. */ @@ -861,9 +855,7 @@ build_binary_op (enum tree_code op_code, tree result_type, && TYPE_JUSTIFIED_MODULAR_P (operation_type)) operation_type = TREE_TYPE (TYPE_FIELDS (operation_type)); - if (operation_type - && TREE_CODE (operation_type) == INTEGER_TYPE - && TYPE_EXTRA_SUBTYPE_P (operation_type)) + if (operation_type && TYPE_IS_EXTRA_SUBTYPE_P (operation_type)) operation_type = get_base_type (operation_type); modulus = (operation_type @@ -2431,16 +2423,13 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc, size = TYPE_SIZE_UNIT (TREE_TYPE (init)); /* If the size is still self-referential, reference the initializing - expression, if it is present. If not, this must have been a - call to allocate a library-level object, in which case we use - the maximum size. */ - if (CONTAINS_PLACEHOLDER_P (size)) - { - if (!ignore_init_type && init) - size = substitute_placeholder_in_expr (size, init); - else - size = max_size (size, true); - } + expression, if it is present. If not, this must have been a call + to allocate a library-level object, in which case we just use the + maximum size. */ + if (!ignore_init_type && init) + size = SUBSTITUTE_PLACEHOLDER_IN_EXPR (size, init); + else if (CONTAINS_PLACEHOLDER_P (size)) + size = max_size (size, true); /* If the size overflows, pass -1 so Storage_Error will be raised. */ if (TREE_CODE (size) == INTEGER_CST && !valid_constant_size_p (size)) diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb index 182c26f8516..007fe39c422 100644 --- a/gcc/ada/repinfo.adb +++ b/gcc/ada/repinfo.adb @@ -1338,7 +1338,7 @@ package body Repinfo is if List_Representation_Info_To_JSON then UI_Write (Esiz); else - if Lbit < 10 then + if Lbit >= 0 and then Lbit < 10 then Write_Char (' '); end if;