diff mbox series

[1/5] OpenMP: Move Fortran 'declare mapper' instantiation code

Message ID a38a757a186a7ed0530bec6eed632d7230b5f3d5.1691672603.git.julian@codesourcery.com
State New
Headers show
Series OpenMP: Implement 'declare mapper' for 'target update' directives | expand

Commit Message

Julian Brown Aug. 10, 2023, 1:33 p.m. UTC
This patch moves the code for explicit 'declare mapper' directive
instantiation in the Fortran front-end to openmp.cc from trans-openmp.cc.
The transformation takes place entirely in the front end's own
representation and doesn't involve middle-end trees at all. Also, having
the code in openmp.cc is more convenient for the following patch that
introduces the 'resolve_omp_mapper_clauses' function.

2023-08-10  Julian Brown  <julian@codesourcery.com>

gcc/fortran/
	* gfortran.h (toc_directive): Move here.
	(gfc_omp_instantiate_mappers, gfc_get_location): Add prototypes.
	* openmp.cc (omp_split_map_op, omp_join_map_op, omp_map_decayed_kind,
	omp_basic_map_kind_name, gfc_subst_replace, gfc_subst_prepend_ref,
	gfc_subst_in_expr_1, gfc_subst_in_expr, gfc_subst_mapper_var): Move
	here.
	(gfc_omp_instantiate_mapper, gfc_omp_instantiate_mappers): Move here
	and rename.
	* trans-openmp.cc (toc_directive, omp_split_map_op, omp_join_map_op,
	omp_map_decayed_kind, gfc_subst_replace, gfc_subst_prepend_ref,
	gfc_subst_in_expr_1, gfc_subst_in_expr, gfc_subst_mapper_var,
	gfc_trans_omp_instantiate_mapper, gfc_trans_omp_instantiate_mappers):
	Remove from here.
	(gfc_trans_omp_target, gfc_trans_omp_target_data,
	gfc_trans_omp_target_enter_data, gfc_trans_omp_target_exit_data):
	Rename calls to gfc_omp_instantiate_mappers.
---
 gcc/fortran/gfortran.h      |  16 ++
 gcc/fortran/openmp.cc       | 435 ++++++++++++++++++++++++++++++++++++
 gcc/fortran/trans-openmp.cc | 388 +-------------------------------
 3 files changed, 456 insertions(+), 383 deletions(-)
diff mbox series

Patch

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 0e7e80e4bf1..788b3797893 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3246,6 +3246,18 @@  typedef struct gfc_finalizer
 gfc_finalizer;
 #define gfc_get_finalizer() XCNEW (gfc_finalizer)
 
+/* Control clause translation per-directive for gfc_trans_omp_clauses.  Also
+   used for gfc_omp_instantiate_mappers.  */
+
+enum toc_directive
+{
+  TOC_OPENMP,
+  TOC_OPENMP_DECLARE_SIMD,
+  TOC_OPENMP_DECLARE_MAPPER,
+  TOC_OPENMP_EXIT_DATA,
+  TOC_OPENACC,
+  TOC_OPENACC_DECLARE
+};
 
 /************************ Function prototypes *************************/
 
@@ -3707,6 +3719,9 @@  void gfc_resolve_omp_do_blocks (gfc_code *, gfc_namespace *);
 void gfc_resolve_omp_declare_simd (gfc_namespace *);
 void gfc_resolve_omp_udrs (gfc_symtree *);
 void gfc_resolve_omp_udms (gfc_symtree *);
+void gfc_omp_instantiate_mappers (gfc_code *, gfc_omp_clauses *,
+				  toc_directive = TOC_OPENMP,
+				  int = OMP_LIST_MAP);
 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 *);
