diff options
| -rw-r--r-- | gcc/fortran/gfortran.h | 9 | ||||
| -rw-r--r-- | gcc/fortran/openmp.c | 29 | ||||
| -rw-r--r-- | gcc/fortran/trans-openmp.c | 30 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/flush-1.f90 | 41 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/flush-2.f90 | 18 |
5 files changed, 123 insertions, 4 deletions
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index d0cea83..931b908 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1361,6 +1361,14 @@ enum gfc_omp_requires_kind | OMP_REQ_ATOMIC_MEM_ORDER_RELAXED) }; +enum gfc_omp_memorder +{ + OMP_MEMORDER_ACQ_REL, + OMP_MEMORDER_RELEASE, + OMP_MEMORDER_ACQUIRE, + OMP_MEMORDER_LAST +}; + typedef struct gfc_omp_clauses { struct gfc_expr *if_expr; @@ -1376,6 +1384,7 @@ typedef struct gfc_omp_clauses bool inbranch, notinbranch, defaultmap, nogroup; bool sched_simd, sched_monotonic, sched_nonmonotonic; bool simd, threads, depend_source, order_concurrent; + enum gfc_omp_memorder memorder; enum gfc_omp_cancel_kind cancel; enum gfc_omp_proc_bind_kind proc_bind; struct gfc_expr *safelen_expr; diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 1efce33..b143ba7 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -2766,15 +2766,44 @@ match gfc_match_omp_flush (void) { gfc_omp_namelist *list = NULL; + gfc_omp_clauses *c = NULL; + gfc_gobble_whitespace (); + enum gfc_omp_memorder mo = OMP_MEMORDER_LAST; + if (gfc_match_omp_eos () == MATCH_NO && gfc_peek_ascii_char () != '(') + { + if (gfc_match ("acq_rel") == MATCH_YES) + mo = OMP_MEMORDER_ACQ_REL; + else if (gfc_match ("release") == MATCH_YES) + mo = OMP_MEMORDER_RELEASE; + else if (gfc_match ("acquire") == MATCH_YES) + mo = OMP_MEMORDER_ACQUIRE; + else + { + gfc_error ("Expected AQC_REL, RELEASE, or ACQUIRE at %C"); + return MATCH_ERROR; + } + c = gfc_get_omp_clauses (); + c->memorder = mo; + } gfc_match_omp_variable_list (" (", &list, true); + if (list && mo != OMP_MEMORDER_LAST) + { + gfc_error ("List specified together with memory order clause in FLUSH " + "directive at %C"); + gfc_free_omp_namelist (list); + gfc_free_omp_clauses (c); + return MATCH_ERROR; + } if (gfc_match_omp_eos () != MATCH_YES) { gfc_error ("Unexpected junk after $OMP FLUSH statement at %C"); gfc_free_omp_namelist (list); + gfc_free_omp_clauses (c); return MATCH_ERROR; } new_st.op = EXEC_OMP_FLUSH; new_st.ext.omp_namelist = list; + new_st.ext.omp_clauses = c; return MATCH_YES; } diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 378088a..bd7e13d 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -38,6 +38,8 @@ along with GCC; see the file COPYING3. If not see #include "gomp-constants.h" #include "omp-general.h" #include "omp-low.h" +#include "memmodel.h" /* For MEMMODEL_ enums. */ + #undef GCC_DIAG_STYLE #define GCC_DIAG_STYLE __gcc_tdiag__ #include "diagnostic-core.h" @@ -4785,10 +4787,30 @@ gfc_trans_oacc_combined_directive (gfc_code *code) } static tree -gfc_trans_omp_flush (void) +gfc_trans_omp_flush (gfc_code *code) { - tree decl = builtin_decl_explicit (BUILT_IN_SYNC_SYNCHRONIZE); - return build_call_expr_loc (input_location, decl, 0); + tree call; + if (!code->ext.omp_clauses + || code->ext.omp_clauses->memorder == OMP_MEMORDER_LAST) + { + call = builtin_decl_explicit (BUILT_IN_SYNC_SYNCHRONIZE); + call = build_call_expr_loc (input_location, call, 0); + } + else + { + enum memmodel mo = MEMMODEL_LAST; + switch (code->ext.omp_clauses->memorder) + { + case OMP_MEMORDER_ACQ_REL: mo = MEMMODEL_ACQ_REL; break; + case OMP_MEMORDER_RELEASE: mo = MEMMODEL_RELEASE; break; + case OMP_MEMORDER_ACQUIRE: mo = MEMMODEL_ACQUIRE; break; + default: gcc_unreachable (); break; + } + call = builtin_decl_explicit (BUILT_IN_ATOMIC_THREAD_FENCE); + call = build_call_expr_loc (input_location, call, 1, + build_int_cst (integer_type_node, mo)); + } + return call; } static tree @@ -6033,7 +6055,7 @@ gfc_trans_omp_directive (gfc_code *code) case EXEC_OMP_DO_SIMD: return gfc_trans_omp_do_simd (code, NULL, NULL, NULL_TREE); case EXEC_OMP_FLUSH: - return gfc_trans_omp_flush (); + return gfc_trans_omp_flush (code); case EXEC_OMP_MASTER: return gfc_trans_omp_master (code); case EXEC_OMP_ORDERED: diff --git a/gcc/testsuite/gfortran.dg/gomp/flush-1.f90 b/gcc/testsuite/gfortran.dg/gomp/flush-1.f90 new file mode 100644 index 0000000..d0b7f9e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/flush-1.f90 @@ -0,0 +1,41 @@ +! { dg-additional-options "-fdump-tree-gimple" } +! { dg-final { scan-tree-dump "foo \\(4\\);\[\n\r]* __atomic_thread_fence \\(4\\);\[\n\r]* foo \\(4\\);" "gimple" } } +! { dg-final { scan-tree-dump "foo \\(3\\);\[\n\r]* __atomic_thread_fence \\(3\\);\[\n\r]* foo \\(3\\);" "gimple" } } +! { dg-final { scan-tree-dump "foo \\(2\\);\[\n\r]* __atomic_thread_fence \\(2\\);\[\n\r]* foo \\(2\\);" "gimple" } } +! { dg-final { scan-tree-dump "foo \\(5\\);\[\n\r]* __sync_synchronize \\(\\);\[\n\r]* foo \\(5\\);" "gimple" } } + +module m + interface + subroutine foo(x) + integer, value :: x + end + end interface +end module m + +subroutine f1 + use m + call foo (4) + !$omp flush acq_rel + call foo (4) +end + +subroutine f2 + use m + call foo (3) + !$omp flush release + call foo (3) +end + +subroutine f3 + use m + call foo (2) + !$omp flush acquire + call foo (2) +end + +subroutine f4 + use m + call foo (5) + !$omp flush + call foo (5) +end diff --git a/gcc/testsuite/gfortran.dg/gomp/flush-2.f90 b/gcc/testsuite/gfortran.dg/gomp/flush-2.f90 new file mode 100644 index 0000000..6857371 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/flush-2.f90 @@ -0,0 +1,18 @@ +module m + integer :: a, b +end module m + +subroutine foo (void) + use m + !$omp flush + !$omp flush (a, b) + !$omp flush acquire + !$omp flush release + !$omp flush acq_rel + !$omp flush relaxed ! { dg-error "Expected AQC_REL, RELEASE, or ACQUIRE" } + !$omp flush seq_cst ! { dg-error "Expected AQC_REL, RELEASE, or ACQUIRE" } + !$omp flush foobar ! { dg-error "Expected AQC_REL, RELEASE, or ACQUIRE" } + !$omp flush acquire (a, b) ! { dg-error "List specified together with memory order clause in FLUSH directive" } + !$omp flush release (a, b) ! { dg-error "List specified together with memory order clause in FLUSH directive" } + !$omp flush acq_rel (a, b) ! { dg-error "List specified together with memory order clause in FLUSH directive" } +end |