]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
uintp.h (UI_Lt): Declare.
authorEric Botcazou <ebotcazou@adacore.com>
Sat, 17 Apr 2010 14:16:36 +0000 (14:16 +0000)
committerEric Botcazou <ebotcazou@gcc.gnu.org>
Sat, 17 Apr 2010 14:16:36 +0000 (14:16 +0000)
* uintp.h (UI_Lt): Declare.
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Array_Type>: Do the size
computation in sizetype.
<E_Array_Subtype>: Use unified handling for all index types.  Do not
generate MAX_EXPR-based expressions, only COND_EXPR-based ones.  Add
bypass for PATs.
(annotate_value): Change test for negative values.
(validate_size): Apply test for negative values on GNAT nodes.
(set_rm_size): Likewise.
* gcc-interface/misc.c (gnat_init): Set unsigned types for sizetypes.
* gcc-interface/utils.c (rest_of_record_type_compilation): Change test
for negative values.
(max_size) <MINUS_EXPR>: Do not reassociate a COND_EXPR on the LHS.
(builtin_type_for_size): Adjust definition of signed_size_type_node.
* gcc-interface/utils2.c (compare_arrays): Optimize comparison of
lengths against zero.

From-SVN: r158466

gcc/ada/ChangeLog
gcc/ada/gcc-interface/decl.c
gcc/ada/gcc-interface/misc.c
gcc/ada/gcc-interface/utils.c
gcc/ada/gcc-interface/utils2.c
gcc/ada/uintp.h
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/sizetype1.adb [moved from gcc/testsuite/gnat.dg/sizetype.adb with 91% similarity]
gcc/testsuite/gnat.dg/sizetype2.adb [new file with mode: 0644]

index 2a0af0b7bcce156f705fbd70807d7956d1c8bdc0..b68d53570c43c57b97841f600aa792277323b6fb 100644 (file)
@@ -1,3 +1,22 @@
+2010-04-17  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * uintp.h (UI_Lt): Declare.
+       * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Array_Type>: Do the size
+       computation in sizetype.
+       <E_Array_Subtype>: Use unified handling for all index types.  Do not
+       generate MAX_EXPR-based expressions, only COND_EXPR-based ones.  Add
+       bypass for PATs.
+       (annotate_value): Change test for negative values.
+       (validate_size): Apply test for negative values on GNAT nodes.
+       (set_rm_size): Likewise.
+       * gcc-interface/misc.c (gnat_init): Set unsigned types for sizetypes.
+       * gcc-interface/utils.c (rest_of_record_type_compilation): Change test
+       for negative values.
+       (max_size) <MINUS_EXPR>: Do not reassociate a COND_EXPR on the LHS.
+       (builtin_type_for_size): Adjust definition of signed_size_type_node.
+       * gcc-interface/utils2.c (compare_arrays): Optimize comparison of
+       lengths against zero.
+
 2010-04-17  Eric Botcazou  <ebotcazou@adacore.com>
 
        * back-end.adb (Call_Back_End): Pass Standard_Character to gigi.
index 5d6bc79fd93e3b4bf21a106cb6ef05759b6d1161..b8e8a5b10bf0b021df76d1110006cb6cd2ee07cf 100644 (file)
@@ -2112,15 +2112,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
               gnat_base_index = Next_Index (gnat_base_index))
            {
              tree gnu_index_type = get_unpadded_type (Etype (gnat_index));
-             const int prec_comp
-               = compare_tree_int (rm_size (gnu_index_type),
-                                   TYPE_PRECISION (sizetype));
-             const bool subrange_p = (prec_comp < 0
-                                      && (TYPE_UNSIGNED (gnu_index_type)
-                                          || !TYPE_UNSIGNED (sizetype)))
-                                     || (prec_comp == 0
-                                         && TYPE_UNSIGNED (gnu_index_type)
-                                            == TYPE_UNSIGNED (sizetype));
              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);
@@ -2129,7 +2120,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                = 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, gnu_low;
+             tree gnu_high;
 
              /* See if the base array type is already flat.  If it is, we
                 are probably compiling an ACATS test but it will cause the
@@ -2145,8 +2136,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
              /* Similarly, if one of the values overflows in sizetype and the
                 range is null, use 1..0 for the sizetype bounds.  */
