From e55ba804d3b8de86a430a8a5553dfc1ad06daa74 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Wed, 22 Jul 2020 21:02:01 +0200 Subject: [PATCH] OpenMP: Support 'if (simd:/cancel:' in Fortran gcc/fortran/ChangeLog: * gfortran.h (enum gfc_omp_if_kind): Add OMP_IF_CANCEL and OMP_IF_SIMD. * openmp.c (OMP_SIMD_CLAUSES): Add OMP_CLAUSE_IF. (gfc_match_omp_clauses, resolve_omp_clauses): Handle 'if (simd/cancel:'. * dump-parse-tree.c (show_omp_clauses): Likewise. * trans-openmp.c (gfc_trans_omp_clauses, gfc_trans_omp_cancel, (gfc_split_omp_clauses): Likewise. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/cancel-2.f90: New test. * gfortran.dg/gomp/cancel-3.f90: New test. * gfortran.dg/gomp/if-1.f90: New test. --- gcc/fortran/dump-parse-tree.c | 2 + gcc/fortran/gfortran.h | 2 + gcc/fortran/openmp.c | 46 +++++++++-- gcc/fortran/trans-openmp.c | 17 +++- gcc/testsuite/gfortran.dg/gomp/cancel-2.f90 | 15 ++++ gcc/testsuite/gfortran.dg/gomp/cancel-3.f90 | 35 ++++++++ gcc/testsuite/gfortran.dg/gomp/if-1.f90 | 122 ++++++++++++++++++++++++++++ 7 files changed, 229 insertions(+), 10 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/gomp/cancel-2.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/cancel-3.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/if-1.f90 diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index f9a6bf4..2a02bc8 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -1693,7 +1693,9 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) if (omp_clauses->if_exprs[i]) { static const char *ifs[] = { + "CANCEL", "PARALLEL", + "SIMD", "TASK", "TASKLOOP", "TARGET", diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 264822e..1648831 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1320,7 +1320,9 @@ enum gfc_omp_cancel_kind enum gfc_omp_if_kind { + OMP_IF_CANCEL, OMP_IF_PARALLEL, + OMP_IF_SIMD, OMP_IF_TASK, OMP_IF_TASKLOOP, OMP_IF_TARGET, diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 58552af..e89ae29 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -1303,7 +1303,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, { /* This should match the enum gfc_omp_if_kind order. */ static const char *ifs[OMP_IF_LAST] = { + " cancel : %e )", " parallel : %e )", + " simd : %e )", " task : %e )", " taskloop : %e )", " target : %e )", @@ -2568,7 +2570,8 @@ cleanup: #define OMP_SIMD_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_LASTPRIVATE \ | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_SAFELEN \ - | OMP_CLAUSE_LINEAR | OMP_CLAUSE_ALIGNED | OMP_CLAUSE_SIMDLEN) + | OMP_CLAUSE_LINEAR | OMP_CLAUSE_ALIGNED | OMP_CLAUSE_SIMDLEN \ + | OMP_CLAUSE_IF) #define OMP_TASK_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT \ @@ -4133,33 +4136,53 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, else switch (code->op) { + case EXEC_OMP_CANCEL: + ok = ifc == OMP_IF_CANCEL; + break; + case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: case EXEC_OMP_PARALLEL_SECTIONS: case EXEC_OMP_PARALLEL_WORKSHARE: - case EXEC_OMP_PARALLEL_DO_SIMD: case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: - case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: - case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: ok = ifc == OMP_IF_PARALLEL; break; + case EXEC_OMP_PARALLEL_DO_SIMD: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + ok = ifc == OMP_IF_PARALLEL || ifc == OMP_IF_SIMD; + break; + + case EXEC_OMP_SIMD: + case EXEC_OMP_DO_SIMD: + case EXEC_OMP_DISTRIBUTE_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: + ok = ifc == OMP_IF_SIMD; + break; + case EXEC_OMP_TASK: ok = ifc == OMP_IF_TASK; break; case EXEC_OMP_TASKLOOP: - case EXEC_OMP_TASKLOOP_SIMD: ok = ifc == OMP_IF_TASKLOOP; break; + case EXEC_OMP_TASKLOOP_SIMD: + ok = ifc == OMP_IF_TASKLOOP || ifc == OMP_IF_SIMD; + break; + case EXEC_OMP_TARGET: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + ok = ifc == OMP_IF_TARGET; + break; + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: case EXEC_OMP_TARGET_SIMD: - ok = ifc == OMP_IF_TARGET; + ok = ifc == OMP_IF_TARGET || ifc == OMP_IF_SIMD; break; case EXEC_OMP_TARGET_DATA: @@ -4179,13 +4202,18 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, break; case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: - case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: case EXEC_OMP_TARGET_PARALLEL: case EXEC_OMP_TARGET_PARALLEL_DO: - case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: ok = ifc == OMP_IF_TARGET || ifc == OMP_IF_PARALLEL; break; + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + ok = (ifc == OMP_IF_TARGET + || ifc == OMP_IF_PARALLEL + || ifc == OMP_IF_SIMD); + break; + default: ok = false; break; @@ -4193,7 +4221,9 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, if (!ok) { static const char *ifs[] = { + "CANCEL", "PARALLEL", + "SIMD", "TASK", "TASKLOOP", "TARGET", diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index a63000b..56bc7cd 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -3201,9 +3201,15 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_IF); switch (ifc) { + case OMP_IF_CANCEL: + OMP_CLAUSE_IF_MODIFIER (c) = VOID_CST; + break; case OMP_IF_PARALLEL: OMP_CLAUSE_IF_MODIFIER (c) = OMP_PARALLEL; break; + case OMP_IF_SIMD: + OMP_CLAUSE_IF_MODIFIER (c) = OMP_SIMD; + break; case OMP_IF_TASK: OMP_CLAUSE_IF_MODIFIER (c) = OMP_TASK; break; @@ -4197,13 +4203,18 @@ gfc_trans_omp_cancel (gfc_code *code) default: gcc_unreachable (); } gfc_start_block (&block); - if (code->ext.omp_clauses->if_expr) + if (code->ext.omp_clauses->if_expr + || code->ext.omp_clauses->if_exprs[OMP_IF_CANCEL]) { gfc_se se; tree if_var; + gcc_assert ((code->ext.omp_clauses->if_expr == NULL) + ^ (code->ext.omp_clauses->if_exprs[OMP_IF_CANCEL] == NULL)); gfc_init_se (&se, NULL); - gfc_conv_expr (&se, code->ext.omp_clauses->if_expr); + gfc_conv_expr (&se, code->ext.omp_clauses->if_expr != NULL + ? code->ext.omp_clauses->if_expr + : code->ext.omp_clauses->if_exprs[OMP_IF_CANCEL]); gfc_add_block_to_block (&block, &se.pre); if_var = gfc_evaluate_now (se.expr, &block); gfc_add_block_to_block (&block, &se.post); @@ -4997,6 +5008,8 @@ gfc_split_omp_clauses (gfc_code *code, /* Duplicate collapse. */ clausesa[GFC_OMP_SPLIT_SIMD].collapse = code->ext.omp_clauses->collapse; + clausesa[GFC_OMP_SPLIT_SIMD].if_exprs[OMP_IF_SIMD] + = code->ext.omp_clauses->if_exprs[OMP_IF_SIMD]; /* And this is copied to all. */ clausesa[GFC_OMP_SPLIT_SIMD].if_expr = code->ext.omp_clauses->if_expr; diff --git a/gcc/testsuite/gfortran.dg/gomp/cancel-2.f90 b/gcc/testsuite/gfortran.dg/gomp/cancel-2.f90 new file mode 100644 index 0000000..481b1aa --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/cancel-2.f90 @@ -0,0 +1,15 @@ +! { dg-do compile } + +subroutine foo () + !$omp parallel + !$omp cancel parallel if (.true.) + !$omp cancel parallel if (cancel: .true.) + + !$omp cancel parallel if (.true.) if (.true.) ! { dg-error "Failed to match clause" } + !$omp cancel parallel if (cancel: .true.) if (cancel: .true.) ! { dg-error "Failed to match clause" } + !$omp cancel parallel if (cancel: .true.) if (.true.) ! { dg-error "IF clause without modifier at .1. used together with IF clauses with modifiers" } + !$omp cancel parallel if (cancel: .true.) if (parallel: .true.) ! { dg-error "IF clause modifier PARALLEL at .1. not appropriate for the current OpenMP construct" } + !$omp cancel parallel if (.true.) if (cancel: .true.) ! { dg-error "Failed to match clause at" } + !$omp cancel parallel if (parallel: .true.) if (cancel: .true.) ! { dg-error "IF clause modifier PARALLEL at .1. not appropriate for the current OpenMP construct" } + !$omp end parallel +end subroutine diff --git a/gcc/testsuite/gfortran.dg/gomp/cancel-3.f90 b/gcc/testsuite/gfortran.dg/gomp/cancel-3.f90 new file mode 100644 index 0000000..78b54d8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/cancel-3.f90 @@ -0,0 +1,35 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +subroutine foo () + !$omp parallel + !$omp cancel parallel if (.true.) + !$omp cancel parallel if (cancel: .true.) + !$omp cancel parallel if (.false.) + !$omp cancel parallel if (cancel: .false.) + !$omp end parallel + + !$omp sections + !$omp cancel sections if (cancel: .true.) + stop + !$omp end sections + + !$omp do + do i = 1, 10 + !$omp cancel do if (.false.) + end do + + !$omp task + !$omp cancel taskgroup if (cancel: .false.) + !$omp end task + !$omp task + !$omp cancel taskgroup + !$omp end task +end subroutine + +! { dg-final { scan-tree-dump-times "__builtin_GOMP_cancel \\(1, 1\\);" 2 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_cancel \\(1, 0\\);" 2 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_cancel \\(4, 1\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_cancel \\(2, 0\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_cancel \\(8, 0\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_cancel \\(8, 1\\);" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/if-1.f90 b/gcc/testsuite/gfortran.dg/gomp/if-1.f90 new file mode 100644 index 0000000..ddf903f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/if-1.f90 @@ -0,0 +1,122 @@ +! { dg-do compile } + +subroutine foo (a, b, p, q) + logical, value :: a + logical :: b + integer :: p(:) + integer, pointer :: q(:) + integer :: i + !$omp parallel if (a) + !$omp end parallel + !$omp parallel if (parallel:a) + !$omp end parallel + !$omp parallel do simd if (a) + do i = 1, 16 + end do + !$omp end parallel do simd + !$omp parallel do simd if (parallel : a) + do i = 1, 16 + end do + !$omp end parallel do simd + !$omp parallel do simd if (simd : a) + do i = 1, 16 + end do + !$omp end parallel do simd + !$omp parallel do simd if (simd : a) if (parallel:b) + do i = 1, 16 + end do + !$omp end parallel do simd + !$omp task if (a) + !$omp end task + !$omp task if (task: a) + !$omp end task + !$omp taskloop if (a) + do i = 1, 16 + end do + !$omp end taskloop + !$omp taskloop if (taskloop : a) + do i = 1, 16 + end do + !$omp end taskloop + !$omp taskloop simd if (a) + do i = 1, 16 + end do + !$omp end taskloop simd + !$omp taskloop simd if (taskloop : a) + do i = 1, 16 + end do + !$omp end taskloop simd + !$omp taskloop simd if (simd : a) + do i = 1, 16 + end do + !$omp end taskloop simd + !$omp taskloop simd if (taskloop:b) if (simd : a) + do i = 1, 16 + end do + !$omp end taskloop simd + !$omp target if (a) + !$omp end target + !$omp target if (target: a) + !$omp end target + !$omp target simd if (a) + do i = 1, 16 + end do + !$omp end target simd + !$omp target simd if (simd : a) if (target: b) + do i = 1, 16 + end do + !$omp end target simd + !$omp target teams distribute parallel do simd if (a) + do i = 1, 16 + end do + !$omp end target teams distribute parallel do simd + !$omp target teams distribute parallel do simd if (parallel : a) if (target: b) + do i = 1, 16 + end do + !$omp end target teams distribute parallel do simd + !$omp target teams distribute parallel do simd if (simd : a) if (target: b) + do i = 1, 16 + end do + !$omp end target teams distribute parallel do simd + + !$omp target data if (a) map (p(1:2)) + !$omp end target data + !$omp target data if (target data: a) map (p(1:2)) + !$omp end target data + !$omp target enter data if (a) map (to: p(1:2)) + !$omp target enter data if (target enter data: a) map (to: p(1:2)) + !$omp target exit data if (a) map (from: p(1:2)) + !$omp target exit data if (target exit data: a) map (from: p(1:2)) + !$omp target update if (a) to (q(1:3)) + !$omp target update if (target update:a) to (q(1:3)) + !$omp parallel + !$omp cancel parallel if (a) + !$omp end parallel + !$omp parallel + !$omp cancel parallel if (cancel:a) + !$omp end parallel + !$omp do + do i = 1, 16 + !$omp cancel do if (a) + end do + !$omp do + do i = 1, 16 + !$omp cancel do if (cancel: a) + end do + !$omp sections + !$omp section + !$omp cancel sections if (a) + !$omp end sections + !$omp sections + !$omp section + !$omp cancel sections if (cancel: a) + !$omp end sections + !$omp taskgroup + !$omp task + !$omp cancel taskgroup if (a) + !$omp end task + !$omp task + !$omp cancel taskgroup if (cancel: a) + !$omp end task + !$omp end taskgroup +end -- 2.7.4