OpenMP: Add 'omp requires' to Fortran (mostly parsing)
gcc/fortran/ChangeLog: * gfortran.h (enum gfc_statement): Add ST_OMP_REQUIRES. (enum gfc_omp_requires_kind): New. (enum gfc_omp_atomic_op): Add GFC_OMP_ATOMIC_ACQ_REL. (struct gfc_namespace): Add omp_requires and omp_target_seen. (gfc_omp_requires_add_clause, (gfc_check_omp_requires): New. * match.h (gfc_match_omp_requires): New. * module.c (enum ab_attribute, attr_bits): Add omp requires clauses. (mio_symbol_attribute): Read/write them. * openmp.c (gfc_check_omp_requires, (gfc_omp_requires_add_clause, gfc_match_omp_requires): New. (gfc_match_omp_oacc_atomic): Use requires's default mem-order. * parse.c (decode_omp_directive): Match requires, set omp_target_seen. (gfc_ascii_statement): Handle ST_OMP_REQUIRES. * trans-openmp.c (gfc_trans_omp_atomic): Handle GFC_OMP_ATOMIC_ACQ_REL. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/requires-1.f90: New test. * gfortran.dg/gomp/requires-2.f90: New test. * gfortran.dg/gomp/requires-3.f90: New test. * gfortran.dg/gomp/requires-4.f90: New test. * gfortran.dg/gomp/requires-5.f90: New test. * gfortran.dg/gomp/requires-6.f90: New test. * gfortran.dg/gomp/requires-7.f90: New test. * gfortran.dg/gomp/requires-8.f90: New test. * gfortran.dg/gomp/requires-9.f90: New test.
This commit is contained in:
Tobias Burnus
parent
5c180464b7
commit
269322ece1
|
|
@ -263,7 +263,7 @@ enum gfc_statement
|
|||
ST_OMP_TARGET_SIMD, ST_OMP_END_TARGET_SIMD,
|
||||
ST_OMP_TASKLOOP, ST_OMP_END_TASKLOOP,
|
||||
ST_OMP_TASKLOOP_SIMD, ST_OMP_END_TASKLOOP_SIMD, ST_OMP_ORDERED_DEPEND,
|
||||
ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL,
|
||||
ST_OMP_REQUIRES, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL,
|
||||
ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_EVENT_POST,
|
||||
ST_EVENT_WAIT, ST_FAIL_IMAGE, ST_FORM_TEAM, ST_CHANGE_TEAM,
|
||||
ST_END_TEAM, ST_SYNC_TEAM, ST_NONE
|
||||
|
|
@ -1334,6 +1334,24 @@ enum gfc_omp_if_kind
|
|||
OMP_IF_LAST
|
||||
};
|
||||
|
||||
enum gfc_omp_requires_kind
|
||||
{
|
||||
/* Keep in sync with gfc_namespace, esp. with omp_req_mem_order. */
|
||||
OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST = 1, /* 01 */
|
||||
OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL = 2, /* 10 */
|
||||
OMP_REQ_ATOMIC_MEM_ORDER_RELAXED = 3, /* 11 */
|
||||
OMP_REQ_REVERSE_OFFLOAD = (1 << 2),
|
||||
OMP_REQ_UNIFIED_ADDRESS = (1 << 3),
|
||||
OMP_REQ_UNIFIED_SHARED_MEMORY = (1 << 4),
|
||||
OMP_REQ_DYNAMIC_ALLOCATORS = (1 << 5),
|
||||
OMP_REQ_TARGET_MASK = (OMP_REQ_REVERSE_OFFLOAD
|
||||
| OMP_REQ_UNIFIED_ADDRESS
|
||||
| OMP_REQ_UNIFIED_SHARED_MEMORY),
|
||||
OMP_REQ_ATOMIC_MEM_ORDER_MASK = (OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST
|
||||
| OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL
|
||||
| OMP_REQ_ATOMIC_MEM_ORDER_RELAXED)
|
||||
};
|
||||
|
||||
typedef struct gfc_omp_clauses
|
||||
{
|
||||
struct gfc_expr *if_expr;
|
||||
|
|
@ -1915,6 +1933,10 @@ typedef struct gfc_namespace
|
|||
|
||||
/* Set to 1 if there are any calls to procedures with implicit interface. */
|
||||
unsigned implicit_interface_calls:1;
|
||||
|
||||
/* OpenMP requires. */
|
||||
unsigned omp_requires:6;
|
||||
unsigned omp_target_seen:1;
|
||||
}
|
||||
gfc_namespace;
|
||||
|
||||
|
|
@ -2645,7 +2667,8 @@ enum gfc_omp_atomic_op
|
|||
GFC_OMP_ATOMIC_CAPTURE = 3,
|
||||
GFC_OMP_ATOMIC_MASK = 3,
|
||||
GFC_OMP_ATOMIC_SEQ_CST = 4,
|
||||
GFC_OMP_ATOMIC_SWAP = 8
|
||||
GFC_OMP_ATOMIC_ACQ_REL = 8,
|
||||
GFC_OMP_ATOMIC_SWAP = 16
|
||||
};
|
||||
|
||||
typedef struct gfc_code
|
||||
|
|
@ -3270,6 +3293,9 @@ gfc_expr *gfc_get_parentheses (gfc_expr *);
|
|||
|
||||
/* openmp.c */
|
||||
struct gfc_omp_saved_state { void *ptrs[2]; int ints[1]; };
|
||||
bool gfc_omp_requires_add_clause (gfc_omp_requires_kind, const char *,
|
||||
locus *, const char *);
|
||||
void gfc_check_omp_requires (gfc_namespace *, int);
|
||||
void gfc_free_omp_clauses (gfc_omp_clauses *);
|
||||
void gfc_free_oacc_declare_clauses (struct gfc_oacc_declare *);
|
||||
void gfc_free_omp_declare_simd (gfc_omp_declare_simd *);
|
||||
|
|
|
|||
|
|
@ -177,6 +177,7 @@ match gfc_match_omp_parallel_do (void);
|
|||
match gfc_match_omp_parallel_do_simd (void);
|
||||
match gfc_match_omp_parallel_sections (void);
|
||||
match gfc_match_omp_parallel_workshare (void);
|
||||
match gfc_match_omp_requires (void);
|
||||
match gfc_match_omp_sections (void);
|
||||
match gfc_match_omp_simd (void);
|
||||
match gfc_match_omp_single (void);
|
||||
|
|
|
|||
|
|
@ -2047,7 +2047,11 @@ enum ab_attribute
|
|||
AB_OMP_DECLARE_TARGET_LINK, AB_PDT_KIND, AB_PDT_LEN, AB_PDT_TYPE,
|
||||
AB_PDT_TEMPLATE, AB_PDT_ARRAY, AB_PDT_STRING,
|
||||
AB_OACC_ROUTINE_LOP_GANG, AB_OACC_ROUTINE_LOP_WORKER,
|
||||
AB_OACC_ROUTINE_LOP_VECTOR, AB_OACC_ROUTINE_LOP_SEQ
|
||||
AB_OACC_ROUTINE_LOP_VECTOR, AB_OACC_ROUTINE_LOP_SEQ,
|
||||
AB_OMP_REQ_REVERSE_OFFLOAD, AB_OMP_REQ_UNIFIED_ADDRESS,
|
||||
AB_OMP_REQ_UNIFIED_SHARED_MEMORY, AB_OMP_REQ_DYNAMIC_ALLOCATORS,
|
||||
AB_OMP_REQ_MEM_ORDER_SEQ_CST, AB_OMP_REQ_MEM_ORDER_ACQ_REL,
|
||||
AB_OMP_REQ_MEM_ORDER_RELAXED
|
||||
};
|
||||
|
||||
static const mstring attr_bits[] =
|
||||
|
|
@ -2121,6 +2125,13 @@ static const mstring attr_bits[] =
|
|||
minit ("OACC_ROUTINE_LOP_WORKER", AB_OACC_ROUTINE_LOP_WORKER),
|
||||
minit ("OACC_ROUTINE_LOP_VECTOR", AB_OACC_ROUTINE_LOP_VECTOR),
|
||||
minit ("OACC_ROUTINE_LOP_SEQ", AB_OACC_ROUTINE_LOP_SEQ),
|
||||
minit ("OMP_REQ_REVERSE_OFFLOAD", AB_OMP_REQ_REVERSE_OFFLOAD),
|
||||
minit ("OMP_REQ_UNIFIED_ADDRESS", AB_OMP_REQ_UNIFIED_ADDRESS),
|
||||
minit ("OMP_REQ_UNIFIED_SHARED_MEMORY", AB_OMP_REQ_UNIFIED_SHARED_MEMORY),
|
||||
minit ("OMP_REQ_DYNAMIC_ALLOCATORS", AB_OMP_REQ_DYNAMIC_ALLOCATORS),
|
||||
minit ("OMP_REQ_MEM_ORDER_SEQ_CST", AB_OMP_REQ_MEM_ORDER_SEQ_CST),
|
||||
minit ("OMP_REQ_MEM_ORDER_ACQ_REL", AB_OMP_REQ_MEM_ORDER_ACQ_REL),
|
||||
minit ("OMP_REQ_MEM_ORDER_RELAXED", AB_OMP_REQ_MEM_ORDER_RELAXED),
|
||||
minit (NULL, -1)
|
||||
};
|
||||
|
||||
|
|
@ -2366,8 +2377,27 @@ mio_symbol_attribute (symbol_attribute *attr)
|
|||
gcc_unreachable ();
|
||||
}
|
||||
|
||||
if (attr->flavor == FL_MODULE && gfc_current_ns->omp_requires)
|
||||
{
|
||||
if (gfc_current_ns->omp_requires & OMP_REQ_REVERSE_OFFLOAD)
|
||||
MIO_NAME (ab_attribute) (AB_OMP_REQ_REVERSE_OFFLOAD, attr_bits);
|
||||
if (gfc_current_ns->omp_requires & OMP_REQ_UNIFIED_ADDRESS)
|
||||
MIO_NAME (ab_attribute) (AB_OMP_REQ_UNIFIED_ADDRESS, attr_bits);
|
||||
if (gfc_current_ns->omp_requires & OMP_REQ_UNIFIED_SHARED_MEMORY)
|
||||
MIO_NAME (ab_attribute) (AB_OMP_REQ_UNIFIED_SHARED_MEMORY, attr_bits);
|
||||
if (gfc_current_ns->omp_requires & OMP_REQ_DYNAMIC_ALLOCATORS)
|
||||
MIO_NAME (ab_attribute) (AB_OMP_REQ_DYNAMIC_ALLOCATORS, attr_bits);
|
||||
if ((gfc_current_ns->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
|
||||
== OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST)
|
||||
MIO_NAME (ab_attribute) (AB_OMP_REQ_MEM_ORDER_SEQ_CST, attr_bits);
|
||||
if ((gfc_current_ns->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
|
||||
== OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL)
|
||||
MIO_NAME (ab_attribute) (AB_OMP_REQ_MEM_ORDER_ACQ_REL, attr_bits);
|
||||
if ((gfc_current_ns->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
|
||||
== OMP_REQ_ATOMIC_MEM_ORDER_RELAXED)
|
||||
MIO_NAME (ab_attribute) (AB_OMP_REQ_MEM_ORDER_RELAXED, attr_bits);
|
||||
}
|
||||
mio_rparen ();
|
||||
|
||||
}
|
||||
else
|
||||
{
|
||||
|
|
@ -2592,6 +2622,45 @@ mio_symbol_attribute (symbol_attribute *attr)
|
|||
verify_OACC_ROUTINE_LOP_NONE (attr->oacc_routine_lop);
|
||||
attr->oacc_routine_lop = OACC_ROUTINE_LOP_SEQ;
|
||||
break;
|
||||
case AB_OMP_REQ_REVERSE_OFFLOAD:
|
||||
gfc_omp_requires_add_clause (OMP_REQ_REVERSE_OFFLOAD,
|
||||
"reverse_offload",
|
||||
&gfc_current_locus,
|
||||
module_name);
|
||||
break;
|
||||
case AB_OMP_REQ_UNIFIED_ADDRESS:
|
||||
gfc_omp_requires_add_clause (OMP_REQ_UNIFIED_ADDRESS,
|
||||
"unified_address",
|
||||
&gfc_current_locus,
|
||||
module_name);
|
||||
break;
|
||||
case AB_OMP_REQ_UNIFIED_SHARED_MEMORY:
|
||||
gfc_omp_requires_add_clause (OMP_REQ_UNIFIED_SHARED_MEMORY,
|
||||
"unified_shared_memory",
|
||||
&gfc_current_locus,
|
||||
module_name);
|
||||
break;
|
||||
case AB_OMP_REQ_DYNAMIC_ALLOCATORS:
|
||||
gfc_omp_requires_add_clause (OMP_REQ_DYNAMIC_ALLOCATORS,
|
||||
"dynamic_allocators",
|
||||
&gfc_current_locus,
|
||||
module_name);
|
||||
break;
|
||||
case AB_OMP_REQ_MEM_ORDER_SEQ_CST:
|
||||
gfc_omp_requires_add_clause (OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST,
|
||||
"seq_cst", &gfc_current_locus,
|
||||
module_name);
|
||||
break;
|
||||
case AB_OMP_REQ_MEM_ORDER_ACQ_REL:
|
||||
gfc_omp_requires_add_clause (OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL,
|
||||
"acq_rel", &gfc_current_locus,
|
||||
module_name);
|
||||
break;
|
||||
case AB_OMP_REQ_MEM_ORDER_RELAXED:
|
||||
gfc_omp_requires_add_clause (OMP_REQ_ATOMIC_MEM_ORDER_RELAXED,
|
||||
"relaxed", &gfc_current_locus,
|
||||
module_name);
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -3424,6 +3424,230 @@ gfc_match_omp_parallel_workshare (void)
|
|||
return match_omp (EXEC_OMP_PARALLEL_WORKSHARE, OMP_PARALLEL_CLAUSES);
|
||||
}
|
||||
|
||||
void
|
||||
gfc_check_omp_requires (gfc_namespace *ns, int ref_omp_requires)
|
||||
{
|
||||
if (ns->omp_target_seen
|
||||
&& (ns->omp_requires & OMP_REQ_TARGET_MASK)
|
||||
!= (ref_omp_requires & OMP_REQ_TARGET_MASK))
|
||||
{
|
||||
gcc_assert (ns->proc_name);
|
||||
if ((ref_omp_requires & OMP_REQ_REVERSE_OFFLOAD)
|
||||
&& !(ns->omp_requires & OMP_REQ_REVERSE_OFFLOAD))
|
||||
gfc_error ("Program unit at %L has OpenMP device constructs/routines "
|
||||
"but does not set !$OMP REQUIRES REVERSE_OFFSET but other "
|
||||
"program units do", &ns->proc_name->declared_at);
|
||||
if ((ref_omp_requires & OMP_REQ_UNIFIED_ADDRESS)
|
||||
&& !(ns->omp_requires & OMP_REQ_UNIFIED_ADDRESS))
|
||||
gfc_error ("Program unit at %L has OpenMP device constructs/routines "
|
||||
"but does not set !$OMP REQUIRES UNIFIED_ADDRESS but other "
|
||||
"program units do", &ns->proc_name->declared_at);
|
||||
if ((ref_omp_requires & OMP_REQ_UNIFIED_SHARED_MEMORY)
|
||||
&& !(ns->omp_requires & OMP_REQ_UNIFIED_SHARED_MEMORY))
|
||||
gfc_error ("Program unit at %L has OpenMP device constructs/routines "
|
||||
"but does not set !$OMP REQUIRES UNIFIED_SHARED_MEMORY but "
|
||||
"other program units do", &ns->proc_name->declared_at);
|
||||
}
|
||||
}
|
||||
|
||||
bool
|
||||
gfc_omp_requires_add_clause (gfc_omp_requires_kind clause,
|
||||
const char *clause_name, locus *loc,
|
||||
const char *module_name)
|
||||
{
|
||||
gfc_namespace *prog_unit = gfc_current_ns;
|
||||
while (prog_unit->parent)
|
||||
{
|
||||
if (gfc_state_stack->previous
|
||||
&& gfc_state_stack->previous->state == COMP_INTERFACE)
|
||||
break;
|
||||
prog_unit = prog_unit->parent;
|
||||
}
|
||||
|
||||
/* Requires added after use. */
|
||||
if (prog_unit->omp_target_seen
|
||||
&& (clause & OMP_REQ_TARGET_MASK)
|
||||
&& !(prog_unit->omp_requires & clause))
|
||||
{
|
||||
if (module_name)
|
||||
gfc_error ("!$OMP REQUIRES clause %qs specified via module %qs use "
|
||||
"at %L comes after using a device construct/routine",
|
||||
clause_name, module_name, loc);
|
||||
else
|
||||
gfc_error ("!$OMP REQUIRES clause %qs specified at %L comes after "
|
||||
"using a device construct/routine", clause_name, loc);
|
||||
return false;
|
||||
}
|
||||
|
||||
/* Overriding atomic_default_mem_order clause value. */
|
||||
if ((clause & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
|
||||
&& (prog_unit->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
|
||||
&& (prog_unit->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
|
||||
!= (int) clause)
|
||||
{
|
||||
const char *other;
|
||||
if (prog_unit->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST)
|
||||
other = "seq_cst";
|
||||
else if (prog_unit->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL)
|
||||
other = "acq_rel";
|
||||
else if (prog_unit->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_RELAXED)
|
||||
other = "relaxed";
|
||||
else
|
||||
gcc_unreachable ();
|
||||
|
||||
if (module_name)
|
||||
gfc_error ("!$OMP REQUIRES clause %<atomic_default_mem_order(%s)%> "
|
||||
"specified via module %qs use at %L overrides a previous "
|
||||
"%<atomic_default_mem_order(%s)%> (which might be through "
|
||||
"using a module)", clause_name, module_name, loc, other);
|
||||
else
|
||||
gfc_error ("!$OMP REQUIRES clause %<atomic_default_mem_order(%s)%> "
|
||||
"specified at %L overrides a previous "
|
||||
"%<atomic_default_mem_order(%s)%> (which might be through "
|
||||
"using a module)", clause_name, loc, other);
|
||||
return false;
|
||||
}
|
||||
|
||||
/* Requires via module not at program-unit level and not repeating clause. */
|
||||
if (prog_unit != gfc_current_ns && !(prog_unit->omp_requires & clause))
|
||||
{
|
||||
if (clause & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
|
||||
gfc_error ("!$OMP REQUIRES clause %<atomic_default_mem_order(%s)%> "
|
||||
"specified via module %qs use at %L but same clause is "
|
||||
"not set at for the program unit", clause_name, module_name,
|
||||
loc);
|
||||
else
|
||||
gfc_error ("!$OMP REQUIRES clause %qs specified via module %qs use at "
|
||||
"%L but same clause is not set at for the program unit",
|
||||
clause_name, module_name, loc);
|
||||
return false;
|
||||
}
|
||||
|
||||
if (!gfc_state_stack->previous
|
||||
|| gfc_state_stack->previous->state != COMP_INTERFACE)
|
||||
prog_unit->omp_requires |= clause;
|
||||
return true;
|
||||
}
|
||||
|
||||
match
|
||||
gfc_match_omp_requires (void)
|
||||
{
|
||||
static const char *clauses[] = {"reverse_offload",
|
||||
"unified_address",
|
||||
"unified_shared_memory",
|
||||
"dynamic_allocators",
|
||||
"atomic_default"};
|
||||
const char *clause = NULL;
|
||||
int requires_clauses = 0;
|
||||
bool first = true;
|
||||
locus old_loc;
|
||||
|
||||
if (gfc_current_ns->parent
|
||||
&& (!gfc_state_stack->previous
|
||||
|| gfc_state_stack->previous->state != COMP_INTERFACE))
|
||||
{
|
||||
gfc_error ("!$OMP REQUIRES at %C must appear in the specification part "
|
||||
"of a program unit");
|
||||
return MATCH_ERROR;
|
||||
}
|
||||
|
||||
while (true)
|
||||
{
|
||||
old_loc = gfc_current_locus;
|
||||
gfc_omp_requires_kind requires_clause;
|
||||
if ((first || gfc_match_char (',') != MATCH_YES)
|
||||
&& (first && gfc_match_space () != MATCH_YES))
|
||||
goto error;
|
||||
first = false;
|
||||
gfc_gobble_whitespace ();
|
||||
old_loc = gfc_current_locus;
|
||||
|
||||
if (gfc_match_omp_eos () != MATCH_NO)
|
||||
break;
|
||||
if (gfc_match (clauses[0]) == MATCH_YES)
|
||||
{
|
||||
clause = clauses[0];
|
||||
requires_clause = OMP_REQ_REVERSE_OFFLOAD;
|
||||
if (requires_clauses & OMP_REQ_REVERSE_OFFLOAD)
|
||||
goto duplicate_clause;
|
||||
}
|
||||
else if (gfc_match (clauses[1]) == MATCH_YES)
|
||||
{
|
||||
clause = clauses[1];
|
||||
requires_clause = OMP_REQ_UNIFIED_ADDRESS;
|
||||
if (requires_clauses & OMP_REQ_UNIFIED_ADDRESS)
|
||||
goto duplicate_clause;
|
||||
}
|
||||
else if (gfc_match (clauses[2]) == MATCH_YES)
|
||||
{
|
||||
clause = clauses[2];
|
||||
requires_clause = OMP_REQ_UNIFIED_SHARED_MEMORY;
|
||||
if (requires_clauses & OMP_REQ_UNIFIED_SHARED_MEMORY)
|
||||
goto duplicate_clause;
|
||||
}
|
||||
else if (gfc_match (clauses[3]) == MATCH_YES)
|
||||
{
|
||||
clause = clauses[3];
|
||||
requires_clause = OMP_REQ_DYNAMIC_ALLOCATORS;
|
||||
if (requires_clauses & OMP_REQ_DYNAMIC_ALLOCATORS)
|
||||
goto duplicate_clause;
|
||||
}
|
||||
else if (gfc_match ("atomic_default_mem_order (") == MATCH_YES)
|
||||
{
|
||||
clause = clauses[4];
|
||||
if (requires_clauses & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
|
||||
goto duplicate_clause;
|
||||
if (gfc_match (" seq_cst )") == MATCH_YES)
|
||||
{
|
||||
clause = "seq_cst";
|
||||
requires_clause = OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST;
|
||||
}
|
||||
else if (gfc_match (" acq_rel )") == MATCH_YES)
|
||||
{
|
||||
clause = "acq_rel";
|
||||
requires_clause = OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL;
|
||||
}
|
||||
else if (gfc_match (" relaxed )") == MATCH_YES)
|
||||
{
|
||||
clause = "relaxed";
|
||||
requires_clause = OMP_REQ_ATOMIC_MEM_ORDER_RELAXED;
|
||||
}
|
||||
else
|
||||
{
|
||||
gfc_error ("Expected SEQ_CST, ACQ_REL or RELAXED for "
|
||||
"ATOMIC_DEFAULT_MEM_ORDER clause at %C");
|
||||
goto error;
|
||||
}
|
||||
}
|
||||
else
|
||||
goto error;
|
||||
|
||||
if (requires_clause & ~OMP_REQ_ATOMIC_MEM_ORDER_MASK)
|
||||
gfc_error_now ("Sorry, %qs clause at %L on REQUIRES directive is not "
|
||||
"yet supported", clause, &old_loc);
|
||||
if (!gfc_omp_requires_add_clause (requires_clause, clause, &old_loc, NULL))
|
||||
goto error;
|
||||
requires_clauses |= requires_clause;
|
||||
}
|
||||
|
||||
if (requires_clauses == 0)
|
||||
{
|
||||
if (!gfc_error_flag_test ())
|
||||
gfc_error ("Clause expected at %C");
|
||||
goto error;
|
||||
}
|
||||
return MATCH_YES;
|
||||
|
||||
duplicate_clause:
|
||||
gfc_error ("%qs clause at %L specified more than once", clause, &old_loc);
|
||||
error:
|
||||
if (!gfc_error_flag_test ())
|
||||
gfc_error ("Expected UNIFIED_ADDRESS, UNIFIED_SHARED_MEMORY, "
|
||||
"DYNAMIC_ALLOCATORS, REVERSE_OFFLOAD, or "
|
||||
"ATOMIC_DEFAULT_MEM_ORDER clause at %L", &old_loc);
|
||||
return MATCH_ERROR;
|
||||
}
|
||||
|
||||
|
||||
match
|
||||
gfc_match_omp_sections (void)
|
||||
|
|
@ -3745,6 +3969,26 @@ gfc_match_omp_oacc_atomic (bool omp_p)
|
|||
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_namespace *prog_unit = gfc_current_ns;
|
||||
while (prog_unit->parent)
|
||||
prog_unit = prog_unit->parent;
|
||||
switch (prog_unit->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
|
||||
{
|
||||
case 0:
|
||||
case OMP_REQ_ATOMIC_MEM_ORDER_RELAXED:
|
||||
break;
|
||||
case OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST:
|
||||
op = (gfc_omp_atomic_op) (op | GFC_OMP_ATOMIC_SEQ_CST);
|
||||
break;
|
||||
case OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL:
|
||||
op = (gfc_omp_atomic_op) (op | GFC_OMP_ATOMIC_ACQ_REL);
|
||||
break;
|
||||
default:
|
||||
gcc_unreachable ();
|
||||
}
|
||||
}
|
||||
new_st.ext.omp_atomic = op;
|
||||
return MATCH_YES;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -995,6 +995,9 @@ decode_omp_directive (void)
|
|||
ST_OMP_PARALLEL_WORKSHARE);
|
||||
matcho ("parallel", gfc_match_omp_parallel, ST_OMP_PARALLEL);
|
||||
break;
|
||||
case 'r':
|
||||
matcho ("requires", gfc_match_omp_requires, ST_OMP_REQUIRES);
|
||||
break;
|
||||
case 's':
|
||||
matcho ("sections", gfc_match_omp_sections, ST_OMP_SECTIONS);
|
||||
matcho ("section", gfc_match_omp_eos_error, ST_OMP_SECTION);
|
||||
|
|
@ -1086,6 +1089,38 @@ decode_omp_directive (void)
|
|||
return ST_NONE;
|
||||
}
|
||||
}
|
||||
switch (ret)
|
||||
{
|
||||
case ST_OMP_DECLARE_TARGET:
|
||||
case ST_OMP_TARGET:
|
||||
case ST_OMP_TARGET_DATA:
|
||||
case ST_OMP_TARGET_ENTER_DATA:
|
||||
case ST_OMP_TARGET_EXIT_DATA:
|
||||
case ST_OMP_TARGET_TEAMS:
|
||||
case ST_OMP_TARGET_TEAMS_DISTRIBUTE:
|
||||
case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
|
||||
case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
|
||||
case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
|
||||
case ST_OMP_TARGET_PARALLEL:
|
||||
case ST_OMP_TARGET_PARALLEL_DO:
|
||||
case ST_OMP_TARGET_PARALLEL_DO_SIMD:
|
||||
case ST_OMP_TARGET_SIMD:
|
||||
case ST_OMP_TARGET_UPDATE:
|
||||
{
|
||||
gfc_namespace *prog_unit = gfc_current_ns;
|
||||
while (prog_unit->parent)
|
||||
{
|
||||
if (gfc_state_stack->previous
|
||||
&& gfc_state_stack->previous->state == COMP_INTERFACE)
|
||||
break;
|
||||
prog_unit = prog_unit->parent;
|
||||
}
|
||||
prog_unit->omp_target_seen = true;
|
||||
break;
|
||||
}
|
||||
default:
|
||||
break;
|
||||
}
|
||||
return ret;
|
||||
|
||||
do_spec_only:
|
||||
|
|
@ -1604,7 +1639,8 @@ next_statement (void)
|
|||
/* OpenMP declaration statements. */
|
||||
|
||||
#define case_omp_decl case ST_OMP_THREADPRIVATE: case ST_OMP_DECLARE_SIMD: \
|
||||
case ST_OMP_DECLARE_TARGET: case ST_OMP_DECLARE_REDUCTION
|
||||
case ST_OMP_DECLARE_TARGET: case ST_OMP_DECLARE_REDUCTION: \
|
||||
case ST_OMP_REQUIRES
|
||||
|
||||
/* Block end statements. Errors associated with interchanging these
|
||||
are detected in gfc_match_end(). */
|
||||
|
|
@ -2407,6 +2443,9 @@ gfc_ascii_statement (gfc_statement st)
|
|||
case ST_OMP_PARALLEL_WORKSHARE:
|
||||
p = "!$OMP PARALLEL WORKSHARE";
|
||||
break;
|
||||
case ST_OMP_REQUIRES:
|
||||
p = "!$OMP REQUIRES";
|
||||
break;
|
||||
case ST_OMP_SECTIONS:
|
||||
p = "!$OMP SECTIONS";
|
||||
break;
|
||||
|
|
@ -6516,10 +6555,18 @@ done:
|
|||
}
|
||||
while (changed);
|
||||
|
||||
/* Fixup for external procedures. */
|
||||
/* Fixup for external procedures and resolve 'omp requires'. */
|
||||
int omp_requires;
|
||||
omp_requires = 0;
|
||||
for (gfc_current_ns = gfc_global_ns_list; gfc_current_ns;
|
||||
gfc_current_ns = gfc_current_ns->sibling)
|
||||
gfc_check_externals (gfc_current_ns);
|
||||
{
|
||||
omp_requires |= gfc_current_ns->omp_requires;
|
||||
gfc_check_externals (gfc_current_ns);
|
||||
}
|
||||
for (gfc_current_ns = gfc_global_ns_list; gfc_current_ns;
|
||||
gfc_current_ns = gfc_current_ns->sibling)
|
||||
gfc_check_omp_requires (gfc_current_ns, omp_requires);
|
||||
|
||||
/* Do the parse tree dump. */
|
||||
gfc_current_ns = flag_dump_fortran_original ? gfc_global_ns_list : NULL;
|
||||
|
|
|
|||
|
|
@ -3932,9 +3932,13 @@ gfc_trans_omp_atomic (gfc_code *code)
|
|||
enum tree_code op = ERROR_MARK;
|
||||
enum tree_code aop = OMP_ATOMIC;
|
||||
bool var_on_left = false;
|
||||
enum omp_memory_order mo
|
||||
= ((atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SEQ_CST)
|
||||
? OMP_MEMORY_ORDER_SEQ_CST : OMP_MEMORY_ORDER_RELAXED);
|
||||
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;
|
||||
|
||||
code = code->block->next;
|
||||
gcc_assert (code->op == EXEC_ASSIGN);
|
||||
|
|
|
|||
|
|
@ -0,0 +1,13 @@
|
|||
subroutine foo
|
||||
!$omp requires unified_address
|
||||
!$omp requires unified_shared_memory
|
||||
!$omp requires unified_shared_memory unified_address
|
||||
!$omp requires dynamic_allocators,reverse_offload
|
||||
end
|
||||
|
||||
subroutine bar
|
||||
!$omp requires unified_shared_memory unified_address
|
||||
!$omp requires atomic_default_mem_order(seq_cst)
|
||||
end
|
||||
|
||||
! { dg-prune-output "not yet supported" }
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
!$omp requires ! { dg-error "Clause expected" }
|
||||
!$omp requires unified_shared_memory,unified_shared_memory ! { dg-error "specified more than once" }
|
||||
!$omp requires unified_address unified_address ! { dg-error "specified more than once" }
|
||||
!$omp requires reverse_offload reverse_offload ! { dg-error "specified more than once" }
|
||||
!$omp requires foobarbaz ! { dg-error "Expected UNIFIED_ADDRESS, UNIFIED_SHARED_MEMORY, DYNAMIC_ALLOCATORS, REVERSE_OFFLOAD, or ATOMIC_DEFAULT_MEM_ORDER clause" }
|
||||
!$omp requires dynamic_allocators , dynamic_allocators ! { dg-error "specified more than once" }
|
||||
!$omp requires atomic_default_mem_order(seq_cst) atomic_default_mem_order(seq_cst) ! { dg-error "specified more than once" }
|
||||
!$omp requires atomic_default_mem_order (seq_cst)
|
||||
!$omp requires atomic_default_mem_order (seq_cst)
|
||||
!$omp requires atomic_default_mem_order (acq_rel) ! { dg-error "overrides a previous 'atomic_default_mem_order\\(seq_cst\\)'" }
|
||||
!$omp requires atomic_default_mem_order (foo) ! { dg-error "Expected SEQ_CST, ACQ_REL or RELAXED for ATOMIC_DEFAULT_MEM_ORDER clause" }
|
||||
end
|
||||
|
||||
! { dg-prune-output "not yet supported" }
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
!$omp requires atomic_default_mem_order(acquire) ! { dg-error "Expected SEQ_CST, ACQ_REL or RELAXED for ATOMIC_DEFAULT_MEM_ORDER clause" }
|
||||
!$omp requires atomic_default_mem_order(release) ! { dg-error "Expected SEQ_CST, ACQ_REL or RELAXED for ATOMIC_DEFAULT_MEM_ORDER clause" }
|
||||
!$omp requires atomic_default_mem_order(foobar) ! { dg-error "Expected SEQ_CST, ACQ_REL or RELAXED for ATOMIC_DEFAULT_MEM_ORDER clause" }
|
||||
end
|
||||
|
|
@ -0,0 +1,36 @@
|
|||
subroutine bar
|
||||
!$omp requires unified_shared_memory,unified_address,reverse_offload
|
||||
end
|
||||
|
||||
module m
|
||||
!$omp requires unified_shared_memory,unified_address,reverse_offload
|
||||
end module m
|
||||
|
||||
subroutine foo
|
||||
!$omp target
|
||||
!$omp end target
|
||||
! { dg-error "OpenMP device constructs/routines but does not set !.OMP REQUIRES REVERSE_OFFSET but other program units do" "" { target *-*-* } 9 }
|
||||
! { dg-error "OpenMP device constructs/routines but does not set !.OMP REQUIRES UNIFIED_ADDRESS but other program units do" "" { target *-*-* } 9 }
|
||||
! { dg-error "OpenMP device constructs/routines but does not set !.OMP REQUIRES UNIFIED_SHARED_MEMORY but other program units do" "" { target *-*-* } 9 }
|
||||
end
|
||||
|
||||
subroutine foobar
|
||||
i = 5 ! < execution statement
|
||||
!$omp requires atomic_default_mem_order(seq_cst) ! { dg-error "Unexpected ..OMP REQUIRES statement" }
|
||||
end
|
||||
|
||||
program main
|
||||
!$omp requires dynamic_allocators ! OK
|
||||
!$omp requires unified_shared_memory
|
||||
!$omp requires unified_address
|
||||
!$omp requires reverse_offload
|
||||
contains
|
||||
subroutine foo
|
||||
!$target
|
||||
!$end target
|
||||
end subroutine
|
||||
subroutine bar
|
||||
!$omp requires unified_addres ! { dg-error "must appear in the specification part of a program unit" }
|
||||
end subroutine bar
|
||||
end
|
||||
! { dg-prune-output "not yet supported" }
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
subroutine bar
|
||||
!$omp requires atomic_default_mem_order(seq_cst)
|
||||
!$omp requires unified_shared_memory
|
||||
end
|
||||
|
||||
subroutine foo
|
||||
!$omp requires unified_shared_memory
|
||||
!$omp requires unified_shared_memory
|
||||
!$omp requires atomic_default_mem_order(relaxed)
|
||||
!$omp requires atomic_default_mem_order(relaxed)
|
||||
!$omp requires atomic_default_mem_order(seq_cst) ! { dg-error "overrides a previous 'atomic_default_mem_order\\(seq_cst\\)'" }
|
||||
!$omp target
|
||||
!$omp end target
|
||||
end
|
||||
|
||||
! { dg-prune-output "not yet supported" }
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
subroutine bar
|
||||
!$omp atomic
|
||||
i = i + 5
|
||||
end
|
||||
|
||||
subroutine foo
|
||||
!$omp requires atomic_default_mem_order(seq_cst)
|
||||
end
|
||||
|
||||
subroutine foobar
|
||||
!$omp atomic
|
||||
i = i + 5
|
||||
!$omp requires atomic_default_mem_order(acq_rel) ! { dg-error "Unexpected !.OMP REQUIRES statement" }
|
||||
end
|
||||
|
||||
! { dg-prune-output "not yet supported" }
|
||||
|
|
@ -0,0 +1,41 @@
|
|||
subroutine bar2
|
||||
block
|
||||
!$omp requires unified_shared_memory ! { dg-error "must appear in the specification part of a program unit" }
|
||||
end block
|
||||
end
|
||||
|
||||
subroutine bar
|
||||
contains
|
||||
subroutine foo
|
||||
!$omp requires unified_shared_memory ! { dg-error "must appear in the specification part of a program unit" }
|
||||
end
|
||||
end
|
||||
|
||||
module m
|
||||
contains
|
||||
subroutine foo
|
||||
!$omp requires unified_shared_memory ! { dg-error "must appear in the specification part of a program unit" }
|
||||
end
|
||||
end
|
||||
|
||||
module m2
|
||||
interface
|
||||
module subroutine foo()
|
||||
end
|
||||
end interface
|
||||
end
|
||||
|
||||
submodule (m2) m2_sub
|
||||
!$omp requires unified_shared_memory
|
||||
contains
|
||||
module procedure foo
|
||||
end
|
||||
end
|
||||
|
||||
program main
|
||||
contains
|
||||
subroutine foo
|
||||
!$omp requires unified_shared_memory ! { dg-error "must appear in the specification part of a program unit" }
|
||||
end
|
||||
end
|
||||
! { dg-prune-output "not yet supported" }
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
module m ! { dg-error "has OpenMP device constructs/routines but does not set !.OMP REQUIRES UNIFIED_SHARED_MEMORY but other program units do" }
|
||||
!$omp requires reverse_offload
|
||||
contains
|
||||
subroutine foo
|
||||
interface
|
||||
subroutine bar2
|
||||
!$!omp requires dynamic_allocators
|
||||
end subroutine
|
||||
end interface
|
||||
!$omp target
|
||||
call bar2()
|
||||
!$omp end target
|
||||
end subroutine foo
|
||||
end module m
|
||||
|
||||
subroutine bar ! { dg-error "has OpenMP device constructs/routines but does not set !.OMP REQUIRES REVERSE_OFFSET but other program units do" }
|
||||
!use m
|
||||
!$omp requires unified_shared_memory
|
||||
!$omp declare target
|
||||
end subroutine bar
|
||||
|
||||
! { dg-prune-output "not yet supported" }
|
||||
|
|
@ -0,0 +1,85 @@
|
|||
! { dg-additional-options "-fdump-tree-original" }
|
||||
|
||||
module relaxed
|
||||
!$omp requires atomic_default_mem_order(relaxed)
|
||||
end module relaxed
|
||||
|
||||
module seq
|
||||
!$omp requires atomic_default_mem_order(seq_cst)
|
||||
end module seq
|
||||
|
||||
module acq
|
||||
!$omp requires atomic_default_mem_order(acq_rel)
|
||||
end module acq
|
||||
|
||||
subroutine sub1
|
||||
!$omp atomic ! <= relaxed
|
||||
i1 = i1 + 5
|
||||
end subroutine
|
||||
|
||||
subroutine sub2
|
||||
!$omp atomic seq_cst
|
||||
i2 = i2 + 5
|
||||
end subroutine
|
||||
|
||||
subroutine sub3
|
||||
use relaxed
|
||||
!$omp atomic
|
||||
i3 = i3 + 5
|
||||
end subroutine
|
||||
|
||||
subroutine sub4
|
||||
use relaxed
|
||||
!$omp atomic seq_cst
|
||||
i4 = i4 + 5
|
||||
end subroutine
|
||||
|
||||
subroutine sub5
|
||||
use seq
|
||||
!$omp atomic
|
||||
i5 = i5 + 5
|
||||
contains
|
||||
subroutine bar
|
||||
block
|
||||
!$omp atomic
|
||||
i5b = i5b + 5
|
||||
end block
|
||||
end
|
||||
end subroutine
|
||||
|
||||
subroutine sub6
|
||||
use seq
|
||||
!$omp atomic seq_cst
|
||||
i6 = i6 + 5
|
||||
end subroutine
|
||||
|
||||
subroutine sub7
|
||||
use acq
|
||||
!$omp atomic
|
||||
i7 = i7 + 5
|
||||
contains
|
||||
subroutine foobar
|
||||
block
|
||||
!$omp atomic
|
||||
i7b = i7b + 5
|
||||
end block
|
||||
end
|
||||
end subroutine
|
||||
|
||||
subroutine sub8
|
||||
use acq
|
||||
!$omp atomic seq_cst
|
||||
i8 = i8 + 5
|
||||
end subroutine
|
||||
|
||||
! { dg-final { scan-tree-dump-times "#pragma omp atomic relaxed\[\n\r]\[^\n\r]*&i1 =" 1 "original" } }
|
||||
! { dg-final { scan-tree-dump-times "#pragma omp atomic seq_cst\[\n\r]\[^\n\r]*&i2 =" 1 "original" } }
|
||||
! { dg-final { scan-tree-dump-times "#pragma omp atomic relaxed\[\n\r]\[^\n\r]*&i3 =" 1 "original" } }
|
||||
! { dg-final { scan-tree-dump-times "#pragma omp atomic seq_cst\[\n\r]\[^\n\r]*&i4 =" 1 "original" } }
|
||||
! { 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]*&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 seq_cst\[\n\r]\[^\n\r]*&i8 =" 1 "original" } }
|
||||
Loading…
Reference in New Issue