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.
This commit is contained in:
Tobias Burnus
parent
f9d2def016
commit
972da55746
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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. */
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
{
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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). */
|
||||
|
|
|
|||
|
|
@ -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",
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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. */
|
||||
|
|
|
|||
184
libgomp/target.c
184
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);
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
Loading…
Reference in New Issue