-             else if (!subrange_p
-                      && TREE_CODE (gnu_min) == INTEGER_CST
+             else if (TREE_CODE (gnu_min) == INTEGER_CST
                       && TREE_CODE (gnu_max) == INTEGER_CST
                       && (TREE_OVERFLOW (gnu_min) || TREE_OVERFLOW (gnu_max))
                       && tree_int_cst_lt (gnu_orig_max, gnu_orig_min))
@@ -2159,8 +2149,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
              /* 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 (!subrange_p
-                      && TREE_CODE (gnu_min) == INTEGER_CST
+             else if (TREE_CODE (gnu_min) == INTEGER_CST
                       && TREE_CODE (gnu_max) == INTEGER_CST
                       && TREE_OVERFLOW (gnu_min) && TREE_OVERFLOW (gnu_max)
                       && !TREE_OVERFLOW
@@ -2179,57 +2168,47 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                 deal with the "superflat" case.  There are three ways to do
                 this.  If we can prove that the array can never be superflat,
                 we can just use the high bound of the index type.  */
-             else if (Nkind (gnat_index) == N_Range
-                      && cannot_be_superflat_p (gnat_index))
+             else if ((Nkind (gnat_index) == N_Range
+                       && cannot_be_superflat_p (gnat_index))
+                      /* Packed Array Types are never superflat.  */
+                      || Is_Packed_Array_Type (gnat_entity))
                gnu_high = gnu_max;
 
-             /* Otherwise, if we can prove that the low bound minus one and
-                the high bound cannot overflow, we can just use the expression
-                MAX (hb, lb - 1).  Similarly, if we can prove that the high
-                bound plus one and the low bound cannot overflow, we can use
-                the high bound as-is and MIN (hb + 1, lb) for the low bound.
-                Otherwise, we have to fall back to the most general expression
-                (hb >= lb) ? hb : lb - 1.  Note that the comparison must be
-                done in the original index type, to avoid any overflow during
-                the conversion.  */
-             else
+             /* Otherwise, if the high bound is constant but the low bound is
+                not, we use the expression (hb >= lb) ? lb : hb + 1 for the
+                lower bound.  Note that the comparison must be done in the
+                original type to avoid any overflow during the conversion.  */
+             else if (TREE_CODE (gnu_max) == INTEGER_CST
+                      && TREE_CODE (gnu_min) != INTEGER_CST)
                {
-                 gnu_high = size_binop (MINUS_EXPR, gnu_min, size_one_node);
-                 gnu_low = size_binop (PLUS_EXPR, gnu_max, size_one_node);
-
-                 /* If gnu_high is a constant that has overflowed, the low
-                    bound is the smallest integer so cannot be the maximum.
-                    If gnu_low is a constant that has overflowed, the high
-                    bound is the highest integer so cannot be the minimum.  */
-                 if ((TREE_CODE (gnu_high) == INTEGER_CST
-                      && TREE_OVERFLOW (gnu_high))
-                     || (TREE_CODE (gnu_low) == INTEGER_CST
-                          && TREE_OVERFLOW (gnu_low)))
-                   gnu_high = gnu_max;
-
-                 /* If the index type is a subrange and gnu_high a constant
-                    that hasn't overflowed, we can use the maximum.  */
-                 else if (subrange_p && TREE_CODE (gnu_high) == INTEGER_CST)
-                   gnu_high = size_binop (MAX_EXPR, gnu_max, gnu_high);
-
-                 /* If the index type is a subrange and gnu_low a constant
-                    that hasn't overflowed, we can use the minimum.  */
-                 else if (subrange_p && TREE_CODE (gnu_low) == INTEGER_CST)
-                   {
-                     gnu_high = gnu_max;
-                     gnu_min = size_binop (MIN_EXPR, gnu_min, gnu_low);
-                   }
-
-                 else
-                   gnu_high
-                     = build_cond_expr (sizetype,
-                                        build_binary_op (GE_EXPR,
-                                                         boolean_type_node,
-                                                         gnu_orig_max,
-                                                         gnu_orig_min),
-                                        gnu_max, gnu_high);
+                 gnu_high = gnu_max;
+                 gnu_min
+                   = build_cond_expr (sizetype,
+                                      build_binary_op (GE_EXPR,
+                                                       boolean_type_node,
+                                                       gnu_orig_max,
+                                                       gnu_orig_min),
+                                      gnu_min,
+                                      size_binop (PLUS_EXPR, gnu_max,
+                                                  size_one_node));
                }
 
+             /* 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.  */
+             else
+               gnu_high
+                 = build_cond_expr (sizetype,
+                                    build_binary_op (GE_EXPR,
+                                                     boolean_type_node,
+                                                     gnu_orig_max,
+                                                     gnu_orig_min),
+                                    gnu_max,
+                                    size_binop (MINUS_EXPR, gnu_min,
+                                                size_one_node));
+
              gnu_index_types[index]
                = create_index_type (gnu_min, gnu_high, gnu_index_type,
                                     gnat_entity);
@@ -2299,7 +2278,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                      && TREE_CODE (TREE_TYPE (gnu_index_type))
                         != INTEGER_TYPE)
                  || TYPE_BIASED_REPRESENTATION_P (gnu_index_type)
