* gcc-interface/ada-tree.h (DECL_LOOP_PARM_P): New flag.

	(DECL_INDUCTION_VAR): New macro.
	(SET_DECL_INDUCTION_VAR): Likewise.
	* gcc-interface/gigi.h (convert_to_index_type): Declare.
	(gnat_invariant_expr): Likewise.
	* gcc-interface/decl.c (gnat_to_gnu_entity) <object>: If this is a loop
	parameter, set DECL_LOOP_PARM_P on it.
	* gcc-interface/misc.c (gnat_print_decl) <VAR_DECL>: If DECL_LOOP_PARM_P
	is set, print DECL_INDUCTION_VAR instead of DECL_RENAMED_OBJECT.
	* gcc-interface/trans.c (gnu_loop_label_stack): Delete.
	(struct range_check_info_d): New type.
	(struct loop_info_d): Likewise.
	(gnu_loop_stack): New stack.
	(Identifier_to_gnu): Set TREE_READONLY flag on the first dereference
	built for a by-double-ref read-only parameter.  If DECL_LOOP_PARM_P
	is set, do not test DECL_RENAMED_OBJECT.
	(push_range_check_info): New function.
	(Loop_Statement_to_gnu): Push a new struct loop_info_d instead of just
	the label.  Reference the label and the iteration variable from it.
	Build the special induction variable in the unsigned version of the
	size type, if it is larger than the base type.  And attach it to the
	iteration variable if the latter isn't by-ref.  In the iteration scheme
	case, initialize the invariant conditions in front of the loop if
	deemed profitable.  Use gnu_loop_stack.
	(gnat_to_gnu) <N_Exit_Statement>: Use gnu_loop_stack.
	<N_Raise_Constraint_Error>: Always process the reason.  In the range
	check and related cases, and if loop unswitching is enabled, compute
	invariant conditions and push this information onto the stack.
	Do not translate again the condition if it has been already translated.
	* gcc-interface/utils.c (record_global_renaming_pointer): Assert that
	DECL_LOOP_PARM_P isn't set.
	(convert_to_index_type): New function.
	* gcc-interface/utils2.c (build_binary_op) <ARRAY_REF>: Use it in order
	to convert the index from the base index type to sizetype.
	(gnat_invariant_expr): New function.


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

27 files changed, 1325 insertions, 69 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index bbcb20bafcc..07a734e7729 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,11 +1,47 @@
+2011-10-12  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/ada-tree.h (DECL_LOOP_PARM_P): New flag.
+	(DECL_INDUCTION_VAR): New macro.
+	(SET_DECL_INDUCTION_VAR): Likewise.
+	* gcc-interface/gigi.h (convert_to_index_type): Declare.
+	(gnat_invariant_expr): Likewise.
+	* gcc-interface/decl.c (gnat_to_gnu_entity) <object>: If this is a loop
+	parameter, set DECL_LOOP_PARM_P on it.
+	* gcc-interface/misc.c (gnat_print_decl) <VAR_DECL>: If DECL_LOOP_PARM_P
+	is set, print DECL_INDUCTION_VAR instead of DECL_RENAMED_OBJECT.
+	* gcc-interface/trans.c (gnu_loop_label_stack): Delete.
+	(struct range_check_info_d): New type.
+	(struct loop_info_d): Likewise.
+	(gnu_loop_stack): New stack.
+	(Identifier_to_gnu): Set TREE_READONLY flag on the first dereference
+	built for a by-double-ref read-only parameter.  If DECL_LOOP_PARM_P
+	is set, do not test DECL_RENAMED_OBJECT.
+	(push_range_check_info): New function.
+	(Loop_Statement_to_gnu): Push a new struct loop_info_d instead of just
+	the label.  Reference the label and the iteration variable from it.
+	Build the special induction variable in the unsigned version of the
+	size type, if it is larger than the base type.  And attach it to the
+	iteration variable if the latter isn't by-ref.  In the iteration scheme
+	case, initialize the invariant conditions in front of the loop if
+	deemed profitable.  Use gnu_loop_stack.
+	(gnat_to_gnu) <N_Exit_Statement>: Use gnu_loop_stack.
+	<N_Raise_Constraint_Error>: Always process the reason.  In the range
+	check and related cases, and if loop unswitching is enabled, compute
+	invariant conditions and push this information onto the stack.
+	Do not translate again the condition if it has been already translated.
+	* gcc-interface/utils.c (record_global_renaming_pointer): Assert that
+	DECL_LOOP_PARM_P isn't set.
+	(convert_to_index_type): New function.
+	* gcc-interface/utils2.c (build_binary_op) <ARRAY_REF>: Use it in order
+	to convert the index from the base index type to sizetype.
+	(gnat_invariant_expr): New function.
+
 2011-10-11  Michael Meissner  <meissner@linux.vnet.ibm.com>
 
 	* gcc-interface/utils.c (def_builtin_1): Delete old interface with
 	two parallel arrays to hold standard builtin declarations, and
 	replace it with a function based interface that can support
-	creating builtins on the fly in the future.  Change all uses, and
-	poison the old names.  Make sure 0 is not a legitimate builtin
-	index.
+	creating builtins on the fly in the future.
 	* gcc-interface/trans.c (Exception_Handler_to_gnu_zcx): Ditto.
 	(gnat_to_gnu): Ditto.
 
diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h
index d10fcf0ad92..c408de30296 100644
--- a/gcc/ada/gcc-interface/ada-tree.h
+++ b/gcc/ada/gcc-interface/ada-tree.h
@@ -355,6 +355,9 @@ do {						   \
 /* Nonzero in a DECL if it is made for a pointer that can never be null.  */
 #define DECL_CAN_NEVER_BE_NULL_P(NODE) DECL_LANG_FLAG_2 (NODE)
 
+/* Nonzero in a VAR_DECL if it is made for a loop parameter.  */
+#define DECL_LOOP_PARM_P(NODE) DECL_LANG_FLAG_3 (VAR_DECL_CHECK (NODE))
+
 /* Nonzero in a FIELD_DECL that is a dummy built for some internal reason.  */
 #define DECL_INTERNAL_P(NODE) DECL_LANG_FLAG_3 (FIELD_DECL_CHECK (NODE))
 
@@ -409,9 +412,16 @@ do {						   \
    || (DECL_ORIGINAL_FIELD (FIELD1)					\
        && (DECL_ORIGINAL_FIELD (FIELD1) == DECL_ORIGINAL_FIELD (FIELD2))))
 
-/* In a VAR_DECL, points to the object being renamed if the VAR_DECL is a
-   renaming pointer, otherwise 0.  Note that this object is guaranteed to
-   be protected against multiple evaluations.  */
+/* In a VAR_DECL with the DECL_LOOP_PARM_P flag set, points to the special
+   induction variable that is built under certain circumstances, if any.  */
+#define DECL_INDUCTION_VAR(NODE) \
+  GET_DECL_LANG_SPECIFIC (VAR_DECL_CHECK (NODE))
+#define SET_DECL_INDUCTION_VAR(NODE, X) \
+  SET_DECL_LANG_SPECIFIC (VAR_DECL_CHECK (NODE), X)
+
+/* In a VAR_DECL without the DECL_LOOP_PARM_P flag set and that is a renaming
+   pointer, points to the object being renamed, if any.  Note that this object
+   is guaranteed to be protected against multiple evaluations.  */
 #define DECL_RENAMED_OBJECT(NODE) \
   GET_DECL_LANG_SPECIFIC (VAR_DECL_CHECK (NODE))
 #define SET_DECL_RENAMED_OBJECT(NODE, X) \
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index feb353ba783..81f891fee63 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -1431,10 +1431,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	    TREE_ADDRESSABLE (gnu_decl) = 1;
 	  }
 
