Fortran: annotations for DO CONCURRENT loops [PR113305]

gcc/fortran/ChangeLog:

	PR fortran/113305
	* gfortran.h (gfc_loop_annot): New.
	(gfc_iterator, gfc_forall_iterator): Use for annotation control.
	* array.cc (gfc_copy_iterator): Adjust.
	* gfortran.texi: Document annotations IVDEP, UNROLL n, VECTOR,
	NOVECTOR as applied to DO CONCURRENT.
	* parse.cc (parse_do_block): Parse annotations IVDEP, UNROLL n,
	VECTOR, NOVECTOR as applied to DO CONCURRENT.  Apply UNROLL only to
	first loop control variable.
	* trans-stmt.cc (iter_info): Use gfc_loop_annot.
	(gfc_trans_simple_do): Adjust.
	(gfc_trans_forall_loop): Annotate loops with IVDEP, UNROLL n,
	VECTOR, NOVECTOR as needed for DO CONCURRENT.
	(gfc_trans_forall_1): Handle loop annotations.

gcc/testsuite/ChangeLog:

	PR fortran/113305
	* gfortran.dg/do_concurrent_7.f90: New test.

diff --git a/gcc/fortran/array.cc b/gcc/fortran/array.cc
index 19456baf103e508fa69316122cda116eb1240f51..81fa99d219fd0eeb92621028f15dca7578b382c1 100644 (file)
--- a/gcc/fortran/array.cc
+++ b/gcc/fortran/array.cc
@@ -2308,10 +2308,7 @@ gfc_copy_iterator (gfc_iterator *src)
   dest->start = gfc_copy_expr (src->start);
   dest->end = gfc_copy_expr (src->end);
   dest->step = gfc_copy_expr (src->step);
-  dest->unroll = src->unroll;
-  dest->ivdep = src->ivdep;
-  dest->vector = src->vector;
-  dest->novector = src->novector;
+  dest->annot = src->annot;
 
   return dest;
 }

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 82f388c05f84a7ce6e713bb5bf53b9b290c9c761..fd73e4ce4314852863cf0a8b1e4a42fc99d4608b 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2830,14 +2830,22 @@ gfc_case;
 #define gfc_get_case() XCNEW (gfc_case)
 
 
+/* Annotations for loop constructs.  */
 typedef struct
 {
-  gfc_expr *var, *start, *end, *step;
   unsigned short unroll;
   bool ivdep;
   bool vector;
   bool novector;
 }
+gfc_loop_annot;
+
+
+typedef struct
+{
+  gfc_expr *var, *start, *end, *step;
+  gfc_loop_annot annot;
+}
 gfc_iterator;
 
 #define gfc_get_iterator() XCNEW (gfc_iterator)
@@ -2926,6 +2934,7 @@ gfc_dt;
 typedef struct gfc_forall_iterator
 {
   gfc_expr *var, *start, *end, *stride;
+  gfc_loop_annot annot;
   struct gfc_forall_iterator *next;
 }
 gfc_forall_iterator;

diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 5615fee2897d74561b5b09b18de4071013b09d1a..371666dcbb60482fa1a447bbc518aa24d7e90c5f 100644 (file)
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -3262,6 +3262,9 @@ It must be placed immediately before a @code{DO} loop and applies only to the
 loop that follows.  N is an integer constant specifying the unrolling factor.
 The values of 0 and 1 block any unrolling of the loop.
 
+For @code{DO CONCURRENT} constructs the unrolling specification applies
+only to the first loop control variable.
+
 
 @node BUILTIN directive
 @subsection BUILTIN directive
@@ -3300,6 +3303,9 @@ whether a particular loop is vectorizable due to potential
 dependencies between iterations.  The purpose of the directive is to
 tell the compiler that vectorization is safe.
 
+For @code{DO CONCURRENT} constructs this annotation is implicit to all
+loop control variables.
+
 This directive is intended for annotation of existing code.  For new
 code it is recommended to consider OpenMP SIMD directives as potential
 alternative.
@@ -3316,6 +3322,9 @@ This directive tells the compiler to vectorize the following loop.  It
 must be placed immediately before a @code{DO} loop and applies only to
 the loop that follows.
 
+For @code{DO CONCURRENT} constructs this annotation applies to all loops
+specified in the concurrent header.
+
 
 @node NOVECTOR directive
 @subsection NOVECTOR directive
@@ -3328,6 +3337,9 @@ This directive tells the compiler to not vectorize the following loop.
 It must be placed immediately before a @code{DO} loop and applies only
 to the loop that follows.
 