-                 || prec_comp > 0)
+                 || compare_tree_int (rm_size (gnu_index_type),
+                                      TYPE_PRECISION (sizetype)) > 0)
                need_index_type_struct = true;
            }
 
@@ -7128,9 +7108,11 @@ annotate_value (tree gnu_size)
         this is in bitsizetype.  */
       gnu_size = convert (bitsizetype, gnu_size);
 
-      /* For a negative value, use NEGATE_EXPR of the opposite.  Such values
-        appear in expressions containing aligning patterns.  */
-      if (tree_int_cst_sgn (gnu_size) < 0)
+      /* For a negative value, build NEGATE_EXPR of the opposite.  Such values
+        appear in expressions containing aligning patterns.  Note that, since
+        sizetype is sign-extended but nonetheless unsigned, we don't directly
+        use tree_int_cst_sgn.  */
+      if (TREE_INT_CST_HIGH (gnu_size) < 0)
        {
          tree op_size = fold_build1 (NEGATE_EXPR, bitsizetype, gnu_size);
          return annotate_value (build1 (NEGATE_EXPR, bitsizetype, op_size));
@@ -7498,6 +7480,10 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object,
   if (uint_size == No_Uint)
     return NULL_TREE;
 
+  /* Ignore a negative size since that corresponds to our back-annotation.  */
+  if (UI_Lt (uint_size, Uint_0))
+    return NULL_TREE;
+
   /* Find the node to use for errors.  */
   if ((Ekind (gnat_object) == E_Component
        || Ekind (gnat_object) == E_Discriminant)
@@ -7522,9 +7508,8 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object,
       return NULL_TREE;
     }
 
-  /* Ignore a negative size since that corresponds to our back-annotation.
-     Also ignore a zero size if it is not permitted.  */
-  if (tree_int_cst_sgn (size) < 0 || (integer_zerop (size) && !zero_ok))
+  /* Ignore a zero size if it is not permitted.  */
+  if (!zero_ok && integer_zerop (size))
     return NULL_TREE;
 
   /* The size of objects is always a multiple of a byte.  */
@@ -7611,6 +7596,10 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity)
   if (uint_size == No_Uint)
     return;
 
+  /* Ignore a negative size since that corresponds to our back-annotation.  */
+  if (UI_Lt (uint_size, Uint_0))
+    return;
+
   /* Only issue an error if a Value_Size clause was explicitly given.
      Otherwise, we'd be duplicating an error on the Size clause.  */
   gnat_attr_node
@@ -7627,15 +7616,13 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity)
       return;
     }
 
-  /* Ignore a negative size since that corresponds to our back-annotation.
-     Also ignore a zero size unless a Value_Size clause exists, or a size
-     clause exists, or this is an integer type, in which case the front-end
-     will have always set it.  */
-  if (tree_int_cst_sgn (size) < 0
-      || (integer_zerop (size)
-         && No (gnat_attr_node)
-         && !Has_Size_Clause (gnat_entity)
-         && !Is_Discrete_Or_Fixed_Point_Type (gnat_entity)))
+  /* Ignore a zero size unless a Value_Size clause exists, or a size clause
+     exists, or this is an integer type, in which case the front-end will
+     have always set it.  */
+  if (No (gnat_attr_node)
+      && integer_zerop (size)
+      && !Has_Size_Clause (gnat_entity)
+      && !Is_Discrete_Or_Fixed_Point_Type (gnat_entity))
     return;
 
   old_size = rm_size (gnu_type);
