This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[gomp] Predetermined loop iterators (take 2)
On Wed, Oct 19, 2005 at 11:07:44AM -0400, Diego Novillo wrote:
> IMO, in all these cases variable 'i' is implicitly private. The same rule
> applies. The standard says that it is "... private in the parallel
> construct.". I would probably have worded it as "... private in the
> outermost parallel construct.".
Ok, this updated patch implements what Intel seems to be doing.
Particularly, for any DO (including OMP DO) iterator var, it walks all
PARALLEL{, DO, SECTIONS, WORKSHARE} constructs the DO is nested in
and if the iterator var is not listed explicitly in data sharing clauses
of that construct, it is added to the private clause.
GCC ICEs on the newly added testcase, but that seems unrelated to this
patch (particularly if I replace default (none) with private (i, j, k)
on all constructs, it ICEs too).
2005-10-19 Jakub Jelinek <jakub@redhat.com>
* gfortran.h (gfc_resolve_do_iterator, gfc_resolve_blocks,
gfc_resolve_omp_parallel_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 EXEC_OMP_PARALLEL* directives. Call
gfc_resolve_omp_parallel_blocks for EXEC_OMP_PARALLEL* directives.
Call gfc_resolve_do_iterator if resolved successfully EXEC_DO
iterator.
* openmp.c: Include pointer-set.h.
(omp_current_ctx): New variable.
(gfc_resolve_omp_parallel_blocks, gfc_resolve_do_iterator): New
functions.
* Make-lang.in (fortran/openmp.o): Depend on pointer-set.h.
testsuite/
* gfortran.dg/gomp/sharing-2.f90: New test.
--- gcc/fortran/resolve.c.jj 2005-10-17 09:04:27.000000000 +0200
+++ gcc/fortran/resolve.c 2005-10-19 18:06:06.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,21 @@ 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_PARALLEL:
+ case EXEC_OMP_PARALLEL_DO:
+ case EXEC_OMP_PARALLEL_SECTIONS:
+ case EXEC_OMP_PARALLEL_WORKSHARE:
+ gfc_resolve_omp_parallel_blocks (code, ns);
+ break;
+ default:
+ gfc_resolve_blocks (code->block, ns);
+ break;
+ }
+ }
if (code->op == EXEC_FORALL)
forall_flag = forall_save;
@@ -4006,7 +4017,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_parallel_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 18:04: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,68 @@ 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;
+ struct omp_context *previous;
+} *omp_current_ctx;
+
+void
+gfc_resolve_omp_parallel_blocks (gfc_code *code, gfc_namespace *ns)
+{
+ struct omp_context ctx;
+ 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 ();
+ ctx.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 = ctx.previous;
+ pointer_set_destroy (ctx.sharing_clauses);
+ pointer_set_destroy (ctx.private_iterators);
+}
+
+/* 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)
+{
+ struct omp_context *ctx;
+
+ if (sym->attr.threadprivate)
+ return;
+
+ for (ctx = omp_current_ctx; ctx; ctx = ctx->previous)
+ {
+ if (pointer_set_contains (ctx->sharing_clauses, sym))
+ continue;
+
+ if (! pointer_set_insert (ctx->private_iterators, sym))
+ {
+ gfc_omp_clauses *omp_clauses = 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-2.f90.jj 2005-10-19 18:09:27.000000000 +0200
+++ gcc/testsuite/gfortran.dg/gomp/sharing-2.f90 2005-10-19 18:21:30.000000000 +0200
@@ -0,0 +1,77 @@
+ integer :: i, j, k, l
+ integer, dimension (10, 10) :: a
+!$omp parallel do default (none) shared (a)
+ do i = 1, 10
+ j = 4
+ do j = 1, 10
+ a(i, j) = i + j
+ end do
+ j = 8
+ end do
+!$omp end parallel do
+!$omp parallel default (none) shared (a) ! { dg-error "enclosing parallel" }
+ i = 1
+ j = 1
+ k = 1
+ l = 1 ! { dg-error "not specified in" }
+ do i = 1, 10
+ a(i, 1) = 1
+ end do
+!$omp critical
+ do j = 1, 10
+ a(1, j) = j
+ end do
+!$omp end critical
+!$omp single
+ do k = 1, 10
+ a(k, k) = k
+ end do
+!$omp end single
+!$omp end parallel
+!$omp parallel default (none) shared (a)
+ i = 1
+ j = 1
+ k = 1
+!$omp parallel default (none) shared (a)
+ i = 1
+ j = 1
+ k = 1
+ do i = 1, 10
+ a(i, 1) = 1
+ end do
+!$omp critical
+ do j = 1, 10
+ a(1, j) = j
+ end do
+!$omp end critical
+!$omp single
+ do k = 1, 10
+ a(k, k) = k
+ end do
+!$omp end single
+!$omp end parallel
+ i = 1
+ j = 1
+ k = 1
+!$omp end parallel
+!$omp parallel default (none) shared (a)
+ i = 1
+!$omp do
+ do i = 1, 10
+ a(i, 1) = i + 1
+ end do
+!$omp end parallel
+!$omp parallel default (none) shared (a)
+ i = 1
+!$omp parallel default (none) shared (a, i)
+ i = 2
+!$omp parallel default (none) shared (a)
+ do i = 1, 10
+ a(i, 1) = i
+ end do
+!$omp end parallel
+ i = 3
+!$omp end parallel
+ i = 4
+!$omp end parallel
+end
Jakub