+For @code{DO CONCURRENT} constructs this annotation applies to all loops
+specified in the concurrent header.
+
 
 @node Non-Fortran Main Program
 @section Non-Fortran Main Program

diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index d8b38cfb5ac1b20bd0259d291b5e58f96983a453..98a04e72a93cb8aded046161fce856205c1b154d 100644 (file)
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -5307,27 +5307,51 @@ parse_do_block (void)
   do_op = new_st.op;
   s.ext.end_do_label = new_st.label1;
 
-  if (new_st.ext.iterator != NULL)
+  if (do_op == EXEC_DO_CONCURRENT)
+    {
+      gfc_forall_iterator *fa;
+      for (fa = new_st.ext.forall_iterator; fa; fa = fa->next)
+       {
+         /* Apply unroll only to innermost loop (first control
+            variable).  */
+         if (directive_unroll != -1)
+           {
+             fa->annot.unroll = directive_unroll;
+             directive_unroll = -1;
+           }
+         if (directive_ivdep)
+           fa->annot.ivdep = directive_ivdep;
+         if (directive_vector)
+           fa->annot.vector = directive_vector;
+         if (directive_novector)
+           fa->annot.novector = directive_novector;
+       }
+      directive_ivdep = false;
+      directive_vector = false;
+      directive_novector = false;
+      stree = NULL;
+    }
+  else if (new_st.ext.iterator != NULL)
     {
       stree = new_st.ext.iterator->var->symtree;
       if (directive_unroll != -1)
        {
-         new_st.ext.iterator->unroll = directive_unroll;
+         new_st.ext.iterator->annot.unroll = directive_unroll;
          directive_unroll = -1;
        }
       if (directive_ivdep)
        {
-         new_st.ext.iterator->ivdep = directive_ivdep;
+         new_st.ext.iterator->annot.ivdep = directive_ivdep;
          directive_ivdep = false;
        }
       if (directive_vector)
        {
-         new_st.ext.iterator->vector = directive_vector;
+         new_st.ext.iterator->annot.vector = directive_vector;
          directive_vector = false;
        }
       if (directive_novector)
        {
-         new_st.ext.iterator->novector = directive_novector;
+         new_st.ext.iterator->annot.novector = directive_novector;
          directive_novector = false;
        }
     }

diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index a718dce237fc2477fe117b835729c578cac770a1..5247d3d39d71bf4ee7871a6539b3d2364d1b821d 100644 (file)
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -41,6 +41,7 @@ typedef struct iter_info
   tree start;
   tree end;
   tree step;
+  gfc_loop_annot annot;
   struct iter_info *next;
 }
 iter_info;
@@ -2462,21 +2463,22 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar,
                            fold_convert (type, to));
 
   cond = gfc_evaluate_now_loc (loc, cond, &body);
-  if (code->ext.iterator->unroll && cond != error_mark_node)
+  if (code->ext.iterator->annot.unroll && cond != error_mark_node)
     cond
       = build3 (ANNOTATE_EXPR, TREE_TYPE (cond), cond,
                build_int_cst (integer_type_node, annot_expr_unroll_kind),
-               build_int_cst (integer_type_node, code->ext.iterator->unroll));
+               build_int_cst (integer_type_node,
+                              code->ext.iterator->annot.unroll));
 
-  if (code->ext.iterator->ivdep && cond != error_mark_node)
+  if (code->ext.iterator->annot.ivdep && cond != error_mark_node)
     cond = build3 (ANNOTATE_EXPR, TREE_TYPE (cond), cond,
                   build_int_cst (integer_type_node, annot_expr_ivdep_kind),
                   integer_zero_node);
-  if (code->ext.iterator->vector && cond != error_mark_node)
+  if (code->ext.iterator->annot.vector && cond != error_mark_node)
     cond = build3 (ANNOTATE_EXPR, TREE_TYPE (cond), cond,
                   build_int_cst (integer_type_node, annot_expr_vector_kind),
                   integer_zero_node);
-  if (code->ext.iterator->novector && cond != error_mark_node)
+  if (code->ext.iterator->annot.novector && cond != error_mark_node)
     cond = build3 (ANNOTATE_EXPR, TREE_TYPE (cond), cond,
                   build_int_cst (integer_type_node, annot_expr_no_vector_kind),
                   integer_zero_node);
@@ -2806,21 +2808,22 @@ gfc_trans_do (gfc_code * code, tree exit_cond)
   /* End with the loop condition.  Loop until countm1t == 0.  */
   cond = fold_build2_loc (loc, EQ_EXPR, logical_type_node, countm1t,
                          build_int_cst (utype, 0));