+	/* If this is a loop parameter, set the corresponding flag.  */
+	else if (kind == E_Loop_Parameter)
+	  DECL_LOOP_PARM_P (gnu_decl) = 1;
+
 	/* If this is a renaming pointer, attach the renamed object to it and
 	   register it if we are at the global level.  Note that an external
 	   constant is at the global level.  */
-	if (TREE_CODE (gnu_decl) == VAR_DECL && renamed_obj)
+	else if (TREE_CODE (gnu_decl) == VAR_DECL && renamed_obj)
 	  {
 	    SET_DECL_RENAMED_OBJECT (gnu_decl, renamed_obj);
 	    if ((!definition && kind == E_Constant) || global_bindings_p ())
diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h
index f7f9b09272e..143926160ac 100644
--- a/gcc/ada/gcc-interface/gigi.h
+++ b/gcc/ada/gcc-interface/gigi.h
@@ -492,6 +492,10 @@ extern bool fntype_same_flags_p (const_tree, tree, bool, bool, bool);
    not permitted by the language being compiled.  */
 extern tree convert (tree type, tree expr);
 
+/* Create an expression whose value is that of EXPR converted to the common
+   index type, which is sizetype.  */
+extern tree convert_to_index_type (tree expr);
+
 /* Routines created solely for the tree translator's sake. Their prototypes
    can be changed as desired.  */
 
@@ -916,6 +920,11 @@ extern tree gnat_protect_expr (tree exp);
    through something we don't know how to stabilize.  */
 extern tree gnat_stabilize_reference (tree ref, bool force, bool *success);
 
+/* If EXPR is an expression that is invariant in the current function, in the
+   sense that it can be evaluated anywhere in the function and any number of
+   times, return EXPR or an equivalent expression.  Otherwise return NULL.  */
+extern tree gnat_invariant_expr (tree expr);
+
 /* Implementation of the builtin_function langhook.  */
 extern tree gnat_builtin_function (tree decl);
 
diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c
index f651af5afe3..9b667125225 100644
--- a/gcc/ada/gcc-interface/misc.c
+++ b/gcc/ada/gcc-interface/misc.c
@@ -394,8 +394,12 @@ gnat_print_decl (FILE *file, tree node, int indent)
       break;
 
     case VAR_DECL:
-      print_node (file, "renamed object", DECL_RENAMED_OBJECT (node),
-		  indent + 4);
+      if (DECL_LOOP_PARM_P (node))
+	print_node (file, "induction var", DECL_INDUCTION_VAR (node),
+		    indent + 4);
+      else
+	print_node (file, "renamed object", DECL_RENAMED_OBJECT (node),
+		    indent + 4);
       break;
 
     default:
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 858810ae4e8..cd84dc7eaf2 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -189,8 +189,33 @@ static GTY(()) VEC(tree,gc) *gnu_return_label_stack;
    parameters.  See processing for N_Subprogram_Body.  */
 static GTY(()) VEC(tree,gc) *gnu_return_var_stack;
 
-/* Stack of LOOP_STMT nodes.  */
-static GTY(()) VEC(tree,gc) *gnu_loop_label_stack;
+/* Structure used to record information for a range check.  */
+struct GTY(()) range_check_info_d {
+  tree low_bound;
+  tree high_bound;
+  tree type;
+  tree invariant_cond;
+};
+
+typedef struct range_check_info_d *range_check_info;
+
+DEF_VEC_P(range_check_info);
+DEF_VEC_ALLOC_P(range_check_info,gc);
+
+/* Structure used to record information for a loop.  */
+struct GTY(()) loop_info_d {
+  tree label;
+  tree loop_var;
+  VEC(range_check_info,gc) *checks;
+};
+
+typedef struct loop_info_d *loop_info;
+
+DEF_VEC_P(loop_info);
+DEF_VEC_ALLOC_P(loop_info,gc);
+
+/* Stack of loop_info structures associated with LOOP_STMT nodes.  */
+static GTY(()) VEC(loop_info,gc) *gnu_loop_stack;
 
 /* The stacks for N_{Push,Pop}_*_Label.  */
 static GTY(()) VEC(tree,gc) *gnu_constraint_error_label_stack;
@@ -1008,6 +1033,9 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
 	  gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_result);
 	  if (TREE_CODE (gnu_result) == INDIRECT_REF)
 	    TREE_THIS_NOTRAP (gnu_result) = 1;
+
+	  if (read_only)
+	    TREE_READONLY (gnu_result) = 1;
 	}
 
       /* If it's a PARM_DECL to foreign convention subprogram, convert it.  */
@@ -1024,6 +1052,7 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
 	 we can reference the renamed object directly, since the renamed
 	 expression has been protected against multiple evaluations.  */
       if (TREE_CODE (gnu_result) == VAR_DECL
+          && !DECL_LOOP_PARM_P (gnu_result)
 	  && DECL_RENAMED_OBJECT (gnu_result)
 	  && (!DECL_RENAMING_GLOBAL_P (gnu_result) || global_bindings_p ()))
 	gnu_result = DECL_RENAMED_OBJECT (gnu_result);
@@ -2114,6 +2143,44 @@ Case_Statement_to_gnu (Node_Id gnat_node)
   return gnu_result;
 }
 
+/* Find out whether VAR is an iteration variable of an enclosing loop in the
+   current function.  If so, push a range_check_info structure onto the stack
+   of this enclosing loop and return it.  Otherwise, return NULL.  */
+
+static struct range_check_info_d *
+push_range_check_info (tree var)
+{
+  struct loop_info_d *iter = NULL;
+  unsigned int i;
+
+  if (VEC_empty (loop_info, gnu_loop_stack))
+    return NULL;
+
+  while (CONVERT_EXPR_P (var) || TREE_CODE (var) == VIEW_CONVERT_EXPR)
+    var = TREE_OPERAND (var, 0);
+
+  if (TREE_CODE (var) != VAR_DECL)
+    return NULL;
+
+  if (decl_function_context (var) != current_function_decl)
+    return NULL;
+
+  for (i = VEC_length (loop_info, gnu_loop_stack) - 1;
+       VEC_iterate (loop_info, gnu_loop_stack, i, iter);
+       i--)
+    if (var == iter->loop_var)
+      break;
+
+  if (iter)
+    {
+      struct range_check_info_d *rci = ggc_alloc_range_check_info_d ();
+      VEC_safe_push (range_check_info, gc, iter->checks, rci);
+      return rci;
+    }
+
+  return NULL;
+}
+
 /* Return true if VAL (of type TYPE) can equal the minimum value if MAX is
    false, or the maximum value if MAX is true, of TYPE.  */
 
@@ -2181,10 +2248,15 @@ static tree
 Loop_Statement_to_gnu (Node_Id gnat_node)
 {
   const Node_Id gnat_iter_scheme = Iteration_Scheme (gnat_node);
+  struct loop_info_d *gnu_loop_info = ggc_alloc_cleared_loop_info_d ();
   tree gnu_loop_stmt = build4 (LOOP_STMT, void_type_node, NULL_TREE,
 			       NULL_TREE, NULL_TREE, NULL_TREE);
   tree gnu_loop_label = create_artificial_label (input_location);
-  tree gnu_cond_expr = NULL_TREE, gnu_result;
+  tree gnu_cond_expr = NULL_TREE, gnu_low = NULL_TREE, gnu_high = NULL_TREE;
+  tree gnu_result;
+
+  /* Push the loop_info structure associated with the LOOP_STMT.  */
+  VEC_safe_push (loop_info, gc, gnu_loop_stack, gnu_loop_info);
 
   /* Set location information for statement and end label.  */
   set_expr_location_from_node (gnu_loop_stmt, gnat_node);
@@ -2192,9 +2264,8 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
 		 &DECL_SOURCE_LOCATION (gnu_loop_label));
   LOOP_STMT_LABEL (gnu_loop_stmt) = gnu_loop_label;
 
