* [Patch] Fortran: Update omp atomic for OpenMP 5
@ 2020-10-29 17:05 Tobias Burnus
2020-10-29 21:15 ` Tobias Burnus
2020-10-30 11:36 ` [Patch] Fortran: Update omp atomic for OpenMP 5 Jakub Jelinek
0 siblings, 2 replies; 5+ messages in thread
From: Tobias Burnus @ 2020-10-29 17:05 UTC (permalink / raw)
To: gcc-patches, Jakub Jelinek
[-- Attachment #1: Type: text/plain, Size: 1052 bytes --]
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
[-- Attachment #2: omp-fort-atomic.diff --]
[-- Type: text/x-patch, Size: 29676 bytes --]
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
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: [Patch] Fortran: Update omp atomic for OpenMP 5
2020-10-29 17:05 [Patch] Fortran: Update omp atomic for OpenMP 5 Tobias Burnus
@ 2020-10-29 21:15 ` Tobias Burnus
2020-11-02 11:52 ` [Patch] Fortran: OpenMP - fixes for omp atomic [PR97655] (was: Re: [Patch] Fortran: Update omp atomic for OpenMP 5) Tobias Burnus
2020-10-30 11:36 ` [Patch] Fortran: Update omp atomic for OpenMP 5 Jakub Jelinek
1 sibling, 1 reply; 5+ messages in thread
From: Tobias Burnus @ 2020-10-29 21:15 UTC (permalink / raw)
To: gcc-patches, Jakub Jelinek, fortran
[-- Attachment #1: Type: text/plain, Size: 1163 bytes --]
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
[-- Attachment #2: omp-fort-atomic.diff --]
[-- Type: text/x-patch, Size: 29676 bytes --]
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
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: [Patch] Fortran: Update omp atomic for OpenMP 5
2020-10-29 17:05 [Patch] Fortran: Update omp atomic for OpenMP 5 Tobias Burnus
2020-10-29 21:15 ` Tobias Burnus
@ 2020-10-30 11:36 ` Jakub Jelinek
1 sibling, 0 replies; 5+ messages in thread
From: Jakub Jelinek @ 2020-10-30 11:36 UTC (permalink / raw)
To: Tobias Burnus; +Cc: gcc-patches, fortran
On Thu, Oct 29, 2020 at 06:05:41PM +0100, Tobias Burnus wrote:
> 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.
> + gfc_error ("OMP ATOMIC READ at %L incompatible with "
> + "ACQ_REL or RELEASE clauses", &loc);
> + gfc_error ("Unexpected junk after $ACC ATOMIC statement at %C");
> + gfc_free_omp_clauses (c);
Would be nice to be consistent. I think most commonly in diagnostics
we use !$OMP ... and !$ACC , $ACC is not used anywhere, and while
some uses of just OMP ... crept in, they aren't used that much yet.
> - = (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);
Too long line.
Otherwise LGTM.
Jakub
^ permalink raw reply [flat|nested] 5+ messages in thread
* [Patch] Fortran: OpenMP - fixes for omp atomic [PR97655] (was: Re: [Patch] Fortran: Update omp atomic for OpenMP 5)
2020-10-29 21:15 ` Tobias Burnus
@ 2020-11-02 11:52 ` Tobias Burnus
2020-11-02 11:59 ` Jakub Jelinek
0 siblings, 1 reply; 5+ messages in thread
From: Tobias Burnus @ 2020-11-02 11:52 UTC (permalink / raw)
To: gcc-patches, Jakub Jelinek, fortran
[-- Attachment #1: Type: text/plain, Size: 1348 bytes --]
Intermangled OpenMP 5.0 and 5.1.
OpenMP 5.1:
- 'capture' is no longer an atomic-clause
- can only be used with 'update' (which is implied if absent)
(a) The patch (accidentally) accepted the OpenMP 5 syntax.
→ now rejects 'capture' + 'update'
Additionally:
(b) There was a copy and paste error regarding the default
memory-order specified via 'requires' (twice the same 'if' value).
"If the default memory ordering is specified as acq_rel, atomic
constructs on which memory-order-clause is not specified behave
as if the release clause appears if the atomic write or atomic
update operation is specified, as if the acquire clause appears
if the atomic read operation is specified, and as if the acq_rel
clause appears if the atomic captured update operation is specified."
(c) Due to the the 'update' thinko, the following restriction was
wrongly applied to 'capture' instead of only to 'update':
* If atomic-clause is update or not present then memory-order-clause
must not be acq_rel or acquire.
(In OpenMP 5.1, that restriction is gone and also 'acq_rel' is
accepted for write/read.)
OK?
Tobias
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter
[-- Attachment #2: omp-atomic-fix.diff --]
[-- Type: text/x-patch, Size: 8505 bytes --]
Fortran: OpenMP - fixes for omp atomic [PR97655]
gcc/fortran/ChangeLog:
PR fortran/97655
* openmp.c (gfc_match_omp_atomic): Fix mem-order handling;
reject specifying update + capture together.
gcc/testsuite/ChangeLog:
PR fortran/97655
* gfortran.dg/gomp/atomic.f90: Update tree-dump counts; move
invalid OMP 5.0 code to ...
* gfortran.dg/gomp/atomic-2.f90: ... here; update dg-error.
* gfortran.dg/gomp/requires-9.f90: Update tree dump scan.
gcc/fortran/openmp.c | 20 +++++++-----
gcc/testsuite/gfortran.dg/gomp/atomic-2.f90 | 47 ++++++++++++++++++++++++---
gcc/testsuite/gfortran.dg/gomp/atomic.f90 | 30 ++---------------
gcc/testsuite/gfortran.dg/gomp/requires-9.f90 | 4 +--
4 files changed, 58 insertions(+), 43 deletions(-)
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 608ff5a0b55..6cb4f2862ab 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -4107,12 +4107,13 @@ gfc_match_omp_atomic (void)
if (gfc_match_omp_clauses (&c, OMP_ATOMIC_CLAUSES, true, true) != MATCH_YES)
return MATCH_ERROR;
+
+ if (c->capture && c->atomic_op != GFC_OMP_ATOMIC_UNSET)
+ gfc_error ("OMP ATOMIC at %L with multiple atomic clauses", &loc);
+
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;
@@ -4128,12 +4129,12 @@ gfc_match_omp_atomic (void)
c->memorder = OMP_MEMORDER_SEQ_CST;
break;
case OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL:
- if (c->atomic_op == GFC_OMP_ATOMIC_READ)
- c->memorder = OMP_MEMORDER_ACQUIRE;
+ if (c->capture)
+ c->memorder = OMP_MEMORDER_ACQ_REL;
else if (c->atomic_op == GFC_OMP_ATOMIC_READ)
- c->memorder = OMP_MEMORDER_RELEASE;
+ c->memorder = OMP_MEMORDER_ACQUIRE;
else
- c->memorder = OMP_MEMORDER_ACQ_REL;
+ c->memorder = OMP_MEMORDER_RELEASE;
break;
default:
gcc_unreachable ();
@@ -4161,8 +4162,9 @@ gfc_match_omp_atomic (void)
}
break;
case GFC_OMP_ATOMIC_UPDATE:
- if (c->memorder == OMP_MEMORDER_ACQ_REL
- || c->memorder == OMP_MEMORDER_ACQUIRE)
+ if ((c->memorder == OMP_MEMORDER_ACQ_REL
+ || c->memorder == OMP_MEMORDER_ACQUIRE)
+ && !c->capture)
{
gfc_error ("!$OMP ATOMIC UPDATE at %L incompatible with "
"ACQ_REL or ACQUIRE clauses", &loc);
diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic-2.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic-2.f90
index 5094caa5154..1de418dcc95 100644
--- a/gcc/testsuite/gfortran.dg/gomp/atomic-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/atomic-2.f90
@@ -9,25 +9,62 @@ subroutine bar
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" }
+ !$omp atomic acq_rel ! { 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" }
+ !$omp atomic capture,acq_rel , hint (1)
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" }
+ !$omp atomic acq_rel , hint (1), update ! { dg-error "OMP ATOMIC UPDATE at .1. incompatible with ACQ_REL or ACQUIRE clauses" }
+ i = i + 1
+ !$omp end atomic
+
+ !$omp atomic hint(0),acquire capture
i = i + 1
v = i
!$omp end atomic
- !$omp atomic write capture ! { dg-error "OMP ATOMIC at .1. with CAPTURE clause must be UPDATE" }
+ !$omp atomic write capture ! { dg-error "multiple atomic clauses" }
i = 2
v = i
!$omp end atomic
!$omp atomic foobar ! { dg-error "Failed to match clause" }
end
+
+! moved here from atomic.f90
+subroutine openmp51_foo
+ integer :: x, v
+ !$omp atomic update seq_cst capture ! { dg-error "multiple atomic clauses" }
+ x = x + 2
+ v = x
+ !$omp end atomic
+ !$omp atomic seq_cst, capture, update ! { dg-error "multiple atomic clauses" }
+ x = x + 2
+ v = x
+ !$omp end atomic
+ !$omp atomic capture, seq_cst ,update ! { dg-error "multiple atomic clauses" }
+ x = x + 2
+ v = x
+ !$omp end atomic
+end
+
+subroutine openmp51_bar
+ integer :: i, v
+ real :: f
+ !$omp atomic relaxed capture update ! { dg-error "multiple atomic clauses" }
+ i = i + 1
+ v = i
+ !$omp end atomic
+ !$omp atomic update capture,release , hint (1) ! { dg-error "multiple atomic clauses" }
+ i = i + 1
+ v = i
+ !$omp end atomic
+ !$omp atomic hint(0),update relaxed capture ! { dg-error "multiple atomic clauses" }
+ i = i + 1
+ v = i
+ !$omp end atomic
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/atomic.f90 b/gcc/testsuite/gfortran.dg/gomp/atomic.f90
index 8a1cf5b1f68..b4caf03952d 100644
--- a/gcc/testsuite/gfortran.dg/gomp/atomic.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/atomic.f90
@@ -3,13 +3,13 @@
! { 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 capture relaxed" 2 "original" } }
+! { dg-final { scan-tree-dump-times "v = #pragma omp atomic capture release" 1 "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" } }
+! { dg-final { scan-tree-dump-times "v = #pragma omp atomic capture seq_cst" 3 "original" } }
subroutine foo ()
@@ -36,18 +36,10 @@ subroutine foo ()
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
@@ -58,10 +50,6 @@ subroutine foo ()
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
@@ -78,10 +66,6 @@ subroutine bar
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
@@ -90,18 +74,10 @@ subroutine bar
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
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-9.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-9.f90
index a2b0f50ae73..d90940d95dc 100644
--- a/gcc/testsuite/gfortran.dg/gomp/requires-9.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-9.f90
@@ -80,6 +80,6 @@ end subroutine
! { dg-final { scan-tree-dump-times "#pragma omp atomic seq_cst\[\n\r]\[^\n\r]*&i5 =" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp atomic seq_cst\[\n\r]\[^\n\r]*&i5b =" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp atomic seq_cst\[\n\r]\[^\n\r]*&i6 =" 1 "original" } }
-! { dg-final { scan-tree-dump-times "#pragma omp atomic acq_rel\[\n\r]\[^\n\r]*&i7 =" 1 "original" } }
-! { dg-final { scan-tree-dump-times "#pragma omp atomic acq_rel\[\n\r]\[^\n\r]*&i7b =" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp atomic release\[\n\r]\[^\n\r]*&i7 =" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp atomic release\[\n\r]\[^\n\r]*&i7b =" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp atomic seq_cst\[\n\r]\[^\n\r]*&i8 =" 1 "original" } }
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: [Patch] Fortran: OpenMP - fixes for omp atomic [PR97655] (was: Re: [Patch] Fortran: Update omp atomic for OpenMP 5)
2020-11-02 11:52 ` [Patch] Fortran: OpenMP - fixes for omp atomic [PR97655] (was: Re: [Patch] Fortran: Update omp atomic for OpenMP 5) Tobias Burnus
@ 2020-11-02 11:59 ` Jakub Jelinek
0 siblings, 0 replies; 5+ messages in thread
From: Jakub Jelinek @ 2020-11-02 11:59 UTC (permalink / raw)
To: Tobias Burnus; +Cc: gcc-patches, fortran
On Mon, Nov 02, 2020 at 12:52:03PM +0100, Tobias Burnus wrote:
> Fortran: OpenMP - fixes for omp atomic [PR97655]
>
> gcc/fortran/ChangeLog:
>
> PR fortran/97655
> * openmp.c (gfc_match_omp_atomic): Fix mem-order handling;
> reject specifying update + capture together.
>
> gcc/testsuite/ChangeLog:
>
> PR fortran/97655
> * gfortran.dg/gomp/atomic.f90: Update tree-dump counts; move
> invalid OMP 5.0 code to ...
> * gfortran.dg/gomp/atomic-2.f90: ... here; update dg-error.
> * gfortran.dg/gomp/requires-9.f90: Update tree dump scan.
Ok, thanks.
Jakub
^ permalink raw reply [flat|nested] 5+ messages in thread
end of thread, other threads:[~2020-11-02 13:03 UTC | newest]
Thread overview: 5+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-10-29 17:05 [Patch] Fortran: Update omp atomic for OpenMP 5 Tobias Burnus
2020-10-29 21:15 ` Tobias Burnus
2020-11-02 11:52 ` [Patch] Fortran: OpenMP - fixes for omp atomic [PR97655] (was: Re: [Patch] Fortran: Update omp atomic for OpenMP 5) Tobias Burnus
2020-11-02 11:59 ` Jakub Jelinek
2020-10-30 11:36 ` [Patch] Fortran: Update omp atomic for OpenMP 5 Jakub Jelinek
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).