]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
* repinfo.adb (List_Component_Layout): Remove superfluous space for
authorebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4>
Sun, 27 Jan 2019 19:14:14 +0000 (19:14 +0000)
committerebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4>
Sun, 27 Jan 2019 19:14:14 +0000 (19:14 +0000)
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.
<E_Array_Type>: 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.
<E_Array_Subtype>: 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) <tcc_reference>: Compute a better value by using the extra
  subtypes on the self-referential bounds.
<tcc_binary>: Rewrite.  Deal with "negative value" in unsigned types.
<tcc_expression>: 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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@268318 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/gcc-interface/ada-tree.h
gcc/ada/gcc-interface/decl.c
gcc/ada/gcc-interface/gigi.h
gcc/ada/gcc-interface/misc.c
gcc/ada/gcc-interface/trans.c
gcc/ada/gcc-interface/utils.c
gcc/ada/gcc-interface/utils2.c
gcc/ada/repinfo.adb

index 4a147775625eecd34ee64058dbe4ef2709abfba6..123da2f16234ed0fd2d7720f3e12050e447ed2a9 100644 (file)
@@ -1,3 +1,38 @@
+2019-01-27  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * 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.
+       <E_Array_Type>: 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.
+       <E_Array_Subtype>: 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) <tcc_reference>: Compute a better value by using the extra
+       subtypes on the self-referential bounds.
+       <tcc_binary>: Rewrite.  Deal with "negative value" in unsigned types.
+       <tcc_expression>: 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  <ebotcazou@adacore.com>
 
        * gcc-interface/decl.c (array_type_has_nonaliased_component): Return
index 77e6bac05baba0fe9bd44d3d4cf7f19cba8f25ba..ea2c94559920de67903095f256f11d81be5c0d5a 100644 (file)
@@ -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)                                     \
index a1cd6949a9d2fa49a4fe8eb50b5f22d00c704530..ed015baa57f6e9e8830d2bfe2b5c9c9f2bf77df7 100644 (file)
 #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;
+}
 \f
 /* 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;
index f25c32879a30008a0e27bff20b23430e19a16439..191a017f6068e35714d93335c5404118e5d3271d 100644 (file)
@@ -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);
index 623c48e2a9319a812195366f88d643f0001a89af..38e33beea70005b34057ec7ad5dfa903df3c17a1 100644 (file)
@@ -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;
index 3e326b432ed27b40f5681df1faf1d5c0bb81a186..3b0093e12292b63e475b1d321f20a3fc772f21fb 100644 (file)
@@ -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;
index 9bbb46f0512bd9316fdc43e08ee844a19578a8f0..2ff664ba04e3bfae611b6aa19d86ff52e8c95215 100644 (file)
@@ -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;
 }
 \f
+\f/* 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;
+}
+\f
 /* 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;
 
index bb7889e50459e5eb775d26138845fb4a5c9afcc8..6ff1372899c006beecbc445f94ce84fef2f6e20f 100644 (file)
@@ -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))
index 182c26f85164a40d796889fd7aa05890af9b8e36..007fe39c42227129142e307761b03f632e913c0c 100644 (file)
@@ -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;