-  /* Save the end label of this LOOP_STMT in a stack so that a corresponding
-     N_Exit_Statement can find it.  */
-  VEC_safe_push (tree, gc, gnu_loop_label_stack, gnu_loop_label);
+  /* Save the label so that a corresponding N_Exit_Statement can find it.  */
+  gnu_loop_info->label = gnu_loop_label;
 
   /* Set the condition under which the loop must keep going.
      For the case "LOOP .... END LOOP;" the condition is always true.  */
@@ -2214,14 +2285,15 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
       Entity_Id gnat_loop_var = Defining_Entity (gnat_loop_spec);
       Entity_Id gnat_type = Etype (gnat_loop_var);
       tree gnu_type = get_unpadded_type (gnat_type);
-      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_loop_var, gnu_loop_iv, gnu_first, gnu_last, gnu_stmt;
       enum tree_code update_code, test_code, shift_code;
       bool reverse = Reverse_Present (gnat_loop_spec), use_iv = false;
 
+      gnu_low = TYPE_MIN_VALUE (gnu_type);
+      gnu_high = TYPE_MAX_VALUE (gnu_type);
+
       /* We must disable modulo reduction for the iteration variable, if any,
 	 in order for the loop comparison to be effective.  */
       if (reverse)
@@ -2296,17 +2368,20 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
 	    ;
 
 	  /* Otherwise, use the do-while form with the help of a special
-	     induction variable in the (unsigned version of) the base
-	     type, in order to have wrap-around arithmetics for it.  */
+	     induction variable in the unsigned version of the base type
+	     or the unsigned version of the size type, whichever is the
+	     largest, in order to have wrap-around arithmetics for it.  */
 	  else
 	    {
-	      if (!TYPE_UNSIGNED (gnu_base_type))
-		{
-		  gnu_base_type = gnat_unsigned_type (gnu_base_type);
-		  gnu_first = convert (gnu_base_type, gnu_first);
-		  gnu_last = convert (gnu_base_type, gnu_last);
-		  gnu_one_node = convert (gnu_base_type, integer_one_node);
-		}
+	      if (TYPE_PRECISION (gnu_base_type)
+		  > TYPE_PRECISION (size_type_node))
+		gnu_base_type = gnat_unsigned_type (gnu_base_type);
+	      else
+		gnu_base_type = size_type_node;
+
+	      gnu_first = convert (gnu_base_type, gnu_first);
+	      gnu_last = convert (gnu_base_type, gnu_last);
+	      gnu_one_node = convert (gnu_base_type, integer_one_node);
 	      use_iv = true;
 	    }
 
@@ -2379,6 +2454,12 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
       gnu_loop_var = gnat_to_gnu_entity (gnat_loop_var, gnu_first, 1);
       if (DECL_BY_REF_P (gnu_loop_var))
 	gnu_loop_var = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_loop_var);
+      else if (use_iv)
+	{
+	  gcc_assert (DECL_LOOP_PARM_P (gnu_loop_var));
+	  SET_DECL_INDUCTION_VAR (gnu_loop_var, gnu_loop_iv);
+	}
+      gnu_loop_info->loop_var = gnu_loop_var;
 
       /* Do all the arithmetics in the base type.  */
       gnu_loop_var = convert (gnu_base_type, gnu_loop_var);
@@ -2437,6 +2518,45 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
      the LOOP_STMT to it, finish it and make it the "loop".  */
   if (Present (gnat_iter_scheme) && No (Condition (gnat_iter_scheme)))
     {
+      struct range_check_info_d *rci;
+      unsigned n_checks = VEC_length (range_check_info, gnu_loop_info->checks);
+      unsigned int i;
+
+      /* First, if we have computed a small number of invariant conditions for
+	 range checks applied to the iteration variable, then initialize these
+	 conditions in front of the loop.  Otherwise, leave them set to True.
+
+	 ??? The heuristics need to be improved, by taking into account the
+	     following datapoints:
+	       - loop unswitching is disabled for big loops.  The cap is the
+		 parameter PARAM_MAX_UNSWITCH_INSNS (50).
+	       - loop unswitching can only be applied a small number of times
+		 to a given loop.  The cap is PARAM_MAX_UNSWITCH_LEVEL (3).
+	       - the front-end quickly generates useless or redundant checks
+		 that can be entirely optimized away in the end.  */
+      if (1 <= n_checks && n_checks <= 4)
+	for (i = 0;
+	     VEC_iterate (range_check_info, gnu_loop_info->checks, i, rci);
+	     i++)
+	  {
+	    tree low_ok
+	      = build_binary_op (GE_EXPR, boolean_type_node,
+				 convert (rci->type, gnu_low),
+				 rci->low_bound);
+	    tree high_ok
+	      = build_binary_op (LE_EXPR, boolean_type_node,
+				 convert (rci->type, gnu_high),
+				 rci->high_bound);
+	    tree range_ok
+	      = build_binary_op (TRUTH_ANDIF_EXPR, boolean_type_node,
+				 low_ok, high_ok);
+
+	    TREE_OPERAND (rci->invariant_cond, 0)
+	      = build_unary_op (TRUTH_NOT_EXPR, boolean_type_node, range_ok);
+
+	    add_stmt_with_node_force (rci->invariant_cond, gnat_node);
+	  }
+
       add_stmt (gnu_loop_stmt);
       gnat_poplevel ();
       gnu_loop_stmt = end_stmt_group ();
@@ -2453,7 +2573,7 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
   else
     gnu_result = gnu_loop_stmt;
 
-  VEC_pop (tree, gnu_loop_label_stack);
+  VEC_pop (loop_info, gnu_loop_stack);
 
   return gnu_result;
 }
@@ -5588,7 +5708,7 @@ gnat_to_gnu (Node_Id gnat_node)
 		   ? gnat_to_gnu (Condition (gnat_node)) : NULL_TREE),
 		  (Present (Name (gnat_node))
 		   ? get_gnu_tree (Entity (Name (gnat_node)))
-		   : VEC_last (tree, gnu_loop_label_stack)));
+		   : VEC_last (loop_info, gnu_loop_stack)->label));
       break;
 
     case N_Return_Statement:
