From 972da557463ec946a31577294764a186b9821012 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Tue, 15 Sep 2020 09:24:47 +0200 Subject: [PATCH] OpenMP/Fortran: Fix (re)mapping of allocatable/pointer arrays [PR96668] gcc/cp/ChangeLog: PR fortran/96668 * cp-gimplify.c (cxx_omp_finish_clause): Add bool openacc arg. * cp-tree.h (cxx_omp_finish_clause): Likewise * semantics.c (handle_omp_for_class_iterator): Update call. gcc/fortran/ChangeLog: PR fortran/96668 * trans.h (gfc_omp_finish_clause): Add bool openacc arg. * trans-openmp.c (gfc_omp_finish_clause): Ditto. Use GOMP_MAP_ALWAYS_POINTER with PSET for pointers. (gfc_trans_omp_clauses): Like the latter and also if the always modifier is used. gcc/ChangeLog: PR fortran/96668 * gimplify.c (gimplify_omp_for): Add 'bool openacc' argument; update omp_finish_clause calls. (gimplify_adjust_omp_clauses_1, gimplify_adjust_omp_clauses, gimplify_expr, gimplify_omp_loop): Update omp_finish_clause and/or gimplify_for calls. * langhooks-def.h (lhd_omp_finish_clause): Add bool openacc arg. * langhooks.c (lhd_omp_finish_clause): Likewise. * langhooks.h (lhd_omp_finish_clause): Likewise. * omp-low.c (scan_sharing_clauses): Keep GOMP_MAP_TO_PSET cause for 'declare target' vars. include/ChangeLog: PR fortran/96668 * gomp-constants.h (GOMP_MAP_ALWAYS_POINTER_P): Define. libgomp/ChangeLog: PR fortran/96668 * libgomp.h (struct target_var_desc): Add has_null_ptr_assoc member. * target.c (gomp_map_vars_existing): Add always_to_flag flag. (gomp_map_vars_existing): Update call to it. (gomp_map_fields_existing): Likewise (gomp_map_vars_internal): Update PSET handling such that if a nullptr is now allocated or if GOMP_MAP_POINTER is used PSET is updated and pointer remapped. (GOMP_target_enter_exit_data): Hanlde GOMP_MAP_ALWAYS_POINTER like GOMP_MAP_POINTER. * testsuite/libgomp.fortran/map-alloc-ptr-1.f90: New test. * testsuite/libgomp.fortran/map-alloc-ptr-2.f90: New test. --- gcc/cp/cp-gimplify.c | 2 +- gcc/cp/cp-tree.h | 2 +- gcc/cp/semantics.c | 4 +- gcc/fortran/trans-openmp.c | 31 ++- gcc/fortran/trans.h | 2 +- gcc/gimplify.c | 25 ++- gcc/langhooks-def.h | 2 +- gcc/langhooks.c | 2 +- gcc/langhooks.h | 2 +- gcc/omp-low.c | 1 + include/gomp-constants.h | 3 + libgomp/libgomp.h | 3 + libgomp/target.c | 184 ++++++++++++++---- .../libgomp.fortran/map-alloc-ptr-1.f90 | 114 +++++++++++ .../libgomp.fortran/map-alloc-ptr-2.f90 | 86 ++++++++ 15 files changed, 405 insertions(+), 58 deletions(-) create mode 100644 libgomp/testsuite/libgomp.fortran/map-alloc-ptr-1.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/map-alloc-ptr-2.f90 diff --git a/gcc/cp/cp-gimplify.c b/gcc/cp/cp-gimplify.c index f8695835684..b2befa7148d 100644 --- a/gcc/cp/cp-gimplify.c +++ b/gcc/cp/cp-gimplify.c @@ -2357,7 +2357,7 @@ cxx_omp_predetermined_mapping (tree decl) /* Finalize an implicitly determined clause. */ void -cxx_omp_finish_clause (tree c, gimple_seq *) +cxx_omp_finish_clause (tree c, gimple_seq *, bool /* openacc */) { tree decl, inner_type; bool make_shared = false; diff --git a/gcc/cp/cp-tree.h b/gcc/cp/cp-tree.h index 5923574a7aa..6e4de7d0c4b 100644 --- a/gcc/cp/cp-tree.h +++ b/gcc/cp/cp-tree.h @@ -7749,7 +7749,7 @@ extern tree cxx_omp_clause_default_ctor (tree, tree, tree); extern tree cxx_omp_clause_copy_ctor (tree, tree, tree); extern tree cxx_omp_clause_assign_op (tree, tree, tree); extern tree cxx_omp_clause_dtor (tree, tree); -extern void cxx_omp_finish_clause (tree, gimple_seq *); +extern void cxx_omp_finish_clause (tree, gimple_seq *, bool); extern bool cxx_omp_privatize_by_reference (const_tree); extern bool cxx_omp_disregard_value_expr (tree, bool); extern void cp_fold_function (tree); diff --git a/gcc/cp/semantics.c b/gcc/cp/semantics.c index dafb4032c00..4ca2a2f0030 100644 --- a/gcc/cp/semantics.c +++ b/gcc/cp/semantics.c @@ -8770,7 +8770,7 @@ handle_omp_for_class_iterator (int i, location_t locus, enum tree_code code, { tree ivc = build_omp_clause (locus, OMP_CLAUSE_FIRSTPRIVATE); OMP_CLAUSE_DECL (ivc) = iter; - cxx_omp_finish_clause (ivc, NULL); + cxx_omp_finish_clause (ivc, NULL, false); OMP_CLAUSE_CHAIN (ivc) = clauses; clauses = ivc; } @@ -8802,7 +8802,7 @@ handle_omp_for_class_iterator (int i, location_t locus, enum tree_code code, OMP_CLAUSE_CODE (loop_iv_seen) = OMP_CLAUSE_FIRSTPRIVATE; } if (OMP_CLAUSE_CODE (loop_iv_seen) == OMP_CLAUSE_FIRSTPRIVATE) - cxx_omp_finish_clause (loop_iv_seen, NULL); + cxx_omp_finish_clause (loop_iv_seen, NULL, false); } orig_pre_body = *pre_body; diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 0e1da0426b4..9ec0df204ac 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -1276,7 +1276,7 @@ gfc_build_cond_assign_expr (stmtblock_t *block, tree cond_val, } void -gfc_omp_finish_clause (tree c, gimple_seq *pre_p) +gfc_omp_finish_clause (tree c, gimple_seq *pre_p, bool openacc) { if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_MAP) return; @@ -1357,6 +1357,16 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p) tree type = TREE_TYPE (decl); tree ptr = gfc_conv_descriptor_data_get (decl); + /* OpenMP: automatically map pointer targets with the pointer; + hence, always update the descriptor/pointer itself. + NOTE: This also remaps the pointer for allocatable arrays with + 'target' attribute which also don't have the 'restrict' qualifier. */ + bool always_modifier = false; + + if (!openacc + && !(TYPE_QUALS (TREE_TYPE (ptr)) & TYPE_QUAL_RESTRICT)) + always_modifier = true; + if (present) ptr = gfc_build_cond_assign_expr (&block, present, ptr, null_pointer_node); @@ -1376,7 +1386,8 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p) OMP_CLAUSE_DECL (c2) = decl; OMP_CLAUSE_SIZE (c2) = TYPE_SIZE_UNIT (type); c3 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP); - OMP_CLAUSE_SET_MAP_KIND (c3, GOMP_MAP_POINTER); + OMP_CLAUSE_SET_MAP_KIND (c3, always_modifier ? GOMP_MAP_ALWAYS_POINTER + : GOMP_MAP_POINTER); if (present) { ptr = gfc_conv_descriptor_data_get (decl); @@ -2549,11 +2560,19 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if (!n->sym->attr.referenced) continue; + bool always_modifier = false; tree node = build_omp_clause (input_location, OMP_CLAUSE_MAP); tree node2 = NULL_TREE; tree node3 = NULL_TREE; tree node4 = NULL_TREE; + /* OpenMP: automatically map pointer targets with the pointer; + hence, always update the descriptor/pointer itself. */ + if (!openacc + && ((n->expr == NULL && n->sym->attr.pointer) + || (n->expr && gfc_expr_attr (n->expr).pointer))) + always_modifier = true; + switch (n->u.map_op) { case OMP_MAP_ALLOC: @@ -2575,12 +2594,15 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_TOFROM); break; case OMP_MAP_ALWAYS_TO: + always_modifier = true; OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_TO); break; case OMP_MAP_ALWAYS_FROM: + always_modifier = true; OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_FROM); break; case OMP_MAP_ALWAYS_TOFROM: + always_modifier = true; OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_TOFROM); break; case OMP_MAP_RELEASE: @@ -2760,7 +2782,10 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, goto finalize_map_clause; } else - OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_POINTER); + OMP_CLAUSE_SET_MAP_KIND (node3, + always_modifier + ? GOMP_MAP_ALWAYS_POINTER + : GOMP_MAP_POINTER); /* We have to check for n->sym->attr.dimension because of scalar coarrays. */ diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index e126fe92782..d257963d5f8 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -810,7 +810,7 @@ tree gfc_omp_clause_copy_ctor (tree, tree, tree); tree gfc_omp_clause_assign_op (tree, tree, tree); tree gfc_omp_clause_linear_ctor (tree, tree, tree, tree); tree gfc_omp_clause_dtor (tree, tree); -void gfc_omp_finish_clause (tree, gimple_seq *); +void gfc_omp_finish_clause (tree, gimple_seq *, bool); bool gfc_omp_scalar_p (tree); bool gfc_omp_disregard_value_expr (tree, bool); bool gfc_omp_private_debug_clause (tree, bool); diff --git a/gcc/gimplify.c b/gcc/gimplify.c index 23d0e2511f7..2dea03cce3d 100644 --- a/gcc/gimplify.c +++ b/gcc/gimplify.c @@ -10123,13 +10123,15 @@ gimplify_adjust_omp_clauses_1 (splay_tree_node n, void *data) OMP_CLAUSE_CHAIN (clause) = nc; struct gimplify_omp_ctx *ctx = gimplify_omp_ctxp; gimplify_omp_ctxp = ctx->outer_context; - lang_hooks.decls.omp_finish_clause (nc, pre_p); + lang_hooks.decls.omp_finish_clause (nc, pre_p, + (ctx->region_type & ORT_ACC) != 0); gimplify_omp_ctxp = ctx; } *list_p = clause; struct gimplify_omp_ctx *ctx = gimplify_omp_ctxp; gimplify_omp_ctxp = ctx->outer_context; - lang_hooks.decls.omp_finish_clause (clause, pre_p); + lang_hooks.decls.omp_finish_clause (clause, pre_p, + (ctx->region_type & ORT_ACC) != 0); if (gimplify_omp_ctxp) for (; clause != chain; clause = OMP_CLAUSE_CHAIN (clause)) if (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_MAP @@ -10539,7 +10541,9 @@ gimplify_adjust_omp_clauses (gimple_seq *pre_p, gimple_seq body, tree *list_p, OMP_CLAUSE_SET_MAP_KIND (nc, GOMP_MAP_TOFROM); OMP_CLAUSE_DECL (nc) = decl; OMP_CLAUSE_CHAIN (c) = nc; - lang_hooks.decls.omp_finish_clause (nc, pre_p); + lang_hooks.decls.omp_finish_clause (nc, pre_p, + (ctx->region_type + & ORT_ACC) != 0); while (1) { OMP_CLAUSE_MAP_IN_REDUCTION (nc) = 1; @@ -11040,6 +11044,7 @@ gimplify_omp_for (tree *expr_p, gimple_seq *pre_p) int i; bitmap has_decl_expr = NULL; enum omp_region_type ort = ORT_WORKSHARE; + bool openacc = TREE_CODE (*expr_p) == OACC_LOOP; orig_for_stmt = for_stmt = *expr_p; @@ -11147,7 +11152,7 @@ gimplify_omp_for (tree *expr_p, gimple_seq *pre_p) OMP_CLAUSE_CHAIN (c) = OMP_FOR_CLAUSES (for_stmt); OMP_FOR_CLAUSES (for_stmt) = c; OMP_CLAUSE_CODE (*pc) = OMP_CLAUSE_FIRSTPRIVATE; - lang_hooks.decls.omp_finish_clause (*pc, pre_p); + lang_hooks.decls.omp_finish_clause (*pc, pre_p, openacc); } else { @@ -11159,7 +11164,7 @@ gimplify_omp_for (tree *expr_p, gimple_seq *pre_p) OMP_CLAUSE_DECL (c) = OMP_CLAUSE_DECL (*pc); OMP_CLAUSE_CHAIN (c) = *pc; *pc = c; - lang_hooks.decls.omp_finish_clause (*pc, pre_p); + lang_hooks.decls.omp_finish_clause (*pc, pre_p, openacc); } tree c = build_omp_clause (UNKNOWN_LOCATION, OMP_CLAUSE_FIRSTPRIVATE); @@ -12115,7 +12120,8 @@ gimplify_omp_for (tree *expr_p, gimple_seq *pre_p) = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_FIRSTPRIVATE); OMP_CLAUSE_DECL (*gtask_clauses_ptr) = OMP_CLAUSE_DECL (c); - lang_hooks.decls.omp_finish_clause (*gtask_clauses_ptr, NULL); + lang_hooks.decls.omp_finish_clause (*gtask_clauses_ptr, NULL, + openacc); gtask_clauses_ptr = &OMP_CLAUSE_CHAIN (*gtask_clauses_ptr); *gforo_clauses_ptr = c; gforo_clauses_ptr = &OMP_CLAUSE_CHAIN (c); @@ -12154,7 +12160,8 @@ gimplify_omp_for (tree *expr_p, gimple_seq *pre_p) = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_FIRSTPRIVATE); OMP_CLAUSE_DECL (*gtask_clauses_ptr) = OMP_CLAUSE_DECL (c); - lang_hooks.decls.omp_finish_clause (*gtask_clauses_ptr, NULL); + lang_hooks.decls.omp_finish_clause (*gtask_clauses_ptr, NULL, + openacc); gtask_clauses_ptr = &OMP_CLAUSE_CHAIN (*gtask_clauses_ptr); OMP_CLAUSE_LASTPRIVATE_FIRSTPRIVATE (c) = 1; *gforo_clauses_ptr = build_omp_clause (OMP_CLAUSE_LOCATION (c), @@ -12535,7 +12542,7 @@ gimplify_omp_loop (tree *expr_p, gimple_seq *pre_p) *pc = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_FIRSTPRIVATE); OMP_CLAUSE_DECL (*pc) = OMP_CLAUSE_DECL (c); - lang_hooks.decls.omp_finish_clause (*pc, NULL); + lang_hooks.decls.omp_finish_clause (*pc, NULL, false); pc = &OMP_CLAUSE_CHAIN (*pc); } *pc = copy_node (c); @@ -12546,7 +12553,7 @@ gimplify_omp_loop (tree *expr_p, gimple_seq *pre_p) if (pass != last) OMP_CLAUSE_LASTPRIVATE_FIRSTPRIVATE (*pc) = 1; else - lang_hooks.decls.omp_finish_clause (*pc, NULL); + lang_hooks.decls.omp_finish_clause (*pc, NULL, false); OMP_CLAUSE_LASTPRIVATE_LOOP_IV (*pc) = 0; } pc = &OMP_CLAUSE_CHAIN (*pc); diff --git a/gcc/langhooks-def.h b/gcc/langhooks-def.h index 67b02107c49..a909915d018 100644 --- a/gcc/langhooks-def.h +++ b/gcc/langhooks-def.h @@ -81,7 +81,7 @@ extern int lhd_gimplify_expr (tree *, gimple_seq *, gimple_seq *); extern enum omp_clause_default_kind lhd_omp_predetermined_sharing (tree); extern enum omp_clause_defaultmap_kind lhd_omp_predetermined_mapping (tree); extern tree lhd_omp_assignment (tree, tree, tree); -extern void lhd_omp_finish_clause (tree, gimple_seq *); +extern void lhd_omp_finish_clause (tree, gimple_seq *, bool); struct gimplify_omp_ctx; extern void lhd_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *, tree); diff --git a/gcc/langhooks.c b/gcc/langhooks.c index 3cbe04c6899..8819a8859d4 100644 --- a/gcc/langhooks.c +++ b/gcc/langhooks.c @@ -610,7 +610,7 @@ lhd_omp_assignment (tree clause ATTRIBUTE_UNUSED, tree dst, tree src) /* Finalize clause C. */ void -lhd_omp_finish_clause (tree, gimple_seq *) +lhd_omp_finish_clause (tree, gimple_seq *, bool) { } diff --git a/gcc/langhooks.h b/gcc/langhooks.h index 6ab6fb682f3..a35cf21b673 100644 --- a/gcc/langhooks.h +++ b/gcc/langhooks.h @@ -294,7 +294,7 @@ struct lang_hooks_for_decls tree (*omp_clause_dtor) (tree clause, tree decl); /* Do language specific checking on an implicitly determined clause. */ - void (*omp_finish_clause) (tree clause, gimple_seq *pre_p); + void (*omp_finish_clause) (tree clause, gimple_seq *pre_p, bool); /* Return true if DECL is a scalar variable (for the purpose of implicit firstprivatization). */ diff --git a/gcc/omp-low.c b/gcc/omp-low.c index 53efe5f750c..3d2a9d77c1c 100644 --- a/gcc/omp-low.c +++ b/gcc/omp-low.c @@ -1351,6 +1351,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx) && OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_ALWAYS_TO && OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_ALWAYS_FROM && OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_ALWAYS_TOFROM + && OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_TO_PSET && is_global_var (maybe_lookup_decl_in_outer_ctx (decl, ctx)) && varpool_node::get_create (decl)->offloadable && !lookup_attribute ("omp declare target link", diff --git a/include/gomp-constants.h b/include/gomp-constants.h index 16f2d1352d8..309cbcadd83 100644 --- a/include/gomp-constants.h +++ b/include/gomp-constants.h @@ -171,6 +171,9 @@ enum gomp_map_kind (!((X) & GOMP_MAP_FLAG_SPECIAL) \ && ((X) & GOMP_MAP_FLAG_FROM)) +#define GOMP_MAP_ALWAYS_POINTER_P(X) \ + ((X) == GOMP_MAP_ALWAYS_POINTER) + #define GOMP_MAP_POINTER_P(X) \ ((X) == GOMP_MAP_POINTER) diff --git a/libgomp/libgomp.h b/libgomp/libgomp.h index f9080e9f70f..87f939a1f21 100644 --- a/libgomp/libgomp.h +++ b/libgomp/libgomp.h @@ -954,6 +954,9 @@ struct target_var_desc { bool always_copy_from; /* True if this is for OpenACC 'attach'. */ bool is_attach; + /* If GOMP_MAP_TO_PSET had a NULL pointer; used for Fortran descriptors, + which were initially unallocated. */ + bool has_null_ptr_assoc; /* Relative offset against key host_start. */ uintptr_t offset; /* Actual length. */ diff --git a/libgomp/target.c b/libgomp/target.c index 3e292eb8c62..69cdd9f14a9 100644 --- a/libgomp/target.c +++ b/libgomp/target.c @@ -355,7 +355,8 @@ static inline void gomp_map_vars_existing (struct gomp_device_descr *devicep, struct goacc_asyncqueue *aq, splay_tree_key oldn, splay_tree_key newn, struct target_var_desc *tgt_var, - unsigned char kind, struct gomp_coalesce_buf *cbuf) + unsigned char kind, bool always_to_flag, + struct gomp_coalesce_buf *cbuf) { assert (kind != GOMP_MAP_ATTACH); @@ -377,7 +378,7 @@ gomp_map_vars_existing (struct gomp_device_descr *devicep, (void *) oldn->host_start, (void *) oldn->host_end); } - if (GOMP_MAP_ALWAYS_TO_P (kind)) + if (GOMP_MAP_ALWAYS_TO_P (kind) || always_to_flag) gomp_copy_host2dev (devicep, aq, (void *) (oldn->tgt->tgt_start + oldn->tgt_offset + newn->host_start - oldn->host_start), @@ -456,8 +457,8 @@ gomp_map_fields_existing (struct target_mem_desc *tgt, && n2->tgt == n->tgt && n2->host_start - n->host_start == n2->tgt_offset - n->tgt_offset) { - gomp_map_vars_existing (devicep, aq, n2, &cur_node, - &tgt->list[i], kind & typemask, cbuf); + gomp_map_vars_existing (devicep, aq, n2, &cur_node, &tgt->list[i], + kind & typemask, false, cbuf); return; } if (sizes[i] == 0) @@ -472,8 +473,8 @@ gomp_map_fields_existing (struct target_mem_desc *tgt, && n2->host_start - n->host_start == n2->tgt_offset - n->tgt_offset) { - gomp_map_vars_existing (devicep, aq, n2, &cur_node, - &tgt->list[i], kind & typemask, cbuf); + gomp_map_vars_existing (devicep, aq, n2, &cur_node, &tgt->list[i], + kind & typemask, false, cbuf); return; } } @@ -485,7 +486,7 @@ gomp_map_fields_existing (struct target_mem_desc *tgt, && n2->host_start - n->host_start == n2->tgt_offset - n->tgt_offset) { gomp_map_vars_existing (devicep, aq, n2, &cur_node, &tgt->list[i], - kind & typemask, cbuf); + kind & typemask, false, cbuf); return; } } @@ -661,6 +662,7 @@ gomp_map_vars_internal (struct gomp_device_descr *devicep, { size_t i, tgt_align, tgt_size, not_found_cnt = 0; bool has_firstprivate = false; + bool has_always_ptrset = false; const int rshift = short_mapkind ? 8 : 3; const int typemask = short_mapkind ? 0xff : 0x7; struct splay_tree_s *mem_map = &devicep->mem_map; @@ -848,8 +850,55 @@ gomp_map_vars_internal (struct gomp_device_descr *devicep, else n = splay_tree_lookup (mem_map, &cur_node); if (n && n->refcount != REFCOUNT_LINK) - gomp_map_vars_existing (devicep, aq, n, &cur_node, &tgt->list[i], - kind & typemask, NULL); + { + int always_to_cnt = 0; + if ((kind & typemask) == GOMP_MAP_TO_PSET) + { + bool has_nullptr; + size_t j; + for (j = 0; j < n->tgt->list_count; j++) + if (n->tgt->list[j].key == n) + { + has_nullptr = n->tgt->list[j].has_null_ptr_assoc; + break; + } + if (n->tgt->list_count == 0) + { + /* 'declare target'; assume has_nullptr; it could also be + statically assigned pointer, but that it should be to + the equivalent variable on the host. */ + assert (n->refcount == REFCOUNT_INFINITY); + has_nullptr = true; + } + else + assert (j < n->tgt->list_count); + /* Re-map the data if there is an 'always' modifier or if it a + null pointer was there and non a nonnull has been found; that + permits transparent re-mapping for Fortran array descriptors + which were previously mapped unallocated. */ + for (j = i + 1; j < mapnum; j++) + { + int ptr_kind = get_kind (short_mapkind, kinds, j) & typemask; + if (!GOMP_MAP_ALWAYS_POINTER_P (ptr_kind) + && (!has_nullptr + || !GOMP_MAP_POINTER_P (ptr_kind) + || *(void **) hostaddrs[j] == NULL)) + break; + else if ((uintptr_t) hostaddrs[j] < cur_node.host_start + || ((uintptr_t) hostaddrs[j] + sizeof (void *) + > cur_node.host_end)) + break; + else + { + has_always_ptrset = true; + ++always_to_cnt; + } + } + } + gomp_map_vars_existing (devicep, aq, n, &cur_node, &tgt->list[i], + kind & typemask, always_to_cnt > 0, NULL); + i += always_to_cnt; + } else { tgt->list[i].key = NULL; @@ -881,9 +930,11 @@ gomp_map_vars_internal (struct gomp_device_descr *devicep, if ((kind & typemask) == GOMP_MAP_TO_PSET) { size_t j; + int kind; for (j = i + 1; j < mapnum; j++) - if (!GOMP_MAP_POINTER_P (get_kind (short_mapkind, kinds, j) - & typemask)) + if (!GOMP_MAP_POINTER_P ((kind = (get_kind (short_mapkind, + kinds, j)) & typemask)) + && !GOMP_MAP_ALWAYS_POINTER_P (kind)) break; else if ((uintptr_t) hostaddrs[j] < cur_node.host_start || ((uintptr_t) hostaddrs[j] + sizeof (void *) @@ -951,7 +1002,7 @@ gomp_map_vars_internal (struct gomp_device_descr *devicep, tgt_size = mapnum * sizeof (void *); tgt->array = NULL; - if (not_found_cnt || has_firstprivate) + if (not_found_cnt || has_firstprivate || has_always_ptrset) { if (not_found_cnt) tgt->array = gomp_malloc (not_found_cnt * sizeof (*tgt->array)); @@ -960,7 +1011,58 @@ gomp_map_vars_internal (struct gomp_device_descr *devicep, uintptr_t field_tgt_base = 0; for (i = 0; i < mapnum; i++) - if (tgt->list[i].key == NULL) + if (has_always_ptrset + && tgt->list[i].key + && (get_kind (short_mapkind, kinds, i) & typemask) + == GOMP_MAP_TO_PSET) + { + splay_tree_key k = tgt->list[i].key; + bool has_nullptr; + size_t j; + for (j = 0; j < k->tgt->list_count; j++) + if (k->tgt->list[j].key == k) + { + has_nullptr = k->tgt->list[j].has_null_ptr_assoc; + break; + } + if (k->tgt->list_count == 0) + has_nullptr = true; + else + assert (j < k->tgt->list_count); + + tgt->list[i].has_null_ptr_assoc = false; + for (j = i + 1; j < mapnum; j++) + { + int ptr_kind = get_kind (short_mapkind, kinds, j) & typemask; + if (!GOMP_MAP_ALWAYS_POINTER_P (ptr_kind) + && (!has_nullptr + || !GOMP_MAP_POINTER_P (ptr_kind) + || *(void **) hostaddrs[j] == NULL)) + break; + else if ((uintptr_t) hostaddrs[j] < k->host_start + || ((uintptr_t) hostaddrs[j] + sizeof (void *) + > k->host_end)) + break; + else + { + if (*(void **) hostaddrs[j] == NULL) + tgt->list[i].has_null_ptr_assoc = true; + tgt->list[j].key = k; + tgt->list[j].copy_from = false; + tgt->list[j].always_copy_from = false; + tgt->list[j].is_attach = false; + if (k->refcount != REFCOUNT_INFINITY) + k->refcount++; + gomp_map_pointer (k->tgt, aq, + (uintptr_t) *(void **) hostaddrs[j], + k->tgt_offset + ((uintptr_t) hostaddrs[j] + - k->host_start), + sizes[j], cbufp); + } + } + i = j - 1; + } + else if (tgt->list[i].key == NULL) { int kind = get_kind (short_mapkind, kinds, i); if (hostaddrs[i] == NULL) @@ -1120,7 +1222,7 @@ gomp_map_vars_internal (struct gomp_device_descr *devicep, splay_tree_key n = splay_tree_lookup (mem_map, k); if (n && n->refcount != REFCOUNT_LINK) gomp_map_vars_existing (devicep, aq, n, k, &tgt->list[i], - kind & typemask, cbufp); + kind & typemask, false, cbufp); else { k->aux = NULL; @@ -1192,32 +1294,37 @@ gomp_map_vars_internal (struct gomp_device_descr *devicep, + k->tgt_offset), (void *) k->host_start, k->host_end - k->host_start, cbufp); + tgt->list[i].has_null_ptr_assoc = false; for (j = i + 1; j < mapnum; j++) - if (!GOMP_MAP_POINTER_P (get_kind (short_mapkind, kinds, - j) - & typemask)) - break; - else if ((uintptr_t) hostaddrs[j] < k->host_start - || ((uintptr_t) hostaddrs[j] + sizeof (void *) - > k->host_end)) - break; - else - { - tgt->list[j].key = k; - tgt->list[j].copy_from = false; - tgt->list[j].always_copy_from = false; - tgt->list[j].is_attach = false; - if (k->refcount != REFCOUNT_INFINITY) - k->refcount++; - gomp_map_pointer (tgt, aq, - (uintptr_t) *(void **) hostaddrs[j], - k->tgt_offset - + ((uintptr_t) hostaddrs[j] - - k->host_start), - sizes[j], cbufp); - i++; + { + int ptr_kind = (get_kind (short_mapkind, kinds, j) + & typemask); + if (!GOMP_MAP_POINTER_P (ptr_kind) + && !GOMP_MAP_ALWAYS_POINTER_P (ptr_kind)) + break; + else if ((uintptr_t) hostaddrs[j] < k->host_start + || ((uintptr_t) hostaddrs[j] + sizeof (void *) + > k->host_end)) + break; + else + { + tgt->list[j].key = k; + tgt->list[j].copy_from = false; + tgt->list[j].always_copy_from = false; + tgt->list[j].is_attach = false; + tgt->list[i].has_null_ptr_assoc |= !(*(void **) hostaddrs[j]); + if (k->refcount != REFCOUNT_INFINITY) + k->refcount++; + gomp_map_pointer (tgt, aq, + (uintptr_t) *(void **) hostaddrs[j], + k->tgt_offset + + ((uintptr_t) hostaddrs[j] + - k->host_start), + sizes[j], cbufp); + } } + i = j - 1; break; case GOMP_MAP_FORCE_PRESENT: { @@ -2481,7 +2588,8 @@ GOMP_target_enter_exit_data (int device, size_t mapnum, void **hostaddrs, else if ((kinds[i] & 0xff) == GOMP_MAP_TO_PSET) { for (j = i + 1; j < mapnum; j++) - if (!GOMP_MAP_POINTER_P (get_kind (true, kinds, j) & 0xff)) + if (!GOMP_MAP_POINTER_P (get_kind (true, kinds, j) & 0xff) + && !GOMP_MAP_ALWAYS_POINTER_P (get_kind (true, kinds, j) & 0xff)) break; gomp_map_vars (devicep, j-i, &hostaddrs[i], NULL, &sizes[i], &kinds[i], true, GOMP_MAP_VARS_ENTER_DATA); diff --git a/libgomp/testsuite/libgomp.fortran/map-alloc-ptr-1.f90 b/libgomp/testsuite/libgomp.fortran/map-alloc-ptr-1.f90 new file mode 100644 index 00000000000..a1ff1d6d1e5 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/map-alloc-ptr-1.f90 @@ -0,0 +1,114 @@ +! { dg-do run } +! +! PR fortran/96668 + +implicit none + integer, pointer :: p1(:), p2(:), p3(:) + integer, allocatable :: a1(:), a2(:) + p1 => null() + p3 => null() + + !$omp target enter data map(to:p3) + + !$omp target data map(a1, a2, p1) + !$omp target + if (allocated (a1)) stop 1 + if (allocated (a2)) stop 1 + if (associated (p1)) stop 1 + if (associated (p3)) stop 1 + !$omp end target + + allocate (a1, source=[10,11,12,13,14]) + allocate (a2, source=[10,11,12,13,14]) + allocate (p1, source=[9,8,7,6,5,4]) + allocate (p3, source=[4,5,6]) + p2 => p1 + + !$omp target enter data map(to:p3) + + ! allocatable, TR9 requires 'always' modifier: + !$omp target map(always, tofrom: a1) + if (.not. allocated(a1)) stop 2 + if (size(a1) /= 5) stop 3 + if (any (a1 /= [10,11,12,13,14])) stop 5 + a1(:) = [101, 102, 103, 104, 105] + !$omp end target + + ! allocatable, extension (OpenMP 6.0?): without 'always' + !$omp target + if (.not. allocated(a2)) stop 2 + if (size(a2) /= 5) stop 3 + if (any (a2 /= [10,11,12,13,14])) stop 5 + a2(:) = [101, 102, 103, 104, 105] + !$omp end target + + ! pointer: target is automatically mapped + ! without requiring an explicit mapping or even the always modifier + !$omp target !! map(always, tofrom: p1) + if (.not. associated(p1)) stop 7 + if (size(p1) /= 6) stop 8 + if (any (p1 /= [9,8,7,6,5,4])) stop 10 + p1(:) = [-1, -2, -3, -4, -5, -6] + !$omp end target + + !$omp target !! map(always, tofrom: p3) + if (.not. associated(p3)) stop 7 + if (size(p3) /= 3) stop 8 + if (any (p3 /= [4,5,6])) stop 10 + p3(:) = [23,24,25] + !$omp end target + + if (any (p1 /= [-1, -2, -3, -4, -5, -6])) stop 141 + + !$omp target exit data map(from:p3) + !$omp target exit data map(from:p3) + if (any (p3 /= [23,24,25])) stop 141 + + allocate (p1, source=[99,88,77,66,55,44,33]) + + !$omp target ! And this also should work + if (.not. associated(p1)) stop 7 + if (size(p1) /= 7) stop 8 + if (any (p1 /= [99,88,77,66,55,44,33])) stop 10 + p1(:) = [-11, -22, -33, -44, -55, -66, -77] + !$omp end target + !$omp end target data + + if (any (a1 /= [101, 102, 103, 104, 105])) stop 12 + if (any (a2 /= [101, 102, 103, 104, 105])) stop 12 + + if (any (p1 /= [-11, -22, -33, -44, -55, -66, -77])) stop 142 + if (any (p2 /= [-1, -2, -3, -4, -5, -6])) stop 143 + + + block + integer, pointer :: tmp(:), tmp2(:), tmp3(:) + tmp => p1 + tmp2 => p2 + tmp3 => p3 + !$omp target enter data map(to:p3) + + !$omp target data map(to: p1, p2) + p1 => null () + p2 => null () + p3 => null () + !$omp target map(always, tofrom: p1) + if (associated (p1)) stop 22 + !$omp end target + if (associated (p1)) stop 22 + + !$omp target + if (associated (p2)) stop 22 + !$omp end target + if (associated (p2)) stop 22 + + !$omp target + if (associated (p3)) stop 22 + !$omp end target + if (associated (p3)) stop 22 + !$omp end target data + !$omp target exit data map(from:p3) + deallocate(tmp, tmp2, tmp3) + end block + deallocate(a1, a2) +end diff --git a/libgomp/testsuite/libgomp.fortran/map-alloc-ptr-2.f90 b/libgomp/testsuite/libgomp.fortran/map-alloc-ptr-2.f90 new file mode 100644 index 00000000000..c69a9bf44ad --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/map-alloc-ptr-2.f90 @@ -0,0 +1,86 @@ +! { dg-do run } +! +! PR fortran/96668 + +module m + implicit none + integer, pointer :: p1(:) => null(), p3(:) => null() + integer, allocatable :: a1(:), a2(:) + !$omp declare target to(a1, a2, p1, p3) +end module m + +use m +implicit none + integer, pointer :: p2(:) + + !$omp target + if (allocated (a1)) stop 1 + if (allocated (a2)) stop 1 + if (associated (p1)) stop 1 + if (associated (p3)) stop 1 + !$omp end target + + allocate (a1, source=[10,11,12,13,14]) + allocate (a2, source=[10,11,12,13,14]) + allocate (p1, source=[9,8,7,6,5,4]) + allocate (p3, source=[4,5,6]) + p2 => p1 + + !$omp target enter data map(to:p3) + + ! allocatable, TR9 requires 'always' modifier: + !$omp target map(always, tofrom: a1) + if (.not. allocated(a1)) stop 2 + if (size(a1) /= 5) stop 3 + if (any (a1 /= [10,11,12,13,14])) stop 5 + a1(:) = [101, 102, 103, 104, 105] + !$omp end target + + ! allocatable, extension (OpenMP 6.0?): without 'always' + !$omp target + if (.not. allocated(a2)) stop 2 + if (size(a2) /= 5) stop 3 + if (any (a2 /= [10,11,12,13,14])) stop 5 + a2(:) = [101, 102, 103, 104, 105] + !$omp end target + + ! pointer: target is automatically mapped + ! without requiring an explicit mapping or even the always modifier + !$omp target !! map(always, tofrom: p1) + if (.not. associated(p1)) stop 7 + if (size(p1) /= 6) stop 8 + if (any (p1 /= [9,8,7,6,5,4])) stop 10 + p1(:) = [-1, -2, -3, -4, -5, -6] + !$omp end target + + !$omp target !! map(always, tofrom: p3) + if (.not. associated(p3)) stop 7 + if (size(p3) /= 3) stop 8 + if (any (p3 /= [4,5,6])) stop 10 + p3(:) = [23,24,25] + !$omp end target + + !$omp target update from(p1) + if (any (p1 /= [-1, -2, -3, -4, -5, -6])) stop 141 + + !$omp target exit data map(always, from:p3) + if (any (p3 /= [23,24,25])) stop 141 + + allocate (p1, source=[99,88,77,66,55,44,33]) + + !$omp target ! And this also should work + if (.not. associated(p1)) stop 7 + if (size(p1) /= 7) stop 8 + if (any (p1 /= [99,88,77,66,55,44,33])) stop 10 + p1(:) = [-11, -22, -33, -44, -55, -66, -77] + !$omp end target + !$omp target update from(p1) + + if (any (a1 /= [101, 102, 103, 104, 105])) stop 12 + if (any (a2 /= [101, 102, 103, 104, 105])) stop 12 + + if (any (p1 /= [-11, -22, -33, -44, -55, -66, -77])) stop 142 + if (any (p2 /= [-1, -2, -3, -4, -5, -6])) stop 143 + + deallocate(a1, a2, p1, p2, p3) +end -- 2.30.2