OpenMP: Fortran front-end support for dispatch + adjust_args

This patch adds support for the `dispatch` construct and the `adjust_args`
clause to the Fortran front-end.

Handling of `adjust_args` across translation units is missing due to PR115271.

Minor modifications to the C++ FE and the ME are also folded into this patch as
a side effect of the Fortran work.

gcc/c-family/ChangeLog:

	* c-attribs.cc: (c_common_gnu_attributes): Rename "omp declare variant
	variant adjust_args" into "omp declare variant variant args" to also
	accommodate append_args.

gcc/cp/ChangeLog:

	* parser.cc (cp_parser_omp_dispatch): Handle INDIRECT_REF.

gcc/fortran/ChangeLog:

	* dump-parse-tree.cc (show_omp_clauses): Handle novariants and nocontext
	clauses.
	(show_omp_node): Handle EXEC_OMP_DISPATCH.
	(show_code_node): Likewise.
	* frontend-passes.cc (gfc_code_walker): Handle novariants and nocontext.
	* gfortran.h (enum gfc_statement): Add ST_OMP_DISPATCH.
	(symbol_attribute): Add omp_declare_variant_need_device_ptr.
	(gfc_omp_clauses): Add novariants and nocontext.
	(gfc_omp_declare_variant): Add need_device_ptr_arg_list.
	(enum gfc_exec_op): Add EXEC_OMP_DISPATCH.
	* match.h (gfc_match_omp_dispatch): Declare.
	* openmp.cc (gfc_free_omp_clauses): Free novariants and nocontext
	clauses.
	(gfc_free_omp_declare_variant_list): Free need_device_ptr_arg_list
	namelist.
	(enum omp_mask2): Add OMP_CLAUSE_NOVARIANTS and OMP_CLAUSE_NOCONTEXT.
	(gfc_match_omp_clauses): Handle OMP_CLAUSE_NOVARIANTS and
	OMP_CLAUSE_NOCONTEXT.
	(OMP_DISPATCH_CLAUSES): Define.
	(gfc_match_omp_dispatch): New function.
	(gfc_match_omp_declare_variant): Parse adjust_args.
	(resolve_omp_clauses): Handle adjust_args, novariants and nocontext.
	Adjust handling of OMP_LIST_IS_DEVICE_PTR.
	(icode_code_error_callback): Handle EXEC_OMP_DISPATCH.
	(omp_code_to_statement): Likewise.
	(resolve_omp_dispatch): New function.
	(gfc_resolve_omp_directive): Handle EXEC_OMP_DISPATCH.
	* parse.cc (decode_omp_directive): Match dispatch.
	(next_statement): Handle ST_OMP_DISPATCH.
	(gfc_ascii_statement): Likewise.
	(parse_omp_dispatch): New function.
	(parse_executable): Handle ST_OMP_DISPATCH.
	* resolve.cc (gfc_resolve_blocks): Handle EXEC_OMP_DISPATCH.
	* st.cc (gfc_free_statement): Likewise.
	* trans-decl.cc (create_function_arglist): Declare.
	(gfc_get_extern_function_decl): Call it.
	* trans-openmp.cc (gfc_trans_omp_clauses): Handle novariants and
	nocontext.
	(replace_omp_dispatch_call): New function.
	(gfc_trans_omp_dispatch): New function.
	(gfc_trans_omp_directive): Handle EXEC_OMP_DISPATCH.
	(gfc_trans_omp_declare_variant): Handle adjust_args.
	* trans.cc (trans_code): Handle EXEC_OMP_DISPATCH:.

gcc/ChangeLog:

	* gimplify.cc (gimplify_call_expr): Fix handling of need_device_ptr for
	type(c_ptr). Fix handling of nested function calls in a dispatch region.
	(find_ifn_gomp_dispatch): Return the IFN without stripping it.
	(gimplify_omp_dispatch): Keep IFN_GOMP_DISPATCH until
	gimplify_call_expr.

libgomp/ChangeLog:
	* testsuite/libgomp.fortran/declare-variant-2-aux.f90: New test.
	* testsuite/libgomp.fortran/declare-variant-2.f90: New test (xfail).
	* testsuite/libgomp.fortran/dispatch-1.f90: New test.
	* testsuite/libgomp.fortran/dispatch-2.f90: New test.
	* testsuite/libgomp.fortran/dispatch-3.f90: New test.

