Attached is a WIP patch to the work on the Fortran declare-mapper handling.
Note: This patch is incomplete and untested, but at least it compiles;
The purpose is to have a backup of the current WIP - and in case it
helps someone.
It is based on Julian's patches - with a smaller fix by Sandra's, namely
it is based on:
015cb4002d6c022b33234e6098303edf159fb19e
Julian Brown <[email protected]>
[PATCH] OpenMP: Fortran "!$omp declare mapper" support
4c94d35536cb3a7cb2a30dae3b8d01370f7a4bea
Julian Brown <[email protected]>
[PATCH] OpenMP: Look up 'declare mapper' definitions at resolution
628859fb41e9f21b9ee048efa5723b1ab4a39a63
Julian Brown <[email protected]>
[PATCH] OpenMP: Reprocess expanded clauses after 'declare mapper'
7affa61f67813b86206db027b981b165bccb84b7
Sandra Loosemore <[email protected]>
[PATCH] OpenMP, Fortran: Handle errors in 'declare mapper'
d2ffdc33f61e889d29b53c82d8514835c6e626aa
Julian Brown <[email protected]>
[PATCH] OpenMP: Move Fortran 'declare mapper' instantiation code
Plus: Looking the current OG15 branch.
Known issues:
* There are surely some patches missing.
- In particular for 'target update' (↓)
* Not handled - and probably in some patch I have not looked at:
implicit mapping - I currently have no idea how that works,
but I have also not checked.
* There a bunch of testcases that needs to be integrated,
proof reading won't harm, either, and minor but crucial
bits are likely missing as well ...
* PR121353 - unrelated to the upstreaming but a declare mapper
bug
Known to be missing due to dependency: Fortran parts of
8d4782a1d2ddbea28763e8767864eb56b2d1d12d
OpenMP: Enable 'declare mapper' mappers for 'target update' directives
1188d7e329d329d0e92534fcc8c739450d3d6eae
OpenMP: Expand "declare mapper" mappers for target {enter,exit,} data directives
Thanks,
Tobias,
who will have limited availability the next two weeks.
gcc/fortran/gfortran.h | 21 +-
gcc/fortran/openmp.cc | 668 ++++++++++++++++++++++++++++++++++++++------
gcc/fortran/trans-openmp.cc | 55 +++-
3 files changed, 650 insertions(+), 94 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 907a42a8734..d4904af4fbe 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1421,7 +1421,8 @@ enum gfc_omp_map_op
OMP_MAP_ALWAYS_PRESENT_TO = OMP_MAP_ALWAYS_TO | OMP_MAP_PRESENT_TO,
OMP_MAP_ALWAYS_PRESENT_FROM = OMP_MAP_ALWAYS_FROM | OMP_MAP_PRESENT_FROM,
OMP_MAP_ALWAYS_PRESENT_TOFROM = OMP_MAP_ALWAYS_TOFROM | OMP_MAP_PRESENT_TOFROM,
- OMP_MAP_UNSET = 1 << 14
+ OMP_MAP_REF_PTR = 1 << 14,
+ OMP_MAP_UNSET = 1 << 15
};
enum gfc_omp_defaultmap
@@ -1723,6 +1724,7 @@ typedef struct gfc_omp_clauses
struct gfc_omp_assumptions *assume;
struct gfc_expr_list *sizes_list;
const char *critical_name;
+ gfc_namespace *ns;
enum gfc_omp_default_sharing default_sharing;
enum gfc_omp_atomic_op atomic_op;
enum gfc_omp_defaultmap defaultmap[OMP_DEFAULTMAP_CAT_NUM];
@@ -3530,6 +3532,21 @@ typedef struct gfc_finalizer
gfc_finalizer;
#define gfc_get_finalizer() XCNEW (gfc_finalizer)
+/* Used in trans-openmp.cc and open.cc to distinguish the OpenMP/OpenACC region.
+ Value < vs. >= GFC_ORT_OPENACC can be used to distinguish OpenMP vs.
+ OpenACC. */
+
+enum gfc_omp_region_type
+{
+ GFC_ORT_OPENMP,
+ GFC_ORT_OPENMP_DECLARE_SIMD,
+ GFC_ORT_OPENMP_DECLARE_MAPPER,
+ GFC_ORT_OPENMP_EXIT_DATA,
+ GFC_ORT_OPENACC,
+ GFC_ORT_OPENACC_DECLARE,
+ GFC_ORT_OPENACC_EXIT_DATA
+};
+
/************************ Function prototypes *************************/
@@ -4059,6 +4076,8 @@ void gfc_resolve_omp_do_blocks (gfc_code *, gfc_namespace *);
void gfc_resolve_omp_declare (gfc_namespace *);
void gfc_resolve_omp_udrs (gfc_symtree *);
void gfc_resolve_omp_udms (gfc_symtree *);
+bool gfc_omp_instantiate_mappers (gfc_code *, gfc_omp_clauses *,
+ gfc_omp_region_type, enum gfc_omp_list_type);
void gfc_omp_save_and_clear_state (struct gfc_omp_saved_state *);
void gfc_omp_restore_state (struct gfc_omp_saved_state *);
void gfc_free_expr_list (gfc_expr_list *);
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index bea829a3843..c70247b45c6 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -9728,7 +9728,7 @@ resolve_omp_clauses_aff_dep_map_cache (gfc_code *code,
const char *name,
enum gfc_omp_list_type list,
gfc_omp_clauses *omp_clauses,
- bool openacc)
+ gfc_namespace *ns, bool openacc)
{
gcc_checking_assert (list == OMP_LIST_AFFINITY || list == OMP_LIST_DEPEND
|| list == OMP_LIST_MAP || list == OMP_LIST_TO
@@ -9947,92 +9947,89 @@ resolve_omp_clauses_aff_dep_map_cache (gfc_code *code,
case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
case EXEC_OMP_TARGET_TEAMS_LOOP:
case EXEC_OMP_TARGET_DATA:
- switch (n->u.map.op)
- {
- case OMP_MAP_TO:
- case OMP_MAP_ALWAYS_TO:
- case OMP_MAP_PRESENT_TO:
- case OMP_MAP_ALWAYS_PRESENT_TO:
- case OMP_MAP_FROM:
- case OMP_MAP_ALWAYS_FROM:
- case OMP_MAP_PRESENT_FROM:
- case OMP_MAP_ALWAYS_PRESENT_FROM:
- case OMP_MAP_TOFROM:
- case OMP_MAP_ALWAYS_TOFROM:
- case OMP_MAP_PRESENT_TOFROM:
- case OMP_MAP_ALWAYS_PRESENT_TOFROM:
- case OMP_MAP_ALLOC:
- case OMP_MAP_PRESENT_ALLOC:
- break;
- default:
- gfc_error ("TARGET%s with map-type other than TO, "
- "FROM, TOFROM, or ALLOC on MAP clause "
- "at %L",
- code->op == EXEC_OMP_TARGET_DATA
- ? " DATA" : "", &n->where);
- break;
- }
+ switch (n->u.map.op)
+ {
+ case OMP_MAP_TO:
+ case OMP_MAP_ALWAYS_TO:
+ case OMP_MAP_PRESENT_TO:
+ case OMP_MAP_ALWAYS_PRESENT_TO:
+ case OMP_MAP_FROM:
+ case OMP_MAP_ALWAYS_FROM:
+ case OMP_MAP_PRESENT_FROM:
+ case OMP_MAP_ALWAYS_PRESENT_FROM:
+ case OMP_MAP_TOFROM:
+ case OMP_MAP_ALWAYS_TOFROM:
+ case OMP_MAP_PRESENT_TOFROM:
+ case OMP_MAP_ALWAYS_PRESENT_TOFROM:
+ case OMP_MAP_ALLOC:
+ case OMP_MAP_PRESENT_ALLOC:
break;
+ default:
+ gfc_error ("TARGET%s with map-type other than TO, FROM, TOFROM, or "
+ "ALLOC on MAP clause at %L",
+ code->op == EXEC_OMP_TARGET_DATA ? " DATA" : "",
+ &n->where);
+ break;
+ }
+ break;
case EXEC_OMP_TARGET_ENTER_DATA:
- switch (n->u.map.op)
- {
- case OMP_MAP_TO:
- case OMP_MAP_ALWAYS_TO:
- case OMP_MAP_PRESENT_TO:
- case OMP_MAP_ALWAYS_PRESENT_TO:
- case OMP_MAP_ALLOC:
- case OMP_MAP_PRESENT_ALLOC:
- break;
- case OMP_MAP_TOFROM:
- n->u.map.op = OMP_MAP_TO;
- break;
- case OMP_MAP_ALWAYS_TOFROM:
- n->u.map.op = OMP_MAP_ALWAYS_TO;
- break;
- case OMP_MAP_PRESENT_TOFROM:
- n->u.map.op = OMP_MAP_PRESENT_TO;
- break;
- case OMP_MAP_ALWAYS_PRESENT_TOFROM:
- n->u.map.op = OMP_MAP_ALWAYS_PRESENT_TO;
- break;
- default:
- gfc_error ("TARGET ENTER DATA with map-type other "
- "than TO, TOFROM or ALLOC on MAP clause "
- "at %L", &n->where);
- break;
- }
+ switch (n->u.map.op)
+ {
+ case OMP_MAP_TO:
+ case OMP_MAP_ALWAYS_TO:
+ case OMP_MAP_PRESENT_TO:
+ case OMP_MAP_ALWAYS_PRESENT_TO:
+ case OMP_MAP_ALLOC:
+ case OMP_MAP_PRESENT_ALLOC:
+ break;
+ case OMP_MAP_TOFROM:
+ n->u.map.op = OMP_MAP_TO;
+ break;
+ case OMP_MAP_ALWAYS_TOFROM:
+ n->u.map.op = OMP_MAP_ALWAYS_TO;
+ break;
+ case OMP_MAP_PRESENT_TOFROM:
+ n->u.map.op = OMP_MAP_PRESENT_TO;
break;
+ case OMP_MAP_ALWAYS_PRESENT_TOFROM:
+ n->u.map.op = OMP_MAP_ALWAYS_PRESENT_TO;
+ break;
+ default:
+ gfc_error ("TARGET ENTER DATA with map-type other than TO, TOFROM "
+ "or ALLOC on MAP clause at %L", &n->where);
+ break;
+ }
+ break;
case EXEC_OMP_TARGET_EXIT_DATA:
- switch (n->u.map.op)
- {
- case OMP_MAP_FROM:
- case OMP_MAP_ALWAYS_FROM:
- case OMP_MAP_PRESENT_FROM:
- case OMP_MAP_ALWAYS_PRESENT_FROM:
- case OMP_MAP_RELEASE:
- case OMP_MAP_DELETE:
- break;
- case OMP_MAP_TOFROM:
- n->u.map.op = OMP_MAP_FROM;
- break;
- case OMP_MAP_ALWAYS_TOFROM:
- n->u.map.op = OMP_MAP_ALWAYS_FROM;
- break;
- case OMP_MAP_PRESENT_TOFROM:
- n->u.map.op = OMP_MAP_PRESENT_FROM;
- break;
- case OMP_MAP_ALWAYS_PRESENT_TOFROM:
- n->u.map.op = OMP_MAP_ALWAYS_PRESENT_FROM;
- break;
- default:
- gfc_error ("TARGET EXIT DATA with map-type other "
- "than FROM, TOFROM, RELEASE, or DELETE on "
- "MAP clause at %L", &n->where);
- break;
- }
+ switch (n->u.map.op)
+ {
+ case OMP_MAP_FROM:
+ case OMP_MAP_ALWAYS_FROM:
+ case OMP_MAP_PRESENT_FROM:
+ case OMP_MAP_ALWAYS_PRESENT_FROM:
+ case OMP_MAP_RELEASE:
+ case OMP_MAP_DELETE:
break;
- default:
+ case OMP_MAP_TOFROM:
+ n->u.map.op = OMP_MAP_FROM;
+ break;
+ case OMP_MAP_ALWAYS_TOFROM:
+ n->u.map.op = OMP_MAP_ALWAYS_FROM;
+ break;
+ case OMP_MAP_PRESENT_TOFROM:
+ n->u.map.op = OMP_MAP_PRESENT_FROM;
+ break;
+ case OMP_MAP_ALWAYS_PRESENT_TOFROM:
+ n->u.map.op = OMP_MAP_ALWAYS_PRESENT_FROM;
break;
+ default:
+ gfc_error ("TARGET EXIT DATA with map-type other than FROM, TOFROM,"
+ " RELEASE, or DELETE on MAP clause at %L", &n->where);
+ break;
+ }
+ break;
+ default:
+ break;
}
if (list == OMP_LIST_MAP || list == OMP_LIST_TO || list == OMP_LIST_FROM)
{
@@ -10042,7 +10039,7 @@ resolve_omp_clauses_aff_dep_map_cache (gfc_code *code,
{
const char *mapper_id = (n->u3.udm
? n->u3.udm->requested_mapper_id : "");
- gfc_omp_udm *udm = gfc_find_omp_udm (gfc_current_ns, mapper_id, ts);
+ gfc_omp_udm *udm = gfc_find_omp_udm (ns, mapper_id, ts);
if (mapper_id[0] != '\0' && !udm)
gfc_error ("User-defined mapper %qs not found at %L",
mapper_id, &n->where);
@@ -10071,6 +10068,45 @@ resolve_omp_clauses_aff_dep_map_cache (gfc_code *code,
}
}
+/* This very simplified version of resolve_clauses to handle declare mapper
+ instantiation. It avoids dealing with anything other than basic
+ verification for map/to/from clauses. */
+
+static void
+resolve_omp_mapper_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
+ gfc_namespace *ns)
+{
+ gfc_omp_namelist *n;
+ gfc_omp_list_type list;
+
+ check_omp_clauses_dupl_syms (code, omp_clauses, false);
+
+ for (list = OMP_LIST_FIRST; list < OMP_LIST_NUM;
+ list = gfc_omp_list_type (list + 1))
+ {
+ if (list != OMP_LIST_MAP
+ && list != OMP_LIST_TO
+ && list != OMP_LIST_FROM)
+ continue;
+ n = omp_clauses->lists[list];
+ if (!n)
+ continue;
+ const char *name = NULL;
+ switch (list)
+ {
+ case OMP_LIST_MAP: name = "MAP"; break;
+ case OMP_LIST_TO: name = "TO"; break;
+ case OMP_LIST_FROM: name = "FROM"; break;
+ default: gcc_unreachable ();
+ }
+ if ((n = omp_clauses->lists[list]) != NULL)
+ for (; n != NULL; n = n->next)
+ resolve_omp_clauses_aff_dep_map_cache (code, n, name, list,
+ omp_clauses, ns, false);
+ }
+}
+
+
/* OpenMP directive resolving routines. */
static void
@@ -10098,7 +10134,11 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
if (omp_clauses == NULL)
return;
- if (ns == NULL)
+ /* For declared mapper, the original namespace needs to be preserved
+ to find the symbols for later mapper resolutions. */
+ if (ns)
+ omp_clauses->ns = ns;
+ else
ns = gfc_current_ns;
check_omp_clauses_dupl_syms (code, omp_clauses, openacc);
@@ -10550,7 +10590,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
case OMP_LIST_CACHE:
for (; n != NULL; n = n->next)
resolve_omp_clauses_aff_dep_map_cache (code, n, name, list,
- omp_clauses, openacc);
+ omp_clauses, ns, openacc);
break;
case OMP_LIST_IS_DEVICE_PTR:
last = NULL;
@@ -14185,6 +14225,466 @@ gfc_resolve_omp_udrs (gfc_symtree *st)
gfc_resolve_omp_udr (omp_udr);
}
+static enum gfc_omp_map_op
+omp_split_map_op (enum gfc_omp_map_op op, bool *force_p, bool *always_p,
+ bool *present_p)
+{
+ *force_p = *always_p = *present_p = false;
+
+ switch (op)
+ {
+ case OMP_MAP_FORCE_ALLOC:
+ case OMP_MAP_FORCE_TO:
+ case OMP_MAP_FORCE_FROM:
+ case OMP_MAP_FORCE_TOFROM:
+ case OMP_MAP_FORCE_PRESENT:
+ *force_p = true;
+ break;
+ case OMP_MAP_ALWAYS_TO:
+ case OMP_MAP_ALWAYS_FROM:
+ case OMP_MAP_ALWAYS_TOFROM:
+ *always_p = true;
+ break;
+ case OMP_MAP_ALWAYS_PRESENT_TO:
+ case OMP_MAP_ALWAYS_PRESENT_FROM:
+ case OMP_MAP_ALWAYS_PRESENT_TOFROM:
+ *always_p = true;
+ /* Fallthrough. */
+ case OMP_MAP_PRESENT_ALLOC:
+ case OMP_MAP_PRESENT_TO:
+ case OMP_MAP_PRESENT_FROM:
+ case OMP_MAP_PRESENT_TOFROM:
+ *present_p = true;
+ break;
+ default:
+ ;
+ }
+
+ switch (op)
+ {
+ case OMP_MAP_ALLOC:
+ case OMP_MAP_FORCE_ALLOC:
+ case OMP_MAP_PRESENT_ALLOC:
+ return OMP_MAP_ALLOC;
+ case OMP_MAP_TO:
+ case OMP_MAP_FORCE_TO:
+ case OMP_MAP_ALWAYS_TO:
+ case OMP_MAP_PRESENT_TO:
+ case OMP_MAP_ALWAYS_PRESENT_TO:
+ return OMP_MAP_TO;
+ case OMP_MAP_FROM:
+ case OMP_MAP_FORCE_FROM:
+ case OMP_MAP_ALWAYS_FROM:
+ case OMP_MAP_PRESENT_FROM:
+ case OMP_MAP_ALWAYS_PRESENT_FROM:
+ return OMP_MAP_FROM;
+ case OMP_MAP_TOFROM:
+ case OMP_MAP_FORCE_TOFROM:
+ case OMP_MAP_ALWAYS_TOFROM:
+ case OMP_MAP_PRESENT_TOFROM:
+ case OMP_MAP_ALWAYS_PRESENT_TOFROM:
+ return OMP_MAP_TOFROM;
+ default:
+ ;
+ }
+ return op;
+}
+
+static enum gfc_omp_map_op
+omp_join_map_op (enum gfc_omp_map_op op, bool force_p, bool always_p,
+ bool present_p)
+{
+ gcc_assert (!force_p || !(always_p || present_p));
+
+ switch (op)
+ {
+ case OMP_MAP_ALLOC:
+ if (force_p)
+ return OMP_MAP_FORCE_ALLOC;
+ else if (present_p)
+ return OMP_MAP_PRESENT_ALLOC;
+ break;
+
+ case OMP_MAP_TO:
+ if (force_p)
+ return OMP_MAP_FORCE_TO;
+ else if (always_p && present_p)
+ return OMP_MAP_ALWAYS_PRESENT_TO;
+ else if (always_p)
+ return OMP_MAP_ALWAYS_TO;
+ else if (present_p)
+ return OMP_MAP_PRESENT_TO;
+ break;
+
+ case OMP_MAP_FROM:
+ if (force_p)
+ return OMP_MAP_FORCE_FROM;
+ else if (always_p && present_p)
+ return OMP_MAP_ALWAYS_PRESENT_FROM;
+ else if (always_p)
+ return OMP_MAP_ALWAYS_FROM;
+ else if (present_p)
+ return OMP_MAP_PRESENT_FROM;
+ break;
+
+ case OMP_MAP_TOFROM:
+ if (force_p)
+ return OMP_MAP_FORCE_TOFROM;
+ else if (always_p && present_p)
+ return OMP_MAP_ALWAYS_PRESENT_TOFROM;
+ else if (always_p)
+ return OMP_MAP_ALWAYS_TOFROM;
+ else if (present_p)
+ return OMP_MAP_PRESENT_TOFROM;
+ break;
+
+ default:
+ ;
+ }
+
+ return op;
+}
+
+/* Map kind decay (OpenMP 5.2, 5.8.8 "declare mapper Directive"). Return the
+ map kind to use given MAPPER_KIND specified in the mapper and INVOKED_AS
+ specified on the clause that invokes the mapper. See also
+ c-family/c-omp.cc:omp_map_decayed_kind. */
+
+static enum gfc_omp_map_op
+omp_map_decayed_kind (enum gfc_omp_map_op mapper_kind,
+ enum gfc_omp_map_op invoked_as, bool map_exiting_p)
+{
+ if (invoked_as == OMP_MAP_RELEASE || invoked_as == OMP_MAP_DELETE)
+ return invoked_as;
+
+ bool m_force_p, m_always_p, m_present_p;
+ bool force_p, always_p, present_p;
+
+// FIXME: Add testcase as with C
+ mapper_kind = omp_split_map_op (mapper_kind, &m_force_p, &m_always_p, &m_present_p);
+ invoked_as = omp_split_map_op (invoked_as, &force_p, &always_p, &present_p);
+ gfc_omp_map_op decay_to;
+
+ switch (mapper_kind)
+ {
+ case OMP_MAP_ALLOC:
+ if (map_exiting_p && invoked_as == OMP_MAP_FROM)
+ decay_to = OMP_MAP_RELEASE;
+ else
+ decay_to = OMP_MAP_ALLOC;
+ break;
+
+ case OMP_MAP_TO:
+ if (invoked_as == OMP_MAP_FROM)
+ decay_to = map_exiting_p ? OMP_MAP_RELEASE : OMP_MAP_ALLOC;
+ else if (invoked_as == OMP_MAP_ALLOC)
+ decay_to = OMP_MAP_ALLOC;
+ else
+ decay_to = OMP_MAP_TO;
+ break;
+
+ case OMP_MAP_FROM:
+ if (invoked_as == OMP_MAP_ALLOC || invoked_as == OMP_MAP_TO)
+ decay_to = OMP_MAP_ALLOC;
+ else
+ decay_to = OMP_MAP_FROM;
+ break;
+
+ case OMP_MAP_TOFROM:
+ case OMP_MAP_UNSET:
+ decay_to = invoked_as;
+ break;
+
+ default:
+ gcc_unreachable ();
+ }
+
+ return omp_join_map_op (decay_to, m_force_p | force_p,
+ m_always_p | always_p, m_present_p | present_p);
+}
+
+static const char *
+omp_basic_map_kind_name (enum gfc_omp_map_op op)
+{
+ switch (op)
+ {
+ case OMP_MAP_ALLOC:
+ return "ALLOC";
+ case OMP_MAP_TO:
+ return "TO";
+ case OMP_MAP_FROM:
+ return "FROM";
+ case OMP_MAP_TOFROM:
+ return "TOFROM";
+ case OMP_MAP_RELEASE:
+ return "RELEASE";
+ case OMP_MAP_DELETE:
+ return "DELETE";
+ default:
+ gcc_unreachable ();
+ }
+}
+
+static gfc_symtree *gfc_subst_replace;
+static gfc_ref *gfc_subst_prepend_ref;
+
+static bool
+gfc_subst_in_expr_1 (gfc_expr *expr, gfc_symbol *search, int *)
+{
+ /* The base-object for component accesses may be stored in expr->symtree.
+ If it's the symbol for our "declare mapper" placeholder variable,
+ substitute it. */
+ if (expr->symtree && expr->symtree->n.sym == search)
+ {
+ gfc_ref **lastptr = NULL;
+ expr->symtree = gfc_subst_replace;
+
+ if (!gfc_subst_prepend_ref)
+ return false;
+
+ gfc_ref *prepend_ref = gfc_copy_ref (gfc_subst_prepend_ref);
+
+ for (gfc_ref *walk = prepend_ref; walk; walk = walk->next)
+ lastptr = &walk->next;
+
+ *lastptr = expr->ref;
+ expr->ref = prepend_ref;
+ }
+
+ return false;
+}
+
+
+static void
+gfc_subst_in_expr (gfc_expr *expr, gfc_symbol *search, gfc_symtree *replace,
+ gfc_ref *prepend_ref)
+{
+ gfc_subst_replace = replace;
+ gfc_subst_prepend_ref = prepend_ref;
+ gfc_traverse_expr (expr, search, gfc_subst_in_expr_1, 0);
+}
+
+
+static void
+gfc_subst_mapper_var (gfc_symbol **out_sym, gfc_expr **out_expr,
+ gfc_symbol *orig_sym, gfc_expr *orig_expr,
+ gfc_symbol *dummy_var,
+ gfc_symbol *templ_sym, gfc_expr *templ_expr)
+{
+ gfc_ref *orig_ref = orig_expr ? orig_expr->ref : NULL;
+ gfc_symtree *orig_st = gfc_find_symtree (orig_sym->ns->sym_root,
+ orig_sym->name);
+ if (dummy_var == templ_sym)
+ *out_sym = orig_sym;
+ else
+ *out_sym = templ_sym;
+
+ if (templ_expr)
+ {
+ *out_expr = gfc_copy_expr (templ_expr);
+ gfc_subst_in_expr (*out_expr, dummy_var, orig_st, orig_ref);
+ }
+ else if (orig_expr)
+ *out_expr = gfc_copy_expr (orig_expr);
+ else
+ *out_expr = NULL;
+}
+
+
+/* Apply the mapper operations to the list item of the CLAUSE, OUTER_MAP_OP
+ contains the map-type modifier to be used (same as in the clause for the
+ 'map' clause but not for the 'to'/'from' clauses). UDM contains the resolved
+ mapper for the list item while ORT and LIST are used to distinguis map
+ entering and map exiting. OUTLISTP contains the resulting clauses.
+
+ Note that for list items that are pointer variables, both the pointer
+ and the pointee are mapped such that an additional map clause for the
+ pointer (bare or array descriptor as applicable) is added; likewise for
+ allocatables. */
+
+static gfc_omp_namelist **
+gfc_omp_instantiate_mapper (gfc_code *code,
+ gfc_omp_namelist **outlistp,
+ gfc_omp_namelist *clause,
+ gfc_omp_map_op outer_map_op, gfc_omp_udm *udm,
+ gfc_namespace *ns, gfc_omp_region_type ort,
+ enum gfc_omp_list_type list)
+{
+ struct gfc_symbol *sym = clause->sym;
+ struct gfc_expr *expr = clause->expr;
+ gfc_omp_namelist *mapper_clause = udm->clauses->lists[OMP_LIST_MAP];
+ bool pointer_map_needed_p = false;
+
+ if (expr)
+ {
+ gfc_ref *lastref = expr->ref, *lastcomp = NULL;
+
+ for (; lastref->next; lastref = lastref->next)
+ if (lastref->type == REF_COMPONENT)
+ lastcomp = lastref;
+
+ if (lastref
+ && lastref->type == REF_ARRAY
+ && (lastref->u.ar.type == AR_SECTION
+ || lastref->u.ar.type == AR_FULL))
+ {
+ mpz_t elems;
+ if (!gfc_array_size (expr, &elems) || gfc_mpz_get_hwi (elems) > 0)
+ gfc_error ("Sorry, mapping array-valued list items with a mapper "
+ "is not yet supported at %L", &clause->where);
+ }
+ if (lastcomp
+ && lastcomp->type == REF_COMPONENT
+ && (lastcomp->u.c.component->attr.pointer
+ || lastcomp->u.c.component->attr.allocatable))
+ pointer_map_needed_p = true;
+ }
+
+ if (pointer_map_needed_p)
+ {
+ /* If we're instantiating a mapper via a pointer, we need to map that
+ pointer as well as mapping the entities explicitly listed in the
+ mapper definition. Create a node for that. */
+ gfc_omp_namelist *new_clause = gfc_get_omp_namelist ();
+ new_clause->sym = sym;
+ new_clause->expr = gfc_copy_expr (expr);
+ /* We want the pointer itself: cut off any further accessors after the
+ last component reference (e.g. array indices). */
+ gfc_ref *lastcomp = NULL;
+ for (gfc_ref *lastref = new_clause->expr->ref;
+ lastref; lastref = lastref->next)
+ if (lastref->type == REF_COMPONENT)
+ lastcomp = lastref;
+ gcc_assert (lastcomp != NULL);
+ lastcomp->next = NULL;
+ new_clause->u.map.op = OMP_MAP_REF_PTR;
+ *outlistp = new_clause;
+ outlistp = &new_clause->next;
+ }
+
+ for (; mapper_clause; mapper_clause = mapper_clause->next)
+ {
+ gfc_omp_namelist *new_clause = gfc_get_omp_namelist ();
+
+ gfc_subst_mapper_var (&new_clause->sym, &new_clause->expr,
+ sym, expr, udm->var_sym, mapper_clause->sym,
+ mapper_clause->expr);
+
+ bool map_exiting_p = (ort == GFC_ORT_OPENMP_EXIT_DATA
+ || list == OMP_LIST_FROM);
+ enum gfc_omp_map_op map_clause_op = mapper_clause->u.map.op;
+ enum gfc_omp_map_op new_kind
+ = omp_map_decayed_kind (map_clause_op, outer_map_op, map_exiting_p);
+ if (list == OMP_LIST_FROM || list == OMP_LIST_TO)
+ {
+ switch (new_kind)
+ {
+ case OMP_MAP_PRESENT_FROM:
+ case OMP_MAP_PRESENT_TO:
+ new_clause->u.present_modifier = true;
+ /* Fallthrough. */
+ case OMP_MAP_FROM:
+ case OMP_MAP_TO:
+ break;
+ default:
+ {
+ bool present_p, force_p, always_p;
+ gfc_omp_map_op basic_kind
+ = omp_split_map_op (map_clause_op, &force_p, &always_p,
+ &present_p);
+ free (new_clause);
+ gfc_warning (OPT_Wopenmp,
+ "Dropping incompatible %qs mapper clause at %L",
+ omp_basic_map_kind_name (basic_kind),
+ &clause->where);
+ inform (gfc_get_location (&mapper_clause->where),
+ "Defined here");
+ continue;
+ }
+ }
+ }
+ else
+ new_clause->u.map.op = new_kind;
+
+ new_clause->where = clause->where;
+
+ if (mapper_clause->u3.udm
+ && mapper_clause->u3.udm->resolved_udm != udm)
+ {
+ gfc_omp_udm *inner_udm = mapper_clause->u3.udm->resolved_udm;
+ outlistp = gfc_omp_instantiate_mapper (code, outlistp, new_clause,
+ outer_map_op, inner_udm,
+ ns, ort, list);
+ }
+ else
+ {
+ *outlistp = new_clause;
+ outlistp = &new_clause->next;
+ }
+ }
+ return outlistp;
+}
+
+/* Instantiate mappers for CLAUSES for LIST. Returns true on success and
+ false if errors were diagnosed. */
+
+bool
+gfc_omp_instantiate_mappers (gfc_code *code, gfc_omp_clauses *clauses,
+ gfc_omp_region_type ort,
+ enum gfc_omp_list_type list)
+{
+
+ gfc_omp_namelist *clause = clauses->lists[list];
+ gfc_omp_namelist **clausep = &clauses->lists[list];
+ bool invoked_mappers = false;
+ int orig_error_cnt, new_error_cnt;
+ gfc_get_errors (NULL, &orig_error_cnt);
+
+ for (; clause; clause = *clausep)
+ {
+ if (!clause->u3.udm)
+ {
+ clausep = &clause->next;
+ continue;
+ }
+ invoked_mappers = true;
+ gfc_omp_map_op outer_map_op;
+ switch (list)
+ {
+ case OMP_LIST_TO:
+ outer_map_op = (clause->u.present_modifier ? OMP_MAP_PRESENT_TO
+ : OMP_MAP_TO);
+ break;
+ case OMP_LIST_FROM:
+ outer_map_op = (clause->u.present_modifier ? OMP_MAP_PRESENT_FROM
+ : OMP_MAP_FROM);
+ break;
+ case OMP_LIST_MAP:
+ outer_map_op = clause->u.map.op;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+ clausep = gfc_omp_instantiate_mapper (code, clausep, clause, outer_map_op,
+ clause->u3.udm->resolved_udm,
+ clause->u2.ns, ort, list);
+ *clausep = clause->next;
+ }
+
+ if (invoked_mappers)
+ {
+ gfc_namespace *old_ns = gfc_current_ns;
+ if (clauses->ns)
+ gfc_current_ns = clauses->ns;
+ resolve_omp_mapper_clauses (code, clauses, gfc_current_ns);
+ gfc_current_ns = old_ns;
+ }
+
+ gfc_get_errors (NULL, &new_error_cnt);
+ return new_error_cnt == orig_error_cnt;
+}
+
+
/* Resolve !$omp declare mapper constructs. */
static void
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 8d5842685a5..dfd04f54852 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -9255,9 +9255,16 @@ gfc_trans_omp_target (gfc_code *code)
gfc_start_block (&block);
gfc_split_omp_clauses (code, clausesa);
if (flag_openmp)
- omp_clauses
- = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TARGET],
- code->loc);
+ {
+ gfc_omp_clauses *target_clauses = &clausesa[GFC_OMP_SPLIT_TARGET];
+ if (!gfc_omp_instantiate_mappers (code, target_clauses,
+ GFC_ORT_OPENMP, OMP_LIST_MAP))
+ {
+ stmt = error_mark_node;
+ goto done;
+ }
+ omp_clauses = gfc_trans_omp_clauses (&block, target_clauses, code->loc);
+ }
switch (code->op)
{
case EXEC_OMP_TARGET:
@@ -9354,6 +9361,7 @@ gfc_trans_omp_target (gfc_code *code)
OMP_TARGET_COMBINED (stmt) = 1;
cfun->has_omp_target = true;
}
+ done:
gfc_add_expr_to_block (&block, stmt);
gfc_free_split_omp_clauses (code, clausesa);
return gfc_finish_block (&block);
@@ -9532,8 +9540,19 @@ gfc_trans_omp_target_data (gfc_code *code)
tree stmt, omp_clauses;
gfc_start_block (&block);
- omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
- code->loc);
+ gfc_omp_clauses *target_data_clauses = code->ext.omp_clauses;
+ if (gfc_omp_instantiate_mappers (code, target_data_clauses,
+ GFC_ORT_OPENMP, OMP_LIST_MAP))
+ {
+ omp_clauses = gfc_trans_omp_clauses (&block, target_data_clauses,
+ code->loc);
+ stmt = gfc_trans_omp_code (code->block->next, true);
+ stmt = build2_loc (gfc_get_location (&code->loc), OMP_TARGET_DATA,
+ void_type_node, stmt, omp_clauses);
+ }
+ else
+ stmt = error_mark_node;
+ omp_clauses = gfc_trans_omp_clauses (&block, target_data_clauses, code->loc);
stmt = gfc_trans_omp_code (code->block->next, true);
stmt = build2_loc (gfc_get_location (&code->loc), OMP_TARGET_DATA,
void_type_node, stmt, omp_clauses);
@@ -9548,8 +9567,17 @@ gfc_trans_omp_target_enter_data (gfc_code *code)
tree stmt, omp_clauses;
gfc_start_block (&block);
- omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
- code->loc);
+ gfc_omp_clauses *target_enter_data_clauses = code->ext.omp_clauses;
+ if (gfc_omp_instantiate_mappers (code, target_enter_data_clauses,
+ GFC_ORT_OPENMP, OMP_LIST_MAP))
+ {
+ omp_clauses = gfc_trans_omp_clauses (&block, target_enter_data_clauses,
+ code->loc);
+ stmt = build1_loc (input_location, OMP_TARGET_ENTER_DATA, void_type_node,
+ omp_clauses);
+ }
+ else
+ stmt = error_mark_node;
stmt = build1_loc (input_location, OMP_TARGET_ENTER_DATA, void_type_node,
omp_clauses);
gfc_add_expr_to_block (&block, stmt);
@@ -9563,8 +9591,17 @@ gfc_trans_omp_target_exit_data (gfc_code *code)
tree stmt, omp_clauses;
gfc_start_block (&block);
- omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
- code->loc, false, false, code->op);
+ gfc_omp_clauses *target_exit_data_clauses = code->ext.omp_clauses;
+ if (gfc_omp_instantiate_mappers (code, target_exit_data_clauses,
+ GFC_ORT_OPENMP_EXIT_DATA, OMP_LIST_MAP))
+ {
+ omp_clauses = gfc_trans_omp_clauses (&block, target_exit_data_clauses,
+ code->loc, GFC_ORT_OPENMP_EXIT_DATA);
+ stmt = build1_loc (input_location, OMP_TARGET_EXIT_DATA, void_type_node,
+ omp_clauses);
+ }
+ else
+ stmt = error_mark_node;
stmt = build1_loc (input_location, OMP_TARGET_EXIT_DATA, void_type_node,
omp_clauses);
gfc_add_expr_to_block (&block, stmt);
