ada-tree.def (PLUS_NOMOD_EXPR): New tree code.

	* gcc-interface/ada-tree.def (PLUS_NOMOD_EXPR): New tree code.
	(MINUS_NOMOD_EXPR): Likewise.
	* gcc-interface/utils2.c (build_binary_op) <PREINCREMENT_EXPR>: Make
	unreachable.
	<PLUS_NOMOD_EXPR>: New case.
	<MINUS_NOMOD_EXPR>: Likewise.
	* gcc-interface/trans.c (Loop_Statement_to_gnu): Build increment-and-
	assignment statement instead of using an increment operator.

From-SVN: r141714

gcc/ada/ChangeLog

+2008-11-09  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/ada-tree.def (PLUS_NOMOD_EXPR): New tree code.
+	(MINUS_NOMOD_EXPR): Likewise.
+	* gcc-interface/utils2.c (build_binary_op) <PREINCREMENT_EXPR>: Make
+	unreachable.
+	<PLUS_NOMOD_EXPR>: New case.
+	<MINUS_NOMOD_EXPR>: Likewise.
+	* gcc-interface/trans.c (Loop_Statement_to_gnu): Build increment-and-
+	assignment statement instead of using an increment operator.
+
 2008-11-07  Rainer Orth  <ro@TechFak.Uni-Bielefeld.DE>
 
 	* system-irix-n64.ads: New file.

gcc/ada/gcc-interface/ada-tree.def