gcc/testsuite/ChangeLog:

	* g++.dg/gomp/dispatch-3.C: Update scan dumps.
	* gfortran.dg/gomp/declare-variant-2.f90: Update dg-error.
	* gfortran.dg/gomp/adjust-args-1.f90: New test.
	* gfortran.dg/gomp/adjust-args-2.f90: New test.
	* gfortran.dg/gomp/adjust-args-2a.f90: New test.
	* gfortran.dg/gomp/adjust-args-3.f90: New test.
	* gfortran.dg/gomp/adjust-args-4.f90: New test.
	* gfortran.dg/gomp/adjust-args-5.f90: New test.
	* gfortran.dg/gomp/adjust-args-6.f90: New test.
	* gfortran.dg/gomp/adjust-args-7.f90: New test.
	* gfortran.dg/gomp/adjust-args-8.f90: New test.
	* gfortran.dg/gomp/adjust-args-9.f90: New test.
	* gfortran.dg/gomp/dispatch-1.f90: New test.
	* gfortran.dg/gomp/dispatch-2.f90: New test.
	* gfortran.dg/gomp/dispatch-3.f90: New test.
	* gfortran.dg/gomp/dispatch-4.f90: New test.
	* gfortran.dg/gomp/dispatch-5.f90: New test.
	* gfortran.dg/gomp/dispatch-6.f90: New test.
	* gfortran.dg/gomp/dispatch-7.f90: New test.
	* gfortran.dg/gomp/dispatch-8.f90: New test.
	* gfortran.dg/gomp/dispatch-9.f90: New test.
	* gfortran.dg/gomp/dispatch-9a.f90: New test.
	* gfortran.dg/gomp/dispatch-10.f90: New test.

5 files changed, 316 insertions, 0 deletions

