* [Patch] OpenMP: Add 'omp requires' to Fortran (mostly parsing)
@ 2020-07-24 9:00 Tobias Burnus
2020-07-28 11:05 ` Tobias Burnus
0 siblings, 1 reply; 6+ messages in thread
From: Tobias Burnus @ 2020-07-24 9:00 UTC (permalink / raw)
To: gcc-patches, fortran, Jakub Jelinek
[-- Attachment #1: Type: text/plain, Size: 2007 bytes --]
As with C/C++, the offloading requires are not implemented
an rejected early with a 'sorry'.
The mem-setting default for atomic is handled, but only 'seq_cst'
as currently gfortran's only supports this one. (C/C++ support more.)
In C/C++, the 'requires' has to be at file scope. For Fortran,
"must appear in the specification part of a program unit,"
which is:
"A program unit is a main program, an external subprogram,
a module, a submodule, or a block data program unit."
For the atomic setting, one has:
At most one requires directive with atomic_default_mem_order
clause can appear in a single compilation unit.
For the offloading settings + dynamic_allocators, I do not
see this restriction, i.e. I guess one can specify it multiple
times.
However, there are the restrictions:
A requires directive with a unified_address,
unified_shared_memory, or reverse_offload clause must appear
lexically before any device constructs or device routines.
(i.e. not: dynamic_allocators)
The requires directive with atomic_default_mem_order clause
may not appear lexically after any atomic construct
on which memory-order-clause is not specified.
I do wonder whether the following should be permitted:
subroutine one
!$omp requires unified_shared_memory
!$omp target
...
subroutine two
!$omp requires unified_shared_memory
!$omp target
which conceptually in terms of Fortran makes sense, but is
currently not permitted (in the patch). On the other hand,
for larger modern code, code is usually in a module and there
is one module per file.
I am not sure whether it makes sense to store the offloading
requires also in a module – and what to do on 'use'; the patch
currently does not do this.
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-requires.diff --]
[-- Type: text/x-patch, Size: 17902 bytes --]
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(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 5fa86aa4e30..007cfe596d5 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -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 *);
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index b3fb7033891..7bf70d77016 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -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);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index f8f2439b6e4..3748734392a 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -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;
}
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 96fd4aaee5e..6d200da2f1c 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -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;
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-1.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-1.f90
new file mode 100644
index 00000000000..b115a654e71
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-1.f90
@@ -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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-2.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-2.f90
new file mode 100644
index 00000000000..26ff019e986
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-2.f90
@@ -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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-3.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-3.f90
new file mode 100644
index 00000000000..4429aab2ee6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-3.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-4.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-4.f90
new file mode 100644
index 00000000000..d7af86905d3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-4.f90
@@ -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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-5.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-5.f90
new file mode 100644
index 00000000000..8b85e236f8a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-5.f90
@@ -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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-6.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-6.f90
new file mode 100644
index 00000000000..00326e0be4d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-6.f90
@@ -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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-7.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-7.f90
new file mode 100644
index 00000000000..3d75b89e00b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-7.f90
@@ -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" }
^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: [Patch] OpenMP: Add 'omp requires' to Fortran (mostly parsing)
2020-07-24 9:00 [Patch] OpenMP: Add 'omp requires' to Fortran (mostly parsing) Tobias Burnus
@ 2020-07-28 11:05 ` Tobias Burnus
2020-07-28 15:12 ` Tobias Burnus
0 siblings, 1 reply; 6+ messages in thread
From: Tobias Burnus @ 2020-07-28 11:05 UTC (permalink / raw)
To: gcc-patches, fortran, Jakub Jelinek
[-- Attachment #1: Type: text/plain, Size: 1422 bytes --]
Attached is an updated version – whether that will be fully
in line with OpenMP 5.1 remains to be seen. But in any case,
it now handles properly:
"If a directive appears in the declarative part of a module then the
behavior is as if that directive appears after any references to that
module."
Note: That with the current implementation, the restriction that
the 'requires' cannot come after an 'omp atomic' cannot occur as
'omp requires' belongs into the specification part of a 'program unit'
(Fortran; OpenMP: 'compilation unit') and 'omp atomic' belongs to
the execution part.
Thus, unless a later 'use m' implicitly provides the clause, it
cannot occur. (The current implementation does not permit that
use-stmt which is not at 'program unit' level can introduce new
clauses applicable at 'program unit' level.)
That's different to target as an 'omp declare target' also
belongs into the specification section. (Additionally, that
checking variable is also used for ensure that all program units
use the same offload clauses of omp requires.)
There is no 'use m' test for the three offload-related items
as the 'sorry, not implemented' prevents the creation of the
module file.
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-requires-v2.diff --]
[-- Type: text/x-patch, Size: 31841 bytes --]
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.
(struct gfc_namespace): Add omp_requires and omp_target_seen.
(gfc_omp_requires): New global var.
(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_omp_requires): New global var.
(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.
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.
gcc/fortran/gfortran.h | 29 ++-
gcc/fortran/match.h | 1 +
gcc/fortran/module.c | 73 ++++++-
gcc/fortran/openmp.c | 262 ++++++++++++++++++++++++++
gcc/fortran/parse.c | 48 ++++-
gcc/testsuite/gfortran.dg/gomp/requires-1.f90 | 13 ++
gcc/testsuite/gfortran.dg/gomp/requires-2.f90 | 15 ++
gcc/testsuite/gfortran.dg/gomp/requires-3.f90 | 4 +
gcc/testsuite/gfortran.dg/gomp/requires-4.f90 | 36 ++++
gcc/testsuite/gfortran.dg/gomp/requires-5.f90 | 17 ++
gcc/testsuite/gfortran.dg/gomp/requires-6.f90 | 17 ++
gcc/testsuite/gfortran.dg/gomp/requires-7.f90 | 41 ++++
gcc/testsuite/gfortran.dg/gomp/requires-8.f90 | 22 +++
gcc/testsuite/gfortran.dg/gomp/requires-9.f90 | 59 ++++++
14 files changed, 631 insertions(+), 6 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 5fa86aa4e30..a70c61c557b 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -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;
@@ -3269,7 +3291,12 @@ void gfc_free_case_list (gfc_case *);
gfc_expr *gfc_get_parentheses (gfc_expr *);
/* openmp.c */
+extern int gfc_omp_requires;
+
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 *);
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 *);
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index b3fb7033891..7bf70d77016 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -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);
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index eccf92bf658..684bb7578a3 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -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_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;
}
}
}
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 4a0466f968d..e795a08bf86 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -28,6 +28,16 @@ along with GCC; see the file COPYING3. If not see
#include "diagnostic.h"
#include "gomp-constants.h"
+
+/* gfc_omp_requires: requires which (effectively) apply to the whole TU, namely:
+ reverse_offload, unified_address, unified_shared_memory, which have to be
+ identical in all compilation units. Plus dynamic_allocators which is only
+ per compilation unit, but can be pushed to the whole TU. By contrast,
+ atomic_default_mem_order only applies to the compilation unit and can be
+ processed by the FE. */
+
+int gfc_omp_requires = 0;
+
/* Match an end of OpenMP directive. End of OpenMP directive is optional
whitespace, followed by '\n' or comment '!'. */
@@ -3424,6 +3434,241 @@ gfc_match_omp_parallel_workshare (void)
return match_omp (EXEC_OMP_PARALLEL_WORKSHARE, OMP_PARALLEL_CLAUSES);
}
+void
+gfc_check_omp_requires (gfc_namespace *ns)
+{
+ if (ns->omp_target_seen
+ && (ns->omp_requires & OMP_REQ_TARGET_MASK)
+ != (gfc_omp_requires & OMP_REQ_TARGET_MASK))
+ {
+ gcc_assert (ns->proc_name);
+ if ((gfc_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 ((gfc_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 ((gfc_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)
+{
+ /* All clauses are added both to the TU, i.e. gfc_omp_requires, and to the
+ current program-unit namespace, except that dynamic_allocators is only
+ needed at TU level and atomic_default_memory_order for program unit. */
+ 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 (gfc_omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST)
+ other = "seq_cst";
+ else if (gfc_omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL)
+ other = "acq_rel";
+ else if (gfc_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)
+ {
+ gfc_omp_requires |= clause;
+ 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;
+ }
+ /* TODO: Middle-end support exists, but not yet FE support. */
+ if (requires_clause == OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL)
+ gfc_error_now ("Sorry, only RELAXED and SEQ_CST are currently "
+ "supported for the ATOMIC_DEFAULT_MEM_ORDER clause "
+ "at %L on the REQUIRES directive", &old_loc);
+ }
+ 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 +3990,23 @@ 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_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;
+ default:
+ gcc_unreachable ();
+ }
+ }
new_st.ext.omp_atomic = op;
return MATCH_YES;
}
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 96fd4aaee5e..c298659f716 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -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,13 @@ done:
}
while (changed);
- /* Fixup for external procedures. */
+ /* Fixup for external procedures and resolve 'omp requires'. */
for (gfc_current_ns = gfc_global_ns_list; gfc_current_ns;
gfc_current_ns = gfc_current_ns->sibling)
- gfc_check_externals (gfc_current_ns);
+ {
+ gfc_check_externals (gfc_current_ns);
+ gfc_check_omp_requires (gfc_current_ns);
+ }
/* Do the parse tree dump. */
gfc_current_ns = flag_dump_fortran_original ? gfc_global_ns_list : NULL;
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-1.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-1.f90
new file mode 100644
index 00000000000..b115a654e71
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-1.f90
@@ -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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-2.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-2.f90
new file mode 100644
index 00000000000..c1184ff92c7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-2.f90
@@ -0,0 +1,15 @@
+!$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 "only RELAXED and SEQ_CST are currently supported" }
+! { dg-prune-output "not yet supported" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-3.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-3.f90
new file mode 100644
index 00000000000..4429aab2ee6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-3.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-4.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-4.f90
new file mode 100644
index 00000000000..e0eb4dbc603
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-4.f90
@@ -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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-5.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-5.f90
new file mode 100644
index 00000000000..199cb7f8163
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-5.f90
@@ -0,0 +1,17 @@
+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 "only RELAXED and SEQ_CST are currently supported" }
+! { dg-prune-output "not yet supported" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-6.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-6.f90
new file mode 100644
index 00000000000..f1237ab154f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-6.f90
@@ -0,0 +1,17 @@
+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 "only RELAXED and SEQ_CST are currently supported" }
+! { dg-prune-output "not yet supported" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-7.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-7.f90
new file mode 100644
index 00000000000..3d75b89e00b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-7.f90
@@ -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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-8.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-8.f90
new file mode 100644
index 00000000000..3c32ae9860e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-8.f90
@@ -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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-9.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-9.f90
new file mode 100644
index 00000000000..00c3ef1084c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-9.f90
@@ -0,0 +1,59 @@
+! { 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
+
+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
+
+! { 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" } }
^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: [Patch] OpenMP: Add 'omp requires' to Fortran (mostly parsing)
2020-07-28 11:05 ` Tobias Burnus
@ 2020-07-28 15:12 ` Tobias Burnus
2020-07-29 8:10 ` Tobias Burnus
0 siblings, 1 reply; 6+ messages in thread
From: Tobias Burnus @ 2020-07-28 15:12 UTC (permalink / raw)
To: gcc-patches, fortran, Jakub Jelinek
[-- Attachment #1: Type: text/plain, Size: 636 bytes --]
I just realized that supporting 'acq_rel' is simple; while
'omp atomic' parsing needs to be updated quite a bit for the
OpenMP 5 changes, just adding ACQ_REL support for 'requires'
is trivial.
Hence, I updated the requires-9.c testcase for 'acq_rel',
adjusted trans-openmp.c and did some openmp.c adjustments.
Thus: New version with this trivial change and being
able to tick-off the 'atomic_default_mem_order' clause :-)
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-requires-v3.diff --]
[-- Type: text/x-patch, Size: 33357 bytes --]
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): New global var.
(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_omp_requires): New global var.
(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.
gcc/fortran/gfortran.h | 32 +++-
gcc/fortran/match.h | 1 +
gcc/fortran/module.c | 73 +++++++-
gcc/fortran/openmp.c | 260 ++++++++++++++++++++++++++
gcc/fortran/parse.c | 48 ++++-
gcc/fortran/trans-openmp.c | 10 +-
gcc/testsuite/gfortran.dg/gomp/requires-1.f90 | 13 ++
gcc/testsuite/gfortran.dg/gomp/requires-2.f90 | 14 ++
gcc/testsuite/gfortran.dg/gomp/requires-3.f90 | 4 +
gcc/testsuite/gfortran.dg/gomp/requires-4.f90 | 36 ++++
gcc/testsuite/gfortran.dg/gomp/requires-5.f90 | 16 ++
gcc/testsuite/gfortran.dg/gomp/requires-6.f90 | 16 ++
gcc/testsuite/gfortran.dg/gomp/requires-7.f90 | 41 ++++
gcc/testsuite/gfortran.dg/gomp/requires-8.f90 | 22 +++
gcc/testsuite/gfortran.dg/gomp/requires-9.f90 | 85 +++++++++
15 files changed, 661 insertions(+), 10 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 5fa86aa4e30..948ccbcc2a3 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -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
@@ -3269,7 +3292,12 @@ void gfc_free_case_list (gfc_case *);
gfc_expr *gfc_get_parentheses (gfc_expr *);
/* openmp.c */
+extern int gfc_omp_requires;
+
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 *);
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 *);
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index b3fb7033891..7bf70d77016 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -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);
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index eccf92bf658..684bb7578a3 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -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_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;
}
}
}
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 4a0466f968d..3feb7a6aea7 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -28,6 +28,16 @@ along with GCC; see the file COPYING3. If not see
#include "diagnostic.h"
#include "gomp-constants.h"
+
+/* gfc_omp_requires: requires which (effectively) apply to the whole TU, namely:
+ reverse_offload, unified_address, unified_shared_memory, which have to be
+ identical in all compilation units. Plus dynamic_allocators which is only
+ per compilation unit, but can be pushed to the whole TU. By contrast,
+ atomic_default_mem_order only applies to the compilation unit and can be
+ processed by the FE. */
+
+int gfc_omp_requires = 0;
+
/* Match an end of OpenMP directive. End of OpenMP directive is optional
whitespace, followed by '\n' or comment '!'. */
@@ -3424,6 +3434,236 @@ gfc_match_omp_parallel_workshare (void)
return match_omp (EXEC_OMP_PARALLEL_WORKSHARE, OMP_PARALLEL_CLAUSES);
}
+void
+gfc_check_omp_requires (gfc_namespace *ns)
+{
+ if (ns->omp_target_seen
+ && (ns->omp_requires & OMP_REQ_TARGET_MASK)
+ != (gfc_omp_requires & OMP_REQ_TARGET_MASK))
+ {
+ gcc_assert (ns->proc_name);
+ if ((gfc_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 ((gfc_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 ((gfc_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)
+{
+ /* All clauses are added both to the TU, i.e. gfc_omp_requires, and to the
+ current program-unit namespace, except that dynamic_allocators is only
+ needed at TU level and atomic_default_memory_order for program unit. */
+ 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 (gfc_omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST)
+ other = "seq_cst";
+ else if (gfc_omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL)
+ other = "acq_rel";
+ else if (gfc_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)
+ {
+ gfc_omp_requires |= clause;
+ 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 +3985,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
+ {
+ 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;
}
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 96fd4aaee5e..c298659f716 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -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,13 @@ done:
}
while (changed);
- /* Fixup for external procedures. */
+ /* Fixup for external procedures and resolve 'omp requires'. */
for (gfc_current_ns = gfc_global_ns_list; gfc_current_ns;
gfc_current_ns = gfc_current_ns->sibling)
- gfc_check_externals (gfc_current_ns);
+ {
+ gfc_check_externals (gfc_current_ns);
+ gfc_check_omp_requires (gfc_current_ns);
+ }
/* Do the parse tree dump. */
gfc_current_ns = flag_dump_fortran_original ? gfc_global_ns_list : NULL;
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index d12d7fbddac..f6a39edf121 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -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);
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-1.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-1.f90
new file mode 100644
index 00000000000..b115a654e71
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-1.f90
@@ -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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-2.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-2.f90
new file mode 100644
index 00000000000..7b63d4a8b3b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-2.f90
@@ -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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-3.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-3.f90
new file mode 100644
index 00000000000..4429aab2ee6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-3.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-4.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-4.f90
new file mode 100644
index 00000000000..e0eb4dbc603
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-4.f90
@@ -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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-5.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-5.f90
new file mode 100644
index 00000000000..ade2a3613c6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-5.f90
@@ -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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-6.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-6.f90
new file mode 100644
index 00000000000..cabd3d94a90
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-6.f90
@@ -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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-7.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-7.f90
new file mode 100644
index 00000000000..3d75b89e00b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-7.f90
@@ -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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-8.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-8.f90
new file mode 100644
index 00000000000..3c32ae9860e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-8.f90
@@ -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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-9.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-9.f90
new file mode 100644
index 00000000000..a2b0f50ae73
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-9.f90
@@ -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" } }
^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: [Patch] OpenMP: Add 'omp requires' to Fortran (mostly parsing)
2020-07-28 15:12 ` Tobias Burnus
@ 2020-07-29 8:10 ` Tobias Burnus
2020-07-29 8:23 ` Jakub Jelinek
0 siblings, 1 reply; 6+ messages in thread
From: Tobias Burnus @ 2020-07-29 8:10 UTC (permalink / raw)
To: gcc-patches, fortran, Jakub Jelinek
[-- Attachment #1: Type: text/plain, Size: 1007 bytes --]
And another update; I removed the global variable, which
was only used for checking at the end – and
reconstruct its value in a local variable just before calling
gfc_check_omp_requires.
(Following a suggestion by Jakub and removing a kind-of left
over from the first implementation.)
Tobias
On 7/28/20 5:12 PM, Tobias Burnus wrote:
> I just realized that supporting 'acq_rel' is simple; while
> 'omp atomic' parsing needs to be updated quite a bit for the
> OpenMP 5 changes, just adding ACQ_REL support for 'requires'
> is trivial.
>
> Hence, I updated the requires-9.c testcase for 'acq_rel',
> adjusted trans-openmp.c and did some openmp.c adjustments.
>
> Thus: New version with this trivial change and being
> able to tick-off the 'atomic_default_mem_order' clause :-)
>
> 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-requires-v4.diff --]
[-- Type: text/x-patch, Size: 32755 bytes --]
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.
gcc/fortran/gfortran.h | 30 +++-
gcc/fortran/match.h | 1 +
gcc/fortran/module.c | 73 +++++++-
gcc/fortran/openmp.c | 245 ++++++++++++++++++++++++++
gcc/fortran/parse.c | 53 +++++-
gcc/fortran/trans-openmp.c | 10 +-
gcc/testsuite/gfortran.dg/gomp/requires-1.f90 | 13 ++
gcc/testsuite/gfortran.dg/gomp/requires-2.f90 | 14 ++
gcc/testsuite/gfortran.dg/gomp/requires-3.f90 | 4 +
gcc/testsuite/gfortran.dg/gomp/requires-4.f90 | 36 ++++
gcc/testsuite/gfortran.dg/gomp/requires-5.f90 | 16 ++
gcc/testsuite/gfortran.dg/gomp/requires-6.f90 | 16 ++
gcc/testsuite/gfortran.dg/gomp/requires-7.f90 | 41 +++++
gcc/testsuite/gfortran.dg/gomp/requires-8.f90 | 22 +++
gcc/testsuite/gfortran.dg/gomp/requires-9.f90 | 85 +++++++++
15 files changed, 649 insertions(+), 10 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 5fa86aa4e30..20cce5cf39b 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -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 *);
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index b3fb7033891..7bf70d77016 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -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);
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index eccf92bf658..1745824c28b 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -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;
}
}
}
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 4a0466f968d..c172207f385 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -28,6 +28,7 @@ along with GCC; see the file COPYING3. If not see
#include "diagnostic.h"
#include "gomp-constants.h"
+
/* Match an end of OpenMP directive. End of OpenMP directive is optional
whitespace, followed by '\n' or comment '!'. */
@@ -3424,6 +3425,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 +3970,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
+ {
+ 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;
}
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 96fd4aaee5e..d4d832ca00a 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -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)
+ {
+ 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_externals (gfc_current_ns);
+ 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;
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index d12d7fbddac..f6a39edf121 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -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);
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-1.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-1.f90
new file mode 100644
index 00000000000..b115a654e71
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-1.f90
@@ -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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-2.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-2.f90
new file mode 100644
index 00000000000..7b63d4a8b3b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-2.f90
@@ -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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-3.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-3.f90
new file mode 100644
index 00000000000..4429aab2ee6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-3.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-4.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-4.f90
new file mode 100644
index 00000000000..e0eb4dbc603
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-4.f90
@@ -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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-5.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-5.f90
new file mode 100644
index 00000000000..ade2a3613c6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-5.f90
@@ -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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-6.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-6.f90
new file mode 100644
index 00000000000..cabd3d94a90
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-6.f90
@@ -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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-7.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-7.f90
new file mode 100644
index 00000000000..3d75b89e00b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-7.f90
@@ -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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-8.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-8.f90
new file mode 100644
index 00000000000..3c32ae9860e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-8.f90
@@ -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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-9.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-9.f90
new file mode 100644
index 00000000000..a2b0f50ae73
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-9.f90
@@ -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" } }
^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: [Patch] OpenMP: Add 'omp requires' to Fortran (mostly parsing)
2020-07-29 8:10 ` Tobias Burnus
@ 2020-07-29 8:23 ` Jakub Jelinek
2020-07-29 10:32 ` Tobias Burnus
0 siblings, 1 reply; 6+ messages in thread
From: Jakub Jelinek @ 2020-07-29 8:23 UTC (permalink / raw)
To: Tobias Burnus; +Cc: gcc-patches, fortran
On Wed, Jul 29, 2020 at 10:10:35AM +0200, Tobias Burnus wrote:
> + case AB_OMP_REQ_REVERSE_OFFLOAD:
> + gfc_omp_requires_add_clause (OMP_REQ_REVERSE_OFFLOAD,
> + "reverse_offload",
> + &gfc_current_locus,
> + module_name);
Even visually something is wrong with the indentation here and in a few
others, where I'd expect all the arguments to be in the same column (even
with the > + before it, but they are not. E.g. above I think the
gfc_omp_... is indented by 3 instead of 2 columns from case, and "rev... and
&gfc... match that, but module_name is probably correct.
> + break;
> + case AB_OMP_REQ_UNIFIED_ADDRESS:
> + gfc_omp_requires_add_clause (OMP_REQ_UNIFIED_ADDRESS,
> + "unified_address",
> + &gfc_current_locus,
And e.g. here the &gfc... is off.
> --- a/gcc/fortran/openmp.c
> +++ b/gcc/fortran/openmp.c
> @@ -28,6 +28,7 @@ along with GCC; see the file COPYING3. If not see
> #include "diagnostic.h"
> #include "gomp-constants.h"
>
> +
Unnecessary.
> /* Match an end of OpenMP directive. End of OpenMP directive is optional
> whitespace, followed by '\n' or comment '!'. */
>
> @@ -3745,6 +3970,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
I wonder if this shouldn't be else if (omp_p), I'd think
OpenACC atomics shouldn't be affected by OpenMP requires directive.
> for (gfc_current_ns = gfc_global_ns_list; gfc_current_ns;
> gfc_current_ns = gfc_current_ns->sibling)
> - gfc_check_externals (gfc_current_ns);
> + gfc_check_omp_requires (gfc_current_ns, omp_requires);
Again indentation looks weird.
Otherwise LGTM.
Jakub
^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: [Patch] OpenMP: Add 'omp requires' to Fortran (mostly parsing)
2020-07-29 8:23 ` Jakub Jelinek
@ 2020-07-29 10:32 ` Tobias Burnus
0 siblings, 0 replies; 6+ messages in thread
From: Tobias Burnus @ 2020-07-29 10:32 UTC (permalink / raw)
To: Jakub Jelinek; +Cc: gcc-patches, fortran
Committed as r11-2395, https://gcc.gnu.org/g:269322ece17202632bc354e9c510e4a5bd6ad84b
with review comments applied plus a follow-up commit for an indentation issue I missed:
r11-2399, https://gcc.gnu.org/g:6de5600a8bd1ef0ad3d57670efdcc68bb3484276
Tobias
On 7/29/20 10:23 AM, Jakub Jelinek wrote:
> On Wed, Jul 29, 2020 at 10:10:35AM +0200, Tobias Burnus wrote:
>> + case AB_OMP_REQ_REVERSE_OFFLOAD:
>> + gfc_omp_requires_add_clause (OMP_REQ_REVERSE_OFFLOAD,
>> + "reverse_offload",
>> + &gfc_current_locus,
>> + module_name);
> Even visually something is wrong with the indentation here and in a few
> others, where I'd expect all the arguments to be in the same column (even
> with the > + before it, but they are not. E.g. above I think the
> gfc_omp_... is indented by 3 instead of 2 columns from case, and "rev... and
> &gfc... match that, but module_name is probably correct.
>
>> + break;
>> + case AB_OMP_REQ_UNIFIED_ADDRESS:
>> + gfc_omp_requires_add_clause (OMP_REQ_UNIFIED_ADDRESS,
>> + "unified_address",
>> + &gfc_current_locus,
> And e.g. here the &gfc... is off.
>> --- a/gcc/fortran/openmp.c
>> +++ b/gcc/fortran/openmp.c
>> @@ -28,6 +28,7 @@ along with GCC; see the file COPYING3. If not see
>> #include "diagnostic.h"
>> #include "gomp-constants.h"
>>
>> +
> Unnecessary.
>> /* Match an end of OpenMP directive. End of OpenMP directive is optional
>> whitespace, followed by '\n' or comment '!'. */
>>
>> @@ -3745,6 +3970,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
> I wonder if this shouldn't be else if (omp_p), I'd think
> OpenACC atomics shouldn't be affected by OpenMP requires directive.
>
>> for (gfc_current_ns = gfc_global_ns_list; gfc_current_ns;
>> gfc_current_ns = gfc_current_ns->sibling)
>> - gfc_check_externals (gfc_current_ns);
>> + gfc_check_omp_requires (gfc_current_ns, omp_requires);
> Again indentation looks weird.
>
> Otherwise LGTM.
>
> Jakub
>
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter
^ permalink raw reply [flat|nested] 6+ messages in thread
end of thread, other threads:[~2020-07-29 10:32 UTC | newest]
Thread overview: 6+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-07-24 9:00 [Patch] OpenMP: Add 'omp requires' to Fortran (mostly parsing) Tobias Burnus
2020-07-28 11:05 ` Tobias Burnus
2020-07-28 15:12 ` Tobias Burnus
2020-07-29 8:10 ` Tobias Burnus
2020-07-29 8:23 ` Jakub Jelinek
2020-07-29 10:32 ` Tobias Burnus
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).