From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1729) id 290B4386D623; Thu, 15 Feb 2024 21:06:10 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 290B4386D623 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1708031170; bh=9Eg/0eses9bvwmhPRyzdR9E/4EuJCxqClKPWa5FD4h0=; h=From:To:Subject:Date:From; b=UjMp5nRQtKaBplhbcnCPwl6n+N/MUrOEJwy4utDej8Lm7YUr9tsueZFG2Hun2sCQO tgKazQdcxdESTIlP+/BdnhsI/IioFvmVKxFz9uud5SOaNcrQ+Av1RVIRe8UHJc2yVn XbK9UM3R0pODB0C/uopBS4lKvTokHr7dBtk18s3c= MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Kwok Yeung To: gcc-cvs@gcc.gnu.org Subject: [gcc r14-9019] openmp, fortran: Add Fortran support for indirect clause on the declare target directive X-Act-Checkin: gcc X-Git-Author: Kwok Cheung Yeung X-Git-Refname: refs/heads/master X-Git-Oldrev: 617bd59c659dcf6e5391409a2e9f64f75e905a96 X-Git-Newrev: 451bb5866021cc854cd972396c6bc4923eb14d39 Message-Id: <20240215210610.290B4386D623@sourceware.org> Date: Thu, 15 Feb 2024 21:06:10 +0000 (GMT) List-Id: https://gcc.gnu.org/g:451bb5866021cc854cd972396c6bc4923eb14d39 commit r14-9019-g451bb5866021cc854cd972396c6bc4923eb14d39 Author: Kwok Cheung Yeung Date: Thu Feb 15 20:59:39 2024 +0000 openmp, fortran: Add Fortran support for indirect clause on the declare target directive 2024-02-15 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. Show warning if there are only device_type and/or indirect clauses on the directive. * 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-4.f90 (f1): Update expected warning. * 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. * testsuite/libgomp.fortran/declare-target-indirect-3.f90: New. Diff: --- gcc/fortran/dump-parse-tree.cc | 2 + gcc/fortran/f95-lang.cc | 2 + gcc/fortran/gfortran.h | 3 +- gcc/fortran/openmp.cc | 50 +++++++++++++++-- gcc/fortran/trans-decl.cc | 4 ++ .../gfortran.dg/gomp/declare-target-4.f90 | 2 +- .../gfortran.dg/gomp/declare-target-indirect-1.f90 | 62 ++++++++++++++++++++++ .../gfortran.dg/gomp/declare-target-indirect-2.f90 | 25 +++++++++ .../libgomp.fortran/declare-target-indirect-1.f90 | 39 ++++++++++++++ .../libgomp.fortran/declare-target-indirect-2.f90 | 54 +++++++++++++++++++ .../libgomp.fortran/declare-target-indirect-3.f90 | 35 ++++++++++++ 11 files changed, 273 insertions(+), 5 deletions(-) diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc index 1563b810b988..7b154eb3ca71 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 358cb17fce29..67fda27aa3ed 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 fd73e4ce4314..fd843a3241db 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 d8cce6922b07..77f6e1732f92 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,15 +5594,23 @@ 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 + if ((c->device_type || c->indirect) && !c->lists[OMP_LIST_ENTER] && !c->lists[OMP_LIST_TO] && !c->lists[OMP_LIST_LINK]) gfc_warning_now (OPT_Wopenmp, "OMP DECLARE TARGET directive at %L with only " - "DEVICE_TYPE clause is ignored", &old_loc); + "DEVICE_TYPE or INDIRECT clauses is ignored", + &old_loc); gfc_buffer_error (true); diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index de162f6cc75a..6d4630369660 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-4.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90 index 4f5de4bd8c7e..55534d8fe998 100644 --- a/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90 @@ -2,7 +2,7 @@ ! { dg-additional-options "-fdump-tree-original" } subroutine f1 - !$omp declare target device_type (any) ! { dg-warning "OMP DECLARE TARGET directive at .1. with only DEVICE_TYPE clause is ignored" } + !$omp declare target device_type (any) ! { dg-warning "OMP DECLARE TARGET directive at .1. with only DEVICE_TYPE or INDIRECT clauses is ignored" } end subroutine subroutine f2 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 000000000000..504c1a29813e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-1.f90 @@ -0,0 +1,62 @@ +! { 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 ! { dg-warning "OMP DECLARE TARGET directive at .1. with only DEVICE_TYPE or INDIRECT clauses is ignored" } + end subroutine + + subroutine sub8 + !$omp declare target indirect (.true.) indirect (.false.) to (sub8) ! { dg-error "Duplicated .indirect. clause at .1." } + end subroutine + + subroutine sub9 + !$omp declare target to (sub9) indirect ("abs") ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" } + end subroutine + + subroutine sub10 + !$omp declare target to (sub10) indirect (5.5) ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" } + end subroutine + + subroutine sub11 + !$omp declare target indirect (.true.) device_type (host) enter (sub11) ! { dg-error "DEVICE_TYPE must be ANY when used with INDIRECT at .1." } + end subroutine + + subroutine sub12 + !$omp declare target indirect (.false.) device_type (nohost) enter (sub12) + 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 000000000000..f6b3ae178564 --- /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 000000000000..39a91dfcdcac --- /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 000000000000..34dd27788931 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-2.f90 @@ -0,0 +1,54 @@ +! { dg-do run } +! { dg-xfail-run-if "Requires libgomp bug fix pending review" { offload_device } } + +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 diff --git a/libgomp/testsuite/libgomp.fortran/declare-target-indirect-3.f90 b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-3.f90 new file mode 100644 index 000000000000..00f33bd11704 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-3.f90 @@ -0,0 +1,35 @@ +! { dg-do run } + +! Check that indirect calls work on procedures passed in via a dummy argument + +module m + integer, parameter :: offset = 123 +contains + function bar(x) + !$omp declare target enter (bar) indirect + integer :: bar + integer, intent(in) :: x + bar = x + offset + end function + + function foo(f, x) + integer :: foo + procedure(bar) :: f + integer, intent(in) :: x + + !$omp target map (to: x) map (from: foo) + foo = f(x) + !$omp end target + end function +end module + +program main + use m + implicit none + + integer :: a = 321 + integer :: b + + b = foo(bar, a) + stop b - (a + offset) +end program