@@ -6174,7 +6294,11 @@ gnat_to_gnu (Node_Id gnat_node)
     case N_Raise_Storage_Error:
       {
 	const int reason = UI_To_Int (Reason (gnat_node));
-	const Node_Id cond = Condition (gnat_node);
+	const Node_Id gnat_cond = Condition (gnat_node);
+	const bool with_extra_info = Exception_Extra_Info
+				     && !No_Exception_Handlers_Set ()
+				     && !get_exception_label (kind);
+	tree gnu_cond = NULL_TREE;
 
 	if (type_annotate_only)
 	  {
@@ -6184,43 +6308,66 @@ gnat_to_gnu (Node_Id gnat_node)
 
         gnu_result_type = get_unpadded_type (Etype (gnat_node));
 
-	if (Exception_Extra_Info
-	    && !No_Exception_Handlers_Set ()
-	    && !get_exception_label (kind)
-	    && VOID_TYPE_P (gnu_result_type)
-	    && Present (cond))
-	  switch (reason)
-	    {
-	    case CE_Access_Check_Failed:
+	switch (reason)
+	  {
+	  case CE_Access_Check_Failed:
+	    if (with_extra_info)
 	      gnu_result = build_call_raise_column (reason, gnat_node);
-	      break;
+	    break;
 
-	    case CE_Index_Check_Failed:
-	    case CE_Range_Check_Failed:
-	    case CE_Invalid_Data:
-	      if (Nkind (cond) == N_Op_Not
-		  && Nkind (Right_Opnd (cond)) == N_In
-		  && Nkind (Right_Opnd (Right_Opnd (cond))) == N_Range)
-		{
-		  Node_Id op = Right_Opnd (cond);  /* N_In node */
-		  Node_Id index = Left_Opnd (op);
-		  Node_Id range = Right_Opnd (op);
-		  Node_Id type = Etype (index);
-		  if (Is_Type (type)
-		      && Known_Esize (type)
-		      && UI_To_Int (Esize (type)) <= 32)
-		    gnu_result
-		      = build_call_raise_range (reason, gnat_node,
-						gnat_to_gnu (index),
-						gnat_to_gnu
-						(Low_Bound (range)),
-						gnat_to_gnu
-						(High_Bound (range)));
-	        }
-	      break;
+	  case CE_Index_Check_Failed:
+	  case CE_Range_Check_Failed:
+	  case CE_Invalid_Data:
+	    if (Present (gnat_cond)
+		&& Nkind (gnat_cond) == N_Op_Not
+		&& Nkind (Right_Opnd (gnat_cond)) == N_In
+		&& Nkind (Right_Opnd (Right_Opnd (gnat_cond))) == N_Range)
+	      {
+		Node_Id gnat_index = Left_Opnd (Right_Opnd (gnat_cond));
+		Node_Id gnat_type = Etype (gnat_index);
+		Node_Id gnat_range = Right_Opnd (Right_Opnd (gnat_cond));
+		tree gnu_index = gnat_to_gnu (gnat_index);
+		tree gnu_low_bound = gnat_to_gnu (Low_Bound (gnat_range));
+		tree gnu_high_bound = gnat_to_gnu (High_Bound (gnat_range));
+		struct range_check_info_d *rci;
+
+		if (with_extra_info
+		    && Known_Esize (gnat_type)
+		    && UI_To_Int (Esize (gnat_type)) <= 32)
+		  gnu_result
+		    = build_call_raise_range (reason, gnat_node, gnu_index,
+					      gnu_low_bound, gnu_high_bound);
+
+		/* If loop unswitching is enabled, we try to compute invariant
+		   conditions for checks applied to iteration variables, i.e.
+		   conditions that are both independent of the variable and
+		   necessary in order for the check to fail in the course of
+		   some iteration, and prepend them to the original condition
+		   of the checks.  This will make it possible later for the
+		   loop unswitching pass to replace the loop with two loops,
+		   one of which has the checks eliminated and the other has
+		   the original checks reinstated, and a run time selection.
+		   The former loop will be suitable for vectorization.  */
+		if (flag_unswitch_loops
+		    && (gnu_low_bound = gnat_invariant_expr (gnu_low_bound))
+		    && (gnu_high_bound = gnat_invariant_expr (gnu_high_bound))
+		    && (rci = push_range_check_info (gnu_index)))
+		  {
+		    rci->low_bound = gnu_low_bound;
+		    rci->high_bound = gnu_high_bound;
+		    rci->type = gnat_to_gnu_type (gnat_type);
+		    rci->invariant_cond = build1 (SAVE_EXPR, boolean_type_node,
+						  boolean_true_node);
+		    gnu_cond = build_binary_op (TRUTH_ANDIF_EXPR,
+						boolean_type_node,
+						rci->invariant_cond,
+						gnat_to_gnu (gnat_cond));
+		  }
+	      }
+	    break;
 
-	    default:
-	      break;
+	  default:
+	    break;
 	  }
 
 	if (gnu_result == error_mark_node)
@@ -6232,10 +6379,14 @@ gnat_to_gnu (Node_Id gnat_node)
 	   the code for the call.  Handle a condition, if there is one.  */
 	if (VOID_TYPE_P (gnu_result_type))
 	  {
-	    if (Present (cond))
-	      gnu_result
-		= build3 (COND_EXPR, void_type_node, gnat_to_gnu (cond),
-			  gnu_result, alloc_stmt_list ());
+	    if (Present (gnat_cond))
+	      {
+		if (!gnu_cond)
+		  gnu_cond = gnat_to_gnu (gnat_cond);
+		gnu_result
+		  = build3 (COND_EXPR, void_type_node, gnu_cond, gnu_result,
+			    alloc_stmt_list ());
+	      }
 	  }
 	else
 	  gnu_result = build1 (NULL_EXPR, gnu_result_type, gnu_result);
diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index 7c7e7c6c499..c4cfde7e421 100644
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -1771,7 +1771,7 @@ process_attributes (tree decl, struct attrib *attr_list)
 void
 record_global_renaming_pointer (tree decl)
 {
-  gcc_assert (DECL_RENAMED_OBJECT (decl));
+  gcc_assert (!DECL_LOOP_PARM_P (decl) && DECL_RENAMED_OBJECT (decl));
   VEC_safe_push (tree, gc, global_renaming_pointers, decl);
 }
 
@@ -4247,6 +4247,92 @@ convert (tree type, tree expr)
       gcc_unreachable ();
     }
 }
+
+/* Create an expression whose value is that of EXPR converted to the common
+   index type, which is sizetype.  EXPR is supposed to be in the base type
+   of the GNAT index type.  Calling it is equivalent to doing
+
+     convert (sizetype, expr)
+
+   but we try to distribute the type conversion with the knowledge that EXPR
+   cannot overflow in its type.  This is a best-effort approach and we fall
+   back to the above expression as soon as difficulties are encountered.
+
+   This is necessary to overcome issues that arise when the GNAT base index
+   type and the GCC common index type (sizetype) don't have the same size,
+   which is quite frequent on 64-bit architectures.  In this case, and if
+   the GNAT base index type is signed but the iteration type of the loop has
+   been forced to unsigned, the loop scalar evolution engine cannot compute
+   a simple evolution for the general induction variables associated with the
+   array indices, because it will preserve the wrap-around semantics in the
+   unsigned type of their "inner" part.  As a result, many loop optimizations
+   are blocked.
+
+   The solution is to use a special (basic) induction variable that is at
+   least as large as sizetype, and to express the aforementioned general
+   induction variables in terms of this induction variable, eliminating
+   the problematic intermediate truncation to the GNAT base index type.
+   This is possible as long as the original expression doesn't overflow
+   and if the middle-end hasn't introduced artificial overflows in the
+   course of the various simplification it can make to the expression.  */
+
+tree
+convert_to_index_type (tree expr)
+{
+  enum tree_code code = TREE_CODE (expr);
+  tree type = TREE_TYPE (expr);
+
+  /* If the type is unsigned, overflow is allowed so we cannot be sure that
+     EXPR doesn't overflow.  Keep it simple if optimization is disabled.  */
+  if (TYPE_UNSIGNED (type) || !optimize)
+    return convert (sizetype, expr);
+
+  switch (code)
+    {
+    case VAR_DECL:
+      /* The main effect of the function: replace a loop parameter with its
+	 associated special induction variable.  */
+      if (DECL_LOOP_PARM_P (expr) && DECL_INDUCTION_VAR (expr))
+	expr = DECL_INDUCTION_VAR (expr);
+      break;
+
+    CASE_CONVERT:
+      {
+	tree otype = TREE_TYPE (TREE_OPERAND (expr, 0));
+	/* Bail out as soon as we suspect some sort of type frobbing.  */
+	if (TYPE_PRECISION (type) != TYPE_PRECISION (otype)
+	    || TYPE_UNSIGNED (type) != TYPE_UNSIGNED (otype))
+	  break;
+      }
+
+      /* ... fall through ... */
+
+    case NON_LVALUE_EXPR:
+      return fold_build1 (code, sizetype,
+			  convert_to_index_type (TREE_OPERAND (expr, 0)));
+
+    case PLUS_EXPR:
+    case MINUS_EXPR:
+    case MULT_EXPR:
+      return fold_build2 (code, sizetype,
+			  convert_to_index_type (TREE_OPERAND (expr, 0)),
+			  convert_to_index_type (TREE_OPERAND (expr, 1)));
+
+    case COMPOUND_EXPR:
+      return fold_build2 (code, sizetype, TREE_OPERAND (expr, 0),
+			  convert_to_index_type (TREE_OPERAND (expr, 1)));
+
+    case COND_EXPR:
+      return fold_build3 (code, sizetype, TREE_OPERAND (expr, 0),
+			  convert_to_index_type (TREE_OPERAND (expr, 1)),
+			  convert_to_index_type (TREE_OPERAND (expr, 2)));
+
+    default:
+      break;
+    }
+
+  return convert (sizetype, expr);
+}
 
 /* Remove all conversions that are done in EXP.  This includes converting
    from a padded type or to a justified modular type.  If TRUE_ADDRESS
diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c
index cf290a397b1..4679ea85f30 100644
--- a/gcc/ada/gcc-interface/utils2.c
+++ b/gcc/ada/gcc-interface/utils2.c
@@ -798,7 +798,7 @@ build_binary_op (enum tree_code op_code, tree result_type,
       /* Then convert the right operand to its base type.  This will prevent
 	 unneeded sign conversions when sizetype is wider than integer.  */
       right_operand = convert (right_base_type, right_operand);
-      right_operand = convert (sizetype, right_operand);
+      right_operand = convert_to_index_type (right_operand);
       modulus = NULL_TREE;
       break;
 
@@ -2598,3 +2598,88 @@ gnat_stabilize_reference (tree ref, bool force, bool *success)
 
   return result;
 }
