openmp: Add omp_aligned_{,c}alloc and omp_{c,re}alloc for Fortran
gcc/ChangeLog:
* omp-low.c (omp_runtime_api_call): Add omp_aligned_{,c}alloc and
omp_{c,re}alloc, fix omp_alloc/omp_free.
libgomp/ChangeLog:
* libgomp.texi (OpenMP 5.1): Set implementation status to Y for
omp_aligned_{,c}alloc and omp_{c,re}alloc routines.
* omp_lib.f90.in (omp_aligned_alloc, omp_aligned_calloc, omp_calloc,
omp_realloc): Add.
* omp_lib.h.in (omp_aligned_alloc, omp_aligned_calloc, omp_calloc,
omp_realloc): Add.
* testsuite/libgomp.fortran/alloc-10.f90: New test.
* testsuite/libgomp.fortran/alloc-6.f90: New test.
* testsuite/libgomp.fortran/alloc-7.c: New test.
* testsuite/libgomp.fortran/alloc-7.f90: New test.
* testsuite/libgomp.fortran/alloc-8.f90: New test.
* testsuite/libgomp.fortran/alloc-9.f90: New test.
gcc/omp-low.c | 8 +-
libgomp/libgomp.texi | 2 +-
libgomp/omp_lib.f90.in | 43 +++++-
libgomp/omp_lib.h.in | 46 +++++-
libgomp/testsuite/libgomp.fortran/alloc-10.f90 | 198 +++++++++++++++++++++++++
libgomp/testsuite/libgomp.fortran/alloc-6.f90 | 45 ++++++
libgomp/testsuite/libgomp.fortran/alloc-7.c | 5 +
libgomp/testsuite/libgomp.fortran/alloc-7.f90 | 174 ++++++++++++++++++++++
libgomp/testsuite/libgomp.fortran/alloc-8.f90 | 58 ++++++++
libgomp/testsuite/libgomp.fortran/alloc-9.f90 | 196 ++++++++++++++++++++++++
10 files changed, 770 insertions(+), 5 deletions(-)
@@ -3921,8 +3921,12 @@ omp_runtime_api_call (const_tree fndecl)
{
/* This array has 3 sections. First omp_* calls that don't
have any suffixes. */
- "omp_alloc",
- "omp_free",
+ "aligned_alloc",
+ "aligned_calloc",
+ "alloc",
+ "calloc",
+ "free",
+ "realloc",
"target_alloc",
"target_associate_ptr",
"target_disassociate_ptr",
@@ -315,7 +315,7 @@ The OpenMP 4.5 specification is fully supported.
runtime routines @tab N @tab
@item @code{omp_get_mapped_ptr} runtime routine @tab N @tab
@item @code{omp_calloc}, @code{omp_realloc}, @code{omp_aligned_alloc} and
- @code{omp_aligned_calloc} runtime routines @tab N @tab
+ @code{omp_aligned_calloc} runtime routines @tab Y @tab
@item @code{omp_alloctrait_key_t} enum: @code{omp_atv_serialized} added,
@code{omp_atv_default} changed @tab Y @tab
@item @code{omp_display_env} runtime routine @tab P
@@ -680,13 +680,54 @@
end function omp_alloc
end interface
+ interface
+ function omp_aligned_alloc (alignment, size, allocator) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
+ import :: omp_allocator_handle_kind
+ type(c_ptr) :: omp_aligned_alloc
+ integer(c_size_t), value :: alignment, size
+ integer(omp_allocator_handle_kind), value :: allocator
+ end function omp_aligned_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 subroutine omp_free
+ end interface
+
+ interface
+ function omp_calloc (nmemb, size, allocator) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
+ import :: omp_allocator_handle_kind
+ type(c_ptr) :: omp_calloc
+ integer(c_size_t), value :: nmemb, size
+ integer(omp_allocator_handle_kind), value :: allocator
+ end function omp_calloc
+ end interface
+
+ interface
+ function omp_aligned_calloc (alignment, nmemb, size, allocator) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
+ import :: omp_allocator_handle_kind
+ type(c_ptr) :: omp_aligned_calloc
+ integer(c_size_t), value :: alignment, nmemb, size
+ integer(omp_allocator_handle_kind), value :: allocator
+ end function omp_aligned_calloc
+ end interface
+
+ interface
+ function omp_realloc (ptr, size, allocator, free_allocator) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
+ import :: omp_allocator_handle_kind
+ type(c_ptr) :: omp_realloc
+ type(c_ptr), value :: ptr
+ integer(c_size_t), value :: size
+ integer(omp_allocator_handle_kind), value :: allocator, free_allocator
+ end function omp_realloc
end interface
interface
@@ -282,13 +282,57 @@
end function omp_alloc
end interface
+ interface
+ function omp_aligned_alloc (alignment, size, allocator) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
+ use, intrinsic :: omp_lib_kinds
+ type(c_ptr) :: omp_aligned_alloc
+ integer(c_size_t), value :: alignment, size
+ integer(omp_allocator_handle_kind), value :: allocator
+ end function omp_aligned_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 subroutine omp_free
+ end interface
+
+ interface
+ function omp_calloc (nmemb, size, allocator) bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
+ use, intrinsic :: omp_lib_kinds
+ type(c_ptr) :: omp_calloc
+ integer(c_size_t), value :: nmemb, size
+ integer(omp_allocator_handle_kind), value :: allocator
+ end function omp_calloc
+ end interface
+
+ interface
+ function omp_aligned_calloc (alignment, nmemb, size, allocator) &
+ & bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
+ use, intrinsic :: omp_lib_kinds
+ type(c_ptr) :: omp_aligned_calloc
+ integer(c_size_t), value :: alignment, nmemb, size
+ integer(omp_allocator_handle_kind), value :: allocator
+ end function omp_aligned_calloc
+ end interface
+
+ interface
+ function omp_realloc (ptr, size, allocator, free_allocator) &
+ & bind(c)
+ use, intrinsic :: iso_c_binding, only : c_ptr, c_size_t
+ use, intrinsic :: omp_lib_kinds
+ type(c_ptr) :: omp_realloc
+ type(c_ptr), value :: ptr
+ integer(c_size_t), value :: size
+ integer(omp_allocator_handle_kind), value :: allocator
+ integer(omp_allocator_handle_kind), value :: free_allocator
+ end function omp_realloc
end interface
interface
new file mode 100644
@@ -0,0 +1,198 @@
+! { dg-additional-sources alloc-7.c }
+module m
+ use omp_lib
+ use iso_c_binding
+ implicit none
+
+ type (omp_alloctrait), parameter :: traits2(*) &
+ = [ omp_alloctrait (omp_atk_alignment, 16), &
+ omp_alloctrait (omp_atk_sync_hint, omp_atv_default), &
+ omp_alloctrait (omp_atk_access, omp_atv_default), &
+ omp_alloctrait (omp_atk_pool_size, 1024), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_default_mem_fb), &
+ omp_alloctrait (omp_atk_partition, omp_atv_environment)]
+ type (omp_alloctrait) :: traits3(7) &
+ = [ omp_alloctrait (omp_atk_sync_hint, omp_atv_uncontended), &
+ omp_alloctrait (omp_atk_alignment, 32), &
+ omp_alloctrait (omp_atk_access, omp_atv_all), &
+ omp_alloctrait (omp_atk_pool_size, 512), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_allocator_fb), &
+ omp_alloctrait (omp_atk_fb_data, 0), &
+ omp_alloctrait (omp_atk_partition, omp_atv_default)]
+ type (omp_alloctrait), parameter :: traits4(*) &
+ = [ omp_alloctrait (omp_atk_alignment, 128), &
+ omp_alloctrait (omp_atk_pool_size, 1024), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_null_fb)]
+
+ interface
+ integer(c_int) function get__alignof_int () bind(C)
+ import :: c_int
+ end
+ end interface
+end module m
+
+program main
+ use m
+ implicit none (external, type)
+ type(c_ptr) :: p, q, r
+ integer, pointer, contiguous :: ip(:), iq(:), ir(:)
+ type (omp_alloctrait) :: traits(3)
+ integer (omp_allocator_handle_kind) :: a, a2
+ integer (c_ptrdiff_t) :: iptr
+ integer :: i
+
+ traits = [ omp_alloctrait (omp_atk_alignment, 64), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), &
+ omp_alloctrait (omp_atk_pool_size, 4096)]
+
+ p = omp_aligned_calloc (c_sizeof (0), 3_c_size_t, c_sizeof (0), omp_default_mem_alloc)
+ call c_f_pointer (p, ip, [3])
+ if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0 &
+ .or. ip(1) /= 0 .or. ip(2) /= 0 .or. ip(3) /= 0) &
+ stop 1
+ ip(1) = 1
+ ip(2) = 2
+ ip(3) = 3
+ call omp_free (p, omp_default_mem_alloc)
+ p = omp_aligned_calloc (2 * c_sizeof (0), 1_c_size_t, 2 * c_sizeof (0), omp_default_mem_alloc)
+ call c_f_pointer (p, ip, [2])
+ if (mod (TRANSFER (p, iptr), 2 * c_sizeof (0)) /= 0 &
+ .or. ip(1) /= 0 .or. ip(2) /= 0) &
+ stop 2
+ ip(1) = 1
+ ip(2) = 2
+ call omp_free (p, omp_null_allocator)
+ call omp_set_default_allocator (omp_default_mem_alloc)
+ p = omp_aligned_calloc (1_c_size_t, 1_c_size_t, c_sizeof (0), omp_null_allocator)
+ call c_f_pointer (p, ip, [1])
+ if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0 &
+ .or. ip(1) /= 0) &
+ stop 3
+ ip(1) = 3
+ call omp_free (p, omp_get_default_allocator ())
+
+ a = omp_init_allocator (omp_default_mem_space, 3, traits)
+ if (a == omp_null_allocator) &
+ stop 4
+ p = omp_aligned_calloc (32_c_size_t, 3_c_size_t, 1024_c_size_t, a)
+ call c_f_pointer (p, ip, [3072 / c_sizeof (0)])
+ if (mod (TRANSFER (p, iptr), 64) /= 0) &
+ stop 5
+ do i = 1, 3072 / c_sizeof (0)
+ if (ip(i) /= 0) &
+ stop 6
+ end do
+ ip(1) = 1
+ ip(3072 / c_sizeof (0)) = 2
+ if (c_associated (omp_aligned_calloc (8_c_size_t, 192_c_size_t, 16_c_size_t, a))) &
+ stop 7
+ call omp_free (p, a)
+ p = omp_aligned_calloc (128_c_size_t, 6_c_size_t, 512_c_size_t, a)
+ call c_f_pointer (p, ip, [3072 / c_sizeof (0)])
+ if (mod (TRANSFER (p, iptr), 128) /= 0) &
+ stop 8
+ do i = 1, 3072 / c_sizeof (0)
+ if (ip(i) /= 0) &
+ stop 9
+ end do
+ ip(1) = 3
+ ip(3072 / c_sizeof (0)) = 4
+ call omp_free (p, omp_null_allocator)
+ call omp_set_default_allocator (a)
+ if (omp_get_default_allocator () /= a) &
+ stop 10
+ p = omp_aligned_calloc (64_c_size_t, 12_c_size_t, 256_c_size_t, omp_null_allocator)
+ call c_f_pointer (p, ip, [3072 / c_sizeof (0)])
+ do i = 1, 3072 / c_sizeof (0)
+ if (ip(i) /= 0) &
+ stop 11
+ end do
+ if (c_associated (omp_aligned_calloc (8_c_size_t, 128_c_size_t, 24_c_size_t, omp_null_allocator))) &
+ stop 12
+ call omp_free (p, a)
+ call omp_destroy_allocator (a)
+
+ a = omp_init_allocator (omp_default_mem_space, size (traits2), traits2)
+ if (a == omp_null_allocator) &
+ stop 13
+ if (traits3(6)%key /= omp_atk_fb_data) &
+ stop 14
+ traits3(6)%value = a
+ a2 = omp_init_allocator (omp_default_mem_space, size (traits3), traits3)
+ if (a2 == omp_null_allocator) &
+ stop 15
+ p = omp_aligned_calloc (4_c_size_t, 5_c_size_t, 84_c_size_t, a2)
+ call c_f_pointer (p, ip, [420 / c_sizeof (0)])
+ do i = 1, 420 / c_sizeof (0)
+ if (ip(i) /= 0) &
+ stop 16
+ end do
+ if (mod (TRANSFER (p, iptr), 32) /= 0) &
+ stop 17
+ ip(1) = 5
+ ip(420 / c_sizeof (0)) = 6
+ q = omp_aligned_calloc (8_c_size_t, 24_c_size_t, 32_c_size_t, a2)
+ call c_f_pointer (q, iq, [768 / c_sizeof (0)])
+ if (mod (TRANSFER (p, iptr), 16) /= 0) &
+ stop 18
+ do i = 1, 768 / c_sizeof (0)
+ if (iq(i) /= 0) &
+ stop 19
+ end do
+ iq(1) = 7
+ iq(768 / c_sizeof (0)) = 8
+ r = omp_aligned_calloc (8_c_size_t, 64_c_size_t, 8_c_size_t, a2)
+ call c_f_pointer (r, ir, [512 / c_sizeof (0)])
+ if (mod (TRANSFER (p, iptr), 8) /= 0) &
+ stop 20
+ do i = 1, 512 / c_sizeof (0)
+ if (ir(i) /= 0) &
+ stop 21
+ end do
+ ir(1) = 9
+ ir(512 / c_sizeof (0)) = 10
+ call omp_free (p, omp_null_allocator)
+ call omp_free (q, a2)
+ call omp_free (r, omp_null_allocator)
+ call omp_destroy_allocator (a2)
+ call omp_destroy_allocator (a)
+
+ a = omp_init_allocator (omp_default_mem_space, size (traits4), traits4)
+ if (a == omp_null_allocator) &
+ stop 22
+ if (traits3(6)%key /= omp_atk_fb_data) &
+ stop 23
+ traits3(6)%value = a
+ a2 = omp_init_allocator (omp_default_mem_space, size (traits3), traits3)
+ if (a2 == omp_null_allocator) &
+ stop 24
+ call omp_set_default_allocator (a2)
+ p = omp_aligned_calloc (4_c_size_t, 21_c_size_t, 20_c_size_t, omp_null_allocator)
+ call c_f_pointer (p, ip, [420 / c_sizeof (0)])
+ if (mod (TRANSFER (p, iptr), 32) /= 0) &
+ stop 25
+ do i = 1, 420 / c_sizeof (0)
+ if (ip(i) /= 0) &
+ stop 26
+ end do
+ ip(1) = 5
+ ip(420 / c_sizeof (0)) = 6
+ q = omp_aligned_calloc (64_c_size_t, 12_c_size_t, 64_c_size_t, omp_null_allocator)
+ call c_f_pointer (q, iq, [768 / c_sizeof (0)])
+ if (mod (TRANSFER (q, iptr), 128) /= 0) &
+ stop 27
+ do i = 1, 768 / c_sizeof (0)
+ if (iq(i) /= 0) &
+ stop 28
+ end do
+ iq(1) = 7
+ iq(768 / c_sizeof (0)) = 8
+ if (c_associated (omp_aligned_calloc (8_c_size_t, 24_c_size_t, 32_c_size_t, omp_null_allocator))) &
+ stop 29
+ call omp_free (p, omp_null_allocator)
+ call omp_free (q, omp_null_allocator)
+ call omp_free (c_null_ptr, omp_null_allocator)
+ call omp_free (c_null_ptr, omp_null_allocator)
+ call omp_destroy_allocator (a2)
+ call omp_destroy_allocator (a)
+end program main
new file mode 100644
@@ -0,0 +1,45 @@
+module m
+ use omp_lib
+ implicit none
+
+ type (omp_alloctrait), parameter :: traits(*) &
+ = [ omp_alloctrait (omp_atk_pool_size, 1), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_abort_fb) ]
+end module m
+
+program main
+ use m
+ use iso_c_binding
+ implicit none (external, type)
+ integer (omp_allocator_handle_kind) :: a
+ integer(c_size_t), parameter :: zero = 0_c_size_t
+
+ if (c_associated (omp_alloc (zero, omp_null_allocator))) &
+ stop 1
+ if (c_associated (omp_aligned_alloc (64_c_size_t, zero, omp_null_allocator))) &
+ stop 2
+ if (c_associated (omp_calloc (zero, zero, omp_null_allocator)) &
+ .or. c_associated (omp_calloc (32_c_size_t, zero, omp_null_allocator)) &
+ .or. c_associated (omp_calloc (zero, 64_c_size_t, omp_null_allocator))) &
+ stop 3
+ if (c_associated (omp_aligned_calloc (32_c_size_t, zero, zero, omp_null_allocator)) &
+ .or. c_associated (omp_aligned_calloc (64_c_size_t, 32_c_size_t, zero, omp_null_allocator)) &
+ .or. c_associated (omp_aligned_calloc (16_c_size_t, zero, 64_c_size_t, omp_null_allocator))) &
+ stop 4
+ a = omp_init_allocator (omp_default_mem_space, 2, traits)
+ if (a /= omp_null_allocator) then
+ if (c_associated (omp_alloc (zero, a)) &
+ .or. c_associated (omp_alloc (zero, a)) &
+ .or. c_associated (omp_alloc (zero, a)) &
+ .or. c_associated (omp_aligned_alloc (16_c_size_t, zero, a)) &
+ .or. c_associated (omp_aligned_alloc (128_c_size_t, zero, a)) &
+ .or. c_associated (omp_calloc (zero, zero, a)) &
+ .or. c_associated (omp_calloc (32_c_size_t, zero, a)) &
+ .or. c_associated (omp_calloc (zero, 64_c_size_t, a)) &
+ .or. c_associated (omp_aligned_calloc (32_c_size_t, zero, zero, a)) &
+ .or. c_associated (omp_aligned_calloc (64_c_size_t, 32_c_size_t, zero, a)) &
+ .or. c_associated (omp_aligned_calloc (16_c_size_t, zero, 64_c_size_t, a))) &
+ stop 5
+ call omp_destroy_allocator (a)
+ end if
+end program main
new file mode 100644
@@ -0,0 +1,5 @@
+int
+get__alignof_int ()
+{
+ return __alignof (int);
+}
new file mode 100644
@@ -0,0 +1,174 @@
+! { dg-additional-sources alloc-7.c }
+module m
+ use omp_lib
+ use iso_c_binding
+ implicit none
+
+ type (omp_alloctrait), parameter :: traits2(*) &
+ = [ omp_alloctrait (omp_atk_alignment, 16), &
+ omp_alloctrait (omp_atk_sync_hint, omp_atv_default), &
+ omp_alloctrait (omp_atk_access, omp_atv_default), &
+ omp_alloctrait (omp_atk_pool_size, 1024), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_default_mem_fb), &
+ omp_alloctrait (omp_atk_partition, omp_atv_environment)]
+
+ type (omp_alloctrait) :: traits3(7) &
+ = [ omp_alloctrait (omp_atk_sync_hint, omp_atv_uncontended), &
+ omp_alloctrait (omp_atk_alignment, 32), &
+ omp_alloctrait (omp_atk_access, omp_atv_all), &
+ omp_alloctrait (omp_atk_pool_size, 512), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_allocator_fb), &
+ omp_alloctrait (omp_atk_fb_data, 0), &
+ omp_alloctrait (omp_atk_partition, omp_atv_default)]
+
+ type (omp_alloctrait), parameter :: traits4(*) &
+ = [ omp_alloctrait (omp_atk_alignment, 128), &
+ omp_alloctrait (omp_atk_pool_size, 1024), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_null_fb)]
+
+ interface
+ integer(c_int) function get__alignof_int () bind(C)
+ import :: c_int
+ end
+ end interface
+end module m
+
+program main
+ use m
+ implicit none (external, type)
+ integer(c_ptrdiff_t) :: iptr
+ type (c_ptr), volatile :: p, q, r
+ integer, pointer, volatile, contiguous :: ip(:), iq(:), ir(:)
+ type (omp_alloctrait) :: traits(3)
+ integer (omp_allocator_handle_kind) :: a, a2
+ traits = [ omp_alloctrait (omp_atk_alignment, 64), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), &
+ omp_alloctrait (omp_atk_pool_size, 4096)]
+
+ p = omp_aligned_alloc (c_sizeof (0), 3 * c_sizeof (0), omp_default_mem_alloc)
+ call c_f_pointer (p, ip, [3])
+ if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0) &
+ stop 1
+ ip(0) = 1
+ ip(1) = 2
+ ip(2) = 3
+ call omp_free (p, omp_default_mem_alloc)
+
+ p = omp_aligned_alloc (2 * c_sizeof (0), 2 * c_sizeof (0), omp_default_mem_alloc)
+ call c_f_pointer (p, ip, [2])
+ if (mod (TRANSFER (p, iptr), 2 * c_sizeof (0)) /= 0) &
+ stop 2
+ ip(0) = 1
+ ip(1) = 2
+ call omp_free (p, omp_null_allocator)
+
+ call omp_set_default_allocator (omp_default_mem_alloc)
+ p = omp_aligned_alloc (1_c_size_t, 2 * c_sizeof (0), omp_null_allocator)
+ call c_f_pointer (p, ip, [2])
+ if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0) &
+ stop 3
+ ip(0) = 3
+ call omp_free (p, omp_get_default_allocator ())
+
+ a = omp_init_allocator (omp_default_mem_space, 3, traits)
+ if (a == omp_null_allocator) &
+ stop 4
+ p = omp_aligned_alloc (32_c_size_t, 3072_c_size_t, a)
+ call c_f_pointer (p, ip, [3072/c_sizeof (0)])
+ if (mod (TRANSFER (p, iptr), 64) /= 0) &
+ stop 5
+ ip(1) = 1
+ ip(3072 / c_sizeof (0)) = 2
+
+ if (c_associated (omp_aligned_alloc (8_c_size_t, 3072_c_size_t, a))) &
+ stop 6
+
+ call omp_free (p, a)
+
+ p = omp_aligned_alloc (128_c_size_t, 3072_c_size_t, a)
+ call c_f_pointer (p, ip, [3072/c_sizeof (0)])
+ if (mod (TRANSFER (p, iptr), 128) /= 0) &
+ stop 7
+ ip(1) = 3
+ ip(3072 / c_sizeof (0)) = 4
+ call omp_free (p, omp_null_allocator)
+
+ call omp_set_default_allocator (a)
+ if (omp_get_default_allocator () /= a) &
+ stop 8
+ p = omp_aligned_alloc (64_c_size_t, 3072_c_size_t, omp_null_allocator)
+ call c_f_pointer (p, ip, [3072/c_sizeof (0)])
+ if (c_associated (omp_aligned_alloc (8_c_size_t, 3072_c_size_t, omp_null_allocator))) &
+ stop 9
+ call omp_free (p, a)
+ call omp_destroy_allocator (a)
+
+ a = omp_init_allocator (omp_default_mem_space, size (traits2), traits2)
+ if (a == omp_null_allocator) &
+ stop 9
+ if (traits3(6)%key /= omp_atk_fb_data) &
+ stop 10
+ traits3(6)%value = a
+ a2 = omp_init_allocator (omp_default_mem_space, size (traits3), traits3)
+ if (a2 == omp_null_allocator) &
+ stop 11
+
+ p = omp_aligned_alloc (4_c_size_t, 420_c_size_t, a2)
+ call c_f_pointer (p, ip, [420/c_sizeof (0)])
+ if (mod (TRANSFER (p, iptr), 32) /= 0) &
+ stop 12
+ ip(1) = 5
+ ip(420 / c_sizeof (0)) = 6
+
+ q = omp_aligned_alloc (8_c_size_t, 768_c_size_t, a2)
+ call c_f_pointer (q, iq, [768/c_sizeof (0)])
+ if (mod (TRANSFER (q, iptr), 16) /= 0) &
+ stop 13
+ iq(1) = 7
+ iq(768 / c_sizeof (0)) = 8
+
+ r = omp_aligned_alloc (8_c_size_t, 512_c_size_t, a2)
+ call c_f_pointer (r, ir, [512/c_sizeof (0)])
+ if (mod (TRANSFER (r, iptr), 8) /= 0) &
+ stop 14
+ ir(1) = 9
+ ir(512 / c_sizeof (0)) = 10
+ call omp_free (p, omp_null_allocator)
+ call omp_free (q, a2)
+ call omp_free (r, omp_null_allocator)
+ call omp_destroy_allocator (a2)
+ call omp_destroy_allocator (a)
+
+ a = omp_init_allocator (omp_default_mem_space, size (traits4), traits4)
+ if (a == omp_null_allocator) &
+ stop 15
+ if (traits3(6)%key /= omp_atk_fb_data) &
+ stop 16
+ traits3(6)%value = a
+ a2 = omp_init_allocator (omp_default_mem_space, size (traits3), traits3)
+ if (a2 == omp_null_allocator) &
+ stop 17
+ call omp_set_default_allocator (a2)
+
+ p = omp_aligned_alloc (4_c_size_t, 420_c_size_t, omp_null_allocator)
+ call c_f_pointer (p, ip, [420/c_sizeof (0)])
+ if (mod (TRANSFER (p, iptr), 32) /= 0) &
+ stop 18
+ ip(0) = 5
+ ip(420 / c_sizeof (0)) = 6
+
+ q = omp_aligned_alloc (64_c_size_t, 768_c_size_t, omp_null_allocator)
+ call c_f_pointer (q, iq, [768/c_sizeof (0)])
+ if (mod (TRANSFER (q, iptr), 128) /= 0) &
+ stop 19
+ iq(1) = 7
+ iq(768 / c_sizeof (0)) = 8
+ if (c_associated (omp_aligned_alloc (8_c_size_t, 768_c_size_t, omp_null_allocator))) &
+ stop 20
+ call omp_free (p, omp_null_allocator)
+ call omp_free (q, omp_null_allocator)
+ call omp_free (c_null_ptr, omp_null_allocator)
+ call omp_free (c_null_ptr, omp_null_allocator)
+ call omp_destroy_allocator (a2)
+ call omp_destroy_allocator (a)
+end program main
new file mode 100644
@@ -0,0 +1,58 @@
+module m
+ use omp_lib
+ implicit none
+
+ type (omp_alloctrait), parameter :: traits(*) &
+ = [ omp_alloctrait (omp_atk_alignment, 16), &
+ omp_alloctrait (omp_atk_sync_hint, omp_atv_default), &
+ omp_alloctrait (omp_atk_access, omp_atv_default), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_default_mem_fb), &
+ omp_alloctrait (omp_atk_partition, omp_atv_environment)]
+end module m
+
+program main
+ use m
+ use iso_c_binding
+ implicit none (external, type)
+ integer (omp_allocator_handle_kind) :: a
+ type (c_ptr) :: p, q
+ integer (c_size_t), volatile :: large_sz
+ integer (c_ptrdiff_t) :: iptr
+
+ a = omp_init_allocator (omp_default_mem_space, size (traits), traits)
+ if (a == omp_null_allocator) &
+ stop 1
+ p = omp_alloc (2048_c_size_t, a)
+ if (mod (TRANSFER (p, iptr), 16) /= 0) &
+ stop 2
+ large_sz = NOT (1023_c_size_t)
+ q = omp_alloc (large_sz, a)
+ if (c_associated (q)) &
+ stop 3
+ q = omp_aligned_alloc (32_c_size_t, large_sz, a)
+ if (c_associated (q)) &
+ stop 4
+ q = omp_calloc (large_sz / 4_c_size_t, 4_c_size_t, a)
+ if (c_associated (q)) &
+ stop 5
+ q = omp_aligned_calloc (1_c_size_t, 2_c_size_t, large_sz / 2, a)
+ if (c_associated (q)) &
+ stop 6
+ call omp_free (p, a)
+ large_sz = NOT (0_c_size_t)
+ large_sz = ISHFT (large_sz, -1)
+ large_sz = large_sz + 1
+ if (c_associated (omp_calloc (2_c_size_t, large_sz, a))) &
+ stop 7
+ if (c_associated (omp_calloc (large_sz, 1024_c_size_t, a))) &
+ stop 8
+ if (c_associated (omp_calloc (large_sz, large_sz, a))) &
+ stop 9
+ if (c_associated (omp_aligned_calloc (16_c_size_t, 2_c_size_t, large_sz, a))) &
+ stop 10
+ if (c_associated (omp_aligned_calloc (32_c_size_t, large_sz, 1024_c_size_t, a))) &
+ stop 11
+ if (c_associated (omp_aligned_calloc (64_c_size_t, large_sz, large_sz, a))) &
+ stop 12
+ call omp_destroy_allocator (a)
+end program main
new file mode 100644
@@ -0,0 +1,196 @@
+! { dg-additional-sources alloc-7.c }
+module m
+ use omp_lib
+ use iso_c_binding
+ implicit none
+
+ type (omp_alloctrait), parameter :: traits2(*) &
+ = [ omp_alloctrait (omp_atk_alignment, 16), &
+ omp_alloctrait (omp_atk_sync_hint, omp_atv_default), &
+ omp_alloctrait (omp_atk_access, omp_atv_default), &
+ omp_alloctrait (omp_atk_pool_size, 1024), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_default_mem_fb), &
+ omp_alloctrait (omp_atk_partition, omp_atv_environment)]
+ type (omp_alloctrait) :: traits3(7) &
+ = [ omp_alloctrait (omp_atk_sync_hint, omp_atv_uncontended), &
+ omp_alloctrait (omp_atk_alignment, 32), &
+ omp_alloctrait (omp_atk_access, omp_atv_all), &
+ omp_alloctrait (omp_atk_pool_size, 512), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_allocator_fb), &
+ omp_alloctrait (omp_atk_fb_data, 0), &
+ omp_alloctrait (omp_atk_partition, omp_atv_default)]
+ type (omp_alloctrait), parameter :: traits4(*) &
+ = [ omp_alloctrait (omp_atk_alignment, 128), &
+ omp_alloctrait (omp_atk_pool_size, 1024), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_null_fb)]
+
+ interface
+ integer(c_int) function get__alignof_int () bind(C)
+ import :: c_int
+ end
+ end interface
+end module m
+
+program main
+ use m
+ implicit none (external, type)
+ type(c_ptr), volatile :: p, q, r
+ integer, pointer, contiguous, volatile :: ip(:), iq(:), ir(:)
+ type (omp_alloctrait) :: traits(3)
+ integer (omp_allocator_handle_kind) :: a, a2
+ integer (c_ptrdiff_t) :: iptr
+ integer :: i
+
+ traits = [ omp_alloctrait (omp_atk_alignment, 64), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), &
+ omp_alloctrait (omp_atk_pool_size, 4096)]
+
+ p = omp_calloc (3_c_size_t, sizeof (0), omp_default_mem_alloc)
+ call c_f_pointer (p, ip, [3])
+ if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0 &
+ .or. ip(1) /= 0 .or. ip(2) /= 0 .or. ip(3) /= 0) &
+ stop 1
+ ip(1) = 1
+ ip(2) = 2
+ ip(3) = 3
+ call omp_free (p, omp_default_mem_alloc)
+ p = omp_calloc (2_c_size_t, sizeof (0), omp_default_mem_alloc)
+ call c_f_pointer (p, ip, [2])
+ if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0 &
+ .or. ip(1) /= 0 .or. ip(2) /= 0) &
+ stop 2
+ ip(1) = 1
+ ip(2) = 2
+ call omp_free (p, omp_null_allocator)
+ call omp_set_default_allocator (omp_default_mem_alloc)
+ p = omp_calloc (1_c_size_t, sizeof (0), omp_null_allocator)
+ call c_f_pointer (p, ip, [1])
+ if (mod (TRANSFER (p, iptr), get__alignof_int ()) /= 0 &
+ .or. ip(1) /= 0) &
+ stop 3
+ ip(1) = 3
+ call omp_free (p, omp_get_default_allocator ())
+
+ a = omp_init_allocator (omp_default_mem_space, 3, traits)
+ if (a == omp_null_allocator) &
+ stop 4
+ p = omp_calloc (3_c_size_t, 1024_c_size_t, a)
+ call c_f_pointer (p, ip, [3072 / c_sizeof (0)])
+ if (mod (TRANSFER (p, iptr), 64) /= 0) &
+ stop 5
+ do i = 1, 3072 / c_sizeof (0)
+ if (ip(i) /= 0) &
+ stop 6
+ end do
+ ip(1) = 1
+ ip(3072 / c_sizeof (0)) = 2
+ if (c_associated (omp_calloc (1024_c_size_t, 3_c_size_t, a))) &
+ stop 7
+ call omp_free (p, a)
+ p = omp_calloc (512_c_size_t, 6_c_size_t, a)
+ call c_f_pointer (p, ip, [3072 / c_sizeof (0)])
+ do i = 1, 3072 / c_sizeof (0)
+ if (ip(i) /= 0) &
+ stop 8
+ end do
+ ip(1) = 3
+ ip(3072 / c_sizeof (0)) = 4
+ call omp_free (p, omp_null_allocator)
+ call omp_set_default_allocator (a)
+ if (omp_get_default_allocator () /= a) &
+ stop 9
+ p = omp_calloc (12_c_size_t, 256_c_size_t, omp_null_allocator)
+ call c_f_pointer (p, ip, [3072 / c_sizeof (0)])
+ do i = 1, 3072 / c_sizeof (0)
+ if (ip(i) /= 0) &
+ stop 10
+ end do
+ if (c_associated (omp_calloc (128_c_size_t, 24_c_size_t, omp_null_allocator))) &
+ stop 11
+ call omp_free (p, a)
+ call omp_destroy_allocator (a)
+
+ a = omp_init_allocator (omp_default_mem_space, size (traits2), traits2)
+ if (a == omp_null_allocator) &
+ stop 12
+ if (traits3(6)%key /= omp_atk_fb_data) &
+ stop 13
+ traits3(6)%value = a
+ a2 = omp_init_allocator (omp_default_mem_space, size (traits3), traits3)
+ if (a2 == omp_null_allocator) &
+ stop 14
+ p = omp_calloc (10_c_size_t, 42_c_size_t, a2)
+ call c_f_pointer (p, ip, [420 / c_sizeof (0)])
+ do i = 1, 420 / c_sizeof (0)
+ if (ip(i) /= 0) &
+ stop 15
+ end do
+ if (mod (TRANSFER (p, iptr), 32) /= 0) &
+ stop 16
+ ip(1) = 5
+ ip(420 / c_sizeof (0)) = 6
+ q = omp_calloc (24_c_size_t, 32_c_size_t, a2)
+ call c_f_pointer (q, iq, [768 / c_sizeof (0)])
+ if (mod (TRANSFER (q, iptr), 16) /= 0) &
+ stop 17
+ do i = 1, 768 / c_sizeof (0)
+ if (iq(i) /= 0) &
+ stop 18
+ end do
+ iq(1) = 7
+ iq(768 / c_sizeof (0)) = 8
+ r = omp_calloc (128_c_size_t, 4_c_size_t, a2)
+ call c_f_pointer (r, ir, [512 / c_sizeof (0)])
+ if (mod (TRANSFER (r, iptr), get__alignof_int ()) /= 0) &
+ stop 19
+ do i = 1, 512 / c_sizeof (0)
+ if (ir(i) /= 0) &
+ stop 20
+ end do
+ ir(1) = 9
+ ir(512 / c_sizeof (0)) = 10
+ call omp_free (p, omp_null_allocator)
+ call omp_free (q, a2)
+ call omp_free (r, omp_null_allocator)
+ call omp_destroy_allocator (a2)
+ call omp_destroy_allocator (a)
+
+ a = omp_init_allocator (omp_default_mem_space, size (traits4), traits4)
+ if (a == omp_null_allocator) &
+ stop 21
+ if (traits3(6)%key /= omp_atk_fb_data) &
+ stop 22
+ traits3(6)%value = a
+ a2 = omp_init_allocator (omp_default_mem_space, size (traits3), traits3)
+ if (a2 == omp_null_allocator) &
+ stop 23
+ call omp_set_default_allocator (a2)
+ p = omp_calloc (42_c_size_t, 10_c_size_t, omp_null_allocator)
+ call c_f_pointer (p, ip, [420 / c_sizeof (0)])
+ if (mod (TRANSFER (p, iptr), 32) /= 0) &
+ stop 24
+ do i = 1, 420 / c_sizeof (0)
+ if (ip(i) /= 0) &
+ stop 25
+ end do
+ ip(1) = 5
+ ip(420 / c_sizeof (0)) = 6
+ q = omp_calloc (32_c_size_t, 24_c_size_t, omp_null_allocator)
+ call c_f_pointer (q, iq, [768 / c_sizeof (0)])
+ if (mod (TRANSFER (q, iptr), 128) /= 0) &
+ stop 26
+ do i = 1, 768 / c_sizeof (0)
+ if (iq(i) /= 0) &
+ stop 27
+ end do
+ iq(1) = 7
+ iq(768 / c_sizeof (0)) = 8
+ if (c_associated (omp_calloc (24_c_size_t, 32_c_size_t, omp_null_allocator))) &
+ stop 28
+ call omp_free (p, omp_null_allocator)
+ call omp_free (q, omp_null_allocator)
+ call omp_free (c_null_ptr, omp_null_allocator)
+ call omp_free (c_null_ptr, omp_null_allocator)
+ call omp_destroy_allocator (a2)
+ call omp_destroy_allocator (a)
+end program main
On 30.09.21 09:45, Jakub Jelinek wrote: > This patch adds new OpenMP 5.1 allocator entrypoints ... ... and this patch adds the Fortran support for it, using the C→Fortran converted testcases. Additionally, it fixes and updated the list of API routine names. We now can also tick off one item in the OpenMP 5.1 implementation status list. OK for mainline? Tobias ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955