[gcc/devel/omp/gcc-16] OpenMP: Move Fortran 'declare mapper' instantiation code
Sandra Loosemore via Gcc-cvs <[email protected]>
| Newsgroups | gmane.comp.gcc.cvs |
|---|---|
| Message-ID | <[email protected]> |
https://gcc.gnu.org/g:54856ebc0418187518bbba9318b32c915265dcaf commit 54856ebc0418187518bbba9318b32c915265dcaf Author: Julian Brown <[email protected]> Date: Tue Jun 30 01:20:51 2026 +0000 OpenMP: Move Fortran 'declare mapper' instantiation code 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. 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. Diff: --- gcc/fortran/gfortran.h | 17 ++ gcc/fortran/openmp.cc | 436 ++++++++++++++++++++++++++++++++++++++++++++ gcc/fortran/trans-openmp.cc | 389 +-------------------------------------- 3 files changed, 458 insertions(+), 384 deletions(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 25c10e35c3fd..824ae37dedbf 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3486,6 +3486,19 @@ 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, + TOC_OPENACC_EXIT_DATA +}; /************************ Function prototypes *************************/ @@ -4001,6 +4014,9 @@ 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 *); +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 *); @@ -4263,6 +4279,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 994979f06218..3ca46aa62a4b 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -14089,6 +14089,442 @@ 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->u3.udm) + { + clause->u3.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->u3.udm + && mapper_clause->u3.udm->udm != udm) + { + gfc_omp_udm *inner_udm = mapper_clause->u3.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 ATTRIBUTE_UNUSED, 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->u3.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->u3.udm->udm, cd, list); + *clausep = clause->next; + } + else + clausep = &clause->next; + } +} + /* Resolve !$omp declare mapper constructs. */ static void diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index 3a849c26caef..71fb94c938f2 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -3442,19 +3442,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, - TOC_OPENACC_EXIT_DATA -}; - /* Map an array section or array element. BLOCK will hold any output statements generated; if there are iterators, it's a block for the current iterator group. @@ -10123,372 +10110,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->u3.udm) - { - clause->u3.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->u3.udm - && mapper_clause->u3.udm->udm != udm) - { - gfc_omp_udm *inner_udm = mapper_clause->u3.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->u3.udm) - { - clausep = gfc_trans_omp_instantiate_mapper (clausep, clause, - clause->u3.udm->udm, cd); - *clausep = clause->next; - } - else - clausep = &clause->next; - } -} - /* Code callback for gfc_code_walker. */ static int @@ -10653,7 +10274,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); } @@ -10934,7 +10555,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, @@ -10951,7 +10572,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, @@ -10968,8 +10589,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,