index f3e7b1b74827b033fc8fc27d3c4d7789f64eb092..6923105afa24241edea009ad7e627f93a413e6b7 100644 (file)
@@ -391,13 +391,16 @@ gnat_init (void)
   /* Do little here, most of the standard declarations are set up after the
      front-end has been run.  Use the same `char' as C, this doesn't really
      matter since we'll use the explicit `unsigned char' for Character.  */
-  build_common_tree_nodes (flag_signed_char, true);
-
-  /* In Ada, we use a signed type for SIZETYPE.  Use the signed type
-     corresponding to the width of Pmode.  In most cases when ptr_mode
-     and Pmode differ, C will use the width of ptr_mode for SIZETYPE.
-     But we get far better code using the width of Pmode.  */
-  size_type_node = gnat_type_for_mode (Pmode, 0);
+  build_common_tree_nodes (flag_signed_char, false);
+
+  /* In Ada, we use the unsigned type corresponding to the width of Pmode as
+     SIZETYPE.  In most cases when ptr_mode and Pmode differ, C will use the
+     width of ptr_mode for SIZETYPE, but we get better code using the width
+     of Pmode.  Note that, although we manipulate negative offsets for some
+     internal constructs and rely on compile time overflow detection in size
+     computations, using unsigned types for SIZETYPEs is fine since they are
+     treated specially by the middle-end, in particular sign-extended.  */
+  size_type_node = gnat_type_for_mode (Pmode, 1);
   set_sizetype (size_type_node);
   TYPE_NAME (sizetype) = get_identifier ("size_type");
 