diff --git a/libgomp/testsuite/libgomp.fortran/declare-variant-2-aux.f90 b/libgomp/testsuite/libgomp.fortran/declare-variant-2-aux.f90
new file mode 100644
index 0000000..59b55e0
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-variant-2-aux.f90
@@ -0,0 +1,25 @@
+! { dg-do compile { target skip-all-targets } } 
+
+! Test XFAILed due to https://gcc.gnu.org/PR115271
+
+
+subroutine base_proc (a)
+   use iso_c_binding, only: c_ptr
+   type(c_ptr), intent(inout) :: a
+end subroutine
+
+program main
+   use iso_c_binding, only: c_ptr
+   use my_mod
+   implicit none
+
+   type(c_ptr) :: a
+
+
+   call base_proc(a)
+   !call variant_proc(a)
+
+   !$omp dispatch
+   call base_proc(a)
+
+end program main
diff --git a/libgomp/testsuite/libgomp.fortran/declare-variant-2.f90 b/libgomp/testsuite/libgomp.fortran/declare-variant-2.f90
new file mode 100644
index 0000000..b49833d
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/declare-variant-2.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! { dg-additional-sources declare-variant-2-aux.f90 }
+! { dg-additional-options "-fdump-tree-gimple" }
+
+module my_mod
+   use iso_c_binding, only: c_ptr
+   implicit none
+   interface
+      subroutine base_proc (a)
+         use iso_c_binding, only: c_ptr
+         type(c_ptr), intent(inout) :: a
+      end subroutine
+   end interface
+
+contains
+   subroutine variant_proc (a)
+      type(c_ptr), intent(inout) :: a
+      !$omp declare variant (base_proc) match (construct={dispatch}) adjust_args(need_device_ptr: a)
+   end subroutine
+end module
+
+! { dg-final { scan-tree-dump "variant_proc \\(&a\\)" "gimple" { xfail *-*-* } } }
diff --git a/libgomp/testsuite/libgomp.fortran/dispatch-1.f90 b/libgomp/testsuite/libgomp.fortran/dispatch-1.f90
new file mode 100644
index 0000000..7b2f03f
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/dispatch-1.f90
@@ -0,0 +1,120 @@
+module procedures
+  use iso_c_binding, only: c_ptr, c_f_pointer
+  use omp_lib
+  implicit none
+
+  contains
+
+  function foo(bv, av, n) result(res)
+    implicit none
+    integer :: res, n, i
+    type(c_ptr) :: bv
+    type(c_ptr) :: av
+    real(8), pointer :: fp_bv(:), fp_av(:)  ! Fortran pointers for array access
+    !$omp declare variant(bar) match(construct={dispatch}) adjust_args(need_device_ptr: bv, av)
+    !$omp declare variant(baz) match(implementation={vendor(gnu)})
+
+    ! Associate C pointers with Fortran pointers
+    call c_f_pointer(bv, fp_bv, [n])
+    call c_f_pointer(av, fp_av, [n])
+
+    ! Perform operations using Fortran pointers
+    do i = 1, n
+      fp_bv(i) = fp_av(i) * i
+    end do
+    res = -1
+  end function foo
+
+  function baz(d_bv, d_av, n) result(res)
+    implicit none
+    integer :: res, n, i
+    type(c_ptr) :: d_bv
+    type(c_ptr) :: d_av
+    real(8), pointer :: fp_bv(:), fp_av(:)  ! Fortran pointers for array access
+  
+    ! Associate C pointers with Fortran pointers
+    call c_f_pointer(d_bv, fp_bv, [n])
+    call c_f_pointer(d_av, fp_av, [n])
+
+    !$omp distribute parallel do
+    do i = 1, n
+      fp_bv(i) = fp_av(i) * i
+    end do
+    res = -3
+  end function baz
+
+  function bar(d_bv, d_av, n) result(res)
+    implicit none
+    integer :: res, n, i
+    type(c_ptr) :: d_bv
+    type(c_ptr) :: d_av
+    real(8), pointer :: fp_bv(:), fp_av(:)  ! Fortran pointers for array access
+
+    ! Associate C pointers with Fortran pointers
+    call c_f_pointer(d_bv, fp_bv, [n])
+    call c_f_pointer(d_av, fp_av, [n])
+
+    ! Perform operations on target
+    do i = 1, n
+      fp_bv(i) = fp_av(i) * i
+    end do
+    res = -2
+  end function bar
+
+  function test(n) result(res)
+    use iso_c_binding, only: c_ptr, c_loc
+    implicit none
+    integer :: n, res, i, f, ff, last_dev
+    real(8), allocatable, target :: av(:), bv(:), d_bv(:)
+    real(8), parameter :: e = 2.71828d0
+    type(c_ptr) :: c_av, c_bv, c_d_bv
+    
+    allocate(av(n), bv(n), d_bv(n))
+    
+    ! Initialize arrays
+    do i = 1, n
+      av(i) = e * i
+      bv(i) = 0.0d0
+      d_bv(i) = 0.0d0
+    end do
+
+    last_dev = omp_get_num_devices() - 1
+    
+    c_av = c_loc(av)
+    c_d_bv = c_loc(d_bv)
+    !$omp target data map(to: av(:n)) map(from: d_bv(:n)) device(last_dev) if(n == 1024)
+      !$omp dispatch nocontext(n > 1024) novariants(n < 1024) device(last_dev)
+      f = foo(c_d_bv, c_av, n)
+    !$omp end target data
+    
+    c_bv = c_loc(bv)
+    ff = foo(c_bv, c_loc(av), n)
+    
+    ! Verify results
+    do i = 1, n
+      if (d_bv(i) /= bv(i)) then
+        write(0,*) 'ERROR at ', i, ': ', d_bv(i), ' (act) != ', bv(i), ' (exp)'
+        res = 1
+        return
+      end if
+    end do
+    
+    res = f
+    deallocate(av, bv, d_bv)
+  end function test
+end module procedures
+
+program main
+  use procedures
+  implicit none
+  integer :: ret
+  
+  ret = test(1023)
+  if (ret /= -1) stop 1
+  
+  ret = test(1024)
+  if (ret /= -2) stop 1
+  
+  ret = test(1025)
+  if (ret /= -3) stop 1
+end program main
diff --git a/libgomp/testsuite/libgomp.fortran/dispatch-2.f90 b/libgomp/testsuite/libgomp.fortran/dispatch-2.f90
new file mode 100644
index 0000000..042b4d9
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/dispatch-2.f90
@@ -0,0 +1,69 @@
+module m
+  use iso_c_binding
+  implicit none (type, external)
+  type(c_ptr) :: ref1, ref2, ref3, ref4
+contains
+  subroutine foo(v, w, x, y)
+    type(C_ptr) :: v, w, x, y
+    value :: w, y
+    optional :: x, y
+    !$omp declare variant(bar) match ( construct = { dispatch } )   &
+    !$omp&                     adjust_args(need_device_ptr : v, w, x, y )
+    stop 1  ! should not get called
+  end
+  subroutine bar(a, b, c, d)
+    type(C_ptr) :: a, b, c, d
+    value :: b, d
+    optional :: c, d
+    if (.not. c_associated (a, ref1)) stop 2
+    if (.not. c_associated (b, ref2)) stop 3
+    if (.not. c_associated (c, ref3)) stop 3
+    if (.not. c_associated (d, ref4)) stop 3
+  end
+end
+
+program main
+  use omp_lib
+  use m
+  implicit none (type, external)
+  integer, target :: a, b, c, d
+  type(c_ptr) :: v, w, y, z
+  integer :: dev
+
+  do dev = -1, omp_get_num_devices ()
+    print *, 'dev ', dev
+
+    ! Cross check (1)
+    ref1 = omp_target_alloc (32_c_size_t, dev)
+    ref2 = omp_target_alloc (32_c_size_t, dev)
+    ref3 = omp_target_alloc (32_c_size_t, dev)
+    ref4 = omp_target_alloc (32_c_size_t, dev)
+    call bar (ref1, ref2, ref3, ref4)
+    call omp_target_free (ref1, dev)
+    call omp_target_free (ref2, dev)
+    call omp_target_free (ref3, dev)
+    call omp_target_free (ref4, dev)
+
+    v = c_loc(a)
+    w = c_loc(b)
+    y = c_loc(b)
+    z = c_loc(b)
+
+    !$omp target enter data device(dev) map(a, b, c, d)
+
+    ! Cross check (2)
+    ! This should be effectively identical to 'dispatch'
+    !$omp target data device(dev) use_device_ptr(v, w, y, z)
+      ref1 = v
+      ref2 = w
+      ref3 = y
+      ref4 = z
+      call bar (v, w, y, z)
+    !$omp end target data
+
+    !$omp dispatch device(dev)
+      call foo (v, w, y, z)
+
+    !$omp target exit data device(dev) map(a, b, c, d)
+  end do
+end
diff --git a/libgomp/testsuite/libgomp.fortran/dispatch-3.f90 b/libgomp/testsuite/libgomp.fortran/dispatch-3.f90
new file mode 100644
index 0000000..4a914da
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/dispatch-3.f90
@@ -0,0 +1,80 @@
+! { dg-do run }
+! { dg-additional-options "-fdump-tree-gimple" }
+
+! Check that nested function calls in a dispatch region are handled correctly,
+! i.e. that the adjust_args clause is applied only to the outer call.
+
+module m
+  use iso_c_binding
+  use omp_lib
+  implicit none(type,external)
+contains
+  integer function f(x, y1, y2, z1, z2)
+    allocatable :: f
+    integer, value :: x
+    type(c_ptr), value :: y1, y2
+    type(c_ptr) :: z1, z2
+
+    if (x == 1) then  ! HOST
+      block
+        integer, pointer :: iy1, iy2, iz1, iz2
+        call c_f_pointer (y1, iy1)
+        call c_f_pointer (y2, iy2)
+        call c_f_pointer (z1, iz1)
+        call c_f_pointer (z2, iz2)
+        f = (iy1 + iy2) + 10 * (iz1+iz2)
+      end block
+    else
+      allocate(f)
+      !$omp target is_device_ptr(y1, y2, z1, z2) map(tofrom: f)
+      block
+        integer, pointer :: iy1, iy2, iz1, iz2
+        call c_f_pointer (y1, iy1)
+        call c_f_pointer (y2, iy2)
+        call c_f_pointer (z1, iz1)
+        call c_f_pointer (z2, iz2)
+        f = -(iy1+iy2)*23  -127 * (iz1+iz2) - x * 3
+      end block
+    end if
+  end
+
+  integer function g(x, y1, y2, z1, z2)
+    !$omp declare variant(f) match(construct={dispatch}) adjust_args(need_device_ptr : y1, y2, z1, z2)
+    allocatable :: g
+    integer, value :: x
+    type(c_ptr), value :: y1, y2
+    type(c_ptr) :: z1, z2
+    g = x
+    stop 2  ! should not get called
+  end
+end 
+
+program main
+  use m
+  implicit none (type, external)
+  integer, target :: v1, v2
+  integer :: res, ref
+  v1 = 5
+  v2 = 11
+
+  ref = 5*2 + 10 * 11*2
+  ref = -(5*2)*23 -127 * (11*2) - ref * 3
+
+  !$omp target data map(v1,v2)
+    res = func (c_loc(v1), c_loc(v1), c_loc(v2), c_loc(v2))
+  !$omp end target data
+
+  if (res /= ref) stop 1
+contains
+integer function func(x1, x2, x3, x4)
+  use m
+  implicit none(type,external)
+  type(c_ptr) :: x1, x2, x3, x4
+  value :: x1, x3
+
+  !$omp dispatch
+    func = g(g(1,x1,x2,x3,x4), x1,x2,x3,x4)
+end
+end
+
+! { dg-final { scan-tree-dump-times "__builtin_omp_get_mapped_ptr" 4 "gimple" } }