+
+/* If EXPR is an expression that is invariant in the current function, in the
+   sense that it can be evaluated anywhere in the function and any number of
+   times, return EXPR or an equivalent expression.  Otherwise return NULL.  */
+
+tree
+gnat_invariant_expr (tree expr)
+{
+  tree type = TREE_TYPE (expr), t;
+
+  STRIP_NOPS (expr);
+
+  while ((TREE_CODE (expr) == CONST_DECL
+	  || (TREE_CODE (expr) == VAR_DECL && TREE_READONLY (expr)))
+	 && decl_function_context (expr) == current_function_decl
+	 && DECL_INITIAL (expr))
+    {
+      expr = DECL_INITIAL (expr);
+      STRIP_NOPS (expr);
+    }
+
+  if (TREE_CONSTANT (expr))
+    return fold_convert (type, expr);
+
+  t = expr;
+
+  while (true)
+    {
+      switch (TREE_CODE (t))
+	{
+	case COMPONENT_REF:
+	  if (TREE_OPERAND (t, 2) != NULL_TREE)
+	    return NULL_TREE;
+	  break;
+
+	case ARRAY_REF:
+	case ARRAY_RANGE_REF:
+	  if (!TREE_CONSTANT (TREE_OPERAND (t, 1))
+	      || TREE_OPERAND (t, 2) != NULL_TREE
+	      || TREE_OPERAND (t, 3) != NULL_TREE)
+	    return NULL_TREE;
+	  break;
+
+	case BIT_FIELD_REF:
+	case VIEW_CONVERT_EXPR:
+	case REALPART_EXPR:
+	case IMAGPART_EXPR:
+	  break;
+
+	case INDIRECT_REF:
+	  if (!TREE_READONLY (t)
+	      || TREE_SIDE_EFFECTS (t)
+	      || !TREE_THIS_NOTRAP (t))
+	    return NULL_TREE;
+	  break;
+
+	default:
+	  goto object;
+	}
+
+      t = TREE_OPERAND (t, 0);
+    }
+
+object:
+  if (TREE_SIDE_EFFECTS (t))
+    return NULL_TREE;
+
+  if (TREE_CODE (t) == CONST_DECL
+      && (DECL_EXTERNAL (t)
+	  || decl_function_context (t) != current_function_decl))
+    return fold_convert (type, expr);
+
+  if (!TREE_READONLY (t))
+    return NULL_TREE;
+
+  if (TREE_CODE (t) == PARM_DECL)
+    return fold_convert (type, expr);
+
+  if (TREE_CODE (t) == VAR_DECL
+      && (DECL_EXTERNAL (t)
+	  || decl_function_context (t) != current_function_decl))
+    return fold_convert (type, expr);
+
+  return NULL_TREE;
+}
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 11a3cc6b106..9e8f1f9b952 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,18 @@
+2011-10-12  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/vect1.ad[sb]: New test.
+	* gnat.dg/vect1_pkg.ads: New helper.
+	* gnat.dg/vect2.ad[sb]: New test.
+	* gnat.dg/vect2_pkg.ads: New helper.
+	* gnat.dg/vect3.ad[sb]: New test.
+	* gnat.dg/vect3_pkg.ads: New helper.
+	* gnat.dg/vect4.ad[sb]: New test.
+	* gnat.dg/vect4_pkg.ads: New helper.
+	* gnat.dg/vect5.ad[sb]: New test.
+	* gnat.dg/vect5_pkg.ads: New helper.
+	* gnat.dg/vect6.ad[sb]: New test.
+	* gnat.dg/vect6_pkg.ads: New helper.
+
 2011-10-12  H.J. Lu  <hongjiu.lu@intel.com>
 
 	* gcc.target/i386/fma_run_double_1.c: Add -mfpmath=sse.
