ada-tree.h (DECL_LOOP_PARM_P): New flag.

	* 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.

From-SVN: r179868

gcc/ada/ChangeLog

+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.
 

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) \

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 ())

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);
 

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:

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

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;
+}

gcc/testsuite/ChangeLog

+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.

gcc/testsuite/gnat.dg/vect1.adb

+-- { 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" } }

gcc/testsuite/gnat.dg/vect1.ads

+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;

gcc/testsuite/gnat.dg/vect1_pkg.ads

+package Vect1_Pkg is
+
+   function K return Integer;
+   function N return Integer;
+
+end Vect1_Pkg;

gcc/testsuite/gnat.dg/vect2.adb

+-- { 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" } }

gcc/testsuite/gnat.dg/vect2.ads

+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;

gcc/testsuite/gnat.dg/vect2_pkg.ads

+package Vect2_Pkg is
+
+   function K return Positive;
+   function N return Positive;
+
+end Vect2_Pkg;

gcc/testsuite/gnat.dg/vect3.adb

+-- { 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" } }

gcc/testsuite/gnat.dg/vect3.ads

+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;

gcc/testsuite/gnat.dg/vect3_pkg.ads

+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;

gcc/testsuite/gnat.dg/vect4.adb

+-- { 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" } }

gcc/testsuite/gnat.dg/vect4.ads

+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;

gcc/testsuite/gnat.dg/vect4_pkg.ads

+package Vect4_Pkg is
+
+   function K return Integer;
+   function N return Integer;
+
+end Vect4_Pkg;

gcc/testsuite/gnat.dg/vect5.adb

+-- { 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" } }

gcc/testsuite/gnat.dg/vect5.ads

+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;

gcc/testsuite/gnat.dg/vect5_pkg.ads

+package Vect5_Pkg is
+
+   function K return Positive;
+   function N return Positive;
+
+end Vect5_Pkg;

gcc/testsuite/gnat.dg/vect6.adb

+-- { 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" } }

gcc/testsuite/gnat.dg/vect6.ads

+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;

gcc/testsuite/gnat.dg/vect6_pkg.ads

+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;