* [Patch] Fortran: Add 'device_type' clause to OpenMP's declare target
@ 2020-08-07 15:03 Tobias Burnus
2020-08-18 7:11 ` *PING* / " Tobias Burnus
2020-08-18 17:33 ` Andre Vehreschild
0 siblings, 2 replies; 7+ messages in thread
From: Tobias Burnus @ 2020-08-07 15:03 UTC (permalink / raw)
To: gcc-patches, fortran
[-- Attachment #1: Type: text/plain, Size: 685 bytes --]
This patch adds the device_type(any|nohost|host)
clause for 'omp declare target' to Fortran.
In OpenMP 5.0, it has no effect on variables but
only on procedures – in TR8 (and later), it also
affects variables.
This patch adds this clause to either – except that
the middle end does not seem to like 'target link'
with that clause – for normal variables, common
blocks are accepted. (In line with OpenMP 5, the
middle end ignores the clause for variables.)
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-devtype.diff --]
[-- Type: text/x-patch, Size: 18073 bytes --]
Fortran: Add 'device_type' clause to OpenMP's declare target
gcc/fortran/ChangeLog:
* gfortran.h (enum gfc_omp_device_type): New.
(symbol_attribute, gfc_omp_clauses, gfc_common_head): Use it.
* module.c (enum ab_attribute): Add AB_OMP_DEVICE_TYPE_HOST,
AB_OMP_DEVICE_TYPE_NOHOST and AB_OMP_DEVICE_TYPE_ANY.
(attr_bits, mio_symbol_attribute): Handle it.
(load_commons, write_common_0): Handle omp_device_type flag.
* openmp.c (enum omp_mask1): Add OMP_CLAUSE_DEVICE_TYPE
(OMP_DECLARE_TARGET_CLAUSES): Likewise.
(gfc_match_omp_clauses): Match 'device_type'.
(gfc_match_omp_declare_target): Handle it.
* trans-common.c (build_common_decl): Write device-type clause.
* trans-decl.c (add_attributes_to_decl): Likewise.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/declare-target-4.f90: New test.
* gfortran.dg/gomp/declare-target-5.f90: New test.
gcc/fortran/gfortran.h | 10 +++
gcc/fortran/module.c | 33 ++++++++-
gcc/fortran/openmp.c | 50 ++++++++++++-
gcc/fortran/trans-common.c | 25 ++++++-
gcc/fortran/trans-decl.c | 22 +++++-
.../gfortran.dg/gomp/declare-target-4.f90 | 81 ++++++++++++++++++++++
.../gfortran.dg/gomp/declare-target-5.f90 | 33 +++++++++
7 files changed, 247 insertions(+), 7 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 48b2ab14fdb..846816039e5 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -753,6 +753,13 @@ CInteropKind_t;
that the list is initialized. */
extern CInteropKind_t c_interop_kinds_table[];
+enum gfc_omp_device_type
+{
+ OMP_DEVICE_TYPE_UNSET,
+ OMP_DEVICE_TYPE_HOST,
+ OMP_DEVICE_TYPE_NOHOST,
+ OMP_DEVICE_TYPE_ANY
+};
/* Structure and list of supported extension attributes. */
typedef enum
@@ -919,6 +926,7 @@ typedef struct
/* Mentioned in OMP DECLARE TARGET. */
unsigned omp_declare_target:1;
unsigned omp_declare_target_link:1;
+ ENUM_BITFIELD (gfc_omp_device_type) omp_device_type:2;
/* Mentioned in OACC DECLARE. */
unsigned oacc_declare_create:1;
@@ -1359,6 +1367,7 @@ typedef struct gfc_omp_clauses
struct gfc_expr *num_threads;
gfc_omp_namelist *lists[OMP_LIST_NUM];
enum gfc_omp_sched_kind sched_kind;
+ enum gfc_omp_device_type device_type;
struct gfc_expr *chunk_size;
enum gfc_omp_default_sharing default_sharing;
int collapse, orderedc;
@@ -1698,6 +1707,7 @@ typedef struct gfc_common_head
char use_assoc, saved, threadprivate;
unsigned char omp_declare_target : 1;
unsigned char omp_declare_target_link : 1;
+ ENUM_BITFIELD (gfc_omp_device_type) omp_device_type:2;
/* Provide sufficient space to hold "symbol.symbol.eq.1234567890". */
char name[2*GFC_MAX_SYMBOL_LEN + 1 + 14 + 1];
struct gfc_symbol *head;
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 5114d5534b8..e122b1367bb 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -2051,7 +2051,8 @@ enum ab_attribute
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
+ AB_OMP_REQ_MEM_ORDER_RELAXED, AB_OMP_DEVICE_TYPE_NOHOST,
+ AB_OMP_DEVICE_TYPE_HOST, AB_OMP_DEVICE_TYPE_ANY
};
static const mstring attr_bits[] =
@@ -2132,6 +2133,9 @@ static const mstring attr_bits[] =
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 ("OMP_DEVICE_TYPE_HOST", AB_OMP_DEVICE_TYPE_HOST),
+ minit ("OMP_DEVICE_TYPE_NOHOST", AB_OMP_DEVICE_TYPE_NOHOST),
+ minit ("OMP_DEVICE_TYPE_ANYHOST", AB_OMP_DEVICE_TYPE_ANY),
minit (NULL, -1)
};
@@ -2397,6 +2401,22 @@ mio_symbol_attribute (symbol_attribute *attr)
== OMP_REQ_ATOMIC_MEM_ORDER_RELAXED)
MIO_NAME (ab_attribute) (AB_OMP_REQ_MEM_ORDER_RELAXED, attr_bits);
}
+ switch (attr->omp_device_type)
+ {
+ case OMP_DEVICE_TYPE_UNSET:
+ break;
+ case OMP_DEVICE_TYPE_HOST:
+ MIO_NAME (ab_attribute) (AB_OMP_DEVICE_TYPE_NOHOST, attr_bits);
+ break;
+ case OMP_DEVICE_TYPE_NOHOST:
+ MIO_NAME (ab_attribute) (AB_OMP_DEVICE_TYPE_NOHOST, attr_bits);
+ break;
+ case OMP_DEVICE_TYPE_ANY:
+ MIO_NAME (ab_attribute) (AB_OMP_DEVICE_TYPE_ANY, attr_bits);
+ break;
+ default:
+ gcc_unreachable ();
+ }
mio_rparen ();
}
else
@@ -2661,6 +2681,15 @@ mio_symbol_attribute (symbol_attribute *attr)
"relaxed", &gfc_current_locus,
module_name);
break;
+ case AB_OMP_DEVICE_TYPE_HOST:
+ attr->omp_device_type = OMP_DEVICE_TYPE_HOST;
+ break;
+ case AB_OMP_DEVICE_TYPE_NOHOST:
+ attr->omp_device_type = OMP_DEVICE_TYPE_NOHOST;
+ break;
+ case AB_OMP_DEVICE_TYPE_ANY:
+ attr->omp_device_type = OMP_DEVICE_TYPE_ANY;
+ break;
}
}
}
@@ -4849,6 +4878,7 @@ load_commons (void)
p->saved = 1;
if (flags & 2)
p->threadprivate = 1;
+ p->omp_device_type = (gfc_omp_device_type) ((flags >> 2) & 3);
p->use_assoc = 1;
/* Get whether this was a bind(c) common or not. */
@@ -5713,6 +5743,7 @@ write_common_0 (gfc_symtree *st, bool this_module)
flags = p->saved ? 1 : 0;
if (p->threadprivate)
flags |= 2;
+ flags |= p->omp_device_type << 2;
mio_integer (&flags);
/* Write out whether the common block is bind(c) or not. */
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index f402febc211..b62fa479e39 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -752,7 +752,7 @@ cleanup:
return MATCH_ERROR;
}
-/* OpenMP 4.5 clauses. */
+/* OpenMP clauses. */
enum omp_mask1
{
OMP_CLAUSE_PRIVATE,
@@ -799,7 +799,8 @@ enum omp_mask1
OMP_CLAUSE_SIMD,
OMP_CLAUSE_THREADS,
OMP_CLAUSE_USE_DEVICE_PTR,
- OMP_CLAUSE_USE_DEVICE_ADDR, /* Actually, OpenMP 5.0. */
+ OMP_CLAUSE_USE_DEVICE_ADDR, /* OpenMP 5.0. */
+ OMP_CLAUSE_DEVICE_TYPE, /* OpenMP 5.0. */
OMP_CLAUSE_NOWAIT,
/* This must come last. */
OMP_MASK1_LAST
@@ -1213,6 +1214,24 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
OMP_MAP_FORCE_DEVICEPTR, false,
allow_derived))
continue;
+ if ((mask & OMP_CLAUSE_DEVICE_TYPE)
+ && gfc_match ("device_type ( ") == MATCH_YES)
+ {
+ if (gfc_match ("host") == MATCH_YES)
+ c->device_type = OMP_DEVICE_TYPE_HOST;
+ else if (gfc_match ("nohost") == MATCH_YES)
+ c->device_type = OMP_DEVICE_TYPE_NOHOST;
+ else if (gfc_match ("any") == MATCH_YES)
+ c->device_type = OMP_DEVICE_TYPE_ANY;
+ else
+ {
+ gfc_error ("Expected HOST, NOHOST or ANY at %C");
+ break;
+ }
+ if (gfc_match (" )") != MATCH_YES)
+ break;
+ continue;
+ }
if ((mask & OMP_CLAUSE_DEVICE_RESIDENT)
&& gfc_match_omp_variable_list
("device_resident (",
@@ -2632,7 +2651,7 @@ cleanup:
#define OMP_ORDERED_CLAUSES \
(omp_mask (OMP_CLAUSE_THREADS) | OMP_CLAUSE_SIMD)
#define OMP_DECLARE_TARGET_CLAUSES \
- (omp_mask (OMP_CLAUSE_TO) | OMP_CLAUSE_LINK)
+ (omp_mask (OMP_CLAUSE_TO) | OMP_CLAUSE_LINK | OMP_CLAUSE_DEVICE_TYPE)
static match
@@ -3269,6 +3288,15 @@ gfc_match_omp_declare_target (void)
gfc_add_omp_declare_target_link (&n->sym->attr, n->sym->name,
&n->sym->declared_at);
}
+ if (c->device_type != OMP_DEVICE_TYPE_UNSET)
+ {
+ if (n->sym->attr.omp_device_type != OMP_DEVICE_TYPE_UNSET
+ && n->sym->attr.omp_device_type != c->device_type)
+ gfc_error_now ("List item %qs at %L set in previous OMP DECLARE "
+ "TARGET directive to a different DEVICE_TYPE",
+ n->sym->name, &n->where);
+ n->sym->attr.omp_device_type = c->device_type;
+ }
n->sym->mark = 1;
}
else if (n->u.common->omp_declare_target
@@ -3291,6 +3319,13 @@ gfc_match_omp_declare_target (void)
{
n->u.common->omp_declare_target = 1;
n->u.common->omp_declare_target_link = (list == OMP_LIST_LINK);
+ if (n->u.common->omp_device_type != OMP_DEVICE_TYPE_UNSET
+ && n->u.common->omp_device_type != c->device_type)
+ gfc_error_now ("COMMON at %L set in previous OMP DECLARE "
+ "TARGET directive to a different DEVICE_TYPE",
+ &n->where);
+ n->u.common->omp_device_type = c->device_type;
+
for (s = n->u.common->head; s; s = s->common_next)
{
s->mark = 1;
@@ -3301,8 +3336,17 @@ gfc_match_omp_declare_target (void)
gfc_add_omp_declare_target_link (&s->attr, s->name,
&s->declared_at);
}
+ if (s->attr.omp_device_type != OMP_DEVICE_TYPE_UNSET
+ && s->attr.omp_device_type != c->device_type)
+ gfc_error_now ("List item %qs at %L set in previous OMP DECLARE"
+ " TARGET directive to a different DEVICE_TYPE",
+ s->name, &n->where);
+ s->attr.omp_device_type = c->device_type;
}
}
+ if (c->device_type && !c->lists[OMP_LIST_TO] && !c->lists[OMP_LIST_LINK])
+ gfc_warning_now (0, "OMP DECLARE TARGET directive at %L with only "
+ "DEVICE_TYPE clause is ignored", &old_loc);
gfc_buffer_error (true);
diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index c6383fc2352..1be5e51b67d 100644
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -426,6 +426,8 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init)
/* If there is no backend_decl for the common block, build it. */
if (decl == NULL_TREE)
{
+ tree clauses = NULL_TREE;
+
if (com->is_bind_c == 1 && com->binding_label)
decl = build_decl (input_location, VAR_DECL, identifier, union_type);
else
@@ -460,14 +462,33 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init)
if (com->threadprivate)
set_decl_tls_model (decl, decl_default_tls_model (decl));
+ if (com->omp_device_type != OMP_DEVICE_TYPE_UNSET)
+ {
+ tree c = build_omp_clause (UNKNOWN_LOCATION, OMP_CLAUSE_DEVICE_TYPE);
+ switch (com->omp_device_type)
+ {
+ case OMP_DEVICE_TYPE_HOST:
+ OMP_CLAUSE_DEVICE_TYPE_KIND (c) = OMP_CLAUSE_DEVICE_TYPE_HOST;
+ break;
+ case OMP_DEVICE_TYPE_NOHOST:
+ OMP_CLAUSE_DEVICE_TYPE_KIND (c) = OMP_CLAUSE_DEVICE_TYPE_NOHOST;
+ break;
+ case OMP_DEVICE_TYPE_ANY:
+ OMP_CLAUSE_DEVICE_TYPE_KIND (c) = OMP_CLAUSE_DEVICE_TYPE_ANY;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+ clauses = c;
+ }
if (com->omp_declare_target_link)
DECL_ATTRIBUTES (decl)
= tree_cons (get_identifier ("omp declare target link"),
- NULL_TREE, DECL_ATTRIBUTES (decl));
+ clauses, DECL_ATTRIBUTES (decl));
else if (com->omp_declare_target)
DECL_ATTRIBUTES (decl)
= tree_cons (get_identifier ("omp declare target"),
- NULL_TREE, DECL_ATTRIBUTES (decl));
+ clauses, DECL_ATTRIBUTES (decl));
/* Place the back end declaration for this common block in
GLOBAL_BINDING_LEVEL. */
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 45a739ac860..92242771dde 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1465,11 +1465,31 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list)
tree dims = oacc_build_routine_dims (clauses);
list = oacc_replace_fn_attrib_attr (list, dims);
}
+ if (sym_attr.omp_device_type != OMP_DEVICE_TYPE_UNSET)
+ {
+ tree c = build_omp_clause (UNKNOWN_LOCATION, OMP_CLAUSE_DEVICE_TYPE);
+ switch (sym_attr.omp_device_type)
+ {
+ case OMP_DEVICE_TYPE_HOST:
+ OMP_CLAUSE_DEVICE_TYPE_KIND (c) = OMP_CLAUSE_DEVICE_TYPE_HOST;
+ break;
+ case OMP_DEVICE_TYPE_NOHOST:
+ OMP_CLAUSE_DEVICE_TYPE_KIND (c) = OMP_CLAUSE_DEVICE_TYPE_NOHOST;
+ break;
+ case OMP_DEVICE_TYPE_ANY:
+ OMP_CLAUSE_DEVICE_TYPE_KIND (c) = OMP_CLAUSE_DEVICE_TYPE_ANY;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+ OMP_CLAUSE_CHAIN (c) = clauses;
+ clauses = c;
+ }
if (sym_attr.omp_declare_target_link
|| sym_attr.oacc_declare_link)
list = tree_cons (get_identifier ("omp declare target link"),
- NULL_TREE, list);
+ clauses, list);
else if (sym_attr.omp_declare_target
|| sym_attr.oacc_declare_create
|| sym_attr.oacc_declare_copyin
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90
new file mode 100644
index 00000000000..6e3f91eefca
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90
@@ -0,0 +1,81 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+subroutine f1
+ !$omp declare target device_type (any) ! { dg-warning "OMP DECLARE TARGET directive at .1. with only DEVICE_TYPE clause is ignored" }
+end subroutine
+
+subroutine f2
+ !$omp declare target to (f2) device_type (any)
+end subroutine
+
+subroutine f3
+ !$omp declare target device_type (any) to (f3)
+end subroutine
+
+subroutine f4
+ !$omp declare target device_type (host) to (f4)
+end subroutine
+
+subroutine f5
+ !$omp declare target device_type (nohost) to (f5)
+end subroutine
+
+module mymod
+ ! device_type is ignored for variables in OpenMP 5.0
+ ! but TR8 and later apply those rules to variables as well
+ implicit none
+ integer :: a, b(4), c, d
+ integer :: e, f, g
+ integer :: m, n, o, p, q, r, s, t, u, v, w, x
+ common /block1/ m, n
+ common /block2/ o, p
+ common /block3/ q, r
+ common /block4/ s, t
+ common /block5/ u, v
+ common /block6/ w, x
+
+ !$omp declare target to(a) device_type(nohost)
+ !$omp declare target to(b) device_type(host)
+ !$omp declare target to(c) device_type(any)
+ ! Fails in ME with "Error: wrong number of arguments specified for 'omp declare target link' attribute"
+ ! !$omp declare target link(e) device_type(nohost)
+ ! !$omp declare target link(f) device_type(host)
+ ! !$omp declare target link(g) device_type(any)
+
+ !$omp declare target to(/block1/) device_type(nohost)
+ !$omp declare target to(/block2/) device_type(host)
+ !$omp declare target to(/block3/) device_type(any)
+ !$omp declare target link(/block4/) device_type(nohost)
+ !$omp declare target link(/block5/) device_type(host)
+ !$omp declare target link(/block6/) device_type(any)
+contains
+ subroutine s1
+ !$omp declare target to (s1) device_type (any)
+ end
+ subroutine s2
+ !$omp declare target to (s2) device_type (nohost)
+ end
+ subroutine s3
+ !$omp declare target to (s3) device_type (host)
+ end
+end module
+
+module m2
+ use mymod
+ implicit none
+ public
+ private :: s1, s2, s3, a, b, c, d, e, f, g
+ public :: m, n, o, p, q, r, s, t, u, v, w, x
+end module m2
+
+! { dg-final { scan-tree-dump-times "omp declare target" 7 "original" } }
+! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(" 7 "original" } }
+! { dg-final { scan-tree-dump-times "\[\n\r]\[\n\r]f1" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(any\\)\\)\\)\\)\[\n\r]f2" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(any\\)\\)\\)\\)\[\n\r]f3" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(host\\)\\)\\)\\)\[\n\r]f4" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(nohost\\)\\)\\)\\)\[\n\r]f5" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(any\\)\\)\\)\\)\[\n\r]s1" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(nohost\\)\\)\\)\\)\[\n\r]s2" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(host\\)\\)\\)\\)\[\n\r]s3" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-5.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-5.f90
new file mode 100644
index 00000000000..c2a7b7e0b0c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-5.f90
@@ -0,0 +1,33 @@
+subroutine foo()
+ !$omp declare target to(foo) device_type(bar) ! { dg-error "Expected HOST, NOHOST or ANY" }
+end
+
+subroutine bar()
+ !$omp declare target to(bar) device_type(nohost)
+ !$omp declare target to(bar) device_type(host) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+end
+
+module mymod
+ implicit none
+ integer :: a, b, c, d, e ,f
+ integer :: m, n, o, p, q, r
+ common /block1/ m, n
+ common /block2/ o, p
+ common /block3/ q, r
+ !$omp declare target to(a) device_type(nohost)
+ !$omp declare target to(b) device_type(any)
+ !$omp declare target to(c) device_type(host)
+ !$omp declare target link(d) device_type(nohost)
+ !$omp declare target link(e) device_type(any)
+ !$omp declare target link(f) device_type(host)
+
+ !$omp declare target to(c) device_type(host)
+ !$omp declare target link(d) device_type(nohost)
+
+ !$omp declare target to(a) device_type(any) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+ !$omp declare target to(b) device_type(host) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+ !$omp declare target to(c) device_type(nohost) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+ !$omp declare target link(d) device_type(host) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+ !$omp declare target link(e) device_type(nohost) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+ !$omp declare target link(f) device_type(any) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+end
^ permalink raw reply [flat|nested] 7+ messages in thread
* *PING* / Re: [Patch] Fortran: Add 'device_type' clause to OpenMP's declare target
2020-08-07 15:03 [Patch] Fortran: Add 'device_type' clause to OpenMP's declare target Tobias Burnus
@ 2020-08-18 7:11 ` Tobias Burnus
2020-08-18 17:33 ` Andre Vehreschild
1 sibling, 0 replies; 7+ messages in thread
From: Tobias Burnus @ 2020-08-18 7:11 UTC (permalink / raw)
To: gcc-patches, fortran
On 8/7/20 5:03 PM, Tobias Burnus wrote:
> This patch adds the device_type(any|nohost|host)
> clause for 'omp declare target' to Fortran.
>
> In OpenMP 5.0, it has no effect on variables but
> only on procedures – in TR8 (and later), it also
> affects variables.
>
> This patch adds this clause to either – except that
> the middle end does not seem to like 'target link'
> with that clause – for normal variables, common
> blocks are accepted. (In line with OpenMP 5, the
> middle end ignores the clause for variables.)
>
> 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
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [Patch] Fortran: Add 'device_type' clause to OpenMP's declare target
2020-08-07 15:03 [Patch] Fortran: Add 'device_type' clause to OpenMP's declare target Tobias Burnus
2020-08-18 7:11 ` *PING* / " Tobias Burnus
@ 2020-08-18 17:33 ` Andre Vehreschild
2020-08-19 12:51 ` Tobias Burnus
1 sibling, 1 reply; 7+ messages in thread
From: Andre Vehreschild @ 2020-08-18 17:33 UTC (permalink / raw)
To: Tobias Burnus; +Cc: gcc-patches, fortran
Hi Tobias,
I am not deep in OMP dev, i.e., not at all, but this does not make sense to me:
@@ -2397,6 +2401,22 @@ mio_symbol_attribute (symbol_attribute *attr)
== OMP_REQ_ATOMIC_MEM_ORDER_RELAXED)
MIO_NAME (ab_attribute) (AB_OMP_REQ_MEM_ORDER_RELAXED, attr_bits);
}
+ switch (attr->omp_device_type)
+ {
+ case OMP_DEVICE_TYPE_UNSET:
+ break;
+ case OMP_DEVICE_TYPE_HOST:
+ MIO_NAME (ab_attribute) (AB_OMP_DEVICE_TYPE_NOHOST, attr_bits);
^
Why also NOHOST here? If this intentional please comment.
+ break;
+ case OMP_DEVICE_TYPE_NOHOST:
+ MIO_NAME (ab_attribute) (AB_OMP_DEVICE_TYPE_NOHOST, attr_bits);
+ break;
<snipp>
diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index c6383fc2352..1be5e51b67d 100644
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -426,6 +426,8 @@ build_common_decl (gfc_common_head *com, tree union_type,
bool is_init) /* If there is no backend_decl for the common block, build it. */
if (decl == NULL_TREE)
{
+ tree clauses = NULL_TREE;
Would you mind using "omp_clauses" or the like here?
The reminder looks good to my omp-unexperienced eye.
Regards,
Andre
On Fri, 7 Aug 2020 17:03:34 +0200
Tobias Burnus <tobias@codesourcery.com> wrote:
> This patch adds the device_type(any|nohost|host)
> clause for 'omp declare target' to Fortran.
>
> In OpenMP 5.0, it has no effect on variables but
> only on procedures – in TR8 (and later), it also
> affects variables.
>
> This patch adds this clause to either – except that
> the middle end does not seem to like 'target link'
> with that clause – for normal variables, common
> blocks are accepted. (In line with OpenMP 5, the
> middle end ignores the clause for variables.)
>
> 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
--
Andre Vehreschild * Email: vehre ad gmx dot de
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [Patch] Fortran: Add 'device_type' clause to OpenMP's declare target
2020-08-18 17:33 ` Andre Vehreschild
@ 2020-08-19 12:51 ` Tobias Burnus
2020-08-20 9:51 ` Tobias Burnus
0 siblings, 1 reply; 7+ messages in thread
From: Tobias Burnus @ 2020-08-19 12:51 UTC (permalink / raw)
To: Andre Vehreschild, Tobias Burnus; +Cc: gcc-patches, fortran
Hi Andre,
thanks for the comments.
Am 18.08.20 um 19:33 schrieb Andre Vehreschild:
> + case OMP_DEVICE_TYPE_HOST:
> + MIO_NAME (ab_attribute) (AB_OMP_DEVICE_TYPE_NOHOST, attr_bits);
> Why also NOHOST here?
Copy and paste error. Well spotted. Thanks!
(I wonder why it didn't show up in the testcase;
probably because I generated the module in the same
translation unit, I'd guess.)
> @@ -426,6 +426,8 @@ build_common_decl (gfc_common_head *com, tree union_type,
> bool is_init) /* If there is no backend_decl for the common block, build it. */
> if (decl == NULL_TREE)
> {
> + tree clauses = NULL_TREE;
> Would you mind using "omp_clauses" or the like here?
I thought about this – but due to indentation, I think I
used 'clauses'. But looking again at the patch, this
must have been either 'c' or for some other patch as
"omp_clauses" should work as well.
I will later update the patch for the items.
Tobias
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [Patch] Fortran: Add 'device_type' clause to OpenMP's declare target
2020-08-19 12:51 ` Tobias Burnus
@ 2020-08-20 9:51 ` Tobias Burnus
2020-08-20 16:10 ` Andre Vehreschild
0 siblings, 1 reply; 7+ messages in thread
From: Tobias Burnus @ 2020-08-20 9:51 UTC (permalink / raw)
To: Andre Vehreschild, Jakub Jelinek; +Cc: Tobias Burnus, gcc-patches, fortran
[-- Attachment #1: Type: text/plain, Size: 715 bytes --]
Updated patch – taking Andre's suggestions into account +
extending the testcase, which now catches the previous (NO)HOST
module issue.
OK?
Tobias
On 8/19/20 2:51 PM, Tobias Burnus wrote:
> Am 18.08.20 um 19:33 schrieb Andre Vehreschild:
>> + case OMP_DEVICE_TYPE_HOST:
>> + MIO_NAME (ab_attribute) (AB_OMP_DEVICE_TYPE_NOHOST, attr_bits);
>> Why also NOHOST here?
> Copy and paste error.
...
>> + tree clauses = NULL_TREE;
>> Would you mind using "omp_clauses" or the like here?
Done now.
-----------------
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-devtype-v2.diff --]
[-- Type: text/x-patch, Size: 19615 bytes --]
Fortran: Add 'device_type' clause to OpenMP's declare target
gcc/fortran/ChangeLog:
* gfortran.h (enum gfc_omp_device_type): New.
(symbol_attribute, gfc_omp_clauses, gfc_common_head): Use it.
* module.c (enum ab_attribute): Add AB_OMP_DEVICE_TYPE_HOST,
AB_OMP_DEVICE_TYPE_NOHOST and AB_OMP_DEVICE_TYPE_ANY.
(attr_bits, mio_symbol_attribute): Handle it.
(load_commons, write_common_0): Handle omp_device_type flag.
* openmp.c (enum omp_mask1): Add OMP_CLAUSE_DEVICE_TYPE
(OMP_DECLARE_TARGET_CLAUSES): Likewise.
(gfc_match_omp_clauses): Match 'device_type'.
(gfc_match_omp_declare_target): Handle it.
* trans-common.c (build_common_decl): Write device-type clause.
* trans-decl.c (add_attributes_to_decl): Likewise.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/declare-target-4.f90: New test.
* gfortran.dg/gomp/declare-target-5.f90: New test.
gcc/fortran/gfortran.h | 10 +++
gcc/fortran/module.c | 33 ++++++++-
gcc/fortran/openmp.c | 50 ++++++++++++-
gcc/fortran/trans-common.c | 25 ++++++-
gcc/fortran/trans-decl.c | 22 +++++-
.../gfortran.dg/gomp/declare-target-4.f90 | 81 ++++++++++++++++++++++
.../gfortran.dg/gomp/declare-target-5.f90 | 63 +++++++++++++++++
7 files changed, 277 insertions(+), 7 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 559d3c6b8b8..d0cea838444 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -753,6 +753,13 @@ CInteropKind_t;
that the list is initialized. */
extern CInteropKind_t c_interop_kinds_table[];
+enum gfc_omp_device_type
+{
+ OMP_DEVICE_TYPE_UNSET,
+ OMP_DEVICE_TYPE_HOST,
+ OMP_DEVICE_TYPE_NOHOST,
+ OMP_DEVICE_TYPE_ANY
+};
/* Structure and list of supported extension attributes. */
typedef enum
@@ -919,6 +926,7 @@ typedef struct
/* Mentioned in OMP DECLARE TARGET. */
unsigned omp_declare_target:1;
unsigned omp_declare_target_link:1;
+ ENUM_BITFIELD (gfc_omp_device_type) omp_device_type:2;
/* Mentioned in OACC DECLARE. */
unsigned oacc_declare_create:1;
@@ -1360,6 +1368,7 @@ typedef struct gfc_omp_clauses
struct gfc_expr *num_threads;
gfc_omp_namelist *lists[OMP_LIST_NUM];
enum gfc_omp_sched_kind sched_kind;
+ enum gfc_omp_device_type device_type;
struct gfc_expr *chunk_size;
enum gfc_omp_default_sharing default_sharing;
int collapse, orderedc;
@@ -1699,6 +1708,7 @@ typedef struct gfc_common_head
char use_assoc, saved, threadprivate;
unsigned char omp_declare_target : 1;
unsigned char omp_declare_target_link : 1;
+ ENUM_BITFIELD (gfc_omp_device_type) omp_device_type:2;
/* Provide sufficient space to hold "symbol.symbol.eq.1234567890". */
char name[2*GFC_MAX_SYMBOL_LEN + 1 + 14 + 1];
struct gfc_symbol *head;
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 5114d5534b8..714fbd9c299 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -2051,7 +2051,8 @@ enum ab_attribute
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
+ AB_OMP_REQ_MEM_ORDER_RELAXED, AB_OMP_DEVICE_TYPE_NOHOST,
+ AB_OMP_DEVICE_TYPE_HOST, AB_OMP_DEVICE_TYPE_ANY
};
static const mstring attr_bits[] =
@@ -2132,6 +2133,9 @@ static const mstring attr_bits[] =
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 ("OMP_DEVICE_TYPE_HOST", AB_OMP_DEVICE_TYPE_HOST),
+ minit ("OMP_DEVICE_TYPE_NOHOST", AB_OMP_DEVICE_TYPE_NOHOST),
+ minit ("OMP_DEVICE_TYPE_ANYHOST", AB_OMP_DEVICE_TYPE_ANY),
minit (NULL, -1)
};
@@ -2397,6 +2401,22 @@ mio_symbol_attribute (symbol_attribute *attr)
== OMP_REQ_ATOMIC_MEM_ORDER_RELAXED)
MIO_NAME (ab_attribute) (AB_OMP_REQ_MEM_ORDER_RELAXED, attr_bits);
}
+ switch (attr->omp_device_type)
+ {
+ case OMP_DEVICE_TYPE_UNSET:
+ break;
+ case OMP_DEVICE_TYPE_HOST:
+ MIO_NAME (ab_attribute) (AB_OMP_DEVICE_TYPE_HOST, attr_bits);
+ break;
+ case OMP_DEVICE_TYPE_NOHOST:
+ MIO_NAME (ab_attribute) (AB_OMP_DEVICE_TYPE_NOHOST, attr_bits);
+ break;
+ case OMP_DEVICE_TYPE_ANY:
+ MIO_NAME (ab_attribute) (AB_OMP_DEVICE_TYPE_ANY, attr_bits);
+ break;
+ default:
+ gcc_unreachable ();
+ }
mio_rparen ();
}
else
@@ -2661,6 +2681,15 @@ mio_symbol_attribute (symbol_attribute *attr)
"relaxed", &gfc_current_locus,
module_name);
break;
+ case AB_OMP_DEVICE_TYPE_HOST:
+ attr->omp_device_type = OMP_DEVICE_TYPE_HOST;
+ break;
+ case AB_OMP_DEVICE_TYPE_NOHOST:
+ attr->omp_device_type = OMP_DEVICE_TYPE_NOHOST;
+ break;
+ case AB_OMP_DEVICE_TYPE_ANY:
+ attr->omp_device_type = OMP_DEVICE_TYPE_ANY;
+ break;
}
}
}
@@ -4849,6 +4878,7 @@ load_commons (void)
p->saved = 1;
if (flags & 2)
p->threadprivate = 1;
+ p->omp_device_type = (gfc_omp_device_type) ((flags >> 2) & 3);
p->use_assoc = 1;
/* Get whether this was a bind(c) common or not. */
@@ -5713,6 +5743,7 @@ write_common_0 (gfc_symtree *st, bool this_module)
flags = p->saved ? 1 : 0;
if (p->threadprivate)
flags |= 2;
+ flags |= p->omp_device_type << 2;
mio_integer (&flags);
/* Write out whether the common block is bind(c) or not. */
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 4d33a450a33..235a26987c6 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -752,7 +752,7 @@ cleanup:
return MATCH_ERROR;
}
-/* OpenMP 4.5 clauses. */
+/* OpenMP clauses. */
enum omp_mask1
{
OMP_CLAUSE_PRIVATE,
@@ -800,7 +800,8 @@ enum omp_mask1
OMP_CLAUSE_SIMD,
OMP_CLAUSE_THREADS,
OMP_CLAUSE_USE_DEVICE_PTR,
- OMP_CLAUSE_USE_DEVICE_ADDR, /* Actually, OpenMP 5.0. */
+ OMP_CLAUSE_USE_DEVICE_ADDR, /* OpenMP 5.0. */
+ OMP_CLAUSE_DEVICE_TYPE, /* OpenMP 5.0. */
OMP_CLAUSE_NOWAIT,
/* This must come last. */
OMP_MASK1_LAST
@@ -1214,6 +1215,24 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
OMP_MAP_FORCE_DEVICEPTR, false,
allow_derived))
continue;
+ if ((mask & OMP_CLAUSE_DEVICE_TYPE)
+ && gfc_match ("device_type ( ") == MATCH_YES)
+ {
+ if (gfc_match ("host") == MATCH_YES)
+ c->device_type = OMP_DEVICE_TYPE_HOST;
+ else if (gfc_match ("nohost") == MATCH_YES)
+ c->device_type = OMP_DEVICE_TYPE_NOHOST;
+ else if (gfc_match ("any") == MATCH_YES)
+ c->device_type = OMP_DEVICE_TYPE_ANY;
+ else
+ {
+ gfc_error ("Expected HOST, NOHOST or ANY at %C");
+ break;
+ }
+ if (gfc_match (" )") != MATCH_YES)
+ break;
+ continue;
+ }
if ((mask & OMP_CLAUSE_DEVICE_RESIDENT)
&& gfc_match_omp_variable_list
("device_resident (",
@@ -2638,7 +2657,7 @@ cleanup:
#define OMP_ORDERED_CLAUSES \
(omp_mask (OMP_CLAUSE_THREADS) | OMP_CLAUSE_SIMD)
#define OMP_DECLARE_TARGET_CLAUSES \
- (omp_mask (OMP_CLAUSE_TO) | OMP_CLAUSE_LINK)
+ (omp_mask (OMP_CLAUSE_TO) | OMP_CLAUSE_LINK | OMP_CLAUSE_DEVICE_TYPE)
static match
@@ -3275,6 +3294,15 @@ gfc_match_omp_declare_target (void)
gfc_add_omp_declare_target_link (&n->sym->attr, n->sym->name,
&n->sym->declared_at);
}
+ if (c->device_type != OMP_DEVICE_TYPE_UNSET)
+ {
+ if (n->sym->attr.omp_device_type != OMP_DEVICE_TYPE_UNSET
+ && n->sym->attr.omp_device_type != c->device_type)
+ gfc_error_now ("List item %qs at %L set in previous OMP DECLARE "
+ "TARGET directive to a different DEVICE_TYPE",
+ n->sym->name, &n->where);
+ n->sym->attr.omp_device_type = c->device_type;
+ }
n->sym->mark = 1;
}
else if (n->u.common->omp_declare_target
@@ -3297,6 +3325,13 @@ gfc_match_omp_declare_target (void)
{
n->u.common->omp_declare_target = 1;
n->u.common->omp_declare_target_link = (list == OMP_LIST_LINK);
+ if (n->u.common->omp_device_type != OMP_DEVICE_TYPE_UNSET
+ && n->u.common->omp_device_type != c->device_type)
+ gfc_error_now ("COMMON at %L set in previous OMP DECLARE "
+ "TARGET directive to a different DEVICE_TYPE",
+ &n->where);
+ n->u.common->omp_device_type = c->device_type;
+
for (s = n->u.common->head; s; s = s->common_next)
{
s->mark = 1;
@@ -3307,8 +3342,17 @@ gfc_match_omp_declare_target (void)
gfc_add_omp_declare_target_link (&s->attr, s->name,
&s->declared_at);
}
+ if (s->attr.omp_device_type != OMP_DEVICE_TYPE_UNSET
+ && s->attr.omp_device_type != c->device_type)
+ gfc_error_now ("List item %qs at %L set in previous OMP DECLARE"
+ " TARGET directive to a different DEVICE_TYPE",
+ s->name, &n->where);
+ s->attr.omp_device_type = c->device_type;
}
}
+ if (c->device_type && !c->lists[OMP_LIST_TO] && !c->lists[OMP_LIST_LINK])
+ gfc_warning_now (0, "OMP DECLARE TARGET directive at %L with only "
+ "DEVICE_TYPE clause is ignored", &old_loc);
gfc_buffer_error (true);
diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index c6383fc2352..52a9b2f4f49 100644
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -426,6 +426,8 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init)
/* If there is no backend_decl for the common block, build it. */
if (decl == NULL_TREE)
{
+ tree omp_clauses = NULL_TREE;
+
if (com->is_bind_c == 1 && com->binding_label)
decl = build_decl (input_location, VAR_DECL, identifier, union_type);
else
@@ -460,14 +462,33 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init)
if (com->threadprivate)
set_decl_tls_model (decl, decl_default_tls_model (decl));
+ if (com->omp_device_type != OMP_DEVICE_TYPE_UNSET)
+ {
+ tree c = build_omp_clause (UNKNOWN_LOCATION, OMP_CLAUSE_DEVICE_TYPE);
+ switch (com->omp_device_type)
+ {
+ case OMP_DEVICE_TYPE_HOST:
+ OMP_CLAUSE_DEVICE_TYPE_KIND (c) = OMP_CLAUSE_DEVICE_TYPE_HOST;
+ break;
+ case OMP_DEVICE_TYPE_NOHOST:
+ OMP_CLAUSE_DEVICE_TYPE_KIND (c) = OMP_CLAUSE_DEVICE_TYPE_NOHOST;
+ break;
+ case OMP_DEVICE_TYPE_ANY:
+ OMP_CLAUSE_DEVICE_TYPE_KIND (c) = OMP_CLAUSE_DEVICE_TYPE_ANY;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+ omp_clauses = c;
+ }
if (com->omp_declare_target_link)
DECL_ATTRIBUTES (decl)
= tree_cons (get_identifier ("omp declare target link"),
- NULL_TREE, DECL_ATTRIBUTES (decl));
+ omp_clauses, DECL_ATTRIBUTES (decl));
else if (com->omp_declare_target)
DECL_ATTRIBUTES (decl)
= tree_cons (get_identifier ("omp declare target"),
- NULL_TREE, DECL_ATTRIBUTES (decl));
+ omp_clauses, DECL_ATTRIBUTES (decl));
/* Place the back end declaration for this common block in
GLOBAL_BINDING_LEVEL. */
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 45a739ac860..92242771dde 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1465,11 +1465,31 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list)
tree dims = oacc_build_routine_dims (clauses);
list = oacc_replace_fn_attrib_attr (list, dims);
}
+ if (sym_attr.omp_device_type != OMP_DEVICE_TYPE_UNSET)
+ {
+ tree c = build_omp_clause (UNKNOWN_LOCATION, OMP_CLAUSE_DEVICE_TYPE);
+ switch (sym_attr.omp_device_type)
+ {
+ case OMP_DEVICE_TYPE_HOST:
+ OMP_CLAUSE_DEVICE_TYPE_KIND (c) = OMP_CLAUSE_DEVICE_TYPE_HOST;
+ break;
+ case OMP_DEVICE_TYPE_NOHOST:
+ OMP_CLAUSE_DEVICE_TYPE_KIND (c) = OMP_CLAUSE_DEVICE_TYPE_NOHOST;
+ break;
+ case OMP_DEVICE_TYPE_ANY:
+ OMP_CLAUSE_DEVICE_TYPE_KIND (c) = OMP_CLAUSE_DEVICE_TYPE_ANY;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+ OMP_CLAUSE_CHAIN (c) = clauses;
+ clauses = c;
+ }
if (sym_attr.omp_declare_target_link
|| sym_attr.oacc_declare_link)
list = tree_cons (get_identifier ("omp declare target link"),
- NULL_TREE, list);
+ clauses, list);
else if (sym_attr.omp_declare_target
|| sym_attr.oacc_declare_create
|| sym_attr.oacc_declare_copyin
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90
new file mode 100644
index 00000000000..6e3f91eefca
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90
@@ -0,0 +1,81 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+subroutine f1
+ !$omp declare target device_type (any) ! { dg-warning "OMP DECLARE TARGET directive at .1. with only DEVICE_TYPE clause is ignored" }
+end subroutine
+
+subroutine f2
+ !$omp declare target to (f2) device_type (any)
+end subroutine
+
+subroutine f3
+ !$omp declare target device_type (any) to (f3)
+end subroutine
+
+subroutine f4
+ !$omp declare target device_type (host) to (f4)
+end subroutine
+
+subroutine f5
+ !$omp declare target device_type (nohost) to (f5)
+end subroutine
+
+module mymod
+ ! device_type is ignored for variables in OpenMP 5.0
+ ! but TR8 and later apply those rules to variables as well
+ implicit none
+ integer :: a, b(4), c, d
+ integer :: e, f, g
+ integer :: m, n, o, p, q, r, s, t, u, v, w, x
+ common /block1/ m, n
+ common /block2/ o, p
+ common /block3/ q, r
+ common /block4/ s, t
+ common /block5/ u, v
+ common /block6/ w, x
+
+ !$omp declare target to(a) device_type(nohost)
+ !$omp declare target to(b) device_type(host)
+ !$omp declare target to(c) device_type(any)
+ ! Fails in ME with "Error: wrong number of arguments specified for 'omp declare target link' attribute"
+ ! !$omp declare target link(e) device_type(nohost)
+ ! !$omp declare target link(f) device_type(host)
+ ! !$omp declare target link(g) device_type(any)
+
+ !$omp declare target to(/block1/) device_type(nohost)
+ !$omp declare target to(/block2/) device_type(host)
+ !$omp declare target to(/block3/) device_type(any)
+ !$omp declare target link(/block4/) device_type(nohost)
+ !$omp declare target link(/block5/) device_type(host)
+ !$omp declare target link(/block6/) device_type(any)
+contains
+ subroutine s1
+ !$omp declare target to (s1) device_type (any)
+ end
+ subroutine s2
+ !$omp declare target to (s2) device_type (nohost)
+ end
+ subroutine s3
+ !$omp declare target to (s3) device_type (host)
+ end
+end module
+
+module m2
+ use mymod
+ implicit none
+ public
+ private :: s1, s2, s3, a, b, c, d, e, f, g
+ public :: m, n, o, p, q, r, s, t, u, v, w, x
+end module m2
+
+! { dg-final { scan-tree-dump-times "omp declare target" 7 "original" } }
+! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(" 7 "original" } }
+! { dg-final { scan-tree-dump-times "\[\n\r]\[\n\r]f1" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(any\\)\\)\\)\\)\[\n\r]f2" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(any\\)\\)\\)\\)\[\n\r]f3" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(host\\)\\)\\)\\)\[\n\r]f4" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(nohost\\)\\)\\)\\)\[\n\r]f5" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(any\\)\\)\\)\\)\[\n\r]s1" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(nohost\\)\\)\\)\\)\[\n\r]s2" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(host\\)\\)\\)\\)\[\n\r]s3" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-5.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-5.f90
new file mode 100644
index 00000000000..76687d476d5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-5.f90
@@ -0,0 +1,63 @@
+subroutine foo()
+ !$omp declare target to(foo) device_type(bar) ! { dg-error "Expected HOST, NOHOST or ANY" }
+end
+
+subroutine bar()
+ !$omp declare target to(bar) device_type(nohost)
+ !$omp declare target to(bar) device_type(host) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+end
+
+module mymod_one
+ implicit none
+ integer :: a, b, c, d, e ,f
+ integer :: m, n, o, p, q, r
+ common /block1/ m, n
+ common /block2/ o, p
+ common /block3/ q, r
+ !$omp declare target to(a) device_type(nohost)
+ !$omp declare target to(b) device_type(any)
+ !$omp declare target to(c) device_type(host)
+ !$omp declare target link(d) device_type(nohost)
+ !$omp declare target link(e) device_type(any)
+ !$omp declare target link(f) device_type(host)
+
+ !$omp declare target to(c) device_type(host)
+ !$omp declare target link(d) device_type(nohost)
+end module
+
+module mtest
+ use mymod_one ! { dg-error "Cannot change attributes of USE-associated symbol" }
+ implicit none
+
+ !$omp declare target to(a) device_type(any) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+ !$omp declare target to(b) device_type(host) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+ !$omp declare target to(c) device_type(nohost) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+ !$omp declare target link(d) device_type(host) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+ !$omp declare target link(e) device_type(nohost) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+ !$omp declare target link(f) device_type(any) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+end module
+
+module mymod
+ implicit none
+ integer :: a, b, c, d, e ,f
+ integer :: m, n, o, p, q, r
+ common /block1/ m, n
+ common /block2/ o, p
+ common /block3/ q, r
+ !$omp declare target to(a) device_type(nohost)
+ !$omp declare target to(b) device_type(any)
+ !$omp declare target to(c) device_type(host)
+ !$omp declare target link(d) device_type(nohost)
+ !$omp declare target link(e) device_type(any)
+ !$omp declare target link(f) device_type(host)
+
+ !$omp declare target to(c) device_type(host)
+ !$omp declare target link(d) device_type(nohost)
+
+ !$omp declare target to(a) device_type(any) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+ !$omp declare target to(b) device_type(host) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+ !$omp declare target to(c) device_type(nohost) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+ !$omp declare target link(d) device_type(host) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+ !$omp declare target link(e) device_type(nohost) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+ !$omp declare target link(f) device_type(any) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" }
+end
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [Patch] Fortran: Add 'device_type' clause to OpenMP's declare target
2020-08-20 9:51 ` Tobias Burnus
@ 2020-08-20 16:10 ` Andre Vehreschild
2020-08-26 7:33 ` Tobias Burnus
0 siblings, 1 reply; 7+ messages in thread
From: Andre Vehreschild @ 2020-08-20 16:10 UTC (permalink / raw)
To: Tobias Burnus; +Cc: Jakub Jelinek, Tobias Burnus, gcc-patches, fortran
Hi Tobias,
to me this looks OK now.
Regards,
Andre
On Thu, 20 Aug 2020 11:51:50 +0200
Tobias Burnus <tobias@codesourcery.com> wrote:
> Updated patch – taking Andre's suggestions into account +
> extending the testcase, which now catches the previous (NO)HOST
> module issue.
>
> OK?
>
> Tobias
>
> On 8/19/20 2:51 PM, Tobias Burnus wrote:
> > Am 18.08.20 um 19:33 schrieb Andre Vehreschild:
> >> + case OMP_DEVICE_TYPE_HOST:
> >> + MIO_NAME (ab_attribute) (AB_OMP_DEVICE_TYPE_NOHOST, attr_bits);
> >> Why also NOHOST here?
> > Copy and paste error.
> ...
> >> + tree clauses = NULL_TREE;
> >> Would you mind using "omp_clauses" or the like here?
> Done now.
> -----------------
> Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
> Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung,
> Alexander Walter
--
Andre Vehreschild * Email: vehre ad gmx dot de
^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [Patch] Fortran: Add 'device_type' clause to OpenMP's declare target
2020-08-20 16:10 ` Andre Vehreschild
@ 2020-08-26 7:33 ` Tobias Burnus
0 siblings, 0 replies; 7+ messages in thread
From: Tobias Burnus @ 2020-08-26 7:33 UTC (permalink / raw)
To: Andre Vehreschild; +Cc: Jakub Jelinek, Tobias Burnus, gcc-patches, fortran
Thanks. I have now committed it as
r11-2858-gd58e7173ef964ddac3ab3ad8cc97de8f9f3b32ee
Tobias
On 8/20/20 6:10 PM, Andre Vehreschild wrote:
> Hi Tobias,
>
> to me this looks OK now.
>
> Regards,
> Andre
>
> On Thu, 20 Aug 2020 11:51:50 +0200
> Tobias Burnus <tobias@codesourcery.com> wrote:
>
>> Updated patch – taking Andre's suggestions into account +
>> extending the testcase, which now catches the previous (NO)HOST
>> module issue.
>>
>> OK?
>>
>> Tobias
>>
>> On 8/19/20 2:51 PM, Tobias Burnus wrote:
>>> Am 18.08.20 um 19:33 schrieb Andre Vehreschild:
>>>> + case OMP_DEVICE_TYPE_HOST:
>>>> + MIO_NAME (ab_attribute) (AB_OMP_DEVICE_TYPE_NOHOST, attr_bits);
>>>> Why also NOHOST here?
>>> Copy and paste error.
>> ...
>>>> + tree clauses = NULL_TREE;
>>>> Would you mind using "omp_clauses" or the like here?
>> Done now.
>> -----------------
>> Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
>> Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung,
>> Alexander Walter
>
-----------------
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] 7+ messages in thread
end of thread, other threads:[~2020-08-26 7:33 UTC | newest]
Thread overview: 7+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-08-07 15:03 [Patch] Fortran: Add 'device_type' clause to OpenMP's declare target Tobias Burnus
2020-08-18 7:11 ` *PING* / " Tobias Burnus
2020-08-18 17:33 ` Andre Vehreschild
2020-08-19 12:51 ` Tobias Burnus
2020-08-20 9:51 ` Tobias Burnus
2020-08-20 16:10 ` Andre Vehreschild
2020-08-26 7:33 ` 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).