diff --git a/gcc/testsuite/gnat.dg/vect1.adb b/gcc/testsuite/gnat.dg/vect1.adb
new file mode 100644
index 00000000000..0bbd9ee86a7
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/vect1.adb
@@ -0,0 +1,93 @@
+-- { dg-do compile { target i?86-*-* x86_64-*-* } }
+-- { dg-options "-O3 -msse2 -fdump-tree-vect-details" }
+
+package body Vect1 is
+
+   function "+" (X, Y : Varray) return Varray is
+      R : Varray (X'Range);
+   begin
+      for I in X'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X, Y : not null access Varray; R : not null access Varray) is
+   begin
+      for I in X'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+   end;
+
+
+   function "+" (X, Y : Sarray) return Sarray is
+      R : Sarray;
+   begin
+      for I in Sarray'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X, Y : not null access Sarray; R : not null access Sarray) is
+   begin
+      for I in Sarray'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+   end;
+
+
+   function "+" (X, Y : Darray1) return Darray1 is
+      R : Darray1;
+   begin
+      for I in Darray1'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X, Y : not null access Darray1; R : not null access Darray1) is
+   begin
+      for I in Darray1'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+   end;
+
+
+   function "+" (X, Y : Darray2) return Darray2 is
+      R : Darray2;
+   begin
+      for I in Darray2'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X, Y : not null access Darray2; R : not null access Darray2) is
+   begin
+      for I in Darray2'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+   end;
+
+
+   function "+" (X, Y : Darray3) return Darray3 is
+      R : Darray3;
+   begin
+      for I in Darray3'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X, Y : not null access Darray3; R : not null access Darray3) is
+   begin
+      for I in Darray3'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+   end;
+
+end Vect1;
+
+-- { dg-final { scan-tree-dump-times "vectorized 1 loops" 10 "vect"  } }
+-- { dg-final { cleanup-tree-dump "vect" } }
diff --git a/gcc/testsuite/gnat.dg/vect1.ads b/gcc/testsuite/gnat.dg/vect1.ads
new file mode 100644
index 00000000000..48343fc0553
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/vect1.ads
@@ -0,0 +1,42 @@
+with Vect1_Pkg;
+
+package Vect1 is
+
+   -- Unconstrained array types are vectorizable, possibly with special
+   -- help for the programmer
+   type Varray is array (Integer range <>) of Long_Float;
+   for Varray'Alignment use 16;
+
+   function "+" (X, Y : Varray) return Varray;
+   procedure Add (X, Y : not null access Varray; R : not null access Varray);
+
+
+   -- Constrained array types are vectorizable
+   type Sarray is array (1 .. 4) of Long_Float;
+   for Sarray'Alignment use 16;
+
+   function "+" (X, Y : Sarray) return Sarray;
+   procedure Add (X, Y : not null access Sarray; R : not null access Sarray);
+
+
+   type Darray1 is array (1 .. Vect1_Pkg.N) of Long_Float;
+   for Darray1'Alignment use 16;
+
+   function "+" (X, Y : Darray1) return Darray1;
+   procedure Add (X, Y : not null access Darray1; R : not null access Darray1);
+
+
+   type Darray2 is array (Vect1_Pkg.K .. 4) of Long_Float;
+   for Darray2'Alignment use 16;
+
+   function "+" (X, Y : Darray2) return Darray2;
+   procedure Add (X, Y : not null access Darray2; R : not null access Darray2);
+
+
+   type Darray3 is array (Vect1_Pkg.K .. Vect1_Pkg.N) of Long_Float;
+   for Darray3'Alignment use 16;
+
+   function "+" (X, Y : Darray3) return Darray3;
+   procedure Add (X, Y : not null access Darray3; R : not null access Darray3);
+
+end Vect1;
diff --git a/gcc/testsuite/gnat.dg/vect1_pkg.ads b/gcc/testsuite/gnat.dg/vect1_pkg.ads
new file mode 100644
index 00000000000..b9fab52b1e2
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/vect1_pkg.ads
@@ -0,0 +1,6 @@
+package Vect1_Pkg is
+
+   function K return Integer;
+   function N return Integer;
+
+end Vect1_Pkg;
diff --git a/gcc/testsuite/gnat.dg/vect2.adb b/gcc/testsuite/gnat.dg/vect2.adb
new file mode 100644
index 00000000000..54e0403f135
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/vect2.adb
@@ -0,0 +1,93 @@
+-- { dg-do compile { target i?86-*-* x86_64-*-* } }
+-- { dg-options "-O3 -msse2 -fdump-tree-vect-details" }
+
+package body Vect2 is
+
+   function "+" (X, Y : Varray) return Varray is
+      R : Varray (X'Range);
+   begin
+      for I in X'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X, Y : not null access Varray; R : not null access Varray) is
+   begin
+      for I in X'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+   end;
+
+
+   function "+" (X, Y : Sarray) return Sarray is
+      R : Sarray;
+   begin
+      for I in Sarray'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X, Y : not null access Sarray; R : not null access Sarray) is
+   begin
+      for I in Sarray'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+   end;
+
+
+   function "+" (X, Y : Darray1) return Darray1 is
+      R : Darray1;
+   begin
+      for I in Darray1'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X, Y : not null access Darray1; R : not null access Darray1) is
+   begin
+      for I in Darray1'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+   end;
+
+
+   function "+" (X, Y : Darray2) return Darray2 is
+      R : Darray2;
+   begin
+      for I in Darray2'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X, Y : not null access Darray2; R : not null access Darray2) is
+   begin
+      for I in Darray2'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+   end;
+
+
+   function "+" (X, Y : Darray3) return Darray3 is
+      R : Darray3;
+   begin
+      for I in Darray3'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X, Y : not null access Darray3; R : not null access Darray3) is
+   begin
+      for I in Darray3'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+   end;
+
+end Vect2;
+
+-- { dg-final { scan-tree-dump-times "vectorized 1 loops" 10 "vect"  } }
+-- { dg-final { cleanup-tree-dump "vect" } }
diff --git a/gcc/testsuite/gnat.dg/vect2.ads b/gcc/testsuite/gnat.dg/vect2.ads
new file mode 100644
index 00000000000..b5111875924
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/vect2.ads
@@ -0,0 +1,42 @@
+with Vect2_Pkg;
+
+package Vect2 is
+
+   -- Unconstrained array types are vectorizable, possibly with special
+   -- help for the programmer
+   type Varray is array (Positive range <>) of Long_Float;
+   for Varray'Alignment use 16;
+
+   function "+" (X, Y : Varray) return Varray;
+   procedure Add (X, Y : not null access Varray; R : not null access Varray);
+
+
+   -- Constrained array types are vectorizable
+   type Sarray is array (Positive(1) .. Positive(4)) of Long_Float;
+   for Sarray'Alignment use 16;
+
+   function "+" (X, Y : Sarray) return Sarray;
+   procedure Add (X, Y : not null access Sarray; R : not null access Sarray);
+
+
+   type Darray1 is array (Positive(1) .. Vect2_Pkg.N) of Long_Float;
+   for Darray1'Alignment use 16;
+
+   function "+" (X, Y : Darray1) return Darray1;
+   procedure Add (X, Y : not null access Darray1; R : not null access Darray1);
+
+
+   type Darray2 is array (Vect2_Pkg.K .. Positive(4)) of Long_Float;
+   for Darray2'Alignment use 16;
+
+   function "+" (X, Y : Darray2) return Darray2;
+   procedure Add (X, Y : not null access Darray2; R : not null access Darray2);
+
+
+   type Darray3 is array (Vect2_Pkg.K .. Vect2_Pkg.N) of Long_Float;
+   for Darray3'Alignment use 16;
+
+   function "+" (X, Y : Darray3) return Darray3;
+   procedure Add (X, Y : not null access Darray3; R : not null access Darray3);
+
+end Vect2;
diff --git a/gcc/testsuite/gnat.dg/vect2_pkg.ads b/gcc/testsuite/gnat.dg/vect2_pkg.ads
new file mode 100644
index 00000000000..804e10caebc
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/vect2_pkg.ads
@@ -0,0 +1,6 @@
+package Vect2_Pkg is
+
+   function K return Positive;
+   function N return Positive;
+
+end Vect2_Pkg;
diff --git a/gcc/testsuite/gnat.dg/vect3.adb b/gcc/testsuite/gnat.dg/vect3.adb
new file mode 100644
index 00000000000..3baa6388e17
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/vect3.adb
@@ -0,0 +1,93 @@
+-- { dg-do compile { target i?86-*-* x86_64-*-* } }
+-- { dg-options "-O3 -msse2 -fdump-tree-vect-details" }
+
+package body Vect3 is
+
+   function "+" (X, Y : Varray) return Varray is
+      R : Varray (X'Range);
+   begin
+      for I in X'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X, Y : not null access Varray; R : not null access Varray) is
+   begin
+      for I in X'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+   end;
+
+
+   function "+" (X, Y : Sarray) return Sarray is
+      R : Sarray;
+   begin
+      for I in Sarray'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X, Y : not null access Sarray; R : not null access Sarray) is
+   begin
+      for I in Sarray'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+   end;
+
+
+   function "+" (X, Y : Darray1) return Darray1 is
+      R : Darray1;
+   begin
+      for I in Darray1'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X, Y : not null access Darray1; R : not null access Darray1) is
+   begin
+      for I in Darray1'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+   end;
+
+
+   function "+" (X, Y : Darray2) return Darray2 is
+      R : Darray2;
+   begin
+      for I in Darray2'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X, Y : not null access Darray2; R : not null access Darray2) is
+   begin
+      for I in Darray2'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+   end;
+
+
+   function "+" (X, Y : Darray3) return Darray3 is
+      R : Darray3;
+   begin
+      for I in Darray3'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X, Y : not null access Darray3; R : not null access Darray3) is
+   begin
+      for I in Darray3'Range loop
+         R(I) := X(I) + Y(I);
+      end loop;
+   end;
+
+end Vect3;
+
+-- { dg-final { scan-tree-dump-times "vectorized 1 loops" 10 "vect"  } }
+-- { dg-final { cleanup-tree-dump "vect" } }
diff --git a/gcc/testsuite/gnat.dg/vect3.ads b/gcc/testsuite/gnat.dg/vect3.ads
new file mode 100644
index 00000000000..d78e3c44cff
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/vect3.ads
@@ -0,0 +1,43 @@
+with Vect3_Pkg;
+
+package Vect3 is
+
+   -- Unconstrained array types are vectorizable, possibly with special
+   -- help for the programmer
+   type Varray is array (Vect3_Pkg.Index_Type range <>) of Long_Float;
+   for Varray'Alignment use 16;
+
+   function "+" (X, Y : Varray) return Varray;
+   procedure Add (X, Y : not null access Varray; R : not null access Varray);
+
+
+   -- Constrained array types are vectorizable
+   type Sarray is array (Vect3_Pkg.Index_Type(1) .. Vect3_Pkg.Index_Type(4))
+     of Long_Float;
+   for Sarray'Alignment use 16;
+
+   function "+" (X, Y : Sarray) return Sarray;
+   procedure Add (X, Y : not null access Sarray; R : not null access Sarray);
+
+
+   type Darray1 is array (Vect3_Pkg.Index_Type(1) .. Vect3_Pkg.N) of Long_Float;
+   for Darray1'Alignment use 16;
+
+   function "+" (X, Y : Darray1) return Darray1;
+   procedure Add (X, Y : not null access Darray1; R : not null access Darray1);
+
+
+   type Darray2 is array (Vect3_Pkg.K .. Vect3_Pkg.Index_Type(4)) of Long_Float;
+   for Darray2'Alignment use 16;
+
+   function "+" (X, Y : Darray2) return Darray2;
+   procedure Add (X, Y : not null access Darray2; R : not null access Darray2);
+
+
+   type Darray3 is array (Vect3_Pkg.K .. Vect3_Pkg.N) of Long_Float;
+   for Darray3'Alignment use 16;
+
+   function "+" (X, Y : Darray3) return Darray3;
+   procedure Add (X, Y : not null access Darray3; R : not null access Darray3);
+
+end Vect3;
diff --git a/gcc/testsuite/gnat.dg/vect3_pkg.ads b/gcc/testsuite/gnat.dg/vect3_pkg.ads
new file mode 100644
index 00000000000..8c926bbcd6a
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/vect3_pkg.ads
@@ -0,0 +1,10 @@
+with System;
+
+package Vect3_Pkg is
+
+   type Index_Type is mod System.Memory_Size;
+
+   function K return Index_Type;
+   function N return Index_Type;
+
+end Vect3_Pkg;
diff --git a/gcc/testsuite/gnat.dg/vect4.adb b/gcc/testsuite/gnat.dg/vect4.adb
new file mode 100644
index 00000000000..032a7289394
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/vect4.adb
@@ -0,0 +1,93 @@
+-- { dg-do compile { target i?86-*-* x86_64-*-* } }
+-- { dg-options "-O3 -msse2 -fdump-tree-vect-details" }
+
+package body Vect4 is
+
+   function "+" (X : Varray; Y : Long_Float) return Varray is
+      R : Varray (X'Range);
+   begin
+      for I in X'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X : not null access Varray; Y : Long_Float; R : not null access Varray) is
+   begin
+      for I in X'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+   end;
+
+
+   function "+" (X : Sarray; Y : Long_Float) return Sarray is
+      R : Sarray;
+   begin
+      for I in Sarray'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X : not null access Sarray; Y : Long_Float; R : not null access Sarray) is
+   begin
+      for I in Sarray'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+   end;
+
+
+   function "+" (X : Darray1; Y : Long_Float) return Darray1 is
+      R : Darray1;
+   begin
+      for I in Darray1'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X : not null access Darray1; Y : Long_Float; R : not null access Darray1) is
+   begin
+      for I in Darray1'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+   end;
+
+
+   function "+" (X : Darray2; Y : Long_Float) return Darray2 is
+      R : Darray2;
+   begin
+      for I in Darray2'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X : not null access Darray2; Y : Long_Float; R : not null access Darray2) is
+   begin
+      for I in Darray2'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+   end;
+
+
+   function "+" (X : Darray3; Y : Long_Float) return Darray3 is
+      R : Darray3;
+   begin
+      for I in Darray3'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X : not null access Darray3; Y : Long_Float; R : not null access Darray3) is
+   begin
+      for I in Darray3'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+   end;
+
+end Vect4;
+
+-- { dg-final { scan-tree-dump-times "vectorized 1 loops" 10 "vect"  } }
+-- { dg-final { cleanup-tree-dump "vect" } }
diff --git a/gcc/testsuite/gnat.dg/vect4.ads b/gcc/testsuite/gnat.dg/vect4.ads
new file mode 100644
index 00000000000..98df7efeebc
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/vect4.ads
@@ -0,0 +1,42 @@
+with Vect4_Pkg;
+
+package Vect4 is
+
+   -- Unconstrained array types are vectorizable, possibly with special
+   -- help for the programmer
+   type Varray is array (Integer range <>) of Long_Float;
+   for Varray'Alignment use 16;
+
+   function "+" (X : Varray; Y : Long_Float) return Varray;
+   procedure Add (X : not null access Varray; Y : Long_Float; R : not null access Varray);
+
+
+   -- Constrained array types are vectorizable
+   type Sarray is array (1 .. 4) of Long_Float;
+   for Sarray'Alignment use 16;
+
+   function "+" (X : Sarray; Y : Long_Float) return Sarray;
+   procedure Add (X : not null access Sarray; Y : Long_Float; R : not null access Sarray);
+
+
+   type Darray1 is array (1 .. Vect4_Pkg.N) of Long_Float;
+   for Darray1'Alignment use 16;
+
+   function "+" (X : Darray1; Y : Long_Float) return Darray1;
+   procedure Add (X : not null access Darray1; Y : Long_Float; R : not null access Darray1);
+
+
+   type Darray2 is array (Vect4_Pkg.K .. 4) of Long_Float;
+   for Darray2'Alignment use 16;
+
+   function "+" (X : Darray2; Y : Long_Float) return Darray2;
+   procedure Add (X : not null access Darray2; Y : Long_Float; R : not null access Darray2);
+
+
+   type Darray3 is array (Vect4_Pkg.K .. Vect4_Pkg.N) of Long_Float;
+   for Darray3'Alignment use 16;
+
+   function "+" (X : Darray3; Y : Long_Float) return Darray3;
+   procedure Add (X : not null access Darray3; Y : Long_Float; R : not null access Darray3);
+
+end Vect4;
diff --git a/gcc/testsuite/gnat.dg/vect4_pkg.ads b/gcc/testsuite/gnat.dg/vect4_pkg.ads
new file mode 100644
index 00000000000..2e0008d0a71
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/vect4_pkg.ads
@@ -0,0 +1,6 @@
+package Vect4_Pkg is
+
+   function K return Integer;
+   function N return Integer;
+
+end Vect4_Pkg;
diff --git a/gcc/testsuite/gnat.dg/vect5.adb b/gcc/testsuite/gnat.dg/vect5.adb
new file mode 100644
index 00000000000..98af2c01d54
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/vect5.adb
@@ -0,0 +1,93 @@
+-- { dg-do compile { target i?86-*-* x86_64-*-* } }
+-- { dg-options "-O3 -msse2 -fdump-tree-vect-details" }
+
+package body Vect5 is
+
+   function "+" (X : Varray; Y : Long_Float) return Varray is
+      R : Varray (X'Range);
+   begin
+      for I in X'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X : not null access Varray; Y : Long_Float; R : not null access Varray) is
+   begin
+      for I in X'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+   end;
+
+
+   function "+" (X : Sarray; Y : Long_Float) return Sarray is
+      R : Sarray;
+   begin
+      for I in Sarray'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X : not null access Sarray; Y : Long_Float; R : not null access Sarray) is
+   begin
+      for I in Sarray'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+   end;
+
+
+   function "+" (X : Darray1; Y : Long_Float) return Darray1 is
+      R : Darray1;
+   begin
+      for I in Darray1'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X : not null access Darray1; Y : Long_Float; R : not null access Darray1) is
+   begin
+      for I in Darray1'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+   end;
+
+
+   function "+" (X : Darray2; Y : Long_Float) return Darray2 is
+      R : Darray2;
+   begin
+      for I in Darray2'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X : not null access Darray2; Y : Long_Float; R : not null access Darray2) is
+   begin
+      for I in Darray2'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+   end;
+
+
+   function "+" (X : Darray3; Y : Long_Float) return Darray3 is
+      R : Darray3;
+   begin
+      for I in Darray3'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X : not null access Darray3; Y : Long_Float; R : not null access Darray3) is
+   begin
+      for I in Darray3'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+   end;
+
+end Vect5;
+
+-- { dg-final { scan-tree-dump-times "vectorized 1 loops" 10 "vect"  } }
+-- { dg-final { cleanup-tree-dump "vect" } }
diff --git a/gcc/testsuite/gnat.dg/vect5.ads b/gcc/testsuite/gnat.dg/vect5.ads
new file mode 100644
index 00000000000..09e798aecb2
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/vect5.ads
@@ -0,0 +1,42 @@
+with Vect5_Pkg;
+
+package Vect5 is
+
+   -- Unconstrained array types are vectorizable, possibly with special
+   -- help for the programmer
+   type Varray is array (Positive range <>) of Long_Float;
+   for Varray'Alignment use 16;
+
+   function "+" (X : Varray; Y : Long_Float) return Varray;
+   procedure Add (X : not null access Varray; Y : Long_Float; R : not null access Varray);
+
+
+   -- Constrained array types are vectorizable
+   type Sarray is array (Positive (1) .. Positive (4)) of Long_Float;
+   for Sarray'Alignment use 16;
+
+   function "+" (X : Sarray; Y : Long_Float) return Sarray;
+   procedure Add (X : not null access Sarray; Y : Long_Float; R : not null access Sarray);
+
+
+   type Darray1 is array (Positive(1) .. Vect5_Pkg.N) of Long_Float;
+   for Darray1'Alignment use 16;
+
+   function "+" (X : Darray1; Y : Long_Float) return Darray1;
+   procedure Add (X : not null access Darray1; Y : Long_Float; R : not null access Darray1);
+
+
+   type Darray2 is array (Vect5_Pkg.K .. Positive(4)) of Long_Float;
+   for Darray2'Alignment use 16;
+
+   function "+" (X : Darray2; Y : Long_Float) return Darray2;
+   procedure Add (X : not null access Darray2; Y : Long_Float; R : not null access Darray2);
+
+
+   type Darray3 is array (Vect5_Pkg.K .. Vect5_Pkg.N) of Long_Float;
+   for Darray3'Alignment use 16;
+
+   function "+" (X : Darray3; Y : Long_Float) return Darray3;
+   procedure Add (X : not null access Darray3; Y : Long_Float; R : not null access Darray3);
+
+end Vect5;
diff --git a/gcc/testsuite/gnat.dg/vect5_pkg.ads b/gcc/testsuite/gnat.dg/vect5_pkg.ads
new file mode 100644
index 00000000000..9eb752eedb2
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/vect5_pkg.ads
@@ -0,0 +1,6 @@
+package Vect5_Pkg is
+
+   function K return Positive;
+   function N return Positive;
+
+end Vect5_Pkg;
diff --git a/gcc/testsuite/gnat.dg/vect6.adb b/gcc/testsuite/gnat.dg/vect6.adb
new file mode 100644
index 00000000000..425f2a70362
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/vect6.adb
@@ -0,0 +1,93 @@
+-- { dg-do compile { target i?86-*-* x86_64-*-* } }
+-- { dg-options "-O3 -msse2 -fdump-tree-vect-details" }
+
+package body Vect6 is
+
+   function "+" (X : Varray; Y : Long_Float) return Varray is
+      R : Varray (X'Range);
+   begin
+      for I in X'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X : not null access Varray; Y : Long_Float; R : not null access Varray) is
+   begin
+      for I in X'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+   end;
+
+
+   function "+" (X : Sarray; Y : Long_Float) return Sarray is
+      R : Sarray;
+   begin
+      for I in Sarray'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X : not null access Sarray; Y : Long_Float; R : not null access Sarray) is
+   begin
+      for I in Sarray'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+   end;
+
+
+   function "+" (X : Darray1; Y : Long_Float) return Darray1 is
+      R : Darray1;
+   begin
+      for I in Darray1'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X : not null access Darray1; Y : Long_Float; R : not null access Darray1) is
+   begin
+      for I in Darray1'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+   end;
+
+
+   function "+" (X : Darray2; Y : Long_Float) return Darray2 is
+      R : Darray2;
+   begin
+      for I in Darray2'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X : not null access Darray2; Y : Long_Float; R : not null access Darray2) is
+   begin
+      for I in Darray2'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+   end;
+
+
+   function "+" (X : Darray3; Y : Long_Float) return Darray3 is
+      R : Darray3;
+   begin
+      for I in Darray3'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+      return R;
+   end;
+
+   procedure Add (X : not null access Darray3; Y : Long_Float; R : not null access Darray3) is
+   begin
+      for I in Darray3'Range loop
+         R(I) := X(I) + Y;
+      end loop;
+   end;
+
+end Vect6;
+
+-- { dg-final { scan-tree-dump-times "vectorized 1 loops" 10 "vect"  } }
+-- { dg-final { cleanup-tree-dump "vect" } }
diff --git a/gcc/testsuite/gnat.dg/vect6.ads b/gcc/testsuite/gnat.dg/vect6.ads
new file mode 100644
index 00000000000..013fe13652e
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/vect6.ads
@@ -0,0 +1,43 @@
+with Vect6_Pkg;
+
+package Vect6 is
+
+   -- Unconstrained array types are vectorizable, possibly with special
+   -- help for the programmer
+   type Varray is array (Vect6_Pkg.Index_Type range <>) of Long_Float;
+   for Varray'Alignment use 16;
+
+   function "+" (X : Varray; Y : Long_Float) return Varray;
+   procedure Add (X : not null access Varray; Y : Long_Float; R : not null access Varray);
+
+
+   -- Constrained array types are vectorizable
+   type Sarray is array (Vect6_Pkg.Index_Type(1) .. Vect6_Pkg.Index_Type(4))
+     of Long_Float;
+   for Sarray'Alignment use 16;
+
+   function "+" (X : Sarray; Y : Long_Float) return Sarray;
+   procedure Add (X : not null access Sarray; Y : Long_Float; R : not null access Sarray);
+
+
+   type Darray1 is array (Vect6_Pkg.Index_Type(1) .. Vect6_Pkg.N) of Long_Float;
+   for Darray1'Alignment use 16;
+
+   function "+" (X : Darray1; Y : Long_Float) return Darray1;
+   procedure Add (X : not null access Darray1; Y : Long_Float; R : not null access Darray1);
+
+
+   type Darray2 is array (Vect6_Pkg.K .. Vect6_Pkg.Index_Type(4)) of Long_Float;
+   for Darray2'Alignment use 16;
+
+   function "+" (X : Darray2; Y : Long_Float) return Darray2;
+   procedure Add (X : not null access Darray2; Y : Long_Float; R : not null access Darray2);
+
+
+   type Darray3 is array (Vect6_Pkg.K .. Vect6_Pkg.N) of Long_Float;
+   for Darray3'Alignment use 16;
+
+   function "+" (X : Darray3; Y : Long_Float) return Darray3;
+   procedure Add (X : not null access Darray3; Y : Long_Float; R : not null access Darray3);
+
+end Vect6;
diff --git a/gcc/testsuite/gnat.dg/vect6_pkg.ads b/gcc/testsuite/gnat.dg/vect6_pkg.ads
new file mode 100644
index 00000000000..7db734a359f
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/vect6_pkg.ads
@@ -0,0 +1,10 @@
+with System;
+
+package Vect6_Pkg is
+
+   type Index_Type is mod System.Memory_Size;
+
+   function K return Index_Type;
+   function N return Index_Type;
+
+end Vect6_Pkg;