[Fortran] OpenMP - permit lastprivate in distribute + SIMD fixes (PR94690)
PR fortran/94690
* openmp.c (OMP_DISTRIBUTE_CLAUSES): Add OMP_CLAUSE_LASTPRIVATE.
* trans-openmp.c (gfc_trans_omp_do): Don't add private/lastprivate
for dovar_found == 0, unless !simple.
* openmp.c (gfc_resolve_do_iterator): Skip the private handling
for SIMD as that is handled by ME code.
PR fortran/94690
* libgomp.fortran/pr66199-3.f90: New.
* libgomp.fortran/pr66199-4.f90: New.
* libgomp.fortran/pr66199-5.f90: New.
* libgomp.fortran/pr66199-6.f90: New.
* libgomp.fortran/pr66199-7.f90: New.
* libgomp.fortran/pr66199-8.f90: New.
* libgomp.fortran/pr66199-9.f90: New.
gcc/fortran/openmp.c | 27 ++++++++-
gcc/fortran/trans-openmp.c | 27 +++++----
libgomp/testsuite/libgomp.fortran/pr66199-3.f90 | 53 +++++++++++++++++
libgomp/testsuite/libgomp.fortran/pr66199-4.f90 | 60 +++++++++++++++++++
libgomp/testsuite/libgomp.fortran/pr66199-5.f90 | 71 +++++++++++++++++++++++
libgomp/testsuite/libgomp.fortran/pr66199-6.f90 | 42 ++++++++++++++
libgomp/testsuite/libgomp.fortran/pr66199-7.f90 | 72 +++++++++++++++++++++++
libgomp/testsuite/libgomp.fortran/pr66199-8.f90 | 76 +++++++++++++++++++++++++
libgomp/testsuite/libgomp.fortran/pr66199-9.f90 | 46 +++++++++++++++
9 files changed, 459 insertions(+), 15 deletions(-)
@@ -2595,7 +2595,7 @@ cleanup:
| OMP_CLAUSE_SHARED | OMP_CLAUSE_REDUCTION)
#define OMP_DISTRIBUTE_CLAUSES \
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
- | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_DIST_SCHEDULE)
+ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_DIST_SCHEDULE)
#define OMP_SINGLE_CLAUSES \
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE)
#define OMP_ORDERED_CLAUSES \
@@ -5682,6 +5682,31 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym, bool add_clause)
if (omp_current_ctx->sharing_clauses->contains (sym))
return;
+ if (omp_current_ctx->is_openmp && omp_current_ctx->code->block)
+ {
+ /* SIMD is handled differently and, hence, ignored here. */
+ gfc_code *omp_code = omp_current_ctx->code->block;
+ for ( ; omp_code->next; omp_code = omp_code->next)
+ switch (omp_code->op)
+ {
+ case EXEC_OMP_SIMD:
+ case EXEC_OMP_DO_SIMD:
+ case EXEC_OMP_PARALLEL_DO_SIMD:
+ case EXEC_OMP_DISTRIBUTE_SIMD:
+ case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
+ case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
+ case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+ case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
+ case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
+ case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
+ case EXEC_OMP_TARGET_SIMD:
+ case EXEC_OMP_TASKLOOP_SIMD:
+ return;
+ default:
+ break;
+ }
+ }
+
if (! omp_current_ctx->private_iterators->add (sym) && add_clause)
{
gfc_omp_clauses *omp_clauses = omp_current_ctx->code->ext.omp_clauses;
@@ -4296,23 +4296,22 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
break;
}
}
- if (!dovar_found)
+ if (!dovar_found && op == EXEC_OMP_SIMD)
{
- if (op == EXEC_OMP_SIMD)
+ if (collapse == 1)
{
- if (collapse == 1)
- {
- tmp = build_omp_clause (input_location, OMP_CLAUSE_LINEAR);
- OMP_CLAUSE_LINEAR_STEP (tmp) = step;
- OMP_CLAUSE_LINEAR_NO_COPYIN (tmp) = 1;
- }
- else
- tmp = build_omp_clause (input_location, OMP_CLAUSE_LASTPRIVATE);
- if (!simple)
- dovar_found = 2;
+ tmp = build_omp_clause (input_location, OMP_CLAUSE_LINEAR);
+ OMP_CLAUSE_LINEAR_STEP (tmp) = step;
+ OMP_CLAUSE_LINEAR_NO_COPYIN (tmp) = 1;
+ OMP_CLAUSE_DECL (tmp) = dovar_decl;
+ omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
}
- else
- tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE);
+ if (!simple)
+ dovar_found = 2;
+ }
+ else if (!dovar_found && !simple)
+ {
+ tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE);
OMP_CLAUSE_DECL (tmp) = dovar_decl;
omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
}
new file mode 100644
@@ -0,0 +1,53 @@
+! { dg-do run }
+!
+! PR fortran/94690
+! PR middle-end/66199
+
+module m
+ integer u(0:1024-1), v(0:1024-1), w(0:1024-1)
+contains
+
+integer(8) function f1 (a, b)
+ implicit none
+ integer, value :: a, b
+ integer(8) :: d
+ !$omp parallel do lastprivate (d) default(none) firstprivate (a, b) shared(u, v, w)
+ do d = a, b-1
+ u(d) = v(d) + w(d)
+ end do
+ f1 = d
+end
+
+integer(8) function f2 (a, b, c)
+ implicit none
+ integer, value :: a, b, c
+ integer(8) :: d, e
+ !$omp parallel do lastprivate (d) default(none) firstprivate (a, b) shared(u, v, w) linear(c:5) lastprivate(e)
+ do d = a, b-1
+ u(d) = v(d) + w(d)
+ c = c + 5
+ e = c
+ end do
+ f2 = d + c + e
+end
+
+integer(8) function f3 (a1, b1, a2, b2)
+ implicit none
+ integer, value :: a1, b1, a2, b2
+ integer(8) d1, d2
+ !$omp parallel do default(none) firstprivate (a1, b1, a2, b2) shared(u, v, w) lastprivate(d1, d2) collapse(2)
+ do d1 = a1, b1-1
+ do d2 = a2, b2-1
+ u(d1 * 32 + d2) = v(d1 * 32 + d2) + w(d1 * 32 + d2)
+ end do
+ end do
+ f3 = d1 + d2
+end
+end module m
+
+program main
+ use m
+ if (f1 (0, 1024) /= 1024) stop 1
+ if (f2 (0, 1024, 17) /= 1024 + 2 * (17 + 5 * 1024)) stop 2
+ if (f3 (0, 32, 0, 32) /= 64) stop 3
+end program main
new file mode 100644
@@ -0,0 +1,60 @@
+! { dg-do run }
+!
+! PR fortran/94690
+! PR middle-end/66199
+
+module m
+ implicit none
+ integer u(0:1023), v(0:1023), w(0:1023)
+ !$omp declare target (u, v, w)
+
+contains
+
+subroutine f1 (a, b)
+ integer a, b, d
+ !$omp target teams distribute parallel do default(none) firstprivate (a, b) shared(u, v, w)
+ do d = a, b-1
+ u(d) = v(d) + w(d)
+ end do
+end
+
+subroutine f2 (a, b, c)
+ integer a, b, c, d, e
+ !$omp target teams distribute parallel do default(none) firstprivate (a, b, c) shared(u, v, w) lastprivate(d, e)
+ do d = a, b-1
+ u(d) = v(d) + w(d)
+ e = c + d * 5
+ end do
+end
+
+subroutine f3 (a1, b1, a2, b2)
+ integer :: a1, b1, a2, b2, d1, d2
+ !$omp target teams distribute parallel do default(none) firstprivate (a1, b1, a2, b2) shared(u, v, w) &
+ !$omp& lastprivate(d1, d2) collapse(2)
+ do d1 = a1, b1-1
+ do d2 = a2, b2-1
+ u(d1 * 32 + d2) = v(d1 * 32 + d2) + w(d1 * 32 + d2)
+ end do
+ end do
+end
+
+subroutine f4 (a1, b1, a2, b2)
+ integer :: a1, b1, a2, b2, d1, d2
+ !$omp target teams distribute parallel do default(none) firstprivate (a1, b1, a2, b2) shared(u, v, w) &
+ !$omp& collapse(2)
+ do d1 = a1, b1-1
+ do d2 = a2, b2-1
+ u(d1 * 32 + d2) = v(d1 * 32 + d2) + w(d1 * 32 + d2)
+ end do
+ end do
+end
+end module m
+
+program main
+ use m
+ implicit none
+ call f1 (0, 1024)
+ call f2 (0, 1024, 17)
+ call f3 (0, 32, 0, 32)
+ call f4 (0, 32, 0, 32)
+end
new file mode 100644
@@ -0,0 +1,71 @@
+! { dg-do run }
+!
+! PR fortran/94690
+! PR middle-end/66199
+
+module m
+ implicit none
+ integer u(0:1023), v(0:1023), w(0:1023)
+ !$omp declare target (u, v, w)
+
+contains
+
+integer function f1 (a, b)
+ integer :: a, b, d
+ !$omp target map(from: d)
+ !$omp teams distribute parallel do simd default(none) firstprivate (a, b) shared(u, v, w)
+ do d = a, b-1
+ u(d) = v(d) + w(d)
+ end do
+ !$omp end target
+ f1 = d
+end
+
+integer function f2 (a, b, c)
+ integer :: a, b, c, d, e
+ !$omp target map(from: d, e)
+ !$omp teams distribute parallel do simd default(none) firstprivate (a, b, c) shared(u, v, w) linear(d) lastprivate(e)
+ do d = a, b-1
+ u(d) = v(d) + w(d)
+ e = c + d * 5
+ end do
+ !$omp end target
+ f2 = d + e
+end
+
+integer function f3 (a1, b1, a2, b2)
+ integer :: a1, b1, a2, b2, d1, d2
+ !$omp target map(from: d1, d2)
+ !$omp teams distribute parallel do simd default(none) firstprivate (a1, b1, a2, b2) shared(u, v, w) lastprivate(d1, d2) &
+ !$omp& collapse(2)
+ do d1 = a1, b1-1
+ do d2 = a2, b2-1
+ u(d1 * 32 + d2) = v(d1 * 32 + d2) + w(d1 * 32 + d2)
+ end do
+ end do
+ !$omp end target
+ f3 = d1 + d2
+end
+
+integer function f4 (a1, b1, a2, b2)
+ integer :: a1, b1, a2, b2, d1, d2
+ !$omp target map(from: d1, d2)
+ !$omp teams distribute parallel do simd default(none) firstprivate (a1, b1, a2, b2) shared(u, v, w) collapse(2)
+ do d1 = a1, b1-1
+ do d2 = a2, b2-1
+ u(d1 * 32 + d2) = v(d1 * 32 + d2) + w(d1 * 32 + d2)
+ end do
+ end do
+ !$omp end target
+ f4 = d1 + d2
+end
+end module
+
+program main
+ use m
+ implicit none
+ if (f1 (0, 1024) /= 1024) stop 1
+ if (f2 (0, 1024, 17) /= 1024 + (17 + 5 * 1023)) stop 2
+ if (f3 (0, 32, 0, 32) /= 64) stop 3
+ if (f4 (0, 32, 0, 32) /= 64) stop 3
+end
new file mode 100644
@@ -0,0 +1,42 @@
+! { dg-do run }
+!
+! PR fortran/94690
+! PR middle-end/66199
+
+module m
+ implicit none
+ integer :: u(0:1023), v(0:1023), w(0:1023)
+ !$omp declare target (u, v, w)
+
+contains
+
+integer function f2 (a, b, c)
+ integer :: a, b, c, d, e
+ !$omp target map(from: d, e)
+ !$omp teams distribute parallel do default(none) firstprivate (a, b, c) shared(u, v, w) lastprivate(d, e)
+ do d = a, b-1
+ u(d) = v(d) + w(d)
+ e = c + d * 5
+ end do
+ !$omp end target
+ f2 = d + e
+end
+
+integer function f3 (a1, b1, a2, b2)
+ integer :: a1, b1, a2, b2, d1, d2
+ !$omp target map(from: d1, d2)
+ !$omp teams distribute parallel do default(none) firstprivate (a1, b1, a2, b2) shared(u, v, w) lastprivate(d1, d2) collapse(2)
+ do d1 = a1, b1-1
+ do d2 = a2, b2-1
+ u(d1 * 32 + d2) = v(d1 * 32 + d2) + w(d1 * 32 + d2)
+ end do
+ end do
+ !$omp end target
+ f3 = d1 + d2
+end
+end module m
+
+use m
+ if (f2 (0, 1024, 17) /= 1024 + (17 + 5 * 1023)) stop 1
+ if (f3 (0, 32, 0, 32) /= 64) stop 2
+end
new file mode 100644
@@ -0,0 +1,72 @@
+! { dg-do run }
+!
+! PR fortran/94690
+! PR middle-end/66199
+
+module m
+ implicit none
+ integer u(1024), v(1024), w(1024)
+ !$omp declare target (v, u, w)
+
+contains
+
+integer function f1 (a, b)
+ integer :: a, b, d
+ !$omp target map(from: d)
+ !$omp teams distribute simd default(none) firstprivate (a, b) shared(u, v, w)
+ do d = a, b-1
+ u(d) = v(d) + w(d)
+ end do
+ !$omp end teams distribute simd
+ !$omp end target
+ f1 = d
+end
+
+integer function f2 (a, b, c)
+ integer a, b, c, d, e
+ !$omp target map(from: d, e)
+ !$omp teams distribute simd default(none) firstprivate (a, b, c) shared(u, v, w) linear(d) lastprivate(e)
+ do d = a, b-1
+ u(d) = v(d) + w(d)
+ e = c + d * 5
+ end do
+ !$omp end teams distribute simd
+ !$omp end target
+ f2 = d + e
+end
+
+integer function f3 (a1, b1, a2, b2)
+ integer :: a1, b1, a2, b2, d1, d2
+ !$omp target map(from: d1, d2)
+ !$omp teams distribute simd default(none) firstprivate (a1, b1, a2, b2) shared(u, v, w) lastprivate(d1, d2) collapse(2)
+ do d1 = a1, b1-1
+ do d2 = a2, b2-1
+ u(d1 * 32 + d2) = v(d1 * 32 + d2) + w(d1 * 32 + d2)
+ end do
+ end do
+ !$omp end teams distribute simd
+ !$omp end target
+ f3 = d1 + d2
+end
+
+integer function f4 (a1, b1, a2, b2)
+ integer :: a1, b1, a2, b2, d1, d2
+ !$omp target map(from: d1, d2)
+ !$omp teams distribute simd default(none) firstprivate (a1, b1, a2, b2) shared(u, v, w) collapse(2)
+ do d1 = a1, b1-1
+ do d2 = a2, b2-1
+ u(d1 * 32 + d2) = v(d1 * 32 + d2) + w(d1 * 32 + d2)
+ end do
+ end do
+ !$omp end teams distribute simd
+ !$omp end target
+ f4 = d1 + d2
+end
+end module
+
+use m
+ if (f1 (0, 1024) /= 1024) stop 1
+ if (f2 (0, 1024, 17) /= 1024 + (17 + 5 * 1023)) stop 2
+ if (f3 (0, 32, 0, 32) /= 64) stop 3
+ if (f4 (0, 32, 0, 32) /= 64) stop 4
+end
new file mode 100644
@@ -0,0 +1,76 @@
+! { dg-do run }
+!
+! PR fortran/94690
+! PR middle-end/66199
+
+module m
+ implicit none
+ integer u(0:1023), v(0:1023), w(0:1023)
+ !$omp declare target (u, v, w)
+
+contains
+
+integer function f1 (a, b)
+ integer :: a, b, d
+ !$omp target map(from: d)
+ !$omp teams default(none) shared(a, b, d, u, v, w)
+ !$omp distribute simd firstprivate (a, b)
+ do d = a, b-1
+ u(d) = v(d) + w(d)
+ end do
+ !$omp end teams
+ !$omp end target
+ f1 = d
+end
+
+integer function f2 (a, b, c)
+ integer a, b, c, d, e
+ !$omp target map(from: d, e)
+ !$omp teams default(none) firstprivate (a, b, c) shared(d, e, u, v, w)
+ !$omp distribute simd linear(d) lastprivate(e)
+ do d = a, b-1
+ u(d) = v(d) + w(d)
+ e = c + d * 5
+ end do
+ !$omp end teams
+ !$omp end target
+ f2 = d + e
+end
+
+integer function f3 (a1, b1, a2, b2)
+ integer a1, b1, a2, b2, d1, d2
+ !$omp target map(from: d1, d2)
+ !$omp teams default(none) shared(a1, b1, a2, b2, d1, d2, u, v, w)
+ !$omp distribute simd firstprivate (a1, b1, a2, b2) lastprivate(d1, d2) collapse(2)
+ do d1 = a1, b1-1
+ do d2 = a2, b2-1
+ u(d1 * 32 + d2) = v(d1 * 32 + d2) + w(d1 * 32 + d2)
+ end do
+ end do
+ !$omp end teams
+ !$omp end target
+ f3 = d1 + d2
+end
+
+integer function f4 (a1, b1, a2, b2)
+ integer a1, b1, a2, b2, d1, d2
+ !$omp target map(from: d1, d2)
+ !$omp teams default(none) firstprivate (a1, b1, a2, b2) shared(d1, d2, u, v, w)
+ !$omp distribute simd collapse(2)
+ do d1 = a1, b1-1
+ do d2 = a2, b2-1
+ u(d1 * 32 + d2) = v(d1 * 32 + d2) + w(d1 * 32 + d2)
+ end do
+ end do
+ !$omp end teams
+ !$omp end target
+ f4 = d1 + d2
+end
+end module m
+
+use m
+ if (f1 (0, 1024) /= 1024) stop 1
+ if (f2 (0, 1024, 17) /= 1024 + (17 + 5 * 1023)) stop 2
+ if (f3 (0, 32, 0, 32) /= 64) stop 3
+ if (f4 (0, 32, 0, 32) /= 64) stop 4
+end
new file mode 100644
@@ -0,0 +1,46 @@
+! { dg-do run }
+!
+! PR fortran/94690
+! PR middle-end/66199
+
+module m
+ implicit none
+ integer u(1024), v(1024), w(1024)
+ !$omp declare target (u, v, w)
+
+contains
+
+integer function f2 (a, b, c)
+ integer :: a, b, c, d, e
+ !$omp target map(from: d, e)
+ !$omp teams default(none) firstprivate (a, b, c) shared(d, e, u, v, w)
+ !$omp distribute lastprivate(d, e)
+ do d = a, b-1
+ u(d) = v(d) + w(d)
+ e = c + d * 5
+ end do
+ !$omp end teams
+ !$omp end target
+ f2 = d + e
+end
+
+integer function f3 (a1, b1, a2, b2)
+ integer :: a1, b1, a2, b2, d1, d2
+ !$omp target map(from: d1, d2)
+ !$omp teams default(none) shared(a1, b1, a2, b2, d1, d2, u, v, w)
+ !$omp distribute firstprivate (a1, b1, a2, b2) lastprivate(d1, d2) collapse(2)
+ do d1 = a1, b1-1
+ do d2 = a2, b2-1
+ u(d1 * 32 + d2) = v(d1 * 32 + d2) + w(d1 * 32 + d2)
+ end do
+ end do
+ !$omp end teams
+ !$omp end target
+ f3 = d1 + d2
+end
+end module
+
+use m
+ if (f2 (0, 1024, 17) /= 1024 + (17 + 5 * 1023)) stop 1
+ if (f3 (0, 32, 0, 32) /= 64) stop 2
+end
As found via sollve_vv: the Fortran OpenMP parser missed 'lastprivate' as permitted clause in 'distribute'. Additionally, when copying + fortanifying the libgomp.c*/pr66199-[3-9].c test case, I found an issue with loops. Standard gfortran DO loops use "while()" – probably a legacy because very old Fortran had single tripes. For SIMD loops, a "normal" "for" loop is used. The middle end takes care of most semantic like adding a '(last)private'. For normal DO loops, the FE adds the 'private' to the loop variable. This patch now removes most handling from SIMD loops but keeps it for other constructs. "!simple" means that an auxiliary loop variable ("count.0") is used and the original loop variable is then "j = ... count.0 ...". Issues encountered (see PR): - no truncation warnings (fixed, cf. PR94709) - gfc_trans_omp_do added always a private(loopvar), even if an explicit 'lastprivate(loopvar)' was present (see PR for which test case) - gfc_trans_omp_do [for *-7.f90, function f4] added a 'lastprivate' to the 'simd' for: !$omp distribute collapse(2) !$omp simd collapse(2) This confused the ME as none was added higher up; now the ME handles all. Once removing this from gfc_trans_omp_do, gfortran.dg/target1.f90 failed teams got a private(<loopvar>) which was then not repeated at "distribute simd". The reason is that gfc_resolve_do_iterator added it to 'teams' but 'gfc_trans_omp_do' not (no longer) to 'simd'. Solution: Not adding it to SIMD loops. I am not completely happy how it is done – nor am I sure that there are no further pitholes. I also do not see a good way to ensure that newer "something something SIMD" directives get properly added to gfc_resolve_do_iterator. OK for the trunk? Tobias ----------------- Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter