diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/gfortran.h | 10 | ||||
| -rw-r--r-- | gcc/fortran/module.c | 33 | ||||
| -rw-r--r-- | gcc/fortran/openmp.c | 50 | ||||
| -rw-r--r-- | gcc/fortran/trans-common.c | 25 | ||||
| -rw-r--r-- | gcc/fortran/trans-decl.c | 22 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90 | 81 | ||||
| -rw-r--r-- | gcc/testsuite/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 559d3c6..d0cea83 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 5114d55..714fbd9 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 5098373..d0e516c 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 c6383fc..52a9b2f 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 45a739a..9224277 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 0000000..6e3f91e --- /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 0000000..76687d4 --- /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 |