index 668226bd906fd3efacebe7ba2d81fdb95411bc4d..7b403a7bab810ddfcf78352c8c5cbc6117b25449 100644 (file)
@@ -839,11 +839,13 @@ rest_of_record_type_compilation (tree record_type)
              align = tree_low_cst (TREE_OPERAND (curpos, 1), 1);
 
              /* An offset which is a bitwise AND with a negative power of 2
-                means an alignment corresponding to this power of 2.  */
+                means an alignment corresponding to this power of 2.  Note
+                that, as sizetype is sign-extended but nonetheless unsigned,
+                we don't directly use tree_int_cst_sgn.  */
              offset = remove_conversions (offset, true);
              if (TREE_CODE (offset) == BIT_AND_EXPR
                  && host_integerp (TREE_OPERAND (offset, 1), 0)
-                 && tree_int_cst_sgn (TREE_OPERAND (offset, 1)) < 0)
+                 && TREE_INT_CST_HIGH (TREE_OPERAND (offset, 1)) < 0)
                {
                  unsigned int pow
                    = - tree_low_cst (TREE_OPERAND (offset, 1), 0);
@@ -2175,22 +2177,6 @@ max_size (tree exp, bool max_p)
          if (code == COMPOUND_EXPR)
            return max_size (TREE_OPERAND (exp, 1), max_p);
 
-         /* Calculate "(A ? B : C) - D" as "A ? B - D : C - D" which
-            may provide a tighter bound on max_size.  */
-         if (code == MINUS_EXPR
-             && TREE_CODE (TREE_OPERAND (exp, 0)) == COND_EXPR)
-           {
-             tree lhs = fold_build2 (MINUS_EXPR, type,
-                                     TREE_OPERAND (TREE_OPERAND (exp, 0), 1),
-                                     TREE_OPERAND (exp, 1));
-             tree rhs = fold_build2 (MINUS_EXPR, type,
-                                     TREE_OPERAND (TREE_OPERAND (exp, 0), 2),
-                                     TREE_OPERAND (exp, 1));
-             return fold_build2 (max_p ? MAX_EXPR : MIN_EXPR, type,
-                                 max_size (lhs, max_p),
-                                 max_size (rhs, max_p));
-           }
-
          {
            tree lhs = max_size (TREE_OPERAND (exp, 0), max_p);
            tree rhs = max_size (TREE_OPERAND (exp, 1),
@@ -4707,7 +4693,7 @@ builtin_type_for_size (int size, bool unsignedp)
 static void
 install_builtin_elementary_types (void)
 {
-  signed_size_type_node = size_type_node;
+  signed_size_type_node = gnat_signed_type (size_type_node);
   pid_type_node = integer_type_node;
   void_list_node = build_void_list_node ();
 
index be7044bddfa968c18032a50f5239e5cf17d7b2f8..31c513699afbb455ad697d903cf4aa8798e745be 100644 (file)
@@ -351,14 +351,26 @@ compare_arrays (tree result_type, tree a1, tree a2)
          if (EXPR_P (comparison))
            SET_EXPR_LOCATION (comparison, input_location);
 
-         this_a1_is_null = build_binary_op (EQ_EXPR, result_type, length1,
-                                            size_zero_node);
-         if (EXPR_P (this_a1_is_null))
+         /* 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 (TREE_OPERAND (length1, 0));
+         else
+           this_a1_is_null = build_binary_op (EQ_EXPR, result_type, length1,
+                                              size_zero_node);
+          if (EXPR_P (this_a1_is_null))
            SET_EXPR_LOCATION (this_a1_is_null, input_location);
 
-         this_a2_is_null = build_binary_op (EQ_EXPR, result_type, length2,
-                                            size_zero_node);
-         if (EXPR_P (this_a2_is_null))
+         /* Likewise for the second array.  */
+         if (TREE_CODE (length2) == COND_EXPR
+             && integer_zerop (TREE_OPERAND (length2, 2)))
+           this_a2_is_null = invert_truthvalue (TREE_OPERAND (length2, 0));
+         else
+           this_a2_is_null = build_binary_op (EQ_EXPR, result_type, length2,
+                                              size_zero_node);
+          if (EXPR_P (this_a2_is_null))
            SET_EXPR_LOCATION (this_a2_is_null, input_location);
        }
 
index de70e115f43edb365cfd59d6be9892a3de2a94ac..630fcd18e06d2ff375aaf7732e31eb6f66763d2a 100644 (file)
@@ -75,6 +75,10 @@ typedef struct {const int *Array; Vector_Template *Bounds; }
 #define Vector_To_Uint uintp__vector_to_uint
 extern Uint Vector_To_Uint             (Int_Vector, Boolean);
 
+/* Compare integer values for less than.  */
+#define UI_Lt uintp__ui_lt
+extern Boolean UI_Lt                   (Uint, Uint);
+
 /* Universal integers are represented by the Uint type which is an index into
    the Uints_Ptr table containing Uint_Entry values.  A Uint_Entry contains an
    index and length for getting the "digits" of the universal integer from the
index b58bb508e8812b3f4d5493362169cbbf13a67929..ac81da73654e3f21e3035317d36a4fdbbb1c2ed7 100644 (file)
@@ -1,3 +1,9 @@
+2010-04-17  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/sizetype.adb: Rename into...
+       * gnat.dg/sizetype1.adb: ...this.
+       * gnat.dg/sizetype2.adb: New test.
+
 2010-04-16  Richard Guenther  <rguenther@suse.de>
 
        PR tree-optimization/43572
similarity index 91%
rename from gcc/testsuite/gnat.dg/sizetype.adb
rename to gcc/testsuite/gnat.dg/sizetype1.adb
index acc2d6560bd97e88b71b6b8860cdd95c8e8646f7..e5d12c61e094b124f206aa6f6715e74fc29595d2 100644 (file)
@@ -2,7 +2,7 @@
 
 with Interfaces.C; use Interfaces.C;
 
-procedure Sizetype is
+procedure Sizetype1 is
 
    TC_String : String(1..8) := "abcdefgh";
    TC_No_nul : constant char_array := To_C(TC_String, False);
diff --git a/gcc/testsuite/gnat.dg/sizetype2.adb b/gcc/testsuite/gnat.dg/sizetype2.adb
new file mode 100644 (file)
index 0000000..4593936
--- /dev/null
@@ -0,0 +1,27 @@
+-- { dg-do run }
+
+procedure Sizetype2 is
+
+  function Ident_Int (X : Integer) return Integer is
+  begin
+     return X;
+  end;
+
+  type A is array (Integer range <>) of Boolean;
+  subtype T1 is A (Ident_Int (- 6) .. Ident_Int (Integer'Last - 4));
+  subtype T2 is A (- 6 .. Ident_Int (Integer'Last - 4));
+  subtype T3 is A (Ident_Int (- 6) .. Integer'Last - 4);
+
+begin
+  if T1'Size /= 17179869200 then
+    raise Program_Error;
+  end if;
+
+  if T2'Size /= 17179869200 then
+    raise Program_Error;
+  end if;
+
+  if T3'Size /= 17179869200 then
+    raise Program_Error;
+  end if;
+end;