From 95bbb830f79da1488aba9b55cf43d791a8cd411e Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Fri, 26 Jun 2009 08:05:31 +0000 Subject: [PATCH] * gcc-interface/decl.c (gnat_to_gnu_entity) : Pass correct arguments to create_field_decl. Remove redundant iteration. Rewrite computation of the maximum size. : Reorder and simplify handling of special cases. Rewrite computation of the maximum size. Use consistent naming. * gcc-interface/trans.c (Attribute_to_gnu) : Swap comparison order for consistency. Use generic integer node to build the operator and fold the result. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@148962 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 11 + gcc/ada/gcc-interface/decl.c | 497 +++++++++++++++++++++--------------------- gcc/ada/gcc-interface/trans.c | 49 ++--- 3 files changed, 286 insertions(+), 271 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e8918c4..33de551 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2009-06-26 Eric Botcazou + + * gcc-interface/decl.c (gnat_to_gnu_entity) : Pass + correct arguments to create_field_decl. Remove redundant iteration. + Rewrite computation of the maximum size. + : Reorder and simplify handling of special cases. + Rewrite computation of the maximum size. Use consistent naming. + * gcc-interface/trans.c (Attribute_to_gnu) : Swap + comparison order for consistency. Use generic integer node to + build the operator and fold the result. + 2009-06-25 Vincent Celier * vms_data.ads: Minor comment change diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 974f6f0..5f15cd6 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -1795,14 +1795,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) case E_String_Type: case E_Array_Type: { - Entity_Id gnat_ind_subtype; - Entity_Id gnat_ind_base_subtype; - int ndim = Number_Dimensions (gnat_entity); - int first_dim - = (Convention (gnat_entity) == Convention_Fortran) ? ndim - 1 : 0; - int next_dim - = (Convention (gnat_entity) == Convention_Fortran) ? - 1 : 1; - int index; + Entity_Id gnat_index; + const bool convention_fortran_p + = (Convention (gnat_entity) == Convention_Fortran); + const int ndim = Number_Dimensions (gnat_entity); tree gnu_template_fields = NULL_TREE; tree gnu_template_type = make_node (RECORD_TYPE); tree gnu_template_reference; @@ -1812,6 +1808,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) tree *gnu_temp_fields = (tree *) alloca (ndim * sizeof (tree)); tree gnu_max_size = size_one_node, gnu_max_size_unit; tree gnu_comp_size, tem; + int index; TYPE_NAME (gnu_template_type) = create_concat_name (gnat_entity, "XUB"); @@ -1832,10 +1829,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) tem = chainon (chainon (NULL_TREE, create_field_decl (get_identifier ("P_ARRAY"), ptr_void_type_node, - gnu_fat_type, 0, 0, 0, 0)), + gnu_fat_type, 0, + NULL_TREE, NULL_TREE, 0)), create_field_decl (get_identifier ("P_BOUNDS"), gnu_ptr_template, - gnu_fat_type, 0, 0, 0, 0)); + gnu_fat_type, 0, + NULL_TREE, NULL_TREE, 0)); /* Make sure we can put this into a register. */ TYPE_ALIGN (gnu_fat_type) = MIN (BIGGEST_ALIGNMENT, 2 * POINTER_SIZE); @@ -1855,69 +1854,81 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) = build_unary_op (INDIRECT_REF, gnu_template_type, tem); TREE_READONLY (gnu_template_reference) = 1; - /* Now create the GCC type for each index and add the fields for - that index to the template. */ - for (index = first_dim, gnat_ind_subtype = First_Index (gnat_entity), - gnat_ind_base_subtype - = First_Index (Implementation_Base_Type (gnat_entity)); - index < ndim && index >= 0; - index += next_dim, - gnat_ind_subtype = Next_Index (gnat_ind_subtype), - gnat_ind_base_subtype = Next_Index (gnat_ind_base_subtype)) + /* Now create the GCC type for each index and add the fields for that + index to the template. */ + for (index = (convention_fortran_p ? ndim - 1 : 0), + gnat_index = First_Index (gnat_entity); + 0 <= index && index < ndim; + index += (convention_fortran_p ? - 1 : 1), + gnat_index = Next_Index (gnat_index)) { - char field_name[10]; - tree gnu_ind_subtype - = get_unpadded_type (Base_Type (Etype (gnat_ind_subtype))); - tree gnu_base_subtype - = get_unpadded_type (Etype (gnat_ind_base_subtype)); - tree gnu_base_min - = convert (sizetype, TYPE_MIN_VALUE (gnu_base_subtype)); - tree gnu_base_max - = convert (sizetype, TYPE_MAX_VALUE (gnu_base_subtype)); - tree gnu_min_field, gnu_max_field, gnu_min, gnu_max; - - /* Make the FIELD_DECLs for the minimum and maximum of this - type and then make extractions of that field from the + char field_name[16]; + tree gnu_index_base_type + = get_unpadded_type (Base_Type (Etype (gnat_index))); + tree gnu_low_field, gnu_high_field, gnu_low, gnu_high; + + /* 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_min_field = create_field_decl (get_identifier (field_name), - gnu_ind_subtype, - gnu_template_type, 0, 0, 0, 0); - field_name[0] = 'U'; - gnu_max_field = create_field_decl (get_identifier (field_name), - gnu_ind_subtype, - gnu_template_type, 0, 0, 0, 0); - + gnu_low_field = create_field_decl (get_identifier (field_name), + gnu_index_base_type, + gnu_template_type, 0, + NULL_TREE, NULL_TREE, 0); Sloc_to_locus (Sloc (gnat_entity), - &DECL_SOURCE_LOCATION (gnu_min_field)); + &DECL_SOURCE_LOCATION (gnu_low_field)); + + field_name[0] = 'U'; + gnu_high_field = create_field_decl (get_identifier (field_name), + gnu_index_base_type, + gnu_template_type, 0, + NULL_TREE, NULL_TREE, 0); Sloc_to_locus (Sloc (gnat_entity), - &DECL_SOURCE_LOCATION (gnu_max_field)); - gnu_temp_fields[index] = chainon (gnu_min_field, gnu_max_field); + &DECL_SOURCE_LOCATION (gnu_high_field)); - /* We can't use build_component_ref here since the template - type isn't complete yet. */ - gnu_min = build3 (COMPONENT_REF, gnu_ind_subtype, - gnu_template_reference, gnu_min_field, - NULL_TREE); - gnu_max = build3 (COMPONENT_REF, gnu_ind_subtype, - gnu_template_reference, gnu_max_field, + gnu_temp_fields[index] = chainon (gnu_low_field, gnu_high_field); + + /* We can't use build_component_ref here since the template type + isn't complete yet. */ + gnu_low = build3 (COMPONENT_REF, gnu_index_base_type, + gnu_template_reference, gnu_low_field, NULL_TREE); - TREE_READONLY (gnu_min) = TREE_READONLY (gnu_max) = 1; + gnu_high = build3 (COMPONENT_REF, gnu_index_base_type, + gnu_template_reference, gnu_high_field, + NULL_TREE); + TREE_READONLY (gnu_low) = TREE_READONLY (gnu_high) = 1; - /* Make a range type with the new ranges, but using - the Ada subtype. Then we convert to sizetype. */ + /* Make a range type with the new range in the Ada base type. + Then make an index type with the new range in sizetype. */ gnu_index_types[index] - = create_index_type (convert (sizetype, gnu_min), - convert (sizetype, gnu_max), - create_range_type (gnu_ind_subtype, - gnu_min, gnu_max), + = create_index_type (convert (sizetype, gnu_low), + convert (sizetype, gnu_high), + create_range_type (gnu_index_base_type, + gnu_low, gnu_high), gnat_entity); - /* Update the maximum size of the array, in elements. */ - gnu_max_size - = size_binop (MULT_EXPR, gnu_max_size, - size_binop (PLUS_EXPR, size_one_node, - size_binop (MINUS_EXPR, gnu_base_max, - gnu_base_min))); + + /* Update the maximum size of the array in elements. */ + if (gnu_max_size) + { + tree gnu_index_type = get_unpadded_type (Etype (gnat_index)); + 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 (MAX_EXPR, + size_binop (PLUS_EXPR, size_one_node, + size_binop (MINUS_EXPR, + gnu_max, gnu_min)), + size_zero_node); + + 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); @@ -2006,15 +2017,19 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) if (Unknown_Component_Size (gnat_entity)) Set_Component_Size (gnat_entity, annotate_value (TYPE_SIZE (tem))); - gnu_max_size_unit = size_binop (MAX_EXPR, size_zero_node, - size_binop (MULT_EXPR, gnu_max_size, - TYPE_SIZE_UNIT (tem))); - gnu_max_size = size_binop (MAX_EXPR, bitsize_zero_node, - size_binop (MULT_EXPR, - convert (bitsizetype, - gnu_max_size), - TYPE_SIZE (tem))); + /* Compute the maximum size of the array in units and bits. */ + if (gnu_max_size) + { + gnu_max_size_unit = size_binop (MULT_EXPR, gnu_max_size, + TYPE_SIZE_UNIT (tem)); + gnu_max_size = size_binop (MULT_EXPR, + convert (bitsizetype, gnu_max_size), + TYPE_SIZE (tem)); + } + else + gnu_max_size_unit = NULL_TREE; + /* Now build the array type. */ for (index = ndim - 1; index >= 0; index--) { tem = build_array_type (tem, gnu_index_types[index]); @@ -2036,8 +2051,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) TYPE_USER_ALIGN (tem) = 1; } - TYPE_CONVENTION_FORTRAN_P (tem) - = (Convention (gnat_entity) == Convention_Fortran); + TYPE_CONVENTION_FORTRAN_P (tem) = convention_fortran_p; TREE_TYPE (TYPE_FIELDS (gnu_fat_type)) = build_pointer_type (tem); /* The result type is an UNCONSTRAINED_ARRAY_TYPE that indicates the @@ -2049,15 +2063,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) SET_TYPE_UNCONSTRAINED_ARRAY (gnu_fat_type, gnu_type); /* If the maximum size doesn't overflow, use it. */ - if (TREE_CODE (gnu_max_size) == INTEGER_CST - && !TREE_OVERFLOW (gnu_max_size)) - TYPE_SIZE (tem) - = size_binop (MIN_EXPR, gnu_max_size, TYPE_SIZE (tem)); - if (TREE_CODE (gnu_max_size_unit) == INTEGER_CST + 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_UNIT (tem) - = size_binop (MIN_EXPR, gnu_max_size_unit, - TYPE_SIZE_UNIT (tem)); + { + 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)); + } create_type_decl (create_concat_name (gnat_entity, "XUA"), tem, NULL, !Comes_From_Source (gnat_entity), @@ -2089,123 +2105,100 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) case E_Array_Subtype: /* This is the actual data type for array variables. Multidimensional - arrays are implemented in the gnu tree as arrays of arrays. Note - that for the moment arrays which have sparse enumeration subtypes as - index components create sparse arrays, which is obviously space - inefficient but so much easier to code for now. + arrays are implemented as arrays of arrays. Note that arrays which + have sparse enumeration subtypes as index components create sparse + arrays, which is obviously space inefficient but so much easier to + code for now. - Also note that the subtype never refers to the unconstrained - array type, which is somewhat at variance with Ada semantics. + Also note that the subtype never refers to the unconstrained array + type, which is somewhat at variance with Ada semantics. - First check to see if this is simply a renaming of the array - type. If so, the result is the array type. */ + First check to see if this is simply a renaming of the array type. + If so, the result is the array type. */ gnu_type = gnat_to_gnu_type (Etype (gnat_entity)); if (!Is_Constrained (gnat_entity)) break; else { - Entity_Id gnat_ind_subtype; - Entity_Id gnat_ind_base_subtype; - int dim = Number_Dimensions (gnat_entity); - int first_dim - = (Convention (gnat_entity) == Convention_Fortran) ? dim - 1 : 0; - int next_dim - = (Convention (gnat_entity) == Convention_Fortran) ? -1 : 1; - int index; + Entity_Id gnat_index, gnat_base_index; + const bool convention_fortran_p + = (Convention (gnat_entity) == Convention_Fortran); + const int ndim = Number_Dimensions (gnat_entity); tree gnu_base_type = gnu_type; - tree *gnu_index_type = (tree *) alloca (dim * sizeof (tree)); + tree *gnu_index_types = (tree *) alloca (ndim * sizeof (tree)); tree gnu_max_size = size_one_node, gnu_max_size_unit; bool need_index_type_struct = false; - bool max_overflow = false; - - /* First create the gnu types for each index. Create types for - debugging information to point to the index types if the - are not integer types, have variable bounds, or are - wider than sizetype. */ + int index; - for (index = first_dim, gnat_ind_subtype = First_Index (gnat_entity), - gnat_ind_base_subtype + /* First create the GCC type for each index and find out whether + special types are needed for debugging information. */ + for (index = (convention_fortran_p ? ndim - 1 : 0), + gnat_index = First_Index (gnat_entity), + gnat_base_index = First_Index (Implementation_Base_Type (gnat_entity)); - index < dim && index >= 0; - index += next_dim, - gnat_ind_subtype = Next_Index (gnat_ind_subtype), - gnat_ind_base_subtype = Next_Index (gnat_ind_base_subtype)) + 0 <= index && index < ndim; + index += (convention_fortran_p ? - 1 : 1), + gnat_index = Next_Index (gnat_index), + gnat_base_index = Next_Index (gnat_base_index)) { - tree gnu_index_subtype - = get_unpadded_type (Etype (gnat_ind_subtype)); - tree gnu_min - = convert (sizetype, TYPE_MIN_VALUE (gnu_index_subtype)); - tree gnu_max - = convert (sizetype, TYPE_MAX_VALUE (gnu_index_subtype)); - tree gnu_base_subtype - = get_unpadded_type (Etype (gnat_ind_base_subtype)); - tree gnu_base_min - = convert (sizetype, TYPE_MIN_VALUE (gnu_base_subtype)); - tree gnu_base_max - = convert (sizetype, TYPE_MAX_VALUE (gnu_base_subtype)); - tree gnu_base_type = get_base_type (gnu_base_subtype); - tree gnu_base_base_min - = convert (sizetype, TYPE_MIN_VALUE (gnu_base_type)); - tree gnu_base_base_max - = convert (sizetype, TYPE_MAX_VALUE (gnu_base_type)); + tree gnu_index_type = get_unpadded_type (Etype (gnat_index)); + tree gnu_orig_min = TYPE_MIN_VALUE (gnu_index_type); + tree gnu_orig_max = TYPE_MAX_VALUE (gnu_index_type); + tree gnu_min = convert (sizetype, gnu_orig_min); + tree gnu_max = convert (sizetype, gnu_orig_max); + tree gnu_base_index_type + = get_unpadded_type (Etype (gnat_base_index)); + 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_high; - tree gnu_this_max; - - /* If the minimum and maximum values both overflow in - SIZETYPE, but the difference in the original type - does not overflow in SIZETYPE, ignore the overflow - indications. */ - if ((TYPE_PRECISION (gnu_index_subtype) - > TYPE_PRECISION (sizetype) - || TYPE_UNSIGNED (gnu_index_subtype) - != TYPE_UNSIGNED (sizetype)) - && TREE_CODE (gnu_min) == INTEGER_CST - && TREE_CODE (gnu_max) == INTEGER_CST - && TREE_OVERFLOW (gnu_min) && TREE_OVERFLOW (gnu_max) - && !TREE_OVERFLOW - (fold_build2 (MINUS_EXPR, gnu_index_subtype, - TYPE_MAX_VALUE (gnu_index_subtype), - TYPE_MIN_VALUE (gnu_index_subtype)))) + + /* See if the base array type is already flat. If it is, we + are probably compiling an ACATS test but it will cause the + code below to malfunction if we don't handle it specially. */ + if (TREE_CODE (gnu_base_orig_min) == INTEGER_CST + && TREE_CODE (gnu_base_orig_max) == INTEGER_CST + && tree_int_cst_lt (gnu_base_orig_max, gnu_base_orig_min)) { - TREE_OVERFLOW (gnu_min) = 0; - TREE_OVERFLOW (gnu_max) = 0; - if (tree_int_cst_lt (gnu_max, gnu_min)) - { - gnu_min = size_one_node; - gnu_max = size_zero_node; - } + gnu_min = size_one_node; + gnu_max = size_zero_node; gnu_high = gnu_max; } - /* Similarly, if the range is null, use bounds of 1..0 for - the sizetype bounds. */ - else if ((TYPE_PRECISION (gnu_index_subtype) + /* Similarly, if one of the values overflows in sizetype and the + range is null, use 1..0 for the sizetype bounds. */ + else if ((TYPE_PRECISION (gnu_index_type) > TYPE_PRECISION (sizetype) - || TYPE_UNSIGNED (gnu_index_subtype) + || TYPE_UNSIGNED (gnu_index_type) != TYPE_UNSIGNED (sizetype)) && TREE_CODE (gnu_min) == INTEGER_CST && TREE_CODE (gnu_max) == INTEGER_CST && (TREE_OVERFLOW (gnu_min) || TREE_OVERFLOW (gnu_max)) - && tree_int_cst_lt (TYPE_MAX_VALUE (gnu_index_subtype), - TYPE_MIN_VALUE (gnu_index_subtype))) + && tree_int_cst_lt (gnu_orig_max, gnu_orig_min)) { gnu_min = size_one_node; gnu_max = size_zero_node; gnu_high = gnu_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 - code below to malfunction if we don't handle it specially. */ - else if (TREE_CODE (gnu_base_min) == INTEGER_CST - && TREE_CODE (gnu_base_max) == INTEGER_CST - && !TREE_OVERFLOW (gnu_base_min) - && !TREE_OVERFLOW (gnu_base_max) - && tree_int_cst_lt (gnu_base_max, gnu_base_min)) + /* If the minimum and maximum values both overflow in sizetype, + but the difference in the original type does not overflow in + sizetype, ignore the overflow indication. */ + else if ((TYPE_PRECISION (gnu_index_type) + > TYPE_PRECISION (sizetype) + || TYPE_UNSIGNED (gnu_index_type) + != TYPE_UNSIGNED (sizetype)) + && TREE_CODE (gnu_min) == INTEGER_CST + && TREE_CODE (gnu_max) == INTEGER_CST + && TREE_OVERFLOW (gnu_min) && TREE_OVERFLOW (gnu_max) + && !TREE_OVERFLOW + (convert (sizetype, + fold_build2 (MINUS_EXPR, gnu_index_type, + gnu_orig_max, + gnu_orig_min)))) { - gnu_min = size_one_node; - gnu_max = size_zero_node; + TREE_OVERFLOW (gnu_min) = 0; + TREE_OVERFLOW (gnu_max) = 0; gnu_high = gnu_max; } @@ -2221,16 +2214,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) to use the expression hb >= lb ? hb : lb - 1. */ gnu_high = size_binop (MINUS_EXPR, gnu_min, size_one_node); - /* If gnu_high is now an integer which overflowed, the array + /* If gnu_high is a constant that has overflowed, the array cannot be superflat. */ if (TREE_CODE (gnu_high) == INTEGER_CST && TREE_OVERFLOW (gnu_high)) gnu_high = gnu_max; - /* gnu_high cannot overflow if the subtype is unsigned since - sizetype is signed, or if it is now a constant that hasn't + /* gnu_high cannot overflow if the subtype is unsigned and + sizetype is signed, or if it is a constant that hasn't overflowed. */ - else if (TYPE_UNSIGNED (gnu_base_subtype) + else if ((TYPE_UNSIGNED (gnu_index_type) + && !TYPE_UNSIGNED (sizetype)) || TREE_CODE (gnu_high) == INTEGER_CST) gnu_high = size_binop (MAX_EXPR, gnu_max, gnu_high); @@ -2243,67 +2237,76 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnu_max, gnu_high); } - gnu_index_type[index] - = create_index_type (gnu_min, gnu_high, gnu_index_subtype, + gnu_index_types[index] + = create_index_type (gnu_min, gnu_high, gnu_index_type, gnat_entity); - /* Also compute the maximum size of the array. Here we + /* 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" + 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_index_base_type + = get_base_type (gnu_base_index_type); + 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 + = size_binop (MAX_EXPR, + size_binop (PLUS_EXPR, size_one_node, + size_binop (MINUS_EXPR, + gnu_base_max, + gnu_base_min)), + size_zero_node); + + 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); + } + } - if ((TREE_CODE (gnu_min) == INTEGER_CST - && !TREE_OVERFLOW (gnu_min) - && !operand_equal_p (gnu_min, gnu_base_base_min, 0)) - || !CONTAINS_PLACEHOLDER_P (gnu_min) - || !(TREE_CODE (gnu_base_min) == INTEGER_CST - && !TREE_OVERFLOW (gnu_base_min))) - gnu_base_min = gnu_min; - - if ((TREE_CODE (gnu_max) == INTEGER_CST - && !TREE_OVERFLOW (gnu_max) - && !operand_equal_p (gnu_max, gnu_base_base_max, 0)) - || !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)) - max_overflow = true; - - gnu_base_min = size_binop (MAX_EXPR, gnu_base_min, gnu_min); - gnu_base_max = size_binop (MIN_EXPR, gnu_base_max, gnu_max); - - gnu_this_max - = size_binop (MAX_EXPR, - size_binop (PLUS_EXPR, size_one_node, - size_binop (MINUS_EXPR, gnu_base_max, - gnu_base_min)), - size_zero_node); - - if (TREE_CODE (gnu_this_max) == INTEGER_CST - && TREE_OVERFLOW (gnu_this_max)) - max_overflow = true; - - gnu_max_size - = size_binop (MULT_EXPR, gnu_max_size, gnu_this_max); - - if (!integer_onep (TYPE_MIN_VALUE (gnu_index_subtype)) - || (TREE_CODE (TYPE_MAX_VALUE (gnu_index_subtype)) - != INTEGER_CST) - || TREE_CODE (gnu_index_subtype) != INTEGER_TYPE - || (TREE_TYPE (gnu_index_subtype) - && (TREE_CODE (TREE_TYPE (gnu_index_subtype)) - != INTEGER_TYPE)) - || TYPE_BIASED_REPRESENTATION_P (gnu_index_subtype) - || (TYPE_PRECISION (gnu_index_subtype) + /* 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. */ + if (!integer_onep (gnu_orig_min) + || TREE_CODE (gnu_orig_max) != INTEGER_CST + || TREE_CODE (gnu_index_type) != INTEGER_TYPE + || (TREE_TYPE (gnu_index_type) + && TREE_CODE (TREE_TYPE (gnu_index_type)) + != INTEGER_TYPE) + || TYPE_BIASED_REPRESENTATION_P (gnu_index_type) + || (TYPE_PRECISION (gnu_index_type) > TYPE_PRECISION (sizetype))) need_index_type_struct = true; } @@ -2316,7 +2319,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && !Is_Bit_Packed_Array (Original_Array_Type (gnat_entity))) { gnu_type = gnat_to_gnu_type (Original_Array_Type (gnat_entity)); - for (index = dim - 1; index >= 0; index--) + for (index = ndim - 1; index >= 0; index--) gnu_type = TREE_TYPE (gnu_type); /* One of the above calls might have caused us to be elaborated, @@ -2409,15 +2412,22 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) | TYPE_QUAL_VOLATILE)); } - 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)); + /* Compute the maximum size of the array in units and bits. */ + 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; - for (index = dim - 1; index >= 0; index --) + /* Now build the array type. */ + for (index = ndim - 1; index >= 0; index --) { - gnu_type = build_array_type (gnu_type, gnu_index_type[index]); + gnu_type = build_array_type (gnu_type, gnu_index_types[index]); TYPE_MULTI_ARRAY_P (gnu_type) = (index > 0); if (array_type_has_nonaliased_component (gnat_entity, gnu_type)) TYPE_NONALIASED_COMPONENT (gnu_type) = 1; @@ -2427,10 +2437,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) TYPE_STUB_DECL (gnu_type) = create_type_stub_decl (gnu_entity_name, gnu_type); - /* If we are at file level and this is a multi-dimensional array, we - need to make a variable corresponding to the stride of the + /* If we are at file level and this is a multi-dimensional array, + we need to make a variable corresponding to the stride of the inner dimensions. */ - if (global_bindings_p () && dim > 1) + if (global_bindings_p () && ndim > 1) { tree gnu_str_name = get_identifier ("ST"); tree gnu_arr_type; @@ -2483,9 +2493,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) TYPE_NAME (gnu_bound_rec) = create_concat_name (gnat_entity, "XA"); - for (index = dim - 1; index >= 0; index--) + for (index = ndim - 1; index >= 0; index--) { - tree gnu_index = TYPE_INDEX_TYPE (gnu_index_type[index]); + tree gnu_index = TYPE_INDEX_TYPE (gnu_index_types[index]); tree gnu_index_name = TYPE_NAME (gnu_index); if (TREE_CODE (gnu_index_name) == TYPE_DECL) @@ -2513,20 +2523,19 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) gnat_to_gnu_type (Original_Array_Type (gnat_entity))); - TYPE_CONVENTION_FORTRAN_P (gnu_type) - = (Convention (gnat_entity) == Convention_Fortran); + TYPE_CONVENTION_FORTRAN_P (gnu_type) = convention_fortran_p; TYPE_PACKED_ARRAY_TYPE_P (gnu_type) = (Is_Packed_Array_Type (gnat_entity) && Is_Bit_Packed_Array (Original_Array_Type (gnat_entity))); - /* If our size depends on a placeholder and the maximum size doesn't + /* 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)) - && !max_overflow) + && TREE_OVERFLOW (gnu_max_size_unit))) { TYPE_SIZE (gnu_type) = size_binop (MIN_EXPR, gnu_max_size, TYPE_SIZE (gnu_type)); diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index ed9337c..c4b095b 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -1552,43 +1552,38 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute) /* We used to compute the length as max (hb - lb + 1, 0), which could overflow for some cases of empty arrays, e.g. when lb == index_type'first. We now compute the length as - (hb < lb) ? 0 : hb - lb + 1, which would only overflow in + (hb >= lb) ? hb - lb + 1 : 0, which would only overflow in much rarer cases, for extremely large arrays we expect never to encounter in practice. In addition, the former computation required the use of potentially constraining - signed arithmetic while the latter doesn't. Note that the - comparison must be done in the original index base type, - otherwise the conversion of either bound to gnu_compute_type - may overflow. */ - - tree gnu_compute_type = get_base_type (gnu_result_type); - - tree index_type - = TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type)); - tree lb - = convert (gnu_compute_type, TYPE_MIN_VALUE (index_type)); - tree hb - = convert (gnu_compute_type, TYPE_MAX_VALUE (index_type)); - + signed arithmetic while the latter doesn't. Note that + the comparison must be done in the original index type, + to avoid any overflow during the conversion. */ + tree comp_type = get_base_type (gnu_result_type); + tree index_type = TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type)); + tree lb = TYPE_MIN_VALUE (index_type); + tree hb = TYPE_MAX_VALUE (index_type); gnu_result - = build3 - (COND_EXPR, gnu_compute_type, - build_binary_op (LT_EXPR, get_base_type (index_type), - TYPE_MAX_VALUE (index_type), - TYPE_MIN_VALUE (index_type)), - convert (gnu_compute_type, integer_zero_node), - build_binary_op - (PLUS_EXPR, gnu_compute_type, - build_binary_op (MINUS_EXPR, gnu_compute_type, hb, lb), - convert (gnu_compute_type, integer_one_node))); + = build_binary_op (PLUS_EXPR, comp_type, + build_binary_op (MINUS_EXPR, + comp_type, + convert (comp_type, hb), + convert (comp_type, lb)), + convert (comp_type, integer_one_node)); + gnu_result + = build_cond_expr (comp_type, + build_binary_op (GE_EXPR, + integer_type_node, + hb, lb), + gnu_result, + convert (comp_type, integer_zero_node)); } } /* If this has a PLACEHOLDER_EXPR, qualify it by the object we are handling. Note that these attributes could not have been used on an unconstrained array type. */ - gnu_result = SUBSTITUTE_PLACEHOLDER_IN_EXPR (gnu_result, - gnu_prefix); + gnu_result = SUBSTITUTE_PLACEHOLDER_IN_EXPR (gnu_result, gnu_prefix); /* Cache the expression we have just computed. Since we want to do it at runtime, we force the use of a SAVE_EXPR and let the gimplifier -- 2.7.4