From 545bdb2c8ab9a43e79c7a3a2992bd9edc7d08a6f Mon Sep 17 00:00:00 2001 From: Kwok Cheung Yeung Date: Thu, 11 Jan 2024 19:52:53 +0000 Subject: [PATCH 2/2] openmp, fortran: Add Fortran support for indirect clause on the declare target directive 2024-01-19 Kwok Cheung Yeung gcc/fortran/ * dump-parse-tree.cc (show_attr): Handle omp_declare_target_indirect attribute. * f95-lang.cc (gfc_gnu_attributes): Add entry for 'omp declare target indirect'. * gfortran.h (symbol_attribute): Add omp_declare_target_indirect field. (struct gfc_omp_clauses): Add indirect field. * openmp.cc (omp_mask2): Add OMP_CLAUSE_INDIRECT. (gfc_match_omp_clauses): Match indirect clause. (OMP_DECLARE_TARGET_CLAUSES): Add OMP_CLAUSE_INDIRECT. (gfc_match_omp_declare_target): Check omp_device_type and apply omp_declare_target_indirect attribute to symbol if indirect clause active. * trans-decl.cc (add_attributes_to_decl): Add 'omp declare target indirect' attribute if symbol has indirect attribute set. gcc/testsuite/ * gfortran.dg/gomp/declare-target-indirect-1.f90: New. * gfortran.dg/gomp/declare-target-indirect-2.f90: New. libgomp/ * testsuite/libgomp.fortran/declare-target-indirect-1.f90: New. * testsuite/libgomp.fortran/declare-target-indirect-2.f90: New. --- gcc/fortran/dump-parse-tree.cc | 2 + gcc/fortran/f95-lang.cc | 2 + gcc/fortran/gfortran.h | 3 +- gcc/fortran/openmp.cc | 45 +++++++++++++- gcc/fortran/trans-decl.cc | 4 ++ .../gomp/declare-target-indirect-1.f90 | 58 +++++++++++++++++++ .../gomp/declare-target-indirect-2.f90 | 25 ++++++++ .../declare-target-indirect-1.f90 | 39 +++++++++++++ .../declare-target-indirect-2.f90 | 53 +++++++++++++++++ 9 files changed, 229 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-1.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-2.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-target-indirect-1.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-target-indirect-2.f90 diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc index 1563b810b98..7b154eb3ca7 100644 --- a/gcc/fortran/dump-parse-tree.cc +++ b/gcc/fortran/dump-parse-tree.cc @@ -914,6 +914,8 @@ show_attr (symbol_attribute *attr, const char * module) fputs (" OMP-DECLARE-TARGET", dumpfile); if (attr->omp_declare_target_link) fputs (" OMP-DECLARE-TARGET-LINK", dumpfile); + if (attr->omp_declare_target_indirect) + fputs (" OMP-DECLARE-TARGET-INDIRECT", dumpfile); if (attr->elemental) fputs (" ELEMENTAL", dumpfile); if (attr->pure) diff --git a/gcc/fortran/f95-lang.cc b/gcc/fortran/f95-lang.cc index 358cb17fce2..67fda27aa3e 100644 --- a/gcc/fortran/f95-lang.cc +++ b/gcc/fortran/f95-lang.cc @@ -96,6 +96,8 @@ static const attribute_spec gfc_gnu_attributes[] = gfc_handle_omp_declare_target_attribute, NULL }, { "omp declare target link", 0, 0, true, false, false, false, gfc_handle_omp_declare_target_attribute, NULL }, + { "omp declare target indirect", 0, 0, true, false, false, false, + gfc_handle_omp_declare_target_attribute, NULL }, { "oacc function", 0, -1, true, false, false, false, gfc_handle_omp_declare_target_attribute, NULL }, }; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index fd73e4ce431..fd843a3241d 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -999,6 +999,7 @@ typedef struct /* Mentioned in OMP DECLARE TARGET. */ unsigned omp_declare_target:1; unsigned omp_declare_target_link:1; + unsigned omp_declare_target_indirect:1; ENUM_BITFIELD (gfc_omp_device_type) omp_device_type:2; unsigned omp_allocate:1; @@ -1584,7 +1585,7 @@ typedef struct gfc_omp_clauses unsigned grainsize_strict:1, num_tasks_strict:1, compare:1, weak:1; unsigned non_rectangular:1, order_concurrent:1; unsigned contains_teams_construct:1, target_first_st_is_teams:1; - unsigned contained_in_target_construct:1; + unsigned contained_in_target_construct:1, indirect:1; ENUM_BITFIELD (gfc_omp_sched_kind) sched_kind:3; ENUM_BITFIELD (gfc_omp_device_type) device_type:2; ENUM_BITFIELD (gfc_omp_memorder) memorder:3; diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 0af80d54fad..d1c5c323c54 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -1096,6 +1096,7 @@ enum omp_mask2 OMP_CLAUSE_DOACROSS, /* OpenMP 5.2 */ OMP_CLAUSE_ASSUMPTIONS, /* OpenMP 5.1. */ OMP_CLAUSE_USES_ALLOCATORS, /* OpenMP 5.0 */ + OMP_CLAUSE_INDIRECT, /* OpenMP 5.1 */ /* This must come last. */ OMP_MASK2_LAST }; @@ -2798,6 +2799,32 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, needs_space = true; continue; } + if ((mask & OMP_CLAUSE_INDIRECT) + && (m = gfc_match_dupl_check (!c->indirect, "indirect")) + != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + gfc_expr *indirect_expr = NULL; + m = gfc_match (" ( %e )", &indirect_expr); + if (m == MATCH_YES) + { + if (!gfc_resolve_expr (indirect_expr) + || indirect_expr->ts.type != BT_LOGICAL + || indirect_expr->expr_type != EXPR_CONSTANT) + { + gfc_error ("INDIRECT clause at %C requires a constant " + "logical expression"); + gfc_free_expr (indirect_expr); + goto error; + } + c->indirect = indirect_expr->value.logical; + gfc_free_expr (indirect_expr); + } + else + c->indirect = 1; + continue; + } if ((mask & OMP_CLAUSE_IS_DEVICE_PTR) && gfc_match_omp_variable_list ("is_device_ptr (", @@ -4460,7 +4487,7 @@ cleanup: (omp_mask (OMP_CLAUSE_THREADS) | OMP_CLAUSE_SIMD) #define OMP_DECLARE_TARGET_CLAUSES \ (omp_mask (OMP_CLAUSE_ENTER) | OMP_CLAUSE_LINK | OMP_CLAUSE_DEVICE_TYPE \ - | OMP_CLAUSE_TO) + | OMP_CLAUSE_TO | OMP_CLAUSE_INDIRECT) #define OMP_ATOMIC_CLAUSES \ (omp_mask (OMP_CLAUSE_ATOMIC) | OMP_CLAUSE_CAPTURE | OMP_CLAUSE_HINT \ | OMP_CLAUSE_MEMORDER | OMP_CLAUSE_COMPARE | OMP_CLAUSE_FAIL \ @@ -5513,6 +5540,15 @@ gfc_match_omp_declare_target (void) n->sym->name, &n->where); n->sym->attr.omp_device_type = c->device_type; } + if (c->indirect) + { + if (n->sym->attr.omp_device_type != OMP_DEVICE_TYPE_UNSET + && n->sym->attr.omp_device_type != OMP_DEVICE_TYPE_ANY) + gfc_error_now ("DEVICE_TYPE must be ANY when used with " + "INDIRECT at %L", &n->where); + n->sym->attr.omp_declare_target_indirect = c->indirect; + } + n->sym->mark = 1; } else if (n->u.common->omp_declare_target @@ -5558,6 +5594,13 @@ gfc_match_omp_declare_target (void) " TARGET directive to a different DEVICE_TYPE", s->name, &n->where); s->attr.omp_device_type = c->device_type; + + if (c->indirect + && s->attr.omp_device_type != OMP_DEVICE_TYPE_UNSET + && s->attr.omp_device_type != OMP_DEVICE_TYPE_ANY) + gfc_error_now ("DEVICE_TYPE must be ANY when used with " + "INDIRECT at %L", &n->where); + s->attr.omp_declare_target_indirect = c->indirect; } } if (c->device_type diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index de162f6cc75..6d463036966 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -1526,6 +1526,10 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list) list = tree_cons (get_identifier ("omp declare target"), clauses, list); + if (sym_attr.omp_declare_target_indirect) + list = tree_cons (get_identifier ("omp declare target indirect"), + clauses, list); + return list; } diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-1.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-1.f90 new file mode 100644 index 00000000000..560a0541e9a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-1.f90 @@ -0,0 +1,58 @@ +! { dg-do compile } +! { dg-options "-fopenmp" } + +module m + integer :: a + integer, parameter :: X = 1 + integer, parameter :: Y = 2 + + ! Indirect on a variable should have no effect. + integer :: z + !$omp declare target to (z) indirect +contains + subroutine sub1 + !$omp declare target indirect to (sub1) + end subroutine + + subroutine sub2 + !$omp declare target enter (sub2) indirect (.true.) + end subroutine + + subroutine sub3 + !$omp declare target to (sub3) indirect (.false.) + end subroutine + + subroutine sub4 + !$omp declare target to (sub4) indirect (1) ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" } + end subroutine + + ! Compile-time non-constant expressions are not allowed. + subroutine sub5 + !$omp declare target indirect (a > 0) to (sub5) ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" } + end subroutine + + ! Compile-time constant expressions are permissible. + subroutine sub6 + !$omp declare target indirect (X .eq. Y) to (sub6) + end subroutine + + subroutine sub7 + !$omp declare target indirect (.true.) indirect (.false.) to (sub7) ! { dg-error "Duplicated .indirect. clause at .1." } + end subroutine + + subroutine sub8 + !$omp declare target to (sub8) indirect ("abs") ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" } + end subroutine + + subroutine sub9 + !$omp declare target to (sub9) indirect (5.5) ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" } + end subroutine + + subroutine sub10 + !$omp declare target indirect (.true.) device_type (host) enter (sub10) ! { dg-error "DEVICE_TYPE must be ANY when used with INDIRECT at .1." } + end subroutine + + subroutine sub11 + !$omp declare target indirect (.false.) device_type (nohost) enter (sub11) + end subroutine +end module diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-2.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-2.f90 new file mode 100644 index 00000000000..f6b3ae17856 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-2.f90 @@ -0,0 +1,25 @@ +! { dg-do compile } +! { dg-options "-fopenmp -fdump-tree-gimple" } + +module m +contains + subroutine sub1 + !$omp declare target indirect enter (sub1) + end subroutine + ! { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target, omp declare target indirect\\\)\\\)\\\n.*\\\nvoid sub1" "gimple" } } + + subroutine sub2 + !$omp declare target indirect (.false.) to (sub2) + end subroutine + ! { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target\\\)\\\)\\\n.*\\\nvoid sub2" "gimple" } } + + subroutine sub3 + !$omp declare target indirect (.true.) to (sub3) + end subroutine + ! { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target, omp declare target indirect\\\)\\\)\\\n.*\\\nvoid sub3" "gimple" } } + + subroutine sub4 + !$omp declare target indirect (.false.) enter (sub4) + end subroutine + ! { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target\\\)\\\)\\\n.*\\\nvoid sub4" "gimple" } } +end module diff --git a/libgomp/testsuite/libgomp.fortran/declare-target-indirect-1.f90 b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-1.f90 new file mode 100644 index 00000000000..39a91dfcdca --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-1.f90 @@ -0,0 +1,39 @@ +! { dg-do run } + +module m +contains + integer function foo () + !$omp declare target to (foo) indirect + foo = 5 + end function + + integer function bar () + !$omp declare target to (bar) indirect + bar = 8 + end function + + integer function baz () + !$omp declare target to (baz) indirect + baz = 11 + end function +end module + +program main + use m + implicit none + + integer :: x, expected + procedure (foo), pointer :: foo_ptr, bar_ptr, baz_ptr + + foo_ptr => foo + bar_ptr => bar + baz_ptr => baz + + expected = foo () + bar () + baz () + + !$omp target map (to: foo_ptr, bar_ptr, baz_ptr) map (from: x) + x = foo_ptr () + bar_ptr () + baz_ptr () + !$omp end target + + stop x - expected +end program diff --git a/libgomp/testsuite/libgomp.fortran/declare-target-indirect-2.f90 b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-2.f90 new file mode 100644 index 00000000000..d3baa81dd07 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-2.f90 @@ -0,0 +1,53 @@ +! { dg-do run } + +module m +contains + integer function foo () + !$omp declare target to (foo) indirect + foo = 5 + end function + + integer function bar () + !$omp declare target to (bar) indirect + bar = 8 + end function + + integer function baz () + !$omp declare target to (baz) indirect + baz = 11 + end function +end module + +program main + use m + implicit none + + type fp + procedure (foo), pointer, nopass :: f => null () + end type + + integer, parameter :: N = 256 + integer :: i, x = 0, expected = 0; + type (fp) :: fn_ptr (N) + + do i = 1, N + select case (mod (i, 3)) + case (0) + fn_ptr (i)%f => foo + case (1) + fn_ptr (i)%f => bar + case (2) + fn_ptr (i)%f => baz + end select + expected = expected + fn_ptr (i)%f () + end do + + !$omp target teams distribute parallel do & + !$omp & reduction(+: x) map (to: fn_ptr) map (tofrom: x) + do i = 1, N + x = x + fn_ptr (i)%f () + end do + !$omp end target teams distribute parallel do + + stop x - expected +end program -- 2.34.1