@@ -3956,6 +3971,7 @@  bool gfc_convert_to_structure_constructor (gfc_expr *, gfc_symbol *,
 /* trans.cc */
 void gfc_generate_code (gfc_namespace *);
 void gfc_generate_module_code (gfc_namespace *);
+location_t gfc_get_location (locus *);
 
 /* trans-intrinsic.cc */
 bool gfc_inline_intrinsic_function_p (gfc_expr *);
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index deccb14a525..0f715a6f997 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -12584,6 +12584,441 @@  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 exit_p)
+{
+  if (invoked_as == OMP_MAP_RELEASE || invoked_as == OMP_MAP_DELETE)
+    return invoked_as;
+
+  bool force_p, always_p, 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 (exit_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 = exit_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, force_p, always_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;
+}
+
+static gfc_omp_namelist **
+gfc_omp_instantiate_mapper (gfc_omp_namelist **outlistp,
+			    gfc_omp_namelist *clause,
+			    gfc_omp_map_op outer_map_op, gfc_omp_udm *udm,
+			    toc_directive cd, int list)
+{
+  /* Here "sym" and "expr" describe the clause as written, to be substituted
+     for the dummy variable in the mapper definition.  */
+  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_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;
+	  bool multiple_elems_p = false;
+
+	  if (gfc_array_size (expr, &elems))
+	    {
+	      HOST_WIDE_INT nelems = gfc_mpz_get_hwi (elems);
+	      if (nelems > 1)
+		multiple_elems_p = true;
+	    }
+	  else
+	    multiple_elems_p = true;
+
+	  if (multiple_elems_p && clause->u2.udm)
+	    {
+	      clause->u2.udm->multiple_elems_p = true;
+	      *outlistp = clause;
+	      return &(*outlistp)->next;
+	    }
+	}
+
+      if (lastcomp
+	  && lastcomp->type == REF_COMPONENT
+	  && (lastcomp->u.c.component->attr.pointer
+	      || lastcomp->u.c.component->attr.allocatable))
+	pointer_needed_p = true;
+    }
+
+  if (pointer_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_POINTER_ONLY;
+      *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);
+
+      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,
+				(cd == TOC_OPENMP_EXIT_DATA
+				 || list == OMP_LIST_FROM));
+      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 (0, "Dropping incompatible %qs mapper clause at %C",
+			     omp_basic_map_kind_name (basic_kind));
+		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->u2.udm
+	  && mapper_clause->u2.udm->udm != udm)
+	{
+	  gfc_omp_udm *inner_udm = mapper_clause->u2.udm->udm;
+	  outlistp = gfc_omp_instantiate_mapper (outlistp, new_clause,
+						 outer_map_op, inner_udm, cd,
+						 list);
+	}
+      else
+	{
+	  *outlistp = new_clause;
+	  outlistp = &new_clause->next;
+	}
+    }
+
+  return outlistp;
+}
+
+void
+gfc_omp_instantiate_mappers (gfc_code *code, gfc_omp_clauses *clauses,
+			     toc_directive cd, int list)
+{
+  gfc_omp_namelist *clause = clauses->lists[list];
+  gfc_omp_namelist **clausep = &clauses->lists[list];
+
+  for (; clause; clause = *clausep)
+    {
+      if (clause->u2.udm)
+	{
+	  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 (clausep, clause, outer_map_op,
+						clause->u2.udm->udm, cd, list);
+	  *clausep = clause->next;
+	}
+      else
+	clausep = &clause->next;
+    }
+}
 
 /* The following functions implement automatic recognition and annotation of
    DO loops in OpenACC kernels regions.  Inside a kernels region, a nest of
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 0ef984720d0..170615974b3 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -3859,18 +3859,6 @@  gfc_convert_expr_to_tree (stmtblock_t *block, gfc_expr *expr)
 
 static vec<tree, va_heap, vl_embed> *doacross_steps;
 
-/* Control clause translation per-directive for gfc_trans_omp_clauses.  */
-
-enum toc_directive
-{
-  TOC_OPENMP,
-  TOC_OPENMP_DECLARE_SIMD,
-  TOC_OPENMP_DECLARE_MAPPER,
-  TOC_OPENMP_EXIT_DATA,
-  TOC_OPENACC,
-  TOC_OPENACC_DECLARE
-};
-
 /* Translate an array section or array element.  */
 
 static void
@@ -10082,372 +10070,6 @@  gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa,
   return gfc_finish_block (&block);
 }
 