@@ -41,6 +41,14 @@ DEFTREECODE (UNCONSTRAINED_ARRAY_REF, "unconstrained_array_ref",
    is an expression to be evaluated for side effects only.  */
 DEFTREECODE (NULL_EXPR, "null_expr", tcc_expression, 1)
 
+/* Same as PLUS_EXPR, except that no modulo reduction is applied.
+   This is used for loops and never shows up in the tree.  */
+DEFTREECODE (PLUS_NOMOD_EXPR, "plus_nomod_expr", tcc_binary, 2)
+
+/* Same as MINUS_EXPR, except that no modulo reduction is applied.
+   This is used for loops and never shows up in the tree.  */
+DEFTREECODE (MINUS_NOMOD_EXPR, "minus_nomod_expr", tcc_binary, 2)
+
 /* Same as ADDR_EXPR, except that if the operand represents a bit field,
    return the address of the byte containing the bit.  This is used
    for the 'Address attribute and never shows up in the tree.  */

gcc/ada/gcc-interface/trans.c

@@ -1714,13 +1714,28 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
       tree gnu_type = get_unpadded_type (gnat_type);
       tree gnu_low = TYPE_MIN_VALUE (gnu_type);
       tree gnu_high = TYPE_MAX_VALUE (gnu_type);
-      bool reversep = Reverse_Present (gnat_loop_spec);
-      tree gnu_first = reversep ? gnu_high : gnu_low;
-      tree gnu_last = reversep ? gnu_low : gnu_high;
-      enum tree_code end_code = reversep ? GE_EXPR : LE_EXPR;
+      tree gnu_first, gnu_last, gnu_limit;
+      enum tree_code update_code, end_code;
       tree gnu_base_type = get_base_type (gnu_type);
-      tree gnu_limit = (reversep ? TYPE_MIN_VALUE (gnu_base_type)
-			: TYPE_MAX_VALUE (gnu_base_type));
+
+      /* We must disable modulo reduction for the loop variable, if any,
+	 in order for the loop comparison to be effective.  */
+      if (Reverse_Present (gnat_loop_spec))
+	{
+	  gnu_first = gnu_high;
+	  gnu_last = gnu_low;
+	  update_code = MINUS_NOMOD_EXPR;
+	  end_code = GE_EXPR;
+	  gnu_limit = TYPE_MIN_VALUE (gnu_base_type);
+	}
+      else
+	{
+	  gnu_first = gnu_low;
+	  gnu_last = gnu_high;
+	  update_code = PLUS_NOMOD_EXPR;
+	  end_code = LE_EXPR;
+	  gnu_limit = TYPE_MAX_VALUE (gnu_base_type);
+	}
 
       /* We know the loop variable will not overflow if GNU_LAST is a constant
 	 and is not equal to GNU_LIMIT.  If it might overflow, we have to move
@@ -1764,12 +1779,13 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
 			     gnu_loop_var, gnu_last);
 
       LOOP_STMT_UPDATE (gnu_loop_stmt)
-	= build_binary_op (reversep ? PREDECREMENT_EXPR
-			   : PREINCREMENT_EXPR,
-			   TREE_TYPE (gnu_loop_var),
+	= build_binary_op (MODIFY_EXPR, NULL_TREE,
 			   gnu_loop_var,
-			   convert (TREE_TYPE (gnu_loop_var),
-				    integer_one_node));
+			   build_binary_op (update_code,
+					    TREE_TYPE (gnu_loop_var),
+					    gnu_loop_var,
+					    convert (TREE_TYPE (gnu_loop_var),
+						     integer_one_node)));
       set_expr_location_from_node (LOOP_STMT_UPDATE (gnu_loop_stmt),
 				   gnat_iter_scheme);
     }

gcc/ada/gcc-interface/utils2.c

@@ -943,21 +943,8 @@ build_binary_op (enum tree_code op_code, tree result_type,
     case PREDECREMENT_EXPR:
     case POSTINCREMENT_EXPR:
     case POSTDECREMENT_EXPR:
-      /* In these, the result type and the left operand type should be the
-	 same.  Do the operation in the base type of those and convert the
-	 right operand (which is an integer) to that type.
-
-	 Note that these operations are only used in loop control where
-	 we guarantee that no overflow can occur.  So nothing special need
-	 be done for modular types.  */
-
-      gcc_assert (left_type == result_type);
-      operation_type = get_base_type (result_type);
-      left_operand = convert (operation_type, left_operand);
-      right_operand = convert (operation_type, right_operand);
-      has_side_effects = true;
-      modulus = NULL_TREE;
-      break;
+      /* These operations are not used anymore.  */
+      gcc_unreachable ();
 
     case LSHIFT_EXPR:
     case RSHIFT_EXPR:
@@ -1011,6 +998,16 @@ build_binary_op (enum tree_code op_code, tree result_type,
       right_operand = convert (sizetype, right_operand);
       break;
 
+    case PLUS_NOMOD_EXPR:
+    case MINUS_NOMOD_EXPR:
+      if (op_code == PLUS_NOMOD_EXPR)
+	op_code = PLUS_EXPR;
+      else
+	op_code = MINUS_EXPR;
+      modulus = NULL_TREE;
+
+      /* ... fall through ... */
+
     case PLUS_EXPR:
     case MINUS_EXPR:
       /* Avoid doing arithmetics in BOOLEAN_TYPE like the other compilers.
@@ -1018,7 +1015,8 @@ build_binary_op (enum tree_code op_code, tree result_type,
 	 but we can generate addition or subtraction for 'Succ and 'Pred.  */
       if (operation_type && TREE_CODE (operation_type) == BOOLEAN_TYPE)
 	operation_type = left_base_type = right_base_type = integer_type_node;
-      goto common;
+
+      /* ... fall through ... */
 
     default:
     common:

gcc/testsuite/ChangeLog

+2008-11-09  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/loop_boolean.adb: New test.
+
 2008-11-07  Thomas Quinot  <quinot@adacore.com>
 
 	* gnat.dg/hyper_flat.adb: New test.

gcc/testsuite/gnat.dg/loop_boolean.adb

+-- { dg-do run }
+-- { dg-options "-gnatVaM" }
+
+procedure Loop_Boolean is
+
+  type R is record
+    B : Boolean;
+  end record;
+
+  procedure proc (X : R) is
+    B : Boolean;
+  begin
+    B := X.B;
+  end;
+
+begin
+  for I in reverse Boolean loop
+    Proc ((B => I));
+  end loop;
+end;