* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Array_Type>: Pass
authorebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 26 Jun 2009 08:05:31 +0000 (08:05 +0000)
committerebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 26 Jun 2009 08:05:31 +0000 (08:05 +0000)
correct arguments to create_field_decl.  Remove redundant iteration.
Rewrite computation of the maximum size.
<E_Array_Subtype>: Reorder and simplify handling of special cases.
Rewrite computation of the maximum size.  Use consistent naming.
* gcc-interface/trans.c (Attribute_to_gnu) <Attr_Length>: 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
gcc/ada/gcc-interface/decl.c
gcc/ada/gcc-interface/trans.c

index e8918c4..33de551 100644 (file)
@@ -1,3 +1,14 @@
+2009-06-26  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Array_Type>: Pass
+       correct arguments to create_field_decl.  Remove redundant iteration.
+       Rewrite computation of the maximum size.
+       <E_Array_Subtype>: Reorder and simplify handling of special cases.
+       Rewrite computation of the maximum size.  Use consistent naming.
+       * gcc-interface/trans.c (Attribute_to_gnu) <Attr_Length>: Swap
+       comparison order for consistency.  Use generic integer node to
+       build the operator and fold the result.
+
 2009-06-25  Vincent Celier  <celier@adacore.com>
 
        * vms_data.ads: Minor comment change
index 974f6f0..5f15cd6 100644 (file)
@@ -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));
index ed9337c..c4b095b 100644 (file)
@@ -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