public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r14-9019] openmp, fortran: Add Fortran support for indirect clause on the declare target directive
@ 2024-02-15 21:06 Kwok Yeung
  0 siblings, 0 replies; only message in thread
From: Kwok Yeung @ 2024-02-15 21:06 UTC (permalink / raw)
  To: gcc-cvs

https://gcc.gnu.org/g:451bb5866021cc854cd972396c6bc4923eb14d39

commit r14-9019-g451bb5866021cc854cd972396c6bc4923eb14d39
Author: Kwok Cheung Yeung <kcyeung@baylibre.com>
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  <kcyeung@baylibre.com>
    
            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

^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2024-02-15 21:06 UTC | newest]

Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2024-02-15 21:06 [gcc r14-9019] openmp, fortran: Add Fortran support for indirect clause on the declare target directive Kwok Yeung

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).