-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 exit_p)
-{
-  if (invoked_as == OMP_MAP_RELEASE || invoked_as == OMP_MAP_DELETE)
-    return invoked_as;
-
-  bool force_p, always_p, 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 (exit_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 = exit_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, force_p, always_p, present_p);
-}
-
-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;
-}
-
-static gfc_omp_namelist **
-gfc_trans_omp_instantiate_mapper (gfc_omp_namelist **outlistp,
-				  gfc_omp_namelist *clause, gfc_omp_udm *udm,
-				  toc_directive cd)
-{
-  /* Here "sym" and "expr" describe the clause as written, to be substituted
-     for the dummy variable in the mapper definition.  */
-  struct gfc_symbol *sym = clause->sym;
-  struct gfc_expr *expr = clause->expr;
-  gfc_omp_namelist *mapper_clause = udm->clauses->lists[OMP_LIST_MAP];
-  gfc_omp_map_op outer_map_op = clause->u.map_op;
-  bool pointer_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;
-	  bool multiple_elems_p = false;
-
-	  if (gfc_array_size (expr, &elems))
-	    {
-	      HOST_WIDE_INT nelems = gfc_mpz_get_hwi (elems);
-	      if (nelems > 1)
-		multiple_elems_p = true;
-	    }
-	  else
-	    multiple_elems_p = true;
-
-	  if (multiple_elems_p && clause->u2.udm)
-	    {
-	      clause->u2.udm->multiple_elems_p = true;
-	      *outlistp = clause;
-	      return &(*outlistp)->next;
-	    }
-	}
-
-      if (lastcomp
-	  && lastcomp->type == REF_COMPONENT
-	  && (lastcomp->u.c.component->attr.pointer
-	      || lastcomp->u.c.component->attr.allocatable))
-	pointer_needed_p = true;
-    }
-
-  if (pointer_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_POINTER_ONLY;
-      *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);
-
-      enum gfc_omp_map_op map_clause_op = mapper_clause->u.map_op;
-      new_clause->u.map_op
-	= omp_map_decayed_kind (map_clause_op, outer_map_op,
-				(cd == TOC_OPENMP_EXIT_DATA));
-
-      new_clause->where = clause->where;
-
-      if (mapper_clause->u2.udm
-	  && mapper_clause->u2.udm->udm != udm)
-	{
-	  gfc_omp_udm *inner_udm = mapper_clause->u2.udm->udm;
-	  outlistp = gfc_trans_omp_instantiate_mapper (outlistp, new_clause,
-						       inner_udm, cd);
-	}
-      else
-	{
-	  *outlistp = new_clause;
-	  outlistp = &new_clause->next;
-	}
-    }
-
-  return outlistp;
-}
-
-static void
-gfc_trans_omp_instantiate_mappers (gfc_omp_clauses *clauses,
-				   toc_directive cd = TOC_OPENMP)
-{
-  gfc_omp_namelist *clause = clauses->lists[OMP_LIST_MAP];
-  gfc_omp_namelist **clausep = &clauses->lists[OMP_LIST_MAP];
-
-  for (; clause; clause = *clausep)
-    {
-      if (clause->u2.udm)
-	{
-	  clausep = gfc_trans_omp_instantiate_mapper (clausep, clause,
-						      clause->u2.udm->udm, cd);
-	  *clausep = clause->next;
-	}
-      else
-	clausep = &clause->next;
-    }
-}
-
 /* Code callback for gfc_code_walker.  */
 
 static int
@@ -10612,7 +10234,7 @@  gfc_trans_omp_target (gfc_code *code)
   if (flag_openmp)
     {
       gfc_omp_clauses *target_clauses = &clausesa[GFC_OMP_SPLIT_TARGET];
-      gfc_trans_omp_instantiate_mappers (target_clauses);
+      gfc_omp_instantiate_mappers (code, target_clauses);
       omp_clauses = gfc_trans_omp_clauses (&block, target_clauses,
 					   code->loc);
     }
@@ -10895,7 +10517,7 @@  gfc_trans_omp_target_data (gfc_code *code)
 
   gfc_start_block (&block);
   gfc_omp_clauses *target_data_clauses = code->ext.omp_clauses;
-  gfc_trans_omp_instantiate_mappers (target_data_clauses);
+  gfc_omp_instantiate_mappers (code, target_data_clauses);
   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,
@@ -10912,7 +10534,7 @@  gfc_trans_omp_target_enter_data (gfc_code *code)
 
   gfc_start_block (&block);
   gfc_omp_clauses *target_enter_data_clauses = code->ext.omp_clauses;
-  gfc_trans_omp_instantiate_mappers (target_enter_data_clauses);
+  gfc_omp_instantiate_mappers (code, target_enter_data_clauses);
   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,
@@ -10929,8 +10551,8 @@  gfc_trans_omp_target_exit_data (gfc_code *code)
 
   gfc_start_block (&block);
   gfc_omp_clauses *target_exit_data_clauses = code->ext.omp_clauses;
-  gfc_trans_omp_instantiate_mappers (target_exit_data_clauses,
-				     TOC_OPENMP_EXIT_DATA);
+  gfc_omp_instantiate_mappers (code, target_exit_data_clauses,
+			       TOC_OPENMP_EXIT_DATA);
   omp_clauses = gfc_trans_omp_clauses (&block, target_exit_data_clauses,
 				       code->loc, TOC_OPENMP_EXIT_DATA);
   stmt = build1_loc (input_location, OMP_TARGET_EXIT_DATA, void_type_node,