mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-04 17:51:03 +08:00
Code Issues Packages Projects Releases Wiki Activity

Fortran: Update omp atomic for OpenMP 5

Browse Source 
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.
This commit is contained in:
Tobias Burnus 2020-10-30 15:57:46 +01:00
parent aa701610e5
commit 1fc5e7ef98
9 changed files with 410 additions and 110 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
gcc/fortran/dump-parse-tree.c
View File

@ -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;
}

30
gcc/fortran/gfortran.h
View File

@ -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 */

251
gcc/fortran/openmp.c
View File

@ -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,12 @@ 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 +5652,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 +5712,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 +5765,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 +5774,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 +5989,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 +6988,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:

9
gcc/fortran/parse.c
View File

@ -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;
}

7
gcc/fortran/resolve.c
View File

@ -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));

4
gcc/fortran/st.c
View File

@ -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:

41
gcc/fortran/trans-openmp.c
View File

@ -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);

33
gcc/testsuite/gfortran.dg/gomp/atomic-2.f90 Normal file
View File

@ -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

111
gcc/testsuite/gfortran.dg/gomp/atomic.f90 Normal file
View File

@ -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