Re: [patch,gomp4] make fortran loop variables implicitly private in openacc

[Cesar Philippidis <cesar at codesourcery dot com>]

On 09/07/2014 11:26 PM, Tobias Burnus wrote:

> sorry for the slow review.

No problem. I've been focusing on the subroutine clause lately.

> On 22 August 2014 17:08, Cesar Philippidis wrote:
>>> In OpenMP, one has (OMP 4.0, 2.14.3): "A list item that specifies a
>>> given variable may not appear in more than one clause on the same
>>> directive, except that a variable may be specified in both firstprivate
>>> and lastprivate clauses."
>>> And in 2.14.3.3, OpenMP has: "List items that appear in a private,
>>> firstprivate, or reduction clause in a parallel construct may also
>>> appear in a private clause in an enclosed parallel,task, or worksharing,
>>> or simd construct.
>>>
>>> I tried to find it in something similar in OpenACC - but I failed. I
>>> found in (OpenACC 2.0a, 2.7.11) a reference to reduction with private,
>>> which implies that a reduction variable my be private, but I didn't find
>>> much more. In particular, it is not clear to me whether it would permit
>>> only those which are private implicitly or in an oacc parallel region or
>>> also in an explicit private clause in the same directive. Can you point
>>> me to the spec?
>> I'm not sure. I sent an email to the openacc technical mailing list, but
>> I haven't heard back from them.
> 
> Any new on this?

Not yet, unfortunately.

>> Is this patch ok for gomp-4_0-branch? 
> 
> Looks good to me.
> 
> Tobias
> 
> PS: Looking at
> 
> +  for (n = clauses->lists[OMP_LIST_PRIVATE]; n; n = n->next)
> 
> I was stumbing a bit until I realized that OMP_LIST_PRIVATE is the first
> element. I wonder whether one should have something like OMP_LIST_FIRST
> = OMP_LIST_PRIVATE and OMP_LIST_LAST = OMP_LIST_NUM (or
> OMP_LIST_FIRST_ENUM or ...) which avoids the implicit knowledge which
> comes first in the enum.

That's a good idea. I've made that change in the attached patch and
committed to gomp-4_0-branch.

Thanks,
Cesar

2014-09-08  Cesar Philippidis  <cesar@codesourcery.com>

	gcc/fortran/
	* gfortran.h (enum OMP_LIST_FIRST, OMP_LIST_LAST): New
	OMP enums.
	* openmp.c (oacc_compatible_clauses): New function.
	(resolve_omp_clauses): Use it.
	(struct omp_context): Add is_openmp member.
	(gfc_resolve_omp_parallel_blocks): Set is_openmp true.
	(gfc_resolve_do_iterator): Scan for compatible clauses.
	(typedef oacc_context): Remove.
	(oacc_current_ctx): Remove. Use omp_current_ctx for both
	OpenACC and OpenMP.
	(resolve_oacc_directive_inside_omp_region): Replace
	oacc_current_ctx with omp_current_ctx.
	(resolve_omp_directive_inside_oacc_region): Likewise.
	(resolve_oacc_nested_loops): Likewise.
	(resolve_oacc_params_in_parallel): Likewise.
	(resolve_oacc_loop_blocks): Likewise. Set is_openmp to false.

	gcc/testsuite/
	* gfortran.dg/goacc/private-1.f95: New test.
	* gfortran.dg/goacc/private-2.f95: New test.
	* gfortran.dg/goacc/private-3.f95: New test.


diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 0cde668..abe4f05 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1143,7 +1143,8 @@ gfc_omp_namelist;
 
 enum
 {
-  OMP_LIST_PRIVATE,
+  OMP_LIST_FIRST,
+  OMP_LIST_PRIVATE = OMP_LIST_FIRST,
   OMP_LIST_FIRSTPRIVATE,
   OMP_LIST_LASTPRIVATE,
   OMP_LIST_COPYPRIVATE,
@@ -1166,7 +1167,8 @@ enum
   OMP_LIST_HOST,
   OMP_LIST_DEVICE,
   OMP_LIST_CACHE,
-  OMP_LIST_NUM
+  OMP_LIST_NUM,
+  OMP_LIST_LAST = OMP_LIST_NUM
 };
 
 /* Because a symbol can belong to multiple namelists, they must be
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 91e00c4..824ef79 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -2713,6 +2713,29 @@ resolve_omp_udr_clause (gfc_omp_namelist *n, gfc_namespace *ns,
   return copy;
 }
 
+/* Returns true if clause in list 'list' is compatible with any of
+   of the clauses in lists [0..list-1].  E.g., a reduction variable may
+   appear in both reduction and private clauses, so this function
+   will return true in this case.  */
+
+static bool
+oacc_compatible_clauses (gfc_omp_clauses *clauses, int list,
+			   gfc_symbol *sym, bool openacc)
+{
+  gfc_omp_namelist *n;
+
+  if (!openacc)
+    return false;
+
+  if (list != OMP_LIST_REDUCTION)
+    return false;
+
+  for (n = clauses->lists[OMP_LIST_FIRST]; n; n = n->next)
+    if (n->sym == sym)
+      return true;
+
+  return false;
+}
 
 /* OpenMP directive resolving routines.  */
 
