public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/omp/gcc-11] Fortran/OpenMP: Add memory routines existing for C/C++
@ 2021-08-18 10:24 Tobias Burnus
0 siblings, 0 replies; only message in thread
From: Tobias Burnus @ 2021-08-18 10:24 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:d8bc586a65d6d22c54be7049a597974a7b3773a2
commit d8bc586a65d6d22c54be7049a597974a7b3773a2
Author: Tobias Burnus <tobias@codesourcery.com>
Date: Wed Aug 18 11:21:35 2021 +0200
Fortran/OpenMP: Add memory routines existing for C/C++
This patch adds the Fortran interface for omp_alloc/omp_free
and the omp_target_* memory routines, which were added in
OpenMP 5.0 for C/C++ but only OpenMP 5.1 added them for Fortran.
Those functions use BIND(C), i.e. on the libgomp side, the same
interface as for C/C++ is used.
Note: By using BIND(C) in omp_lib.h, files including this file
no longer compiler with -std=f95 but require at least -std=f2003.
libgomp/ChangeLog:
* omp_lib.f90.in (omp_alloc, omp_free, omp_target_alloc,
omp_target_free. omp_target_is_present, omp_target_memcpy,
omp_target_memcpy_rect, omp_target_associate_ptr,
omp_target_disassociate_ptr): Add interface.
* omp_lib.h.in (omp_alloc, omp_free, omp_target_alloc,
omp_target_free. omp_target_is_present, omp_target_memcpy,
omp_target_memcpy_rect, omp_target_associate_ptr,
omp_target_disassociate_ptr): Add interface.
* testsuite/libgomp.fortran/alloc-1.F90: Remove local
interface block for omp_alloc + omp_free.
* testsuite/libgomp.fortran/alloc-4.f90: Likewise.
* testsuite/libgomp.fortran/refcount-1.f90: New test.
* testsuite/libgomp.fortran/target-12.f90: New test.
(cherry picked from commit 76bb3c50dd43a5f87d4f949cf0d0979144562e6c)
Diff:
---
libgomp/ChangeLog.omp | 19 +++
libgomp/omp_lib.f90.in | 94 +++++++++++++++
libgomp/omp_lib.h.in | 97 +++++++++++++++
libgomp/testsuite/libgomp.fortran/alloc-1.F90 | 16 ---
libgomp/testsuite/libgomp.fortran/alloc-4.f90 | 16 ---
libgomp/testsuite/libgomp.fortran/refcount-1.f90 | 61 ++++++++++
libgomp/testsuite/libgomp.fortran/target-12.f90 | 147 +++++++++++++++++++++++
7 files changed, 418 insertions(+), 32 deletions(-)
diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp
index 75a0b1e159c..c6e8facc9fc 100644
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/ChangeLog.omp
@@ -1,3 +1,22 @@
+2021-08-18 Tobias Burnus <tobias@codesourcery.com>
+
+ Backported from master:
+ 2021-08-18 Tobias Burnus <tobias@codesourcery.com>
+
+ * omp_lib.f90.in (omp_alloc, omp_free, omp_target_alloc,
+ omp_target_free. omp_target_is_present, omp_target_memcpy,
+ omp_target_memcpy_rect, omp_target_associate_ptr,
+ omp_target_disassociate_ptr): Add interface.
+ * omp_lib.h.in (omp_alloc, omp_free, omp_target_alloc,
+ omp_target_free. omp_target_is_present, omp_target_memcpy,
+ omp_target_memcpy_rect, omp_target_associate_ptr,
+ omp_target_disassociate_ptr): Add interface.
+ * testsuite/libgomp.fortran/alloc-1.F90: Remove local
+ interface block for omp_alloc + omp_free.
+ * testsuite/libgomp.fortran/alloc-4.f90: Likewise.
+ * testsuite/libgomp.fortran/refcount-1.f90: New test.
+ * testsuite/libgomp.fortran/target-12.f90: New test.
+
2021-08-18 Tobias Burnus <tobias@codesourcery.com>
Backported from master:
diff --git a/libgomp/omp_lib.f90.in b/libgomp/omp_lib.f90.in
index 6394e65bbf7..a36a5626123 100644
--- a/libgomp/omp_lib.f90.in
+++ b/libgomp/omp_lib.f90.in
@@ -670,6 +670,100 @@
end subroutine omp_display_env_8
end interface
+ interface
+ function omp_alloc (size, allocator) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
+ import :: omp_allocator_handle_kind
+ type(c_ptr) :: omp_alloc
+ integer(c_size_t), value :: size
+ integer(omp_allocator_handle_kind), value :: allocator
+ end function omp_alloc
+ end interface
+
+ interface
+ subroutine omp_free(ptr, allocator) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr
+ import :: omp_allocator_handle_kind
+ type(c_ptr), value :: ptr
+ integer(omp_allocator_handle_kind), value :: allocator
+ end subroutine
+ end interface
+
+ interface
+ function omp_target_alloc (size, device_num) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t, c_int
+ type(c_ptr) :: omp_target_alloc
+ integer(c_size_t), value :: size
+ integer(c_int), value :: device_num
+ end function omp_target_alloc
+ end interface
+
+ interface
+ subroutine omp_target_free (device_ptr, device_num) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_int
+ type(c_ptr), value :: device_ptr
+ integer(c_int), value :: device_num
+ end subroutine omp_target_free
+ end interface
+
+ interface
+ function omp_target_is_present (ptr, device_num) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_int
+ integer(c_int) :: omp_target_is_present
+ type(c_ptr), value :: ptr
+ integer(c_int), value :: device_num
+ end function omp_target_is_present
+ end interface
+
+ interface
+ function omp_target_memcpy (dst, src, length, dst_offset, &
+ src_offset, dst_device_num, &
+ src_device_num) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_int, c_size_t
+ integer(c_int) :: omp_target_memcpy
+ type(c_ptr), value :: dst, src
+ integer(c_size_t), value :: length, dst_offset, src_offset
+ integer(c_int), value :: dst_device_num, src_device_num
+ end function omp_target_memcpy
+ end interface
+
+ interface
+ function omp_target_memcpy_rect (dst,src,element_size, num_dims, &
+ volume, dst_offsets, src_offsets, &
+ dst_dimensions, src_dimensions, &
+ dst_device_num, src_device_num) &
+ bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_int, c_size_t
+ integer(c_int) :: omp_target_memcpy_rect
+ type(c_ptr), value :: dst, src
+ integer(c_size_t), value :: element_size
+ integer(c_int), value :: num_dims, dst_device_num, src_device_num
+ integer(c_size_t), intent(in) :: volume(*), dst_offsets(*), &
+ src_offsets(*), dst_dimensions(*), &
+ src_dimensions(*)
+ end function omp_target_memcpy_rect
+ end interface
+
+ interface
+ function omp_target_associate_ptr (host_ptr, device_ptr, size, &
+ device_offset, device_num) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t, c_int
+ integer(c_int) :: omp_target_associate_ptr
+ type(c_ptr), value :: host_ptr, device_ptr
+ integer(c_size_t), value :: size, device_offset
+ integer(c_int), value :: device_num
+ end function omp_target_associate_ptr
+ end interface
+
+ interface
+ function omp_target_disassociate_ptr (ptr, device_num) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_int
+ integer(c_int) :: omp_target_disassociate_ptr
+ type(c_ptr), value :: ptr
+ integer(c_int), value :: device_num
+ end function omp_target_disassociate_ptr
+ end interface
+
#if _OPENMP >= 201811
!GCC$ ATTRIBUTES DEPRECATED :: omp_get_nested, omp_set_nested
#endif
diff --git a/libgomp/omp_lib.h.in b/libgomp/omp_lib.h.in
index f2ad445f924..1c2eacba554 100644
--- a/libgomp/omp_lib.h.in
+++ b/libgomp/omp_lib.h.in
@@ -271,3 +271,100 @@
integer (omp_allocator_handle_kind) omp_get_default_allocator
external omp_display_env
+
+ interface
+ function omp_alloc (size, allocator) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
+ use, intrinsic :: omp_lib_kinds
+ type(c_ptr) :: omp_alloc
+ integer(c_size_t), value :: size
+ integer(omp_allocator_handle_kind), value :: allocator
+ end function omp_alloc
+ end interface
+
+ interface
+ subroutine omp_free(ptr, allocator) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr
+ use, intrinsic :: omp_lib_kinds
+ type(c_ptr), value :: ptr
+ integer(omp_allocator_handle_kind), value :: allocator
+ end subroutine
+ end interface
+
+ interface
+ function omp_target_alloc (size, device_num) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t, c_int
+ type(c_ptr) :: omp_target_alloc
+ integer(c_size_t), value :: size
+ integer(c_int), value :: device_num
+ end function omp_target_alloc
+ end interface
+
+ interface
+ subroutine omp_target_free (device_ptr, device_num) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_int
+ type(c_ptr), value :: device_ptr
+ integer(c_int), value :: device_num
+ end subroutine omp_target_free
+ end interface
+
+ interface
+ function omp_target_is_present (ptr, device_num) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_int
+ integer(c_int) :: omp_target_is_present
+ type(c_ptr), value :: ptr
+ integer(c_int), value :: device_num
+ end function omp_target_is_present
+ end interface
+
+ interface
+ function omp_target_memcpy (dst, src, length, dst_offset, &
+ & src_offset, dst_device_num, &
+ & src_device_num) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_int, c_size_t
+ integer(c_int) :: omp_target_memcpy
+ type(c_ptr), value :: dst, src
+ integer(c_size_t), value :: length, dst_offset, src_offset
+ integer(c_int), value :: dst_device_num, src_device_num
+ end function omp_target_memcpy
+ end interface
+
+ interface
+ function omp_target_memcpy_rect (dst,src,element_size, num_dims, &
+ & volume, dst_offsets, &
+ & src_offsets, dst_dimensions, &
+ & src_dimensions, dst_device_num, &
+ & src_device_num) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_int, c_size_t
+ integer(c_int) :: omp_target_memcpy_rect
+ type(c_ptr), value :: dst, src
+ integer(c_size_t), value :: element_size
+ integer(c_int), value :: num_dims
+ integer(c_int), value :: dst_device_num, src_device_num
+ integer(c_size_t), intent(in) :: volume(*), dst_offsets(*)
+ integer(c_size_t), intent(in) :: src_offsets(*)
+ integer(c_size_t), intent(in) :: dst_dimensions(*)
+ integer(c_size_t), intent(in) :: src_dimensions(*)
+ end function omp_target_memcpy_rect
+ end interface
+
+ interface
+ function omp_target_associate_ptr (host_ptr, device_ptr, size, &
+ & device_offset, device_num) &
+ & bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t, c_int
+ integer(c_int) :: omp_target_associate_ptr
+ type(c_ptr), value :: host_ptr, device_ptr
+ integer(c_size_t), value :: size, device_offset
+ integer(c_int), value :: device_num
+ end function omp_target_associate_ptr
+ end interface
+
+ interface
+ function omp_target_disassociate_ptr (ptr, device_num) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_int
+ integer(c_int) :: omp_target_disassociate_ptr
+ type(c_ptr), value :: ptr
+ integer(c_int), value :: device_num
+ end function omp_target_disassociate_ptr
+ end interface
diff --git a/libgomp/testsuite/libgomp.fortran/alloc-1.F90 b/libgomp/testsuite/libgomp.fortran/alloc-1.F90
index 178ce771d45..e6365831984 100644
--- a/libgomp/testsuite/libgomp.fortran/alloc-1.F90
+++ b/libgomp/testsuite/libgomp.fortran/alloc-1.F90
@@ -36,22 +36,6 @@
type (omp_alloctrait), allocatable :: traits(:), traits5(:)
- interface
- ! omp_alloc + omp_free part of OpenMP for C/C++
- ! but not (yet) in the OpenMP spec for Fortran
- type(c_ptr) function omp_alloc (size, handle) bind(C)
- import
- integer (c_size_t), value :: size
- integer (omp_allocator_handle_kind), value :: handle
- end function
-
- subroutine omp_free (ptr, handle) bind(C)
- import
- type (c_ptr), value :: ptr
- integer (omp_allocator_handle_kind), value :: handle
- end subroutine
- end interface
-
type(c_ptr), volatile :: cp, cq, cr
integer :: i
integer(c_intptr_t) :: intptr
diff --git a/libgomp/testsuite/libgomp.fortran/alloc-4.f90 b/libgomp/testsuite/libgomp.fortran/alloc-4.f90
index ce353b55eb0..87b6adda645 100644
--- a/libgomp/testsuite/libgomp.fortran/alloc-4.f90
+++ b/libgomp/testsuite/libgomp.fortran/alloc-4.f90
@@ -3,22 +3,6 @@ program main
use ISO_C_Binding
implicit none (external, type)
- interface
- ! omp_alloc + omp_free part of OpenMP for C/C++
- ! but not (yet) in the OpenMP spec for Fortran
- type(c_ptr) function omp_alloc (size, handle) bind(C)
- import
- integer (c_size_t), value :: size
- integer (omp_allocator_handle_kind), value :: handle
- end function
-
- subroutine omp_free (ptr, handle) bind(C)
- import
- type (c_ptr), value :: ptr
- integer (omp_allocator_handle_kind), value :: handle
- end subroutine
- end interface
-
type (omp_alloctrait) :: traits(3)
integer (omp_allocator_handle_kind) :: a
diff --git a/libgomp/testsuite/libgomp.fortran/refcount-1.f90 b/libgomp/testsuite/libgomp.fortran/refcount-1.f90
new file mode 100644
index 00000000000..e3b9d04af81
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/refcount-1.f90
@@ -0,0 +1,61 @@
+program main
+ use omp_lib
+ use iso_c_binding
+ implicit none (type, external)
+
+ integer :: d, id
+ integer(kind=1), target :: a(4)
+ integer(kind=1), pointer :: p, q
+
+ d = omp_get_default_device ()
+ id = omp_get_initial_device ()
+
+ if (d < 0 .or. d >= omp_get_num_devices ()) &
+ d = id
+
+ a = transfer (int(z'cdcdcdcd'), mold=a)
+
+ !$omp target enter data map (to:a)
+
+ a = transfer (int(z'abababab'), mold=a)
+ p => a(1)
+ q => a(3)
+
+ !$omp target enter data map (alloc:p, q)
+
+ if (d /= id) then
+ if (omp_target_is_present (c_loc(a), d) == 0) &
+ stop 1
+ if (omp_target_is_present (c_loc(p), d) == 0) &
+ stop 2
+ if (omp_target_is_present (c_loc(q), d) == 0) &
+ stop 3
+ end if
+
+ !$omp target exit data map (release:a)
+
+ if (d /= id) then
+ if (omp_target_is_present (c_loc(a), d) == 0) &
+ stop 4
+ if (omp_target_is_present (c_loc(p), d) == 0) &
+ stop 5
+ if (omp_target_is_present (c_loc(q), d) == 0) &
+ stop 6
+ end if
+
+ !$omp target exit data map (from:q)
+
+ if (d /= id) then
+ if (omp_target_is_present (c_loc(a), d) /= 0) &
+ stop 7
+ if (omp_target_is_present (c_loc(p), d) /= 0) &
+ stop 8
+ if (omp_target_is_present (c_loc(q), d) /= 0) &
+ stop 9
+
+ if (q /= int(z'cd', kind=1)) &
+ stop 10
+ if (p /= int(z'ab', kind=1)) &
+ stop 11
+ end if
+end program main
diff --git a/libgomp/testsuite/libgomp.fortran/target-12.f90 b/libgomp/testsuite/libgomp.fortran/target-12.f90
new file mode 100644
index 00000000000..17c78f18f9b
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-12.f90
@@ -0,0 +1,147 @@
+program main
+ use omp_lib
+ use iso_c_binding
+ implicit none (external, type)
+ integer :: d, id, i, j, k, l
+ logical :: err
+ integer, target :: q(0:127)
+ type(c_ptr) :: p
+
+ integer(kind=c_size_t) :: volume(0:2)
+ integer(kind=c_size_t) :: dst_offsets(0:2)
+ integer(kind=c_size_t) :: src_offsets(0:2)
+ integer(kind=c_size_t) :: dst_dimensions(0:2)
+ integer(kind=c_size_t) :: src_dimensions(0:2)
+ integer(kind=c_size_t) :: empty(1:0)
+
+ err = .false.
+ d = omp_get_default_device ()
+ id = omp_get_initial_device ()
+
+ if (d < 0 .or. d >= omp_get_num_devices ()) &
+ d = id
+
+ q = [(i, i = 0, 127)]
+ p = omp_target_alloc (130 * c_sizeof (q), d)
+ if (.not. c_associated (p)) &
+ stop 0 ! okay
+
+ if (omp_target_memcpy_rect (C_NULL_PTR, C_NULL_PTR, 0_c_size_t, 0, &
+ empty, empty, empty, empty, empty, d, id) < 3 &
+ .or. omp_target_memcpy_rect (C_NULL_PTR, C_NULL_PTR, 0_c_size_t, 0, &
+ empty, empty, empty, empty, empty, &
+ id, d) < 3 &
+ .or. omp_target_memcpy_rect (C_NULL_PTR, C_NULL_PTR, 0_c_size_t, 0, &
+ empty, empty, empty, empty, empty, &
+ id, id) < 3) &
+ stop 1
+
+ if (omp_target_associate_ptr (c_loc (q), p, 128 * c_sizeof (q(0)), &
+ c_sizeof (q(0)), d) == 0) then
+ volume = [ 128, 0, 0 ]
+ dst_offsets = [ 0, 0, 0 ]
+ src_offsets = [ 1, 0, 0 ]
+ dst_dimensions = [ 128, 0, 0 ]
+ src_dimensions = [ 128, 0, 0 ]
+
+
+ if (omp_target_associate_ptr (c_loc (q), p, 128 * sizeof (q(0)), &
+ sizeof (q(0)), d) /= 0) &
+ stop 2
+
+ if (omp_target_is_present (c_loc (q), d) /= 1 &
+ .or. omp_target_is_present (c_loc (q(32)), d) /= 1 &
+ .or. omp_target_is_present (c_loc (q(127)), d) /= 1) &
+ stop 3
+
+ if (omp_target_memcpy (p, c_loc (q), 128 * sizeof (q(0)), sizeof (q(0)), &
+ 0_c_size_t, d, id) /= 0) &
+ stop 4
+
+ i = 0
+ if (d >= 0) i = d
+ !$omp target if (d >= 0) device (i) map(alloc:q(0:31)) map(from:err)
+ err = .false.
+ do j = 0, 127
+ if (q(j) /= j) then
+ err = .true.
+ else
+ q(j) = q(j) + 4
+ end if
+ end do
+ !$omp end target
+
+ if (err) &
+ stop 5
+
+ if (omp_target_memcpy_rect (c_loc (q), p, sizeof (q(0)), 1, volume, &
+ dst_offsets, src_offsets, dst_dimensions, &
+ src_dimensions, id, d) /= 0) &
+ stop 6
+
+ do i = 0, 127
+ if (q(i) /= i + 4) &
+ stop 7
+ end do
+
+ volume(2) = 2
+ volume(1) = 3
+ volume(0) = 6
+ dst_offsets(2) = 1
+ dst_offsets(1) = 0
+ dst_offsets(0) = 0
+ src_offsets(2) = 1
+ src_offsets(1) = 0
+ src_offsets(0) = 3
+ dst_dimensions(2) = 2
+ dst_dimensions(1) = 3
+ dst_dimensions(0) = 6
+ src_dimensions(2) = 3
+ src_dimensions(1) = 4
+ src_dimensions(0) = 6
+
+ if (omp_target_memcpy_rect (p, c_loc (q), sizeof (q(0)), 3, volume, &
+ dst_offsets, src_offsets, dst_dimensions, &
+ src_dimensions, d, id) /= 0) &
+ stop 8
+
+ i = 0
+ if (d >= 0) i = d
+ !$omp target if (d >= 0) device (i) map(alloc:q(1:32)) map(from:err)
+ err = .false.
+ do j = 0, 5
+ do k = 0, 2
+ do l = 0, 1
+ if (q(j * 6 + k * 2 + l) /= 3 * 12 + 4 + 1 + l + k * 3 + j * 12) &
+ err = .true.
+ end do
+ end do
+ end do
+ !$omp end target
+
+ if (err) &
+ stop 9
+
+ if (omp_target_memcpy (p, p, 10 * sizeof (q(1)), 51 * sizeof (q(1)), &
+ 111 * sizeof (q(1)), d, d) /= 0) &
+ stop 10
+
+ i = 0
+ if (d >= 0) i = d
+ !$omp target if (d >= 0) device (i) map(alloc:q(0:31)) map(from:err)
+ err = .false.
+ do j = 1, 9
+ if (q(50+j) /= q(110 + j)) &
+ err = .true.
+ end do
+ !$omp end target
+
+ if (err) &
+ stop 11
+
+ if (omp_target_disassociate_ptr (c_loc (q), d) /= 0) &
+ stop 12
+ end if
+
+ call omp_target_free (p, d)
+end program main
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-08-18 10:24 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-08-18 10:24 [gcc/devel/omp/gcc-11] Fortran/OpenMP: Add memory routines existing for C/C++ Tobias Burnus
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).