-  if (code->ext.iterator->unroll && cond != error_mark_node)
+  if (code->ext.iterator->annot.unroll && cond != error_mark_node)
     cond
       = build3 (ANNOTATE_EXPR, TREE_TYPE (cond), cond,
                build_int_cst (integer_type_node, annot_expr_unroll_kind),
-               build_int_cst (integer_type_node, code->ext.iterator->unroll));
+               build_int_cst (integer_type_node,
+                              code->ext.iterator->annot.unroll));
 
-  if (code->ext.iterator->ivdep && cond != error_mark_node)
+  if (code->ext.iterator->annot.ivdep && cond != error_mark_node)
     cond = build3 (ANNOTATE_EXPR, TREE_TYPE (cond), cond,
                   build_int_cst (integer_type_node, annot_expr_ivdep_kind),
                   integer_zero_node);
-  if (code->ext.iterator->vector && cond != error_mark_node)
+  if (code->ext.iterator->annot.vector && cond != error_mark_node)
     cond = build3 (ANNOTATE_EXPR, TREE_TYPE (cond), cond,
                   build_int_cst (integer_type_node, annot_expr_vector_kind),
                   integer_zero_node);
-  if (code->ext.iterator->novector && cond != error_mark_node)
+  if (code->ext.iterator->annot.novector && cond != error_mark_node)
     cond = build3 (ANNOTATE_EXPR, TREE_TYPE (cond), cond,
                   build_int_cst (integer_type_node, annot_expr_no_vector_kind),
                   integer_zero_node);
@@ -4117,12 +4120,30 @@ gfc_trans_forall_loop (forall_info *forall_tmp, tree body,
 
       /* PR 83064 means that we cannot use annot_expr_parallel_kind until
        the autoparallelizer can handle this.  */
-      if (forall_tmp->do_concurrent)
+      if (forall_tmp->do_concurrent || iter->annot.ivdep)
        cond = build3 (ANNOTATE_EXPR, TREE_TYPE (cond), cond,
                       build_int_cst (integer_type_node,
                                      annot_expr_ivdep_kind),
                       integer_zero_node);
 
+      if (iter->annot.unroll && cond != error_mark_node)
+       cond = build3 (ANNOTATE_EXPR, TREE_TYPE (cond), cond,
+                      build_int_cst (integer_type_node,
+                                     annot_expr_unroll_kind),
+                      build_int_cst (integer_type_node, iter->annot.unroll));
+
+      if (iter->annot.vector && cond != error_mark_node)
+       cond = build3 (ANNOTATE_EXPR, TREE_TYPE (cond), cond,
+                      build_int_cst (integer_type_node,
+                                     annot_expr_vector_kind),
+                      integer_zero_node);
+
+      if (iter->annot.novector && cond != error_mark_node)
+       cond = build3 (ANNOTATE_EXPR, TREE_TYPE (cond), cond,
+                      build_int_cst (integer_type_node,
+                                     annot_expr_no_vector_kind),
+                      integer_zero_node);
+
       tmp = build1_v (GOTO_EXPR, exit_label);
       tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
                             cond, tmp, build_empty_stmt (input_location));
@@ -5090,6 +5111,9 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
       gfc_add_block_to_block (&block, &se.pre);
       step[n] = se.expr;
 
+      /* Copy loop annotations.  */
+      this_forall->annot = fa->annot;
+
       /* Set the NEXT field of this_forall to NULL.  */
       this_forall->next = NULL;
       /* Link this_forall to the info construct.  */

diff --git a/gcc/testsuite/gfortran.dg/do_concurrent_7.f90 b/gcc/testsuite/gfortran.dg/do_concurrent_7.f90
new file mode 100644 (file)
index 0000000..604f671
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/do_concurrent_7.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+! PR fortran/113305
+
+program dc
+  implicit none
+  real :: a(12), b(12), c(16,8), d(16,8)
+  integer :: i, j
+  call random_number(b)
+!GCC$ ivdep
+!GCC$ vector
+  do concurrent (i=1:12)
+     a(i) = 2*b(i)
+  end do
+  c = b(1)
+  d = a(2)
+!GCC$ novector
+!GCC$ unroll 4
+  do concurrent (i=1:16:2,j=1:8:2)
+     d(i,j) = 3*c(i,j)
+  end do
+end program
+
+! { dg-final { scan-tree-dump "ANNOTATE_EXPR .* ivdep>, vector" "original" } }
+! { dg-final { scan-tree-dump "ANNOTATE_EXPR .* ivdep>, no-vector" "original" } }
+! { dg-final { scan-tree-dump "ANNOTATE_EXPR .* ivdep>, unroll 4>, no-vector" "original" } }