Forgot to add fortran@.
On 29.10.20 18:05, Tobias Burnus wrote:
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