@@ -2826,7 +2849,8 @@ resolve_omp_clauses (gfc_code *code, locus *where,
 	&& list != OMP_LIST_TO)
       for (n = omp_clauses->lists[list]; n; n = n->next)
 	{
-	  if (n->sym->mark)
+	  if (n->sym->mark && !oacc_compatible_clauses (omp_clauses, list,
+							n->sym, openacc))
 	    gfc_error ("Symbol '%s' present on multiple clauses at %L",
 		       n->sym->name, where);
 	  else
@@ -3787,6 +3811,7 @@ struct omp_context
   struct pointer_set_t *sharing_clauses;
   struct pointer_set_t *private_iterators;
   struct omp_context *previous;
+  bool is_openmp;
 } *omp_current_ctx;
 static gfc_code *omp_current_do_code;
 static int omp_current_do_collapse;
@@ -3831,6 +3856,7 @@ gfc_resolve_omp_parallel_blocks (gfc_code *code, gfc_namespace *ns)
   ctx.sharing_clauses = pointer_set_create ();
   ctx.private_iterators = pointer_set_create ();
   ctx.previous = omp_current_ctx;
+  ctx.is_openmp = true;
   omp_current_ctx = &ctx;
 
   for (list = 0; list < OMP_LIST_NUM; list++)
@@ -3925,7 +3951,12 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym)
   if (omp_current_ctx == NULL)
     return;
 
-  if (pointer_set_contains (omp_current_ctx->sharing_clauses, sym))
+  /* An openacc context may represent a data clause.  Abort if so.  */
+  if (!omp_current_ctx->is_openmp && !oacc_is_loop (omp_current_ctx->code))
+    return;
+
+  if (omp_current_ctx->is_openmp
+      && pointer_set_contains (omp_current_ctx->sharing_clauses, sym))
     return;
 
   if (! pointer_set_insert (omp_current_ctx->private_iterators, sym))
@@ -4106,9 +4137,6 @@ resolve_omp_do (gfc_code *code)
     }
 }
 
