https://gcc.gnu.org/g:c491384d5c4917792f176bfe8535e6543bf5f59b
commit c491384d5c4917792f176bfe8535e6543bf5f59b Author: Julian Brown <[email protected]> Date: Mon Jun 29 21:26:59 2026 +0000 OpenMP, Fortran: Expand "declare mapper" mappers for target {enter,exit,} data directives This patch allows 'declare mapper' mappers to be used on 'omp target data', 'omp target enter data' and 'omp target exit data' directives. For each of these, only explicit mappings are supported, unlike for 'omp target' directives where implicit uses of variables inside an offload region might trigger mappers also. This version of the patch is derived from OG15 commit 214479eb07f, and contains only the Fortran parts; the C and C++ parts were already upstream. The patch also adjusts 'map kind decay' to match OpenMP 5.2 semantics, which is particularly important with regard to 'exit data' operations. gcc/fortran/ * trans-openmp.cc (omp_split_map_op, omp_join_map_op, omp_map_decayed_kind): New functions. (gfc_trans_omp_instantiate_mapper): Add CD parameter. Implement map kind decay. (gfc_trans_omp_instantiate_mappers): Add CD parameter. Pass to above function. (gfc_trans_omp_target_data): Instantiate mappers for 'omp target data'. (gfc_trans_omp_target_enter_data): Instantiate mappers for 'omp target enter data'. (gfc_trans_omp_target_exit_data): Instantiate mappers for 'omp target exit data'. gcc/testsuite/ * gfortran.dg/gomp/declare-mapper-22.f90: New test. * gfortran.dg/gomp/declare-mapper-23.f90: New test. Diff: --- gcc/fortran/trans-openmp.cc | 209 +++++++++++++++++++-- .../gfortran.dg/gomp/declare-mapper-22.f90 | 60 ++++++ .../gfortran.dg/gomp/declare-mapper-23.f90 | 25 +++ 3 files changed, 280 insertions(+), 14 deletions(-) diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index 69c9125a3b8a..3a849c26caef 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -10123,6 +10123,180 @@ 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; @@ -10189,7 +10363,8 @@ gfc_subst_mapper_var (gfc_symbol **out_sym, gfc_expr **out_expr, static gfc_omp_namelist ** gfc_trans_omp_instantiate_mapper (gfc_omp_namelist **outlistp, - gfc_omp_namelist *clause, gfc_omp_udm *udm) + 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. */ @@ -10270,10 +10445,10 @@ gfc_trans_omp_instantiate_mapper (gfc_omp_namelist **outlistp, sym, expr, udm->var_sym, mapper_clause->sym, mapper_clause->expr); - if (mapper_clause->u.map.op == OMP_MAP_UNSET) - new_clause->u.map.op = outer_map_op; - else - new_clause->u.map.op = mapper_clause->u.map.op; + 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; @@ -10282,7 +10457,7 @@ gfc_trans_omp_instantiate_mapper (gfc_omp_namelist **outlistp, { gfc_omp_udm *inner_udm = mapper_clause->u3.udm->udm; outlistp = gfc_trans_omp_instantiate_mapper (outlistp, new_clause, - inner_udm); + inner_udm, cd); } else { @@ -10295,7 +10470,8 @@ gfc_trans_omp_instantiate_mapper (gfc_omp_namelist **outlistp, } static void -gfc_trans_omp_instantiate_mappers (gfc_omp_clauses *clauses) +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]; @@ -10304,9 +10480,8 @@ gfc_trans_omp_instantiate_mappers (gfc_omp_clauses *clauses) { if (clause->u3.udm) { - clausep = gfc_trans_omp_instantiate_mapper (clausep, - clause, - clause->u3.udm->udm); + clausep = gfc_trans_omp_instantiate_mapper (clausep, clause, + clause->u3.udm->udm, cd); *clausep = clause->next; } else @@ -10758,8 +10933,9 @@ 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; + gfc_trans_omp_instantiate_mappers (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, void_type_node, stmt, omp_clauses); @@ -10774,7 +10950,9 @@ 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, + gfc_omp_clauses *target_enter_data_clauses = code->ext.omp_clauses; + gfc_trans_omp_instantiate_mappers (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, omp_clauses); @@ -10789,7 +10967,10 @@ 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, + gfc_omp_clauses *target_exit_data_clauses = code->ext.omp_clauses; + gfc_trans_omp_instantiate_mappers (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, omp_clauses); diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-22.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-22.f90 new file mode 100644 index 000000000000..483e848a268c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-22.f90 @@ -0,0 +1,60 @@ +! { dg-do compile } +! { dg-options "-fopenmp -fdump-tree-gimple" } + +type t +integer, allocatable :: arrcomp(:) +integer :: b, c, d +end type t + +type(t) :: myvar + +!$omp declare mapper (t :: x) map(to: x%arrcomp) map(alloc: x%b) & +!$omp & map(from: x%c) map(tofrom: x%d) + +allocate (myvar%arrcomp(1:100)) + +!$omp target enter data map(to: myvar) + +! { dg-final { scan-tree-dump-times {map\(struct:myvar \[len: 4\]\) map\(to:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(alloc:myvar\.b \[len: [0-9]+\]\) map\(alloc:myvar\.c \[len: 4\]\) map\(to:myvar\.d \[len: [0-9]+\]\) map\(to:MEM <integer\(kind=4\)\[0:\]> \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(attach:myvar\.arrcomp\.data \[bias: 0\]\)} 1 "gimple" } } + +!$omp target exit data map(from: myvar) + +! { dg-final { scan-tree-dump-times {map\(release:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(release:myvar\.b \[len: [0-9]+\]\) map\(from:myvar\.c \[len: [0-9]+\]\) map\(from:myvar\.d \[len: [0-9]+\]\) map\(release:MEM <integer\(kind=4\)\[0:\]> \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(detach:myvar\.arrcomp\.data \[bias: 0\]\)} 1 "gimple" } } + + +!$omp target enter data map(alloc: myvar) + +! { dg-final { scan-tree-dump-times {map\(struct:myvar \[len: 4\]\) map\(to:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(alloc:myvar\.b \[len: [0-9]+\]\) map\(alloc:myvar\.c \[len: [0-9]+\]\) map\(alloc:myvar\.d \[len: [0-9]+\]\) map\(alloc:MEM <integer\(kind=4\)\[0:\]> \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(attach:myvar\.arrcomp\.data \[bias: 0\]\)} 1 "gimple" } } + +!$omp target exit data map(release: myvar) + +! { dg-final { scan-tree-dump-times {map\(release:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(release:myvar\.b \[len: [0-9]+\]\) map\(release:myvar\.c \[len: [0-9]+\]\) map\(release:myvar\.d \[len: [0-9]+\]\) map\(release:MEM <integer\(kind=4\)\[0:\]> \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(detach:myvar\.arrcomp\.data \[bias: 0\]\)} 1 "gimple" } } + + +!$omp target enter data map(present, to: myvar) + +! { dg-final { scan-tree-dump-times {map\(force_present:MEM <integer\(kind=4\)\[0:\]> \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(attach:myvar\.arrcomp\.data \[bias: 0\]\) map\(struct:myvar \[len: 4\]\) map\(to:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(force_present:myvar\.b \[len: [0-9]+\]\) map\(force_present:myvar\.c \[len: [0-9]+\]\) map\(force_present:myvar\.d \[len: [0-9]+\]\)} 1 "gimple" } } + +!$omp target exit data map(present, from: myvar) + +! { dg-final { scan-tree-dump-times {map\(release:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(release:myvar\.b \[len: [0-9]+\]\) map\(force_present:myvar\.c \[len: [0-9]+\]\) map\(force_present:myvar\.d \[len: [0-9]+\]\) map\(release:MEM <integer\(kind=4\)\[0:\]> \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(detach:myvar\.arrcomp\.data \[bias: 0\]\)} 1 "gimple" } } + + +!$omp target enter data map(always, to: myvar) + +! { dg-final { scan-tree-dump-times {map\(struct:myvar \[len: 4\]\) map\(to:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(alloc:myvar\.b \[len: [0-9]+\]\) map\(alloc:myvar\.c \[len: [0-9]+\]\) map\(always,to:myvar\.d \[len: [0-9]+\]\) map\(always,to:MEM <integer\(kind=4\)\[0:\]> \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(attach:myvar\.arrcomp\.data \[bias: 0\]\)} 1 "gimple" } } + +!$omp target exit data map(always, from: myvar) + +! { dg-final { scan-tree-dump-times {map\(release:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(release:myvar\.b \[len: [0-9]+\]\) map\(always,from:myvar\.c \[len: [0-9]+\]\) map\(always,from:myvar\.d \[len: [0-9]+\]\) map\(release:MEM <integer\(kind=4\)\[0:\]> \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(detach:myvar\.arrcomp\.data \[bias: 0\]\)} 1 "gimple" } } + + +!$omp target enter data map(always, present, to: myvar) + +! { dg-final { scan-tree-dump-times {map\(struct:myvar \[len: 4\]\) map\(to:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(force_present:myvar\.b \[len: [0-9]+\]\) map\(force_present:myvar\.c \[len: [0-9]+\]\) map\(always,present,to:myvar\.d \[len: [0-9]+\]\) map\(always,present,to:MEM <integer\(kind=4\)\[0:\]> \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(attach:myvar\.arrcomp\.data \[bias: 0\]\)} 1 "gimple" } } + +!$omp target exit data map(always, present, from: myvar) + +! { dg-final { scan-tree-dump-times {map\(release:myvar\.arrcomp \[pointer set, len: [0-9]+\]\) map\(release:myvar\.b \[len: [0-9]+\]\) map\(always,present,from:myvar\.c \[len: [0-9]+\]\) map\(always,present,from:myvar\.d \[len: [0-9]+\]\) map\(release:MEM <integer\(kind=4\)\[0:\]> \[\(integer\(kind=4\)\[0:\] \*\)_[0-9]+\] \[len: _[0-9]+\]\) map\(detach:myvar\.arrcomp\.data \[bias: 0\]\)} 1 "gimple" } } + +end diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-23.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-23.f90 new file mode 100644 index 000000000000..6c07261040d8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-23.f90 @@ -0,0 +1,25 @@ +! { dg-do compile } +! { dg-options "-fopenmp -fdump-tree-gimple" } + +type t +integer :: a, b, c, d +end type t + +type(t) :: myvar + +!$omp declare mapper (t :: x) map(to: x%a) map(alloc: x%b) & +!$omp & map(from: x%c) map(tofrom: x%d) + +!$omp target data map(to: myvar) + +! { dg-final { scan-tree-dump-times {map\(struct:myvar \[len: 4\]\) map\(to:myvar\.a \[len: [0-9]+\]\) map\(alloc:myvar\.b \[len: [0-9]+\]\) map\(alloc:myvar\.c \[len: [0-9]+\]\) map\(to:myvar\.d \[len: [0-9]+\]\)} 1 "gimple" } } + +!$omp end target data + +!$omp target data map(alloc: myvar) + +! { dg-final { scan-tree-dump-times {map\(struct:myvar \[len: 4\]\) map\(alloc:myvar\.a \[len: [0-9]+\]\) map\(alloc:myvar\.b \[len: [0-9]+\]\) map\(alloc:myvar\.c \[len: [0-9]+\]\) map\(alloc:myvar\.d \[len: [0-9]+\]\)} 1 "gimple" } } + +!$omp end target data + +end
