From: Chung-Lin Tang Date: Wed, 20 Oct 2021 16:36:08 +0000 (+0200) Subject: openmp: in_reduction support for Fortran X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=0f3a4cfc6a4e1b65b0e59146e5ef59a150868b44;p=thirdparty%2Fgcc.git openmp: in_reduction support for Fortran This patch implements support for the in_reduction clause for Fortran. It also includes more completion of the taskgroup construct inside the Fortran front-end, thus allowing task_reduction to work for task and target constructs. gcc/fortran/ChangeLog: * openmp.c (gfc_match_omp_clause_reduction): Add 'openmp_target' default false parameter. Add 'always,tofrom' map for OMP_LIST_IN_REDUCTION case. (gfc_match_omp_clauses): Add 'openmp_target' default false parameter, adjust call to gfc_match_omp_clause_reduction. (match_omp): Adjust call to gfc_match_omp_clauses * trans-openmp.c (gfc_trans_omp_taskgroup): Add call to gfc_match_omp_clause, create and return block. gcc/ChangeLog: * omp-low.c (omp_copy_decl_2): For !ctx, use record_vars to add new copy as local variable. (scan_sharing_clauses): Place copy of OMP_CLAUSE_IN_REDUCTION decl in ctx->outer instead of ctx. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/reduction4.f90: Adjust omp target in_reduction' scan pattern. libgomp/ChangeLog: * testsuite/libgomp.fortran/target-in-reduction-1.f90: New test. * testsuite/libgomp.fortran/target-in-reduction-2.f90: New test. (cherry picked from commit d98626bf451dea6a28a42d953f7d0bd7659ad4d5) (This merges the review comments, taken care of in the mainline commit, referenced above. For OG11, the heavy lifting was already done in commit 07a380a8a024fbcc61c0098400da9a382b9a7010 ) --- diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 654d121d88eb..1f5cc5be599b 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -3581,7 +3581,7 @@ match_omp (gfc_exec_op op, const omp_mask mask) { gfc_omp_clauses *c; if (gfc_match_omp_clauses (&c, mask, true, true, false, false, - (op == EXEC_OMP_TARGET)) != MATCH_YES) + op == EXEC_OMP_TARGET) != MATCH_YES) return MATCH_ERROR; new_st.op = op; new_st.ext.omp_clauses = c; diff --git a/gcc/omp-low.c b/gcc/omp-low.c index a2d225ae39eb..43fababb5a37 100644 --- a/gcc/omp-low.c +++ b/gcc/omp-low.c @@ -595,7 +595,15 @@ omp_copy_decl_2 (tree var, tree name, tree type, omp_context *ctx) tree copy = copy_var_decl (var, name, type); DECL_CONTEXT (copy) = current_function_decl; - DECL_CHAIN (copy) = ctx->block_vars; + + if (ctx) + { + DECL_CHAIN (copy) = ctx->block_vars; + ctx->block_vars = copy; + } + else + record_vars (copy); + /* If VAR is listed in task_shared_vars, it means it wasn't originally addressable and is just because task needs to take it's address. But we don't need to take address of privatizations @@ -606,7 +614,6 @@ omp_copy_decl_2 (tree var, tree name, tree type, omp_context *ctx) || (global_nonaddressable_vars && bitmap_bit_p (global_nonaddressable_vars, DECL_UID (var))))) TREE_ADDRESSABLE (copy) = 0; - ctx->block_vars = copy; return copy; } @@ -1412,13 +1419,9 @@ scan_sharing_clauses (tree clauses, omp_context *ctx, gcc_assert (DECL_P (t)); } tree at = t; - omp_context *scan_ctx = ctx; if (ctx->outer) - { - scan_omp_op (&at, ctx->outer); - scan_ctx = ctx->outer; - } - tree nt = omp_copy_decl_1 (at, scan_ctx); + scan_omp_op (&at, ctx->outer); + tree nt = omp_copy_decl_1 (at, ctx->outer); splay_tree_insert (ctx->field_map, (splay_tree_key) &DECL_CONTEXT (t), (splay_tree_value) nt); @@ -1457,13 +1460,9 @@ scan_sharing_clauses (tree clauses, omp_context *ctx, if (is_omp_target (ctx->stmt)) { tree at = decl; - omp_context *scan_ctx = ctx; if (ctx->outer) - { - scan_omp_op (&at, ctx->outer); - scan_ctx = ctx->outer; - } - tree nt = omp_copy_decl_1 (at, scan_ctx); + scan_omp_op (&at, ctx->outer); + tree nt = omp_copy_decl_1 (at, ctx->outer); splay_tree_insert (ctx->field_map, (splay_tree_key) &DECL_CONTEXT (decl), (splay_tree_value) nt); diff --git a/libgomp/testsuite/libgomp.fortran/target-in-reduction-1.f90 b/libgomp/testsuite/libgomp.fortran/target-in-reduction-1.f90 index 68512e223ac3..f9acb711e670 100644 --- a/libgomp/testsuite/libgomp.fortran/target-in-reduction-1.f90 +++ b/libgomp/testsuite/libgomp.fortran/target-in-reduction-1.f90 @@ -1,26 +1,49 @@ ! { dg-do run } -subroutine foo (x, y) - integer :: x, y +module mod1 + contains - !$omp taskgroup task_reduction (+: x, y) + subroutine foo (x, y) + integer :: x, y - !$omp target in_reduction (+: x, y) - x = x + 8 - y = y + 16 - !$omp end target + !$omp taskgroup task_reduction (+: x, y) - !$omp task in_reduction (+: x, y) - x = x + 2 - y = y + 4 - !$omp end task + !$omp target in_reduction (+: x, y) + x = x + 8 + y = y + 16 + !$omp end target - !$omp end taskgroup + !$omp task in_reduction (+: x, y) + x = x + 2 + y = y + 4 + !$omp end task + + !$omp end taskgroup + end subroutine foo + + integer function bar (x) + integer, value :: x + + !$omp taskgroup task_reduction (+: x) + + !$omp target in_reduction (+: x) + x = x + 16 + !$omp end target + + !$omp task in_reduction (+: x) + x = x + 32 + !$omp end task + + !$omp end taskgroup -end subroutine foo + bar = x + end function bar + end module mod1 program main + use mod1 integer :: x, y + real :: f; x = 1 y = 1 @@ -30,4 +53,26 @@ program main if (x .ne. 11) stop 1 if (y .ne. 21) stop 2 + y = bar (8) + if (y .ne. 56) stop 3 + + x = 0 + f = 0.0 + + !$omp taskgroup task_reduction (+: x, f) + !$omp target in_reduction (+: x, f) + x = x + 1 + f = f + 2.0 + !$omp end target + + !$omp task in_reduction (+: x, f) + x = x + 2 + f = f + 3.0 + !$omp end task + + !$omp end taskgroup + + if (x .ne. 3) stop 4 + if (f .ne. 5.0) stop 5 + end program main diff --git a/libgomp/testsuite/libgomp.fortran/target-in-reduction-2.f90 b/libgomp/testsuite/libgomp.fortran/target-in-reduction-2.f90 new file mode 100644 index 000000000000..7f2e16b534b0 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/target-in-reduction-2.f90 @@ -0,0 +1,30 @@ +! { dg-do run } + +program main + integer :: x + + x = 0 + !$omp taskgroup task_reduction (+: x) + call foo (x) + call bar (x) + !$omp end taskgroup + + if (x .ne. 3) stop 1 + +contains + + subroutine foo (x) + integer :: x + !$omp task in_reduction (+: x) + x = x + 1 + !$omp end task + end subroutine foo + + subroutine bar (x) + integer :: x + !$omp target in_reduction (+: x) + x = x + 2 + !$omp end target + end subroutine bar + +end program main