-typedef struct omp_context oacc_context;
-oacc_context *oacc_current_ctx;
-
 static bool
 oacc_is_parallel (gfc_code *code)
 {
@@ -4180,7 +4208,7 @@ switch (code->op)
 static void
 resolve_oacc_directive_inside_omp_region (gfc_code *code)
 {
-  if (omp_current_ctx != NULL)
+  if (omp_current_ctx != NULL && omp_current_ctx->is_openmp)
     {
       gfc_statement st = omp_code_to_statement (omp_current_ctx->code);
       gfc_statement oacc_st = oacc_code_to_statement (code);
@@ -4193,9 +4221,9 @@ resolve_oacc_directive_inside_omp_region (gfc_code *code)
 static void
 resolve_omp_directive_inside_oacc_region (gfc_code *code)
 {
-  if (oacc_current_ctx != NULL)
+  if (omp_current_ctx != NULL && !omp_current_ctx->is_openmp)
     {
-      gfc_statement st = oacc_code_to_statement (oacc_current_ctx->code);
+      gfc_statement st = oacc_code_to_statement (omp_current_ctx->code);
       gfc_statement omp_st = omp_code_to_statement (code);
       gfc_error ("The %s directive cannot be specified within "
 		 "a %s region at %L", gfc_ascii_statement (omp_st), 
@@ -4282,12 +4310,12 @@ resolve_oacc_nested_loops (gfc_code *code, gfc_code* do_code, int collapse,
 static void
 resolve_oacc_params_in_parallel (gfc_code *code, const char *clause)
 {
-  oacc_context *c;
+  omp_context *c;
 
   if (oacc_is_parallel (code))
     gfc_error ("!$ACC LOOP %s in PARALLEL region doesn't allow "
 	       "non-static arguments at %L", clause, &code->loc);
-  for (c = oacc_current_ctx; c; c = c->previous)
+  for (c = omp_current_ctx; c; c = c->previous)
     {
       if (oacc_is_loop (c->code))
 	break;
@@ -4301,13 +4329,13 @@ resolve_oacc_params_in_parallel (gfc_code *code, const char *clause)
 static void
 resolve_oacc_loop_blocks (gfc_code *code)
 {
-  oacc_context *c;
+  omp_context *c;
 
   if (!oacc_is_loop (code))
     return;
 
   if (code->op == EXEC_OACC_LOOP)
-    for (c = oacc_current_ctx; c; c = c->previous)
+    for (c = omp_current_ctx; c; c = c->previous)
       {
 	if (oacc_is_loop (c->code))
 	  {
@@ -4419,17 +4447,21 @@ resolve_oacc_loop_blocks (gfc_code *code)
 void
 gfc_resolve_oacc_blocks (gfc_code *code, gfc_namespace *ns)
 {
-  oacc_context ctx;
+  omp_context ctx;
 
   resolve_oacc_loop_blocks (code);
 
   ctx.code = code;
-  ctx.previous = oacc_current_ctx;
-  oacc_current_ctx = &ctx;
+  ctx.sharing_clauses = NULL;
+  ctx.private_iterators = pointer_set_create ();
+  ctx.previous = omp_current_ctx;
+  ctx.is_openmp = false;
+  omp_current_ctx = &ctx;
 
   gfc_resolve_blocks (code->block, ns);
 
-  oacc_current_ctx = ctx.previous;
+  pointer_set_destroy (ctx.private_iterators);
+  omp_current_ctx = ctx.previous;
 }
 
 
diff --git a/gcc/testsuite/gfortran.dg/goacc/private-1.f95 b/gcc/testsuite/gfortran.dg/goacc/private-1.f95
new file mode 100644
index 0000000..5aeee3b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/private-1.f95
@@ -0,0 +1,38 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-omplower" }
+
+! test for implicit private clauses in do loops
+
+program test
+  implicit none
+  integer :: i, j, k
+
+  !$acc parallel
+  !$acc loop
+  do i = 1, 100
+  end do
+  !$acc end parallel
+
+  !$acc parallel
+  !$acc loop
+  do i = 1, 100
+     do j = 1, 100
+     end do
+  end do
+  !$acc end parallel
+
+  !$acc parallel
+  !$acc loop
+  do i = 1, 100
+     do j = 1, 100
+        do k = 1, 100
+        end do
+     end do
+  end do
+  !$acc end parallel
+end program test
+! { dg-prune-output "unimplemented" }
+! { dg-final { scan-tree-dump-times "pragma acc parallel" 3 "omplower" } }
+! { dg-final { scan-tree-dump-times "private\\(i\\)" 3 "omplower" } }
+! { dg-final { scan-tree-dump-times "private\\(j\\)" 2 "omplower" } }
+! { dg-final { scan-tree-dump-times "private\\(k\\)" 1 "omplower" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/private-2.f95 b/gcc/testsuite/gfortran.dg/goacc/private-2.f95
new file mode 100644
index 0000000..4b038f2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/private-2.f95
@@ -0,0 +1,39 @@
+! { dg-do compile }
+
+! test for implicit private clauses in do loops
+
+program test
+  implicit none
+  integer :: i, j, k, a(10)
+
+  !$acc parallel
+  !$acc loop
+  do i = 1, 100
+  end do
+  !$acc end parallel
+
+  !$acc parallel
+  !$acc loop
+  do i = 1, 100
+     do j = 1, 100
+     end do
+  end do
+  !$acc end parallel
+
+  !$acc data copy(a)
+
+  if(mod(1,10) .eq. 0) write(*,'(i5)') i
+
+  do i = 1, 100
+    !$acc parallel
+    !$acc loop
+     do j = 1, 100
+        do k = 1, 100
+        end do
+     end do
+    !$acc end parallel
+  end do
+
+  !$acc end data
+
+end program test
diff --git a/gcc/testsuite/gfortran.dg/goacc/private-3.f95 b/gcc/testsuite/gfortran.dg/goacc/private-3.f95
new file mode 100644
index 0000000..aa12a56
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/private-3.f95
@@ -0,0 +1,23 @@
+! { dg-do compile }
+
+! test for private variables in a reduction clause
+
+program test
+  implicit none
+  integer, parameter :: n = 100
+  integer :: i, k
+
+!  FIXME: This causes an ICE in the gimplifier.
+!  !$acc parallel private (k) reduction (+:k)
+!  do i = 1, n
+!     k = k + 1
+!  end do
+!  !$acc end parallel
+
+  !$acc parallel private (k)
+  !$acc loop reduction (+:k)
+  do i = 1, n
+     k = k + 1
+  end do
+  !$acc end parallel
+end program test