[gomp] Predetermined loop iterators

Jakub Jelinek jakub@redhat.com
Wed Oct 19 14:36:00 GMT 2005


Hi!

I find the standard pretty vague.  It says:
"Variables used as loop iteration variables in sequential loops in a
parallel construct are private in the parallel construct."

Note only speaking about parallel construct, not other omp constructs,
while a few lines above it e.g. talks about parallel or parallel do
constructs.

So, I don't know what should it do on say:
  integer :: i, j, k
  integer, dimension (10, 10) :: a
!$omp parallel do default (none) shared (a)
  do i = 1, 10		! i is predetermined here from another rule
    do j = 1, 10	! is j predetermined or not?
      a(i, j) = i + j
    end do
  end do
!$omp end parallel do
!$omp parallel default (none) shared (a)
  do i = 1, 10		! i is clearly predetermined here from this
    a(i, 1) = 1		! particular rule
  end do
!$omp critical
  do j = 1, 10		! But how about here?  Is this considered to
    a(1, j) = j		! be also in the parallel construct, or just in
			! the critical construct
  end do
!$omp end critical
!$omp single
  do k = 1, 10		! Similar, but unlike CRITICAL, SINGLE can have
    a(k, k) = k		! its own PRIVATE clause, so why would k be
			! predetermined private in the outer PARALLEL
			! when it could be privatized in the SINGLE
  end do
!$omp end single
!$omp end parallel
end

Can anybody perhaps try Intel compiler on this?

The patch below implements do iterators being predetermined only directly
in !$omp parallel construct (or if/do/... constructs within it), but
not in nested !$omp constructs nor in !$omp parallel {do,sections,workshare}.

2005-10-19  Jakub Jelinek  <jakub@redhat.com>

	* gfortran.h (gfc_resolve_do_iterator, gfc_resolve_omp_blocks,
	gfc_resolve_blocks): New prototypes.
	* resolve.c (resolve_blocks): Renamed to...
	(gfc_resolve_blocks): ... this.  Remove static.
	(gfc_resolve_forall): Adjust caller.
	(resolve_code): Only call gfc_resolve_blocks if code->block != 0
	and not for OMP directives.  Call gfc_resolve_omp_blocks for
	OMP directives.  Call gfc_resolve_do_iterator if resolved
	successfully  EXEC_DO iterator.
	* openmp.c: Include pointer-set.h.
	(omp_current_ctx): New variable.
	(resolve_omp_parallel_blocks, gfc_resolve_do_iterator,
	gfc_resolve_omp_blocks): New functions.
	* Make-lang.in (fortran/openmp.o): Depend on pointer-set.h.
testsuite/
	* gfortran.dg/gomp/sharing-1.f90: Test for sequential loop iteration
	variable in plain !$omp parallel rather than in !$omp parallel do.

