The parser partially anticipates the upcoming OpenMP 5.1 changes, which adds some more clauses - but otherwise does not update it for OpenMP 5.1, yet. In particular, the "omp end atomic" for capture is still required and the memory-order-clause restrictions still apply.
I am a bit unsure about how to handle 'capture' (= update capture) and the internal 'swap' in the internal representation; the current one is not ideal, but others did not seem to be ideal, either. OK? Tobias PS: * On the C/C++ side, 'capture' (or update capture') restrictions are not checked (are the same as 'update' – and both are gone with OpenMP 5.1, which also permits ACQ_REL for read/write) * On the C/C++ side, OpenACC's atomic piggybacks on OpenMP's which accepts too much. * Fortran as C/C++: hint(hint-expr) is parsed but not actually used. ----------------- Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter
Fortran: Update omp atomic for OpenMP 5 gcc/fortran/ChangeLog: * dump-parse-tree.c (show_omp_clauses): Handle atomic clauses. (show_omp_node): Call it for atomic. * gfortran.h (enum gfc_omp_atomic_op): Add GFC_OMP_ATOMIC_UNSET, remove GFC_OMP_ATOMIC_SEQ_CST and GFC_OMP_ATOMIC_ACQ_REL. (enum gfc_omp_memorder): Replace OMP_MEMORDER_LAST by OMP_MEMORDER_UNSET, add OMP_MEMORDER_SEQ_CST/OMP_MEMORDER_RELAXED. (gfc_omp_clauses): Add capture and atomic_op. (gfc_code): remove omp_atomic. * openmp.c (enum omp_mask1): Add atomic, capture, memorder clauses. (gfc_match_omp_clauses): Match them. (OMP_ATOMIC_CLAUSES): Add. (gfc_match_omp_flush): Update for 'last' to 'unset' change. (gfc_match_omp_oacc_atomic): Removed and placed content .. (gfc_match_omp_atomic): ... here. Update for OpenMP 5 clauses. (gfc_match_oacc_atomic): Match directly here. (resolve_omp_atomic, gfc_resolve_omp_directive): Update. * parse.c (parse_omp_oacc_atomic): Update for struct gfc_code changes. * resolve.c (gfc_resolve_blocks): Update assert. * st.c (gfc_free_statement): Also call for EXEC_O{ACC,MP}_ATOMIC. * trans-openmp.c (gfc_trans_omp_atomic): Update. (gfc_trans_omp_flush): Update for 'last' to 'unset' change. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/atomic-2.f90: New test. * gfortran.dg/gomp/atomic.f90: New test. gcc/fortran/dump-parse-tree.c | 34 ++++ gcc/fortran/gfortran.h | 30 ++-- gcc/fortran/openmp.c | 250 +++++++++++++++++++++------- gcc/fortran/parse.c | 9 +- gcc/fortran/resolve.c | 7 +- gcc/fortran/st.c | 4 +- gcc/fortran/trans-openmp.c | 41 ++--- gcc/testsuite/gfortran.dg/gomp/atomic-2.f90 | 33 ++++ gcc/testsuite/gfortran.dg/gomp/atomic.f90 | 111 ++++++++++++ 9 files changed, 409 insertions(+), 110 deletions(-) diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 6e265f4520d..43b97ba26ff 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -1715,6 +1715,36 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) } if (omp_clauses->depend_source) fputs (" DEPEND(source)", dumpfile); + if (omp_clauses->capture) + fputs (" CAPTURE", dumpfile); + if (omp_clauses->atomic_op != GFC_OMP_ATOMIC_UNSET) + { + const char *atomic_op; + switch (omp_clauses->atomic_op) + { + case GFC_OMP_ATOMIC_READ: atomic_op = "READ"; break; + case GFC_OMP_ATOMIC_WRITE: atomic_op = "WRITE"; break; + case GFC_OMP_ATOMIC_UPDATE: atomic_op = "UPDATE"; break; + default: gcc_unreachable (); + } + fputc (' ', dumpfile); + fputs (atomic_op, dumpfile); + } + if (omp_clauses->memorder != OMP_MEMORDER_UNSET) + { + const char *memorder; + switch (omp_clauses->memorder) + { + case OMP_MEMORDER_ACQ_REL: memorder = "ACQ_REL"; break; + case OMP_MEMORDER_ACQUIRE: memorder = "AQUIRE"; break; + case OMP_MEMORDER_RELAXED: memorder = "RELAXED"; break; + case OMP_MEMORDER_RELEASE: memorder = "RELEASE"; break; + case OMP_MEMORDER_SEQ_CST: memorder = "SEQ_CST"; break; + default: gcc_unreachable (); + } + fputc (' ', dumpfile); + fputs (memorder, dumpfile); + } } /* Show a single OpenMP or OpenACC directive node and everything underneath it @@ -1880,6 +1910,10 @@ show_omp_node (int level, gfc_code *c) case EXEC_OMP_TASKWAIT: case EXEC_OMP_TASKYIELD: return; + case EXEC_OACC_ATOMIC: + case EXEC_OMP_ATOMIC: + omp_clauses = c->block ? c->block->ext.omp_clauses : NULL; + break; default: break; } diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 73b6ffd870c..9500032f0e3 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1343,6 +1343,16 @@ enum gfc_omp_if_kind OMP_IF_LAST }; +enum gfc_omp_atomic_op +{ + GFC_OMP_ATOMIC_UNSET = 0, + GFC_OMP_ATOMIC_UPDATE = 1, + GFC_OMP_ATOMIC_READ = 2, + GFC_OMP_ATOMIC_WRITE = 3, + GFC_OMP_ATOMIC_MASK = 3, + GFC_OMP_ATOMIC_SWAP = 16 +}; + enum gfc_omp_requires_kind { /* Keep in sync with gfc_namespace, esp. with omp_req_mem_order. */ @@ -1363,10 +1373,12 @@ enum gfc_omp_requires_kind enum gfc_omp_memorder { + OMP_MEMORDER_UNSET, + OMP_MEMORDER_SEQ_CST, OMP_MEMORDER_ACQ_REL, OMP_MEMORDER_RELEASE, OMP_MEMORDER_ACQUIRE, - OMP_MEMORDER_LAST + OMP_MEMORDER_RELAXED }; typedef struct gfc_omp_clauses @@ -1383,7 +1395,8 @@ typedef struct gfc_omp_clauses bool nowait, ordered, untied, mergeable; bool inbranch, notinbranch, defaultmap, nogroup; bool sched_simd, sched_monotonic, sched_nonmonotonic; - bool simd, threads, depend_source, order_concurrent; + bool simd, threads, depend_source, order_concurrent, capture; + enum gfc_omp_atomic_op atomic_op; enum gfc_omp_memorder memorder; enum gfc_omp_cancel_kind cancel; enum gfc_omp_proc_bind_kind proc_bind; @@ -2682,18 +2695,6 @@ enum gfc_exec_op EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD }; -enum gfc_omp_atomic_op -{ - GFC_OMP_ATOMIC_UPDATE = 0, - GFC_OMP_ATOMIC_READ = 1, - GFC_OMP_ATOMIC_WRITE = 2, - GFC_OMP_ATOMIC_CAPTURE = 3, - GFC_OMP_ATOMIC_MASK = 3, - GFC_OMP_ATOMIC_SEQ_CST = 4, - GFC_OMP_ATOMIC_ACQ_REL = 8, - GFC_OMP_ATOMIC_SWAP = 16 -}; - typedef struct gfc_code { gfc_exec_op op; @@ -2748,7 +2749,6 @@ typedef struct gfc_code const char *omp_name; gfc_omp_namelist *omp_namelist; bool omp_bool; - gfc_omp_atomic_op omp_atomic; } ext; /* Points to additional structures required by statement */ diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index b143ba7454a..048b6c5db05 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -802,6 +802,9 @@ enum omp_mask1 OMP_CLAUSE_USE_DEVICE_PTR, OMP_CLAUSE_USE_DEVICE_ADDR, /* OpenMP 5.0. */ OMP_CLAUSE_DEVICE_TYPE, /* OpenMP 5.0. */ + OMP_CLAUSE_ATOMIC, /* OpenMP 5.0. */ + OMP_CLAUSE_CAPTURE, /* OpenMP 5.0. */ + OMP_CLAUSE_MEMORDER, /* OpenMP 5.0. */ OMP_CLAUSE_NOWAIT, /* This must come last. */ OMP_MASK1_LAST @@ -1017,6 +1020,22 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, n->expr = alignment; continue; } + if ((mask & OMP_CLAUSE_MEMORDER) + && c->memorder == OMP_MEMORDER_UNSET + && gfc_match ("acq_rel") == MATCH_YES) + { + c->memorder = OMP_MEMORDER_ACQ_REL; + needs_space = true; + continue; + } + if ((mask & OMP_CLAUSE_MEMORDER) + && c->memorder == OMP_MEMORDER_UNSET + && gfc_match ("acquire") == MATCH_YES) + { + c->memorder = OMP_MEMORDER_ACQUIRE; + needs_space = true; + continue; + } if ((mask & OMP_CLAUSE_ASYNC) && !c->async && gfc_match ("async") == MATCH_YES) @@ -1055,6 +1074,14 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; break; case 'c': + if ((mask & OMP_CLAUSE_CAPTURE) + && !c->capture + && gfc_match ("capture") == MATCH_YES) + { + c->capture = true; + needs_space = true; + continue; + } if ((mask & OMP_CLAUSE_COLLAPSE) && !c->collapse) { @@ -1681,6 +1708,14 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, } break; case 'r': + if ((mask & OMP_CLAUSE_ATOMIC) + && c->atomic_op == GFC_OMP_ATOMIC_UNSET + && gfc_match ("read") == MATCH_YES) + { + c->atomic_op = GFC_OMP_ATOMIC_READ; + needs_space = true; + continue; + } if ((mask & OMP_CLAUSE_REDUCTION) && gfc_match ("reduction ( ") == MATCH_YES) { @@ -1801,6 +1836,22 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, else gfc_current_locus = old_loc; } + if ((mask & OMP_CLAUSE_MEMORDER) + && c->memorder == OMP_MEMORDER_UNSET + && gfc_match ("relaxed") == MATCH_YES) + { + c->memorder = OMP_MEMORDER_RELAXED; + needs_space = true; + continue; + } + if ((mask & OMP_CLAUSE_MEMORDER) + && c->memorder == OMP_MEMORDER_UNSET + && gfc_match ("release") == MATCH_YES) + { + c->memorder = OMP_MEMORDER_RELEASE; + needs_space = true; + continue; + } break; case 's': if ((mask & OMP_CLAUSE_SAFELEN) @@ -1885,6 +1936,14 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, needs_space = true; continue; } + if ((mask & OMP_CLAUSE_MEMORDER) + && c->memorder == OMP_MEMORDER_UNSET + && gfc_match ("seq_cst") == MATCH_YES) + { + c->memorder = OMP_MEMORDER_SEQ_CST; + needs_space = true; + continue; + } if ((mask & OMP_CLAUSE_SHARED) && gfc_match_omp_variable_list ("shared (", &c->lists[OMP_LIST_SHARED], @@ -1945,6 +2004,14 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, c->untied = needs_space = true; continue; } + if ((mask & OMP_CLAUSE_ATOMIC) + && c->atomic_op == GFC_OMP_ATOMIC_UNSET + && gfc_match ("update") == MATCH_YES) + { + c->atomic_op = GFC_OMP_ATOMIC_UPDATE; + needs_space = true; + continue; + } if ((mask & OMP_CLAUSE_USE_DEVICE) && gfc_match_omp_variable_list ("use_device (", &c->lists[OMP_LIST_USE_DEVICE], @@ -2026,6 +2093,14 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, needs_space = true; continue; } + if ((mask & OMP_CLAUSE_ATOMIC) + && c->atomic_op == GFC_OMP_ATOMIC_UNSET + && gfc_match ("write") == MATCH_YES) + { + c->atomic_op = GFC_OMP_ATOMIC_WRITE; + needs_space = true; + continue; + } break; } break; @@ -2658,6 +2733,9 @@ cleanup: (omp_mask (OMP_CLAUSE_THREADS) | OMP_CLAUSE_SIMD) #define OMP_DECLARE_TARGET_CLAUSES \ (omp_mask (OMP_CLAUSE_TO) | OMP_CLAUSE_LINK | OMP_CLAUSE_DEVICE_TYPE) +#define OMP_ATOMIC_CLAUSES \ + (omp_mask (OMP_CLAUSE_ATOMIC) | OMP_CLAUSE_CAPTURE | OMP_CLAUSE_HINT \ + | OMP_CLAUSE_MEMORDER) static match @@ -2768,7 +2846,7 @@ 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; + enum gfc_omp_memorder mo = OMP_MEMORDER_UNSET; if (gfc_match_omp_eos () == MATCH_NO && gfc_peek_ascii_char () != '(') { if (gfc_match ("acq_rel") == MATCH_YES) @@ -2786,7 +2864,7 @@ gfc_match_omp_flush (void) c->memorder = mo; } gfc_match_omp_variable_list (" (", &list, true); - if (list && mo != OMP_MEMORDER_LAST) + if (list && mo != OMP_MEMORDER_UNSET) { gfc_error ("List specified together with memory order clause in FLUSH " "directive at %C"); @@ -4014,49 +4092,28 @@ gfc_match_omp_ordered_depend (void) } -static match -gfc_match_omp_oacc_atomic (bool omp_p) +/* omp atomic [clause-list] + - atomic-clause: read | write | update + - capture + - memory-order-clause: seq_cst | acq_rel | release | acquire | relaxed + - hint(hint-expr) +*/ + +match +gfc_match_omp_atomic (void) { - gfc_omp_atomic_op op = GFC_OMP_ATOMIC_UPDATE; - int seq_cst = 0; - if (gfc_match ("% seq_cst") == MATCH_YES) - seq_cst = 1; - locus old_loc = gfc_current_locus; - if (seq_cst && gfc_match_char (',') == MATCH_YES) - seq_cst = 2; - if (seq_cst == 2 - || gfc_match_space () == MATCH_YES) - { - gfc_gobble_whitespace (); - if (gfc_match ("update") == MATCH_YES) - op = GFC_OMP_ATOMIC_UPDATE; - else if (gfc_match ("read") == MATCH_YES) - op = GFC_OMP_ATOMIC_READ; - else if (gfc_match ("write") == MATCH_YES) - op = GFC_OMP_ATOMIC_WRITE; - else if (gfc_match ("capture") == MATCH_YES) - op = GFC_OMP_ATOMIC_CAPTURE; - else - { - if (seq_cst == 2) - gfc_current_locus = old_loc; - goto finish; - } - if (!seq_cst - && (gfc_match (", seq_cst") == MATCH_YES - || gfc_match ("% seq_cst") == MATCH_YES)) - seq_cst = 1; - } - finish: - if (gfc_match_omp_eos () != MATCH_YES) - { - gfc_error ("Unexpected junk after $OMP ATOMIC statement at %C"); - return MATCH_ERROR; - } - new_st.op = (omp_p ? EXEC_OMP_ATOMIC : EXEC_OACC_ATOMIC); - if (seq_cst) - op = (gfc_omp_atomic_op) (op | GFC_OMP_ATOMIC_SEQ_CST); - else if (omp_p) + gfc_omp_clauses *c; + locus loc = gfc_current_locus; + + if (gfc_match_omp_clauses (&c, OMP_ATOMIC_CLAUSES, true, true) != MATCH_YES) + return MATCH_ERROR; + if (c->atomic_op == GFC_OMP_ATOMIC_UNSET) + c->atomic_op = GFC_OMP_ATOMIC_UPDATE; + + if (c->capture && c->atomic_op != GFC_OMP_ATOMIC_UPDATE) + gfc_error ("OMP ATOMIC at %L with CAPTURE clause must be UPDATE", &loc); + + if (c->memorder == OMP_MEMORDER_UNSET) { gfc_namespace *prog_unit = gfc_current_ns; while (prog_unit->parent) @@ -4065,32 +4122,95 @@ gfc_match_omp_oacc_atomic (bool omp_p) { case 0: case OMP_REQ_ATOMIC_MEM_ORDER_RELAXED: + c->memorder = OMP_MEMORDER_RELAXED; break; case OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST: - op = (gfc_omp_atomic_op) (op | GFC_OMP_ATOMIC_SEQ_CST); + c->memorder = OMP_MEMORDER_SEQ_CST; break; case OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL: - op = (gfc_omp_atomic_op) (op | GFC_OMP_ATOMIC_ACQ_REL); + if (c->atomic_op == GFC_OMP_ATOMIC_READ) + c->memorder = OMP_MEMORDER_ACQUIRE; + else if (c->atomic_op == GFC_OMP_ATOMIC_READ) + c->memorder = OMP_MEMORDER_RELEASE; + else + c->memorder = OMP_MEMORDER_ACQ_REL; break; default: gcc_unreachable (); } } - new_st.ext.omp_atomic = op; + else + switch (c->atomic_op) + { + case GFC_OMP_ATOMIC_READ: + if (c->memorder == OMP_MEMORDER_ACQ_REL + || c->memorder == OMP_MEMORDER_RELEASE) + { + gfc_error ("OMP ATOMIC READ at %L incompatible with " + "ACQ_REL or RELEASE clauses", &loc); + c->memorder = OMP_MEMORDER_SEQ_CST; + } + break; + case GFC_OMP_ATOMIC_WRITE: + if (c->memorder == OMP_MEMORDER_ACQ_REL + || c->memorder == OMP_MEMORDER_ACQUIRE) + { + gfc_error ("OMP ATOMIC WRITE at %L incompatible with " + "ACQ_REL or ACQUIRE clauses", &loc); + c->memorder = OMP_MEMORDER_SEQ_CST; + } + break; + case GFC_OMP_ATOMIC_UPDATE: + if (c->memorder == OMP_MEMORDER_ACQ_REL + || c->memorder == OMP_MEMORDER_ACQUIRE) + { + gfc_error ("OMP ATOMIC UPDATE at %L incompatible with " + "ACQ_REL or ACQUIRE clauses", &loc); + c->memorder = OMP_MEMORDER_SEQ_CST; + } + break; + default: + break; + } + gfc_error_check (); + new_st.ext.omp_clauses = c; + new_st.op = EXEC_OMP_ATOMIC; return MATCH_YES; } + +/* acc atomic [ read | write | update | capture] + acc atomic update capture. */ + match gfc_match_oacc_atomic (void) { - return gfc_match_omp_oacc_atomic (false); + gfc_omp_clauses *c = gfc_get_omp_clauses (); + c->atomic_op = GFC_OMP_ATOMIC_UPDATE; + c->memorder = OMP_MEMORDER_RELAXED; + gfc_gobble_whitespace (); + if (gfc_match ("update capture") == MATCH_YES) + c->capture = true; + else if (gfc_match ("update") == MATCH_YES) + ; + else if (gfc_match ("read") == MATCH_YES) + c->atomic_op = GFC_OMP_ATOMIC_READ; + else if (gfc_match ("write") == MATCH_YES) + c->atomic_op = GFC_OMP_ATOMIC_WRITE; + else if (gfc_match ("capture") == MATCH_YES) + c->capture = true; + gfc_gobble_whitespace (); + if (gfc_match_omp_eos () != MATCH_YES) + { + gfc_error ("Unexpected junk after $ACC ATOMIC statement at %C"); + gfc_free_omp_clauses (c); + return MATCH_ERROR; + } + new_st.ext.omp_clauses = c; + new_st.op = EXEC_OACC_ATOMIC; + return MATCH_YES; } -match -gfc_match_omp_atomic (void) -{ - return gfc_match_omp_oacc_atomic (true); -} match gfc_match_omp_barrier (void) @@ -5514,11 +5634,11 @@ is_conversion (gfc_expr *expr, bool widening) static void resolve_omp_atomic (gfc_code *code) { - gfc_code *atomic_code = code; + gfc_code *atomic_code = code->block; gfc_symbol *var; gfc_expr *expr2, *expr2_tmp; gfc_omp_atomic_op aop - = (gfc_omp_atomic_op) (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK); + = (gfc_omp_atomic_op) (atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_MASK); code = code->block->next; /* resolve_blocks asserts this is initially EXEC_ASSIGN. @@ -5531,7 +5651,7 @@ resolve_omp_atomic (gfc_code *code) gfc_error ("unexpected !$OMP ATOMIC expression at %L", &code->loc); return; } - if (aop != GFC_OMP_ATOMIC_CAPTURE) + if (!atomic_code->ext.omp_clauses->capture) { if (code->next != NULL) goto unexpected; @@ -5591,7 +5711,11 @@ resolve_omp_atomic (gfc_code *code) "must be scalar and cannot reference var at %L", &expr2->where); return; - case GFC_OMP_ATOMIC_CAPTURE: + default: + break; + } + if (atomic_code->ext.omp_clauses->capture) + { expr2_tmp = expr2; if (expr2 == code->expr2) { @@ -5640,9 +5764,6 @@ resolve_omp_atomic (gfc_code *code) if (expr2 == NULL) expr2 = code->expr2; } - break; - default: - break; } if (gfc_expr_attr (code->expr1).allocatable) @@ -5652,12 +5773,12 @@ resolve_omp_atomic (gfc_code *code) return; } - if (aop == GFC_OMP_ATOMIC_CAPTURE + if (atomic_code->ext.omp_clauses->capture && code->next == NULL && code->expr2->rank == 0 && !expr_references_sym (code->expr2, var, NULL)) - atomic_code->ext.omp_atomic - = (gfc_omp_atomic_op) (atomic_code->ext.omp_atomic + atomic_code->ext.omp_clauses->atomic_op + = (gfc_omp_atomic_op) (atomic_code->ext.omp_clauses->atomic_op | GFC_OMP_ATOMIC_SWAP); else if (expr2->expr_type == EXPR_OP) { @@ -5867,7 +5988,7 @@ resolve_omp_atomic (gfc_code *code) gfc_error ("!$OMP ATOMIC assignment must have an operator or " "intrinsic on right hand side at %L", &expr2->where); - if (aop == GFC_OMP_ATOMIC_CAPTURE && code->next) + if (atomic_code->ext.omp_clauses->capture && code->next) { code = code->next; if (code->expr1->expr_type != EXPR_VARIABLE @@ -6866,6 +6987,7 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) "FROM clause", &code->loc); break; case EXEC_OMP_ATOMIC: + resolve_omp_clauses (code, code->block->ext.omp_clauses, NULL); resolve_omp_atomic (code); break; case EXEC_OMP_CRITICAL: diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 66696215c98..e57669c51e5 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -5062,9 +5062,9 @@ parse_omp_oacc_atomic (bool omp_p) np = new_level (cp); np->op = cp->op; np->block = NULL; - np->ext.omp_atomic = cp->ext.omp_atomic; - count = 1 + ((cp->ext.omp_atomic & GFC_OMP_ATOMIC_MASK) - == GFC_OMP_ATOMIC_CAPTURE); + np->ext.omp_clauses = cp->ext.omp_clauses; + cp->ext.omp_clauses = NULL; + count = 1 + np->ext.omp_clauses->capture; while (count) { @@ -5090,8 +5090,7 @@ parse_omp_oacc_atomic (bool omp_p) gfc_warning_check (); st = next_statement (); } - else if ((cp->ext.omp_atomic & GFC_OMP_ATOMIC_MASK) - == GFC_OMP_ATOMIC_CAPTURE) + else if (np->ext.omp_clauses->capture) gfc_error ("Missing !$OMP END ATOMIC after !$OMP ATOMIC CAPTURE at %C"); return st; } diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 93b918b3077..45c144517f2 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -10731,15 +10731,12 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) case EXEC_OMP_ATOMIC: case EXEC_OACC_ATOMIC: { - gfc_omp_atomic_op aop - = (gfc_omp_atomic_op) (b->ext.omp_atomic & GFC_OMP_ATOMIC_MASK); - /* Verify this before calling gfc_resolve_code, which might change it. */ gcc_assert (b->next && b->next->op == EXEC_ASSIGN); - gcc_assert (((aop != GFC_OMP_ATOMIC_CAPTURE) + gcc_assert ((!b->ext.omp_clauses->capture && b->next->next == NULL) - || ((aop == GFC_OMP_ATOMIC_CAPTURE) + || (b->ext.omp_clauses->capture && b->next->next != NULL && b->next->next->op == EXEC_ASSIGN && b->next->next->next == NULL)); diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c index f6937b93481..a3b0f12b171 100644 --- a/gcc/fortran/st.c +++ b/gcc/fortran/st.c @@ -198,6 +198,7 @@ gfc_free_statement (gfc_code *p) gfc_free_oacc_declare_clauses (p->ext.oacc_declare); break; + case EXEC_OACC_ATOMIC: case EXEC_OACC_PARALLEL_LOOP: case EXEC_OACC_PARALLEL: case EXEC_OACC_KERNELS_LOOP: @@ -213,6 +214,7 @@ gfc_free_statement (gfc_code *p) case EXEC_OACC_ENTER_DATA: case EXEC_OACC_EXIT_DATA: case EXEC_OACC_ROUTINE: + case EXEC_OMP_ATOMIC: case EXEC_OMP_CANCEL: case EXEC_OMP_CANCELLATION_POINT: case EXEC_OMP_CRITICAL: @@ -266,8 +268,6 @@ gfc_free_statement (gfc_code *p) gfc_free_omp_namelist (p->ext.omp_namelist); break; - case EXEC_OACC_ATOMIC: - case EXEC_OMP_ATOMIC: case EXEC_OMP_BARRIER: case EXEC_OMP_MASTER: case EXEC_OMP_END_NOWAIT: diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index bd7e13d748e..d02949ecbe4 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -3967,7 +3967,7 @@ static tree gfc_trans_omp_workshare (gfc_code *, gfc_omp_clauses *); static tree gfc_trans_omp_atomic (gfc_code *code) { - gfc_code *atomic_code = code; + gfc_code *atomic_code = code->block; gfc_se lse; gfc_se rse; gfc_se vse; @@ -3979,12 +3979,16 @@ gfc_trans_omp_atomic (gfc_code *code) enum tree_code aop = OMP_ATOMIC; bool var_on_left = false; enum omp_memory_order mo; - if (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SEQ_CST) - mo = OMP_MEMORY_ORDER_SEQ_CST; - else if (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_ACQ_REL) - mo = OMP_MEMORY_ORDER_ACQ_REL; - else - mo = OMP_MEMORY_ORDER_RELAXED; + switch (atomic_code->ext.omp_clauses->memorder) + { + case OMP_MEMORDER_UNSET: mo = OMP_MEMORY_ORDER_UNSPECIFIED; break; + case OMP_MEMORDER_ACQ_REL: mo = OMP_MEMORY_ORDER_ACQ_REL; break; + case OMP_MEMORDER_ACQUIRE: mo = OMP_MEMORY_ORDER_ACQUIRE; break; + case OMP_MEMORDER_RELAXED: mo = OMP_MEMORY_ORDER_RELAXED; break; + case OMP_MEMORDER_RELEASE: mo = OMP_MEMORY_ORDER_RELEASE; break; + case OMP_MEMORDER_SEQ_CST: mo = OMP_MEMORY_ORDER_SEQ_CST; break; + default: gcc_unreachable (); + } code = code->block->next; gcc_assert (code->op == EXEC_ASSIGN); @@ -3996,16 +4000,16 @@ gfc_trans_omp_atomic (gfc_code *code) gfc_start_block (&block); expr2 = code->expr2; - if (((atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK) + if (((atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_MASK) != GFC_OMP_ATOMIC_WRITE) && expr2->expr_type == EXPR_FUNCTION && expr2->value.function.isym && expr2->value.function.isym->id == GFC_ISYM_CONVERSION) expr2 = expr2->value.function.actual->expr; - switch (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK) + if ((atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_MASK) + == GFC_OMP_ATOMIC_READ) { - case GFC_OMP_ATOMIC_READ: gfc_conv_expr (&vse, code->expr1); gfc_add_block_to_block (&block, &vse.pre); @@ -4023,7 +4027,9 @@ gfc_trans_omp_atomic (gfc_code *code) gfc_add_block_to_block (&block, &rse.pre); return gfc_finish_block (&block); - case GFC_OMP_ATOMIC_CAPTURE: + } + if (atomic_code->ext.omp_clauses->capture) + { aop = OMP_ATOMIC_CAPTURE_NEW; if (expr2->expr_type == EXPR_VARIABLE) { @@ -4042,9 +4048,6 @@ gfc_trans_omp_atomic (gfc_code *code) && expr2->value.function.isym->id == GFC_ISYM_CONVERSION) expr2 = expr2->value.function.actual->expr; } - break; - default: - break; } gfc_conv_expr (&lse, code->expr1); @@ -4052,9 +4055,9 @@ gfc_trans_omp_atomic (gfc_code *code) type = TREE_TYPE (lse.expr); lhsaddr = gfc_build_addr_expr (NULL, lse.expr); - if (((atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK) + if (((atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_MASK) == GFC_OMP_ATOMIC_WRITE) - || (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SWAP)) + || (atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_SWAP)) { gfc_conv_expr (&rse, expr2); gfc_add_block_to_block (&block, &rse.pre); @@ -4190,9 +4193,9 @@ gfc_trans_omp_atomic (gfc_code *code) rhs = gfc_evaluate_now (rse.expr, &block); - if (((atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_MASK) + if (((atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_MASK) == GFC_OMP_ATOMIC_WRITE) - || (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SWAP)) + || (atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_SWAP)) x = rhs; else { @@ -4791,7 +4794,7 @@ gfc_trans_omp_flush (gfc_code *code) { tree call; if (!code->ext.omp_clauses - || code->ext.omp_clauses->memorder == OMP_MEMORDER_LAST) + || code->ext.omp_clauses->memorder == OMP_MEMORDER_UNSET) { call = builtin_decl_explicit (BUILT_IN_SYNC_SYNCHRONIZE); call = build_call_expr_loc (input_location, call, 0); diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic-2.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic-2.f90 new file mode 100644 index 00000000000..5094caa5154 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/atomic-2.f90 @@ -0,0 +1,33 @@ +! { dg-do compile } + +subroutine bar + integer :: i, v + real :: f + !$omp atomic update acq_rel hint("abc") ! { dg-error "OMP ATOMIC UPDATE at .1. incompatible with ACQ_REL or ACQUIRE clauses" } + ! { dg-error "HINT clause at .1. requires a scalar INTEGER expression" "" { target *-*-* } .-1 } + ! { dg-error "Value of HINT clause at .1. shall be a valid constant hint expression" "" { target *-*-* } .-2 } + i = i + 1 + !$omp end atomic + + !$omp atomic acq_rel capture ! { dg-error "OMP ATOMIC UPDATE at .1. incompatible with ACQ_REL or ACQUIRE clauses" } + i = i + 1 + v = i + !$omp end atomic + + !$omp atomic capture,acq_rel , hint (1), update ! { dg-error "OMP ATOMIC UPDATE at .1. incompatible with ACQ_REL or ACQUIRE clauses" } + i = i + 1 + v = i + !$omp end atomic + + !$omp atomic hint(0),acquire capture ! { dg-error "OMP ATOMIC UPDATE at .1. incompatible with ACQ_REL or ACQUIRE clauses" } + i = i + 1 + v = i + !$omp end atomic + + !$omp atomic write capture ! { dg-error "OMP ATOMIC at .1. with CAPTURE clause must be UPDATE" } + i = 2 + v = i + !$omp end atomic + + !$omp atomic foobar ! { dg-error "Failed to match clause" } +end diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic.f90 new file mode 100644 index 00000000000..8a1cf5b1f68 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/atomic.f90 @@ -0,0 +1,111 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +! { dg-final { scan-tree-dump-times "#pragma omp atomic relaxed" 4 "original" } } +! { dg-final { scan-tree-dump-times "#pragma omp atomic release" 4 "original" } } +! { dg-final { scan-tree-dump-times "v = #pragma omp atomic capture relaxed" 4 "original" } } +! { dg-final { scan-tree-dump-times "v = #pragma omp atomic capture release" 2 "original" } } +! { dg-final { scan-tree-dump-times "v = #pragma omp atomic read acquire" 1 "original" } } + +! { dg-final { scan-tree-dump-times "#pragma omp atomic seq_cst" 7 "original" } } +! { dg-final { scan-tree-dump-times "v = #pragma omp atomic read seq_cst" 3 "original" } } +! { dg-final { scan-tree-dump-times "v = #pragma omp atomic capture seq_cst" 6 "original" } } + + +subroutine foo () + integer :: x, v + !$omp atomic + i = i + 2 + + !$omp atomic relaxed + i = i + 2 + + !$omp atomic seq_cst read + v = x + !$omp atomic seq_cst, read + v = x + !$omp atomic seq_cst write + x = v + !$omp atomic seq_cst ,write + x = v + !$omp atomic seq_cst update + x = x + v + !$omp atomic seq_cst , update + x = x + v + !$omp atomic seq_cst capture + x = x + 2 + v = x + !$omp end atomic + !$omp atomic update seq_cst capture + x = x + 2 + v = x + !$omp end atomic + !$omp atomic seq_cst, capture + x = x + 2 + v = x + !$omp end atomic + !$omp atomic seq_cst, capture, update + x = x + 2 + v = x + !$omp end atomic + !$omp atomic read , seq_cst + v = x + !$omp atomic write ,seq_cst + x = v + !$omp atomic update, seq_cst + x = x + v + !$omp atomic capture, seq_cst + x = x + 2 + v = x + !$omp end atomic + !$omp atomic capture, seq_cst ,update + x = x + 2 + v = x + !$omp end atomic +end + +subroutine bar + integer :: i, v + real :: f + !$omp atomic release, hint (0), update + i = i + 1 + !$omp end atomic + !$omp atomic hint(0)seq_cst + i = i + 1 + !$omp atomic relaxed,update,hint (0) + i = i + 1 + !$omp atomic release + i = i + 1 + !$omp atomic relaxed + i = i + 1 + !$omp atomic relaxed capture update + i = i + 1 + v = i + !$omp end atomic + !$omp atomic relaxed capture + i = i + 1 + v = i + !$omp end atomic + !$omp atomic capture,release , hint (1) + i = i + 1 + v = i + !$omp end atomic + !$omp atomic update capture,release , hint (1) + i = i + 1 + v = i + !$omp end atomic + !$omp atomic hint(0),relaxed capture + i = i + 1 + v = i + !$omp end atomic + !$omp atomic hint(0),update relaxed capture + i = i + 1 + v = i + !$omp end atomic + !$omp atomic read acquire + v = i + !$omp atomic release,write + i = v + !$omp atomic hint(1),update,release + f = f + 2.0 +end