OSDN Git Service

* gcc-interface/cuintp.c (UI_To_gnu): Fix long line.
[pf3gnuchains/gcc-fork.git] / gcc / ada / gcc-interface / trans.c
index bf0e183..acabf25 100644 (file)
@@ -1057,6 +1057,9 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
          = lvalue_required_p (gnat_node, gnu_result_type, true,
                               address_of_constant, Is_Aliased (gnat_temp));
 
+      /* ??? We need to unshare the initializer if the object is external
+        as such objects are not marked for unsharing if we are not at the
+        global level.  This should be fixed in add_decl_expr.  */
       if ((constant_only && !address_of_constant) || !require_lvalue)
        gnu_result = unshare_expr (DECL_INITIAL (gnu_result));
     }
@@ -1358,6 +1361,12 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
            tree gnu_char_ptr_type
              = build_pointer_type (unsigned_char_type_node);
            tree gnu_pos = byte_position (TYPE_FIELDS (gnu_obj_type));
+           tree gnu_byte_offset
+             = convert (sizetype,
+                        size_diffop (size_zero_node, gnu_pos));
+           gnu_byte_offset
+             = fold_build1 (NEGATE_EXPR, sizetype, gnu_byte_offset);
+
            gnu_ptr = convert (gnu_char_ptr_type, gnu_ptr);
            gnu_ptr = build_binary_op (POINTER_PLUS_EXPR, gnu_char_ptr_type,
                                       gnu_ptr, gnu_pos);
@@ -2090,8 +2099,8 @@ static tree
 Loop_Statement_to_gnu (Node_Id gnat_node)
 {
   const Node_Id gnat_iter_scheme = Iteration_Scheme (gnat_node);
-  tree gnu_loop_stmt = build4 (LOOP_STMT, void_type_node, NULL_TREE,
-                              NULL_TREE, NULL_TREE, NULL_TREE);
+  tree gnu_loop_stmt = build5 (LOOP_STMT, void_type_node, NULL_TREE,
+                              NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE);
   tree gnu_loop_label = create_artificial_label (input_location);
   tree gnu_loop_var = NULL_TREE, gnu_cond_expr = NULL_TREE;
   tree gnu_result;
@@ -2127,10 +2136,8 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
       tree gnu_low = TYPE_MIN_VALUE (gnu_type);
       tree gnu_high = TYPE_MAX_VALUE (gnu_type);
       tree gnu_base_type = get_base_type (gnu_type);
-      tree gnu_one_node = convert (gnu_base_type, integer_one_node);
-      tree gnu_first, gnu_last;
-      enum tree_code update_code, test_code, shift_code;
-      bool reverse = Reverse_Present (gnat_loop_spec), fallback = false;
+      tree gnu_first, gnu_last, gnu_limit, gnu_test;
+      enum tree_code update_code, test_code;
 
       /* We must disable modulo reduction for the iteration variable, if any,
         in order for the loop comparison to be effective.  */
@@ -2140,7 +2147,7 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
          gnu_last = gnu_low;
          update_code = MINUS_NOMOD_EXPR;
          test_code = GE_EXPR;
-         shift_code = PLUS_NOMOD_EXPR;
+         gnu_limit = TYPE_MIN_VALUE (gnu_base_type);
        }
       else
        {
@@ -2148,110 +2155,17 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
          gnu_last = gnu_high;
          update_code = PLUS_NOMOD_EXPR;
          test_code = LE_EXPR;
-         shift_code = MINUS_NOMOD_EXPR;
+         gnu_limit = TYPE_MAX_VALUE (gnu_base_type);
        }
 