--- gcc/fortran/resolve.c.jj	2005-10-17 09:04:27.000000000 +0200
+++ gcc/fortran/resolve.c	2005-10-19 15:41:43.000000000 +0200
@@ -3679,7 +3679,7 @@ gfc_resolve_forall_body (gfc_code *code,
           gfc_resolve_assign_in_forall (c, nvar, var_expr);
           break;
 
-        /* Because the resolve_blocks() will handle the nested FORALL,
+	/* Because the gfc_resolve_blocks() will handle the nested FORALL,
            there is no need to handle it here.  */
         case EXEC_FORALL:
           break;
@@ -3698,8 +3698,6 @@ gfc_resolve_forall_body (gfc_code *code,
 /* Given a FORALL construct, first resolve the FORALL iterator, then call
    gfc_resolve_forall_body to resolve the FORALL body.  */
 
-static void resolve_blocks (gfc_code *, gfc_namespace *);
-
 static void
 gfc_resolve_forall (gfc_code *code, gfc_namespace *ns, int forall_save)
 {
@@ -3765,7 +3763,7 @@ gfc_resolve_forall (gfc_code *code, gfc_
   gfc_resolve_forall_body (code, nvar, var_expr);
 
   /* May call gfc_resolve_forall to resolve the inner FORALL loop.  */
-  resolve_blocks (code->block, ns);
+  gfc_resolve_blocks (code->block, ns);
 
   /* Free VAR_EXPR after the whole FORALL construct resolved.  */
   for (i = 0; i < total_var; i++)
@@ -3782,8 +3780,8 @@ gfc_resolve_forall (gfc_code *code, gfc_
 
 static void resolve_code (gfc_code *, gfc_namespace *);
 
-static void
-resolve_blocks (gfc_code * b, gfc_namespace * ns)
+void
+gfc_resolve_blocks (gfc_code * b, gfc_namespace * ns)
 {
   try t;
 
@@ -3874,8 +3872,28 @@ resolve_code (gfc_code * code, gfc_names
 	  forall_flag = 1;
           gfc_resolve_forall (code, ns, forall_save);
         }
-      else
-        resolve_blocks (code->block, ns);
+      else if (code->block)
+	{
+	  switch (code->op)
+	    {
+	    case EXEC_OMP_DO:
+	    case EXEC_OMP_PARALLEL_DO:
+	    case EXEC_OMP_WORKSHARE:
+	    case EXEC_OMP_PARALLEL_WORKSHARE:
+	    case EXEC_OMP_PARALLEL:
+	    case EXEC_OMP_PARALLEL_SECTIONS:
+	    case EXEC_OMP_SECTIONS:
+	    case EXEC_OMP_SINGLE:
+	    case EXEC_OMP_CRITICAL:
+	    case EXEC_OMP_MASTER:
+	    case EXEC_OMP_ORDERED:
+	      gfc_resolve_omp_blocks (code, ns);
+	      break;
+	    default:
+	      gfc_resolve_blocks (code->block, ns);
+	      break;
+	    }
+	}
 
       if (code->op == EXEC_FORALL)
 	forall_flag = forall_save;
@@ -4006,7 +4024,11 @@ resolve_code (gfc_code * code, gfc_names
 
 	case EXEC_DO:
 	  if (code->ext.iterator != NULL)
-	    gfc_resolve_iterator (code->ext.iterator, true);
+	    {
+	      gfc_iterator *iter = code->ext.iterator;
+	      if (gfc_resolve_iterator (iter, true) != FAILURE)
+		gfc_resolve_do_iterator (iter->var->symtree->n.sym);
+	    }
 	  break;
 
 	case EXEC_DO_WHILE:
--- gcc/fortran/gfortran.h.jj	2005-10-17 09:04:26.000000000 +0200
+++ gcc/fortran/gfortran.h	2005-10-19 15:27:03.000000000 +0200
@@ -1830,6 +1830,8 @@ void gfc_free_case_list (gfc_case *);
 /* openmp.c */
 void gfc_free_omp_clauses (gfc_omp_clauses *);
 void gfc_resolve_omp_directive (gfc_code *, gfc_namespace *);
+void gfc_resolve_do_iterator (gfc_symbol *);
+void gfc_resolve_omp_blocks (gfc_code *, gfc_namespace *);
 
 /* expr.c */
 void gfc_free_actual_arglist (gfc_actual_arglist *);
@@ -1877,6 +1879,7 @@ void gfc_free_statements (gfc_code *);
 /* resolve.c */
 try gfc_resolve_expr (gfc_expr *);
 void gfc_resolve (gfc_namespace *);
+void gfc_resolve_blocks (gfc_code *, gfc_namespace *);
 int gfc_impure_variable (gfc_symbol *);
 int gfc_pure (gfc_symbol *);
 int gfc_elemental (gfc_symbol *);
--- gcc/fortran/Make-lang.in.jj	2005-10-10 11:30:06.000000000 +0200
+++ gcc/fortran/Make-lang.in	2005-10-19 15:22:49.000000000 +0200
@@ -275,6 +275,7 @@ $(F95_PARSER_OBJS): fortran/gfortran.h f
 		$(CONFIG_H) $(SYSTEM_H) $(TM_H) $(TM_P_H) coretypes.h \
 		$(RTL_H) $(TREE_H) $(TREE_DUMP_H) $(GGC_H) $(EXPR_H) \
 		flags.h output.h diagnostic.h errors.h function.h 
+fortran/openmp.o: pointer-set.h
 
 GFORTRAN_TRANS_DEPS = fortran/gfortran.h fortran/intrinsic.h fortran/trans-array.h \
     fortran/trans-const.h fortran/trans-const.h fortran/trans.h \
--- gcc/fortran/openmp.c.jj	2005-10-18 23:35:37.000000000 +0200
+++ gcc/fortran/openmp.c	2005-10-19 15:41:20.000000000 +0200
@@ -26,6 +26,7 @@ Software Foundation, 51 Franklin Street,
 #include "gfortran.h"
 #include "match.h"
 #include "parse.h"
+#include "pointer-set.h"
 
 /* Match an end of OpenMP directive.  End of OpenMP directive is optional
    whitespace, followed by '\n' or comment '!'.  */
@@ -1119,6 +1120,78 @@ resolve_omp_atomic (gfc_code *code)
 	       " on right hand side at %L", &expr2->where);
 }
 
+struct omp_context
+{
+  gfc_code *code;
+  struct pointer_set_t *sharing_clauses;
+  struct pointer_set_t *private_iterators;
+} *omp_current_ctx;
+
+static void
+resolve_omp_parallel_blocks (gfc_code *code, gfc_namespace *ns)
+{
+  struct omp_context ctx, *previous;
+  gfc_omp_clauses *omp_clauses = code->ext.omp_clauses;
+  gfc_namelist *n;
+  int list;
+
+  ctx.code = code;
+  ctx.sharing_clauses = pointer_set_create ();
+  ctx.private_iterators = pointer_set_create ();
+  previous = omp_current_ctx;
+  omp_current_ctx = &ctx;
+
+  for (list = 0; list < OMP_LIST_NUM; list++)
+    for (n = omp_clauses->lists[list]; n; n = n->next)
+      pointer_set_insert (ctx.sharing_clauses, n->sym);
+
+  gfc_resolve_blocks (code->block, ns);
+
+  omp_current_ctx = previous;
+  pointer_set_destroy (ctx.sharing_clauses);
+  pointer_set_destroy (ctx.private_iterators);
+}
+
+void
+gfc_resolve_omp_blocks (gfc_code *code, gfc_namespace *ns)
+{
+  struct omp_context *previous;
+
+  if (code->op == EXEC_OMP_PARALLEL)
+    resolve_omp_parallel_blocks (code, ns);
+  else
+    {
+      previous = omp_current_ctx;
+      omp_current_ctx = NULL;
+      gfc_resolve_blocks (code->block, ns);
+      omp_current_ctx = previous;
+    }
+}
+
+/* Note a DO iterator variable.  This is special in !$omp parallel
+   construct, where they are predetermined private.  */
+
+void
+gfc_resolve_do_iterator (gfc_symbol *sym)
+{
+  if (omp_current_ctx == NULL || sym->attr.threadprivate)
+    return;
+
+  if (pointer_set_contains (omp_current_ctx->sharing_clauses, sym))
+    return;
+
+  if (! pointer_set_insert (omp_current_ctx->private_iterators, sym))
+    {
+      gfc_omp_clauses *omp_clauses = omp_current_ctx->code->ext.omp_clauses;
+      gfc_namelist *p;
+
+      p = gfc_get_namelist ();
+      p->sym = sym;
+      p->next = omp_clauses->lists[OMP_LIST_PRIVATE];
+      omp_clauses->lists[OMP_LIST_PRIVATE] = p;
+    }
+}
+
 static void
 resolve_omp_do (gfc_code *code)
 {
--- gcc/testsuite/gfortran.dg/gomp/sharing-1.f90.jj	2005-10-16 13:59:41.000000000 +0200
+++ gcc/testsuite/gfortran.dg/gomp/sharing-1.f90	2005-10-19 15:44:31.000000000 +0200
@@ -13,9 +13,6 @@
     call foo (thrpriv)	! Predetermined - threadprivate
     call foo (thr)	! Predetermined - threadprivate
     call foo (i)	! Predetermined - omp do iteration var
-    do j = 1, 64	! Predetermined - sequential loop
-      call foo (j)	! iteration variable
-    end do
     call bar ((/ (k * 4, k = 1, 8) /)) ! Predetermined - implied do
     forall (l = 1 : i) &! Predetermined - forall indice
       p(l) = 6		! Explicitly determined - private
@@ -24,4 +21,9 @@
     call foo (g2)	! { dg-error "not specified in" }
     call foo (m)	! { dg-error "not specified in" }
   end do
+!$omp parallel default (none)
+    do j = 1, 64	! Predetermined - sequential loop
+      call foo (j)	! iteration variable in parallel construct
+    end do
+!$omp end parallel
 end

	Jakub



More information about the Fortran mailing list