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.
(gfc_omp_requires, gfc_seen_omp_target,
gfc_seen_omp_atomic_wo_memorder): New global vars.
* match.h (gfc_match_omp_requires): New.
* openmp.c (gfc_omp_requires, gfc_seen_omp_target,
gfc_seen_omp_atomic_wo_memorder): New global vars.
(gfc_match_omp_requires): New function.
(gfc_match_omp_oacc_atomic): Set gfc_seen_omp_atomic_wo_memorder.
* parse.c (decode_omp_directive): Parse 'omp requires', set
gfc_seen_omp_target.
(gfc_ascii_statement): Handle ST_OMP_REQUIRES.
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.
gcc/fortran/gfortran.h | 20 +++-
gcc/fortran/match.h | 1 +
gcc/fortran/openmp.c | 157 ++++++++++++++++++++++++++
gcc/fortran/parse.c | 31 ++++-
gcc/testsuite/gfortran.dg/gomp/requires-1.f90 | 13 +++
gcc/testsuite/gfortran.dg/gomp/requires-2.f90 | 12 ++
gcc/testsuite/gfortran.dg/gomp/requires-3.f90 | 4 +
gcc/testsuite/gfortran.dg/gomp/requires-4.f90 | 20 ++++
gcc/testsuite/gfortran.dg/gomp/requires-5.f90 | 14 +++
gcc/testsuite/gfortran.dg/gomp/requires-6.f90 | 10 ++
gcc/testsuite/gfortran.dg/gomp/requires-7.f90 | 41 +++++++
11 files changed, 321 insertions(+), 2 deletions(-)
@@ -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,20 @@ enum gfc_omp_if_kind
OMP_IF_LAST
};
+enum gfc_omp_requires_kind
+{
+ OMP_REQ_REVERSE_OFFLOAD = (1 << 0),
+ OMP_REQ_UNIFIED_ADDRESS = (1 << 1),
+ OMP_REQ_UNIFIED_SHARED_MEMORY = (1 << 2),
+ OMP_REQ_DYNAMIC_ALLOCATORS = (1 << 3),
+ OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST = (1 << 4),
+ OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL = (1 << 5),
+ OMP_REQ_ATOMIC_MEM_ORDER_RELAXED = (1 << 6),
+ 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;
@@ -3269,6 +3283,10 @@ void gfc_free_case_list (gfc_case *);
gfc_expr *gfc_get_parentheses (gfc_expr *);
/* openmp.c */
+extern int gfc_omp_requires;
+extern bool gfc_seen_omp_target;
+extern bool gfc_seen_omp_atomic_wo_memorder;
+
struct gfc_omp_saved_state { void *ptrs[2]; int ints[1]; };
void gfc_free_omp_clauses (gfc_omp_clauses *);
void gfc_free_oacc_declare_clauses (struct gfc_oacc_declare *);
@@ -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);
@@ -28,6 +28,9 @@ along with GCC; see the file COPYING3. If not see
#include "diagnostic.h"
#include "gomp-constants.h"
+int gfc_omp_requires = 0;
+bool gfc_seen_omp_target = false, gfc_seen_omp_atomic_wo_memorder = false;
+
/* Match an end of OpenMP directive. End of OpenMP directive is optional
whitespace, followed by '\n' or comment '!'. */
@@ -3424,6 +3427,158 @@ gfc_match_omp_parallel_workshare (void)
return match_omp (EXEC_OMP_PARALLEL_WORKSHARE, OMP_PARALLEL_CLAUSES);
}
+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_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;
+ int requires_clause = 0;
+ 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 = (int) OMP_REQ_REVERSE_OFFLOAD;
+ if (requires_clauses & (int) OMP_REQ_REVERSE_OFFLOAD)
+ goto duplicate_clause;
+ if (gfc_seen_omp_target)
+ goto requires_after_target;
+ if (gfc_omp_requires & (int) OMP_REQ_REVERSE_OFFLOAD)
+ goto next;
+ }
+ else if (gfc_match (clauses[1]) == MATCH_YES)
+ {
+ clause = clauses[1];
+ requires_clause = (int) OMP_REQ_UNIFIED_ADDRESS;
+ if (requires_clauses & (int) OMP_REQ_UNIFIED_ADDRESS)
+ goto duplicate_clause;
+ if (gfc_seen_omp_target)
+ goto requires_after_target;
+ if (gfc_omp_requires & (int) OMP_REQ_UNIFIED_ADDRESS)
+ goto next;
+ }
+ else if (gfc_match (clauses[2]) == MATCH_YES)
+ {
+ clause = clauses[2];
+ requires_clause = (int) OMP_REQ_UNIFIED_SHARED_MEMORY;
+ if (requires_clauses & (int) OMP_REQ_UNIFIED_SHARED_MEMORY)
+ goto duplicate_clause;
+ if (gfc_seen_omp_target)
+ goto requires_after_target;
+ if (gfc_omp_requires & (int) OMP_REQ_UNIFIED_SHARED_MEMORY)
+ goto next;
+ }
+ else if (gfc_match (clauses[3]) == MATCH_YES)
+ {
+ clause = clauses[3];
+ requires_clause = (int) OMP_REQ_DYNAMIC_ALLOCATORS;
+ if (requires_clauses & (int) OMP_REQ_DYNAMIC_ALLOCATORS)
+ goto duplicate_clause;
+ if (gfc_omp_requires & (int) OMP_REQ_DYNAMIC_ALLOCATORS)
+ goto next;
+ }
+ 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)
+ requires_clause = (int) OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST;
+ else if (gfc_match (" acq_rel )") == MATCH_YES)
+ requires_clause = (int) OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL;
+ else if (gfc_match (" relaxed )") == MATCH_YES)
+ requires_clause = (int) 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;
+ }
+ if ((gfc_omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
+ && ((gfc_omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
+ != (requires_clause & OMP_REQ_ATOMIC_MEM_ORDER_MASK)))
+ {
+ gfc_error ("ATOMIC_DEFAULT_MEM_ORDER clause at %L "
+ "specified with different value than previously "
+ "in the same translation unit", &old_loc);
+ goto error;
+ }
+ if (gfc_omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
+ {
+ gfc_error ("Only one ATOMIC_DEFAULT_MEM_ORDER clause such as at "
+ "%L per translation unit permitted", &old_loc);
+ goto error;
+ }
+ if (gfc_seen_omp_atomic_wo_memorder)
+ {
+ gfc_error ("OMP REQUIRES with ATOMIC_DEFAULT_MEM_ORDER clause at "
+ "%L specified after first use of an OMP ATOMIC which "
+ "uses the default-memory order", &old_loc);
+ goto error;
+ }
+ /* TODO: Middle-end support exists, but not yet FE support. */
+ if (requires_clause != OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST)
+ gfc_error_now ("Sorry, only SEQ_CST is currently supported for the "
+ "ATOMIC_DEFAULT_MEM_ORDER clause at %L on the "
+ "REQUIRES directive", &old_loc);
+ }
+ else
+ goto error;
+next:
+ requires_clauses |= requires_clause;
+ if (requires_clause & ~((int) OMP_REQ_ATOMIC_MEM_ORDER_MASK))
+ gfc_error_now ("Sorry, %qs clause at %L on REQUIRES directive is not "
+ "yet supported", clause, &old_loc);
+ }
+
+ gfc_omp_requires |= requires_clauses;
+ if (requires_clauses == 0)
+ {
+ if (!gfc_error_flag_test ())
+ gfc_error ("Clause expected at %C");
+ goto error;
+ }
+ return MATCH_YES;
+
+requires_after_target:
+ gfc_error ("Clause %qs at %L specified after a device construct/routine",
+ clause, &old_loc);
+ goto error;
+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 +3900,8 @@ 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
+ gfc_seen_omp_atomic_wo_memorder = true;
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,28 @@ 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_seen_omp_target = true;
+ break;
+ default:
+ break;
+ }
return ret;
do_spec_only:
@@ -1604,7 +1629,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 +2433,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;
new file mode 100644
@@ -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" }
new file mode 100644
@@ -0,0 +1,12 @@
+!$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) ! { dg-error "Only one ATOMIC_DEFAULT_MEM_ORDER clause such as at .1. per translation unit permitted" }
+end
+
+! { dg-prune-output "not yet supported" }
new file mode 100644
@@ -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
new file mode 100644
@@ -0,0 +1,20 @@
+subroutine bar
+!$omp requires unified_shared_memory,unified_address,reverse_offload
+end
+
+subroutine foo
+ !$omp target
+ !$omp end target
+end
+
+subroutine foobar
+i = 5 ! < execution statement
+!$omp requires atomic_default_mem_order(seq_cst) ! { dg-error "Unexpected ..OMP REQUIRES statement" }
+end
+
+!$omp requires dynamic_allocators ! OK
+!$omp requires unified_shared_memory ! { dg-error "specified after a device construct/routine" }
+!$omp requires unified_address ! { dg-error "specified after a device construct/routine" }
+!$omp requires reverse_offload ! { dg-error "specified after a device construct/routine" }
+end
+! { dg-prune-output "not yet supported" }
new file mode 100644
@@ -0,0 +1,14 @@
+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 atomic_default_mem_order(relaxed) ! { dg-error "specified with different value than previously in the same translation unit" }
+!$omp requires atomic_default_mem_order(seq_cst) ! { dg-error "Only one ATOMIC_DEFAULT_MEM_ORDER clause such as at .1. per translation unit permitted" }
+ !$omp target
+ !$omp end target
+end
+
+! { dg-prune-output "not yet supported" }
new file mode 100644
@@ -0,0 +1,10 @@
+subroutine bar
+!$omp atomic
+ i = i + 5
+end
+
+subroutine foo
+!$omp requires atomic_default_mem_order(seq_cst) ! { dg-error "specified after first use of an OMP ATOMIC which uses the default-memory order" }
+end
+
+! { dg-prune-output "not yet supported" }
new file mode 100644
@@ -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" }