-      /* We use two different strategies to translate the loop, depending on
-        whether optimization is enabled.
-
-        If it is, we try to generate the canonical form of loop expected by
-        the loop optimizer, which is the do-while form:
-
-            ENTRY_COND
-          loop:
-            TOP_UPDATE
-            BODY
-            BOTTOM_COND
-            GOTO loop
-
-        This makes it possible to bypass loop header copying and to turn the
-        BOTTOM_COND into an inequality test.  This should catch (almost) all
-        loops with constant starting point.  If we cannot, we try to generate
-        the default form, which is:
-
-          loop:
-            TOP_COND
-            BODY
-            BOTTOM_UPDATE
-            GOTO loop
-
-        It will be rotated during loop header copying and an entry test added
-        to yield the do-while form.  This should catch (almost) all loops with
-        constant ending point.  If we cannot, we generate the fallback form:
-
-            ENTRY_COND
-          loop:
-            BODY
-            BOTTOM_COND
-            BOTTOM_UPDATE
-            GOTO loop
-
-        which works in all cases but for which loop header copying will copy
-        the BOTTOM_COND, thus adding a third conditional branch.
-
-        If optimization is disabled, loop header copying doesn't come into
-        play and we try to generate the loop forms with the less conditional
-        branches directly.  First, the default form, it should catch (almost)
-        all loops with constant ending point.  Then, if we cannot, we try to
-        generate the shifted form:
-
-          loop:
-            TOP_COND
-            TOP_UPDATE
-            BODY
-            GOTO loop
-
-        which should catch loops with constant starting point.  Otherwise, if
-        we cannot, we generate the fallback form.  */
-
-      if (optimize)
-       {
-         /* We can use the do-while form if GNU_FIRST-1 doesn't overflow.  */
-         if (!can_equal_min_val_p (gnu_first, gnu_base_type, reverse))
-           {
-             gnu_first = build_binary_op (shift_code, gnu_base_type,
-                                          gnu_first, gnu_one_node);
-             LOOP_STMT_TOP_UPDATE_P (gnu_loop_stmt) = 1;
-             LOOP_STMT_BOTTOM_COND_P (gnu_loop_stmt) = 1;
-           }
-
-         /* Otherwise, we can use the default form if GNU_LAST+1 doesn't.  */
-         else if (!can_equal_max_val_p (gnu_last, gnu_base_type, reverse))
-           ;
-
-         /* Otherwise, use the fallback form.  */
-         else
-           fallback = true;
-       }
-      else
-       {
-         /* We can use the default form if GNU_LAST+1 doesn't overflow.  */
-         if (!can_equal_max_val_p (gnu_last, gnu_base_type, reverse))
-           ;
-
-         /* Otherwise, we can use the shifted form if neither GNU_FIRST-1 nor
-            GNU_LAST-1 does.  */
-         else if (!can_equal_min_val_p (gnu_first, gnu_base_type, reverse)
-                  && !can_equal_min_val_p (gnu_last, gnu_base_type, reverse))
-           {
-             gnu_first = build_binary_op (shift_code, gnu_base_type,
-                                          gnu_first, gnu_one_node);
-             gnu_last = build_binary_op (shift_code, gnu_base_type,
-                                         gnu_last, gnu_one_node);
-             LOOP_STMT_TOP_UPDATE_P (gnu_loop_stmt) = 1;
-           }
-
-         /* Otherwise, use the fallback form.  */
-         else
-           fallback = true;
-       }
-
-      if (fallback)
-       LOOP_STMT_BOTTOM_COND_P (gnu_loop_stmt) = 1;
-
-      /* If we use the BOTTOM_COND, we can turn the test into an inequality
-        test but we have to add an ENTRY_COND to protect the empty loop.  */
-      if (LOOP_STMT_BOTTOM_COND_P (gnu_loop_stmt))
+      /* We know that the iteration variable will not overflow if GNU_LAST is
+        a constant and is not equal to GNU_LIMIT.  If it might overflow, we
+        have to turn the limit test into an inequality test and move it to
+        the end of the loop; as a consequence, we also have to test for an
+        empty loop before entering it.  */
+      if (TREE_CODE (gnu_last) != INTEGER_CST
+         || TREE_CODE (gnu_limit) != INTEGER_CST
+         || tree_int_cst_equal (gnu_last, gnu_limit))
        {
          test_code = NE_EXPR;
          gnu_cond_expr
@@ -2260,6 +2174,7 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
                                       gnu_low, gnu_high),
                      NULL_TREE, alloc_stmt_list ());
          set_expr_location_from_node (gnu_cond_expr, gnat_loop_spec);
+         test_code = NE_EXPR;
        }
 
       /* Open a new nesting level that will surround the loop to declare the
@@ -2275,10 +2190,14 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
       /* Do all the arithmetics in the base type.  */
       gnu_loop_var = convert (gnu_base_type, gnu_loop_var);
 
-      /* Set either the top or bottom exit condition.  */
-      LOOP_STMT_COND (gnu_loop_stmt)
-       = build_binary_op (test_code, boolean_type_node, gnu_loop_var,
-                          gnu_last);
+      /* Set either the top or bottom exit condition as appropriate depending
+        on whether or not we know an overflow cannot occur.  */
+      gnu_test = build_binary_op (test_code, integer_type_node, gnu_loop_var,
+                                 gnu_last);
+      if (gnu_cond_expr)
+       LOOP_STMT_BOT_COND (gnu_loop_stmt) = gnu_test;
+      else
+       LOOP_STMT_TOP_COND (gnu_loop_stmt) = gnu_test;
 
       /* Set either the top or bottom update statement and give it the source
         location of the iteration for better coverage info.  */
@@ -3564,9 +3483,10 @@ Compilation_Unit_to_gnu (Node_Id gnat_node)
 
   /* Initialize the information structure for the function.  */
   allocate_struct_function (gnu_elab_proc_decl, false);
-  Sloc_to_locus (Sloc (gnat_unit_entity), &cfun->function_end_locus);
-  current_function_decl = NULL_TREE;
   set_cfun (NULL);
+
+  current_function_decl = NULL_TREE;
+
   start_stmt_group ();
   gnat_pushlevel ();
 
@@ -5389,8 +5309,8 @@ gnat_to_gnu (Node_Id gnat_node)
                gnu_actual_obj_type
                  = build_unc_object_type_from_ptr (gnu_ptr_type,
                                                    gnu_actual_obj_type,
-                                                   get_identifier ("DEALLOC"),
-                                                   false);
+                                                   get_identifier
+                                                   ("DEALLOC"));
            }
          else
            gnu_actual_obj_type = gnu_obj_type;
@@ -5403,6 +5323,12 @@ gnat_to_gnu (Node_Id gnat_node)
              tree gnu_char_ptr_type
                = build_pointer_type (unsigned_char_type_node);
              tree gnu_pos = byte_position (TYPE_FIELDS (gnu_obj_type));
+             tree gnu_byte_offset
+               = convert (sizetype,
+                          size_diffop (size_zero_node, gnu_pos));
+             gnu_byte_offset
+               = fold_build1 (NEGATE_EXPR, sizetype, gnu_byte_offset);
+
              gnu_ptr = convert (gnu_char_ptr_type, gnu_ptr);
              gnu_ptr = build_binary_op (POINTER_PLUS_EXPR, gnu_char_ptr_type,
                                         gnu_ptr, gnu_pos);
@@ -7574,13 +7500,21 @@ post_error_ne (const char *msg, Node_Id node, Entity_Id ent)
     Error_Msg_NE (fp, node, ent);
 }
 
-/* Similar to post_error_ne, but NUM is the number to use for the '^'.  */
+/* Similar, but NODE is the node at which to post the error, ENT is the node
+   to use for the "&" substitution, and NUM is the number to use for ^.  */
 
 void
 post_error_ne_num (const char *msg, Node_Id node, Entity_Id ent, int num)
 {
+  String_Template temp;
+  Fat_Pointer fp;
+
+  temp.Low_Bound = 1, temp.High_Bound = strlen (msg);
+  fp.Array = msg, fp.Bounds = &temp;
   Error_Msg_Uint_1 = UI_From_Int (num);
-  post_error_ne (msg, node, ent);
+
+  if (Present (node))
+    Error_Msg_NE (fp, node, ent);
 }
 \f
 /* Similar to post_error_ne, but T is a GCC tree representing the number to
@@ -7621,7 +7555,8 @@ post_error_ne_tree (const char *msg, Node_Id node, Entity_Id ent, tree t)
   post_error_ne (new_msg, node, ent);
 }
 
-/* Similar to post_error_ne_tree, but NUM is a second integer to write.  */
+/* Similar to post_error_ne_tree, except that NUM is a second integer to write
+   in the message.  */
 
 void
 post_error_ne_tree_2 (const char *msg, Node_Id node, Entity_Id ent, tree t,