libgomp: Add Fortran routine support for allocators

libgomp/ChangeLog:

	* allocator.c: Add ialias for omp_init_allocator and
	omp_destroy_allocator.
	* configure.ac: Set INTPTR_T_KIND.
	* configure: Regenerate.
	* Makefile.in: Regenerate.
	* testsuite/Makefile.in: Regenerate.
	* fortran.c (omp_init_allocator_, omp_destroy_allocator_,
	omp_set_default_allocator_, omp_get_default_allocator_): New
	functions and ialias_redirect.
	* icv.c: Add ialias for omp_set_default_allocator and
	omp_get_default_allocator.
	* libgomp.map (OMP_5.0.1): Add omp_init_allocator_,
	omp_destroy_allocator_, omp_set_default_allocator_ and
	omp_get_default_allocator_.
	* omp_lib.f90.in: Add allocator traits parameters, declare
	allocator routines and add related kind parameters.
	* omp_lib.h.in: Likewise.
	* testsuite/libgomp.c-c++-common/alloc-2.c: Fix sizeof.
	* testsuite/libgomp.fortran/alloc-1.F90: New test.
	* testsuite/libgomp.fortran/alloc-2.F90: New test.
	* testsuite/libgomp.fortran/alloc-3.F: New test.
	* testsuite/libgomp.fortran/alloc-4.f90: New test.
	* testsuite/libgomp.fortran/alloc-5.f90: New test.
This commit is contained in:
Tobias Burnus 2020-07-15 08:33:20 +02:00
parent 8ca07a3072
commit fff15bad1a
16 changed files with 574 additions and 4 deletions

View File

@ -405,6 +405,7 @@ INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
INTPTR_T_KIND = @INTPTR_T_KIND@
LD = @LD@
LDFLAGS = @LDFLAGS@
LIBOBJS = @LIBOBJS@

View File

@ -202,6 +202,9 @@ omp_destroy_allocator (omp_allocator_handle_t allocator)
}
}
ialias (omp_init_allocator)
ialias (omp_destroy_allocator)
void *
omp_alloc (size_t size, omp_allocator_handle_t allocator)
{

11
libgomp/configure vendored
View File

@ -647,6 +647,7 @@ OMP_NEST_LOCK_ALIGN
OMP_NEST_LOCK_SIZE
OMP_LOCK_ALIGN
OMP_LOCK_SIZE
INTPTR_T_KIND
USE_FORTRAN_FALSE
USE_FORTRAN_TRUE
link_gomp
@ -11433,7 +11434,7 @@ else
lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
lt_status=$lt_dlunknown
cat > conftest.$ac_ext <<_LT_EOF
#line 11436 "configure"
#line 11437 "configure"
#include "confdefs.h"
#if HAVE_DLFCN_H
@ -11539,7 +11540,7 @@ else
lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
lt_status=$lt_dlunknown
cat > conftest.$ac_ext <<_LT_EOF
#line 11542 "configure"
#line 11543 "configure"
#include "confdefs.h"
#if HAVE_DLFCN_H
@ -16962,6 +16963,11 @@ for i in $config_path; do
fi
done
if ac_fn_c_compute_int "$LINENO" "sizeof (__INTPTR_TYPE__)" "INTPTR_T_KIND" ""; then :
fi
if ac_fn_c_compute_int "$LINENO" "sizeof (omp_lock_t)" "OMP_LOCK_SIZE" ""; then :
else
@ -17041,6 +17047,7 @@ fi
CFLAGS="$save_CFLAGS"
# Determine what GCC version number to use in filesystem paths.

View File

@ -395,6 +395,7 @@ for i in $config_path; do
fi
done
_AC_COMPUTE_INT([sizeof (__INTPTR_TYPE__)], [INTPTR_T_KIND])
_AC_COMPUTE_INT([sizeof (omp_lock_t)], [OMP_LOCK_SIZE],,
[AC_MSG_ERROR([unsupported system, cannot find sizeof (omp_lock_t)])])
_AC_COMPUTE_INT([__alignof (omp_lock_t)], [OMP_LOCK_ALIGN])
@ -428,6 +429,7 @@ if test $OMP_NEST_LOCK_25_SIZE -gt 8 || test $OMP_NEST_LOCK_25_ALIGN -gt $OMP_NE
OMP_NEST_LOCK_25_KIND=8
fi
AC_SUBST(INTPTR_T_KIND)
AC_SUBST(OMP_LOCK_SIZE)
AC_SUBST(OMP_LOCK_ALIGN)
AC_SUBST(OMP_NEST_LOCK_SIZE)

View File

@ -86,6 +86,10 @@ ialias_redirect (omp_get_initial_device)
ialias_redirect (omp_get_max_task_priority)
ialias_redirect (omp_pause_resource)
ialias_redirect (omp_pause_resource_all)
ialias_redirect (omp_init_allocator)
ialias_redirect (omp_destroy_allocator)
ialias_redirect (omp_set_default_allocator)
ialias_redirect (omp_get_default_allocator)
#endif
#ifndef LIBGOMP_GNU_SYMBOL_VERSIONING
@ -676,3 +680,37 @@ omp_pause_resource_all_ (const int32_t *kind)
{
return omp_pause_resource_all (*kind);
}
intptr_t
omp_init_allocator_ (const intptr_t *memspace, const int32_t *ntraits,
const omp_alloctrait_t *traits)
{
return (intptr_t) omp_init_allocator ((omp_memspace_handle_t) *memspace,
(int) *ntraits, traits);
}
intptr_t
omp_init_allocator_8_ (const intptr_t *memspace, const int64_t *ntraits,
const omp_alloctrait_t *traits)
{
return (intptr_t) omp_init_allocator ((omp_memspace_handle_t) *memspace,
(int) *ntraits, traits);
}
void
omp_destroy_allocator_ (const intptr_t *allocator)
{
omp_destroy_allocator ((omp_allocator_handle_t) *allocator);
}
void
omp_set_default_allocator_ (const intptr_t *allocator)
{
omp_set_default_allocator ((omp_allocator_handle_t) *allocator);
}
intptr_t
omp_get_default_allocator_ ()
{
return (intptr_t) omp_get_default_allocator ();
}

View File

@ -235,3 +235,5 @@ ialias (omp_get_num_places)
ialias (omp_get_place_num)
ialias (omp_get_partition_num_places)
ialias (omp_get_partition_place_nums)
ialias (omp_set_default_allocator)
ialias (omp_get_default_allocator)

View File

@ -183,9 +183,14 @@ OMP_5.0 {
OMP_5.0.1 {
global:
omp_set_default_allocator;
omp_set_default_allocator_;
omp_get_default_allocator;
omp_get_default_allocator_;
omp_init_allocator;
omp_init_allocator_;
omp_init_allocator_8_;
omp_destroy_allocator;
omp_destroy_allocator_;
omp_alloc;
omp_free;
} OMP_5.0;

View File

@ -24,13 +24,19 @@
! <http://www.gnu.org/licenses/>.
module omp_lib_kinds
use iso_c_binding, only: c_int, c_intptr_t
implicit none
private :: c_int, c_intptr_t
integer, parameter :: omp_lock_kind = @OMP_LOCK_KIND@
integer, parameter :: omp_nest_lock_kind = @OMP_NEST_LOCK_KIND@
integer, parameter :: omp_sched_kind = 4
integer, parameter :: omp_proc_bind_kind = 4
integer, parameter :: omp_lock_hint_kind = 4
integer, parameter :: omp_pause_resource_kind = 4
integer, parameter :: omp_allocator_handle_kind = c_intptr_t
integer, parameter :: omp_alloctrait_key_kind = c_int
integer, parameter :: omp_alloctrait_val_kind = c_intptr_t
integer, parameter :: omp_memspace_handle_kind = c_intptr_t
integer (omp_sched_kind), parameter :: omp_sched_static = 1
integer (omp_sched_kind), parameter :: omp_sched_dynamic = 2
integer (omp_sched_kind), parameter :: omp_sched_guided = 3
@ -59,6 +65,95 @@
parameter :: omp_pause_soft = 1
integer (kind=omp_pause_resource_kind), &
parameter :: omp_pause_hard = 2
integer (kind=omp_alloctrait_key_kind), &
parameter :: omp_atk_sync_hint = 1
integer (kind=omp_alloctrait_key_kind), &
parameter :: omp_atk_alignment = 2
integer (kind=omp_alloctrait_key_kind), &
parameter :: omp_atk_access = 3
integer (kind=omp_alloctrait_key_kind), &
parameter :: omp_atk_pool_size = 4
integer (kind=omp_alloctrait_key_kind), &
parameter :: omp_atk_fallback = 5
integer (kind=omp_alloctrait_key_kind), &
parameter :: omp_atk_fb_data = 6
integer (kind=omp_alloctrait_key_kind), &
parameter :: omp_atk_pinned = 7
integer (kind=omp_alloctrait_key_kind), &
parameter :: omp_atk_partition = 8
integer (kind=omp_alloctrait_val_kind), &
parameter :: omp_atv_default = -1
integer (kind=omp_alloctrait_val_kind), &
parameter :: omp_atv_false = 0
integer (kind=omp_alloctrait_val_kind), &
parameter :: omp_atv_true = 1
integer (kind=omp_alloctrait_val_kind), &
parameter :: omp_atv_contended = 3
integer (kind=omp_alloctrait_val_kind), &
parameter :: omp_atv_uncontended = 4
integer (kind=omp_alloctrait_val_kind), &
parameter :: omp_atv_serialized = 5
integer (kind=omp_alloctrait_val_kind), &
parameter :: omp_atv_sequential = omp_atv_serialized
integer (kind=omp_alloctrait_val_kind), &
parameter :: omp_atv_private = 6
integer (kind=omp_alloctrait_val_kind), &
parameter :: omp_atv_all = 7
integer (kind=omp_alloctrait_val_kind), &
parameter :: omp_atv_thread = 8
integer (kind=omp_alloctrait_val_kind), &
parameter :: omp_atv_pteam = 9
integer (kind=omp_alloctrait_val_kind), &
parameter :: omp_atv_cgroup = 10
integer (kind=omp_alloctrait_val_kind), &
parameter :: omp_atv_default_mem_fb = 11
integer (kind=omp_alloctrait_val_kind), &
parameter :: omp_atv_null_fb = 12
integer (kind=omp_alloctrait_val_kind), &
parameter :: omp_atv_abort_fb = 13
integer (kind=omp_alloctrait_val_kind), &
parameter :: omp_atv_allocator_fb = 14
integer (kind=omp_alloctrait_val_kind), &
parameter :: omp_atv_environment = 15
integer (kind=omp_alloctrait_val_kind), &
parameter :: omp_atv_nearest = 16
integer (kind=omp_alloctrait_val_kind), &
parameter :: omp_atv_blocked = 17
integer (kind=omp_alloctrait_val_kind), &
parameter :: omp_atv_interleaved = 18
integer (kind=omp_allocator_handle_kind), &
parameter :: omp_null_allocator = 0
integer (kind=omp_allocator_handle_kind), &
parameter :: omp_default_mem_alloc = 1
integer (kind=omp_allocator_handle_kind), &
parameter :: omp_large_cap_mem_alloc = 2
integer (kind=omp_allocator_handle_kind), &
parameter :: omp_const_mem_alloc = 3
integer (kind=omp_allocator_handle_kind), &
parameter :: omp_high_bw_mem_alloc = 4
integer (kind=omp_allocator_handle_kind), &
parameter :: omp_low_lat_mem_alloc = 5
integer (kind=omp_allocator_handle_kind), &
parameter :: omp_cgroup_mem_alloc = 6
integer (kind=omp_allocator_handle_kind), &
parameter :: omp_pteam_mem_alloc = 7
integer (kind=omp_allocator_handle_kind), &
parameter :: omp_thread_mem_alloc = 8
integer (omp_memspace_handle_kind), &
parameter :: omp_default_mem_space = 0
integer (omp_memspace_handle_kind), &
parameter :: omp_large_cap_mem_space = 1
integer (omp_memspace_handle_kind), &
parameter :: omp_const_mem_space = 2
integer (omp_memspace_handle_kind), &
parameter :: omp_high_bw_mem_space = 3
integer (omp_memspace_handle_kind), &
parameter :: omp_low_lat_mem_space = 4
type omp_alloctrait
integer (kind=omp_alloctrait_key_kind) key
integer (kind=omp_alloctrait_val_kind) value
end type omp_alloctrait
end module
module omp_lib
@ -484,4 +579,47 @@
end function
end interface
interface omp_init_allocator
function omp_init_allocator (memspace, ntraits, traits)
use omp_lib_kinds
integer (kind=omp_allocator_handle_kind) omp_init_allocator
integer (kind=omp_memspace_handle_kind), &
intent(in) :: memspace
integer (4), intent(in) :: ntraits
type (omp_alloctrait), intent(in) :: traits(*)
end function
function omp_init_allocator_8 (memspace, ntraits, traits)
use omp_lib_kinds
integer (kind=omp_allocator_handle_kind) omp_init_allocator_8
integer (kind=omp_memspace_handle_kind), &
intent(in) :: memspace
integer (8), intent(in) :: ntraits
type (omp_alloctrait), intent(in) :: traits(*)
end function
end interface
interface
subroutine omp_destroy_allocator (allocator)
use omp_lib_kinds
integer (kind=omp_allocator_handle_kind), &
intent(in) :: allocator
end subroutine
end interface
interface
subroutine omp_set_default_allocator (allocator)
use omp_lib_kinds
integer (kind=omp_allocator_handle_kind), &
intent(in) :: allocator
end subroutine
end interface
interface
function omp_get_default_allocator ()
use omp_lib_kinds
integer (kind=omp_allocator_handle_kind) &
omp_get_default_allocator
end function
end interface
end module omp_lib

View File

@ -66,6 +66,102 @@
parameter (omp_pause_soft = 1)
parameter (omp_pause_hard = 2)
integer omp_allocator_handle_kind, omp_alloctrait_key_kind
integer omp_alloctrait_val_kind, omp_memspace_handle_kind
parameter (omp_allocator_handle_kind = @INTPTR_T_KIND@)
parameter (omp_alloctrait_key_kind = @INTPTR_T_KIND@)
parameter (omp_alloctrait_val_kind = @INTPTR_T_KIND@)
parameter (omp_memspace_handle_kind = @INTPTR_T_KIND@)
integer (omp_alloctrait_key_kind) omp_atk_sync_hint
integer (omp_alloctrait_key_kind) omp_atk_alignment
integer (omp_alloctrait_key_kind) omp_atk_access
integer (omp_alloctrait_key_kind) omp_atk_pool_size
integer (omp_alloctrait_key_kind) omp_atk_fallback
integer (omp_alloctrait_key_kind) omp_atk_fb_data
integer (omp_alloctrait_key_kind) omp_atk_pinned
integer (omp_alloctrait_key_kind) omp_atk_partition
parameter (omp_atk_sync_hint = 1)
parameter (omp_atk_alignment = 2)
parameter (omp_atk_access = 3)
parameter (omp_atk_pool_size = 4)
parameter (omp_atk_fallback = 5)
parameter (omp_atk_fb_data = 6)
parameter (omp_atk_pinned = 7)
parameter (omp_atk_partition = 8)
integer (omp_alloctrait_val_kind) omp_atv_false
integer (omp_alloctrait_val_kind) omp_atv_true
integer (omp_alloctrait_val_kind) omp_atv_default
integer (omp_alloctrait_val_kind) omp_atv_contended
integer (omp_alloctrait_val_kind) omp_atv_uncontended
integer (omp_alloctrait_val_kind) omp_atv_serialized
integer (omp_alloctrait_val_kind) omp_atv_sequential
integer (omp_alloctrait_val_kind) omp_atv_private
integer (omp_alloctrait_val_kind) omp_atv_all
integer (omp_alloctrait_val_kind) omp_atv_thread
integer (omp_alloctrait_val_kind) omp_atv_pteam
integer (omp_alloctrait_val_kind) omp_atv_cgroup
integer (omp_alloctrait_val_kind) omp_atv_default_mem_fb
integer (omp_alloctrait_val_kind) omp_atv_null_fb
integer (omp_alloctrait_val_kind) omp_atv_abort_fb
integer (omp_alloctrait_val_kind) omp_atv_allocator_fb
integer (omp_alloctrait_val_kind) omp_atv_environment
integer (omp_alloctrait_val_kind) omp_atv_nearest
integer (omp_alloctrait_val_kind) omp_atv_blocked
integer (omp_alloctrait_val_kind) omp_atv_interleaved
parameter (omp_atv_default = -1)
parameter (omp_atv_false = 0)
parameter (omp_atv_true = 1)
parameter (omp_atv_contended = 3)
parameter (omp_atv_uncontended = 4)
parameter (omp_atv_serialized = 5)
parameter (omp_atv_sequential = omp_atv_serialized)
parameter (omp_atv_private = 6)
parameter (omp_atv_all = 7)
parameter (omp_atv_thread = 8)
parameter (omp_atv_pteam = 9)
parameter (omp_atv_cgroup = 10)
parameter (omp_atv_default_mem_fb = 11)
parameter (omp_atv_null_fb = 12)
parameter (omp_atv_abort_fb = 13)
parameter (omp_atv_allocator_fb = 14)
parameter (omp_atv_environment = 15)
parameter (omp_atv_nearest = 16)
parameter (omp_atv_blocked = 17)
parameter (omp_atv_interleaved = 18)
integer (omp_allocator_handle_kind) omp_null_allocator
integer (omp_allocator_handle_kind) omp_default_mem_alloc
integer (omp_allocator_handle_kind) omp_large_cap_mem_alloc
integer (omp_allocator_handle_kind) omp_const_mem_alloc
integer (omp_allocator_handle_kind) omp_high_bw_mem_alloc
integer (omp_allocator_handle_kind) omp_low_lat_mem_alloc
integer (omp_allocator_handle_kind) omp_cgroup_mem_alloc
integer (omp_allocator_handle_kind) omp_pteam_mem_alloc
integer (omp_allocator_handle_kind) omp_thread_mem_alloc
parameter (omp_null_allocator = 0)
parameter (omp_default_mem_alloc = 1)
parameter (omp_large_cap_mem_alloc = 2)
parameter (omp_const_mem_alloc = 3)
parameter (omp_high_bw_mem_alloc = 4)
parameter (omp_low_lat_mem_alloc = 5)
parameter (omp_cgroup_mem_alloc = 6)
parameter (omp_pteam_mem_alloc = 7)
parameter (omp_thread_mem_alloc = 8)
integer (omp_memspace_handle_kind) omp_default_mem_space
integer (omp_memspace_handle_kind) omp_large_cap_mem_space
integer (omp_memspace_handle_kind) omp_const_mem_space
integer (omp_memspace_handle_kind) omp_high_bw_mem_space
integer (omp_memspace_handle_kind) omp_low_lat_mem_space
parameter (omp_default_mem_space = 0)
parameter (omp_large_cap_mem_space = 1)
parameter (omp_const_mem_space = 2)
parameter (omp_high_bw_mem_space = 3)
parameter (omp_low_lat_mem_space = 4)
type omp_alloctrait
integer (omp_alloctrait_key_kind) key
integer (omp_alloctrait_val_kind) value
end type omp_alloctrait
external omp_init_lock, omp_init_nest_lock
external omp_init_lock_with_hint
external omp_init_nest_lock_with_hint
@ -141,3 +237,10 @@
external omp_pause_resource, omp_pause_resource_all
integer(4) omp_pause_resource
integer(4) omp_pause_resource_all
external omp_init_allocator
integer (omp_allocator_handle_kind) omp_init_allocator
external omp_destroy_allocator
external omp_set_default_allocator
external omp_get_default_allocator
integer (omp_allocator_handle_kind) omp_get_default_allocator

View File

@ -170,6 +170,7 @@ INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
INTPTR_T_KIND = @INTPTR_T_KIND@
LD = @LD@
LDFLAGS = @LDFLAGS@
LIBOBJS = @LIBOBJS@
@ -295,6 +296,7 @@ target_alias = @target_alias@
target_cpu = @target_cpu@
target_os = @target_os@
target_vendor = @target_vendor@
tmake_file = @tmake_file@
toolexecdir = @toolexecdir@
toolexeclibdir = @toolexeclibdir@
top_build_prefix = @top_build_prefix@

View File

@ -23,7 +23,7 @@ main ()
if (p == NULL)
abort ();
p[0] = 1.0;
p[1695 / sizeof (double *)] = 2.0;
p[1695 / sizeof (double)] = 2.0;
#pragma omp barrier
omp_set_default_allocator ((n & 1) ? omp_default_mem_alloc : a);
q = (double *) omp_alloc (1696, omp_null_allocator);
@ -32,7 +32,7 @@ main ()
if (q == NULL)
abort ();
q[0] = 3.0;
q[1695 / sizeof (double *)] = 4.0;
q[1695 / sizeof (double)] = 4.0;
}
else if (q != NULL)
abort ();

View File

@ -0,0 +1,169 @@
! { dg-additional-options "-Wall -Wextra -Wno-maybe-uninitialized" }
#ifdef DEFAULT_INTEGER_8
#define ONEoFIVE 105_c_size_t*8
#else
#define ONEoFIVE 105_c_size_t*4
#endif
program main
use iso_c_binding
#ifdef USE_F77_INCLUDE
implicit none
#include "omp_lib.h"
#else
use omp_lib
implicit none (external, type)
#endif
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), parameter :: traits3(*) &
& = [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)]
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
integer, pointer, volatile :: p(:), p0, q(:), r(:)
integer (omp_allocator_handle_kind) :: a, a2
cp = omp_alloc (3 * c_sizeof (i), omp_default_mem_alloc)
if (mod (transfer (cp, intptr), 4_c_intptr_t) /= 0) stop 1
call c_f_pointer (cp, p, [3])
p(1) = 1
p(2) = 2
p(3) = 3
call omp_free (cp, omp_default_mem_alloc)
cp = omp_alloc (2 * c_sizeof (i), omp_default_mem_alloc)
if (mod (transfer (cp, intptr), 4_c_intptr_t) /= 0) stop 2
call c_f_pointer (cp, p, [2])
p(1) = 1
p(2) = 2
call omp_free (cp, omp_null_allocator)
call omp_set_default_allocator (omp_default_mem_alloc)
cp = omp_alloc (c_sizeof (i), omp_null_allocator)
if (mod (transfer (cp, intptr), 4_c_intptr_t) /= 0) stop 3
call c_f_pointer (cp, p0)
p0 = 3
call omp_free (cp, omp_get_default_allocator ())
traits = [omp_alloctrait (omp_atk_alignment, 64), &
& omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), &
& omp_alloctrait (omp_atk_pool_size, 4096)]
a = omp_init_allocator (omp_default_mem_space, 3, traits)
if (a == omp_null_allocator) stop 4
cp = omp_alloc (3072_c_size_t, a)
if (mod (transfer (cp, intptr), 64_c_intptr_t) /= 0) stop 4
call c_f_pointer (cp, p, [3072 / c_sizeof (i)])
p(1) = 1
p(3072 / c_sizeof (i)) = 2
if (c_associated (omp_alloc (3072_c_size_t, a))) stop 5
call omp_free (cp, a)
cp = omp_alloc (3072_c_size_t, a)
call c_f_pointer (cp, p, [3072 / c_sizeof (i)])
p(1) = 3
p(3072 / c_sizeof (i)) = 4
call omp_free (cp, omp_null_allocator)
call omp_set_default_allocator (a)
if (omp_get_default_allocator () /= a) stop 6
cp = omp_alloc (3072_c_size_t, omp_null_allocator)
if (c_associated (omp_alloc (3072_c_size_t, &
& omp_null_allocator))) &
& stop 7
call omp_free (cp, a)
call omp_destroy_allocator (a)
traits5 = traits3
a = omp_init_allocator (omp_default_mem_space, size (traits2), &
& traits2)
if (a == omp_null_allocator) stop 8
if (traits5(6)%key /= omp_atk_fb_data) stop 9
traits5(6)%value = a
if (traits5(4)%key /= omp_atk_pool_size) stop 20
#if DEFAULT_INTEGER_8
traits5(4)%value = 1024
#endif
a2 = omp_init_allocator (omp_default_mem_space, &
& size (traits5), traits5)
if (a2 == omp_null_allocator) stop 10
cp = omp_alloc (ONEoFIVE, a2)
if (mod (transfer (cp, intptr), 32_c_intptr_t) /= 0) stop 11
call c_f_pointer (cp, p, [ONEoFIVE / c_sizeof (i)])
p(1) = 5
p(ONEoFIVE / c_sizeof (i)) = 6
cq = omp_alloc (768_c_size_t, a2)
if (mod (transfer (cq, intptr), 16_c_intptr_t) /= 0) stop 12
call c_f_pointer (cq, q, [768 / c_sizeof (i)])
q(1) = 7
q(768 / c_sizeof (i)) = 8
cr = omp_alloc (512_c_size_t, a2)
if (mod (transfer (cr, intptr), 16_c_intptr_t) /= 0) stop 13
call c_f_pointer (cr, r, [512 / c_sizeof (i)])
r(1) = 9
r(512 / c_sizeof (i)) = 10
call omp_free (cp, omp_null_allocator)
call omp_free (cq, a2)
call omp_free (cr, 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 14
if (traits5(6)%key /= omp_atk_fb_data) stop 15
traits5(6)%value = a
a2 = omp_init_allocator (omp_default_mem_space, &
& size (traits5), traits5)
if (a2 == omp_null_allocator) stop 16
call omp_set_default_allocator (a2)
cp = omp_alloc (ONEoFIVE, omp_null_allocator)
if (mod (transfer (cp, intptr), 32_c_intptr_t) /= 0) stop 17
call c_f_pointer (cq, q, [ONEoFIVE / c_sizeof (i)])
p(1) = 5
p(ONEoFIVE / c_sizeof (i)) = 6
cq = omp_alloc (768_c_size_t, omp_null_allocator)
if (mod (transfer (cq, intptr), 128_c_intptr_t) /= 0) stop 18
q(1) = 7
q(768 / c_sizeof (i)) = 8
if (c_associated (omp_alloc (768_c_size_t, omp_null_allocator))) &
& stop 19
call omp_free (cp, omp_null_allocator)
call omp_free (cq, 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

View File

@ -0,0 +1,3 @@
! { dg-additional-options "-fdefault-integer-8 -Wall -Wextra -Wno-maybe-uninitialized -DDEFAULT_INTEGER_8=1" }
#include "alloc-1.F90"

View File

@ -0,0 +1,3 @@
! { dg-additional-options "-Wall -Wextra -Wno-maybe-uninitialized -Wno-c-binding-type -Wno-unused-parameter -DUSE_F77_INCLUDE=1" }
#include "alloc-1.F90"

View File

@ -0,0 +1,71 @@
program main
use omp_lib
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
traits = [omp_alloctrait (omp_atk_alignment, 64), &
omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), &
omp_alloctrait (omp_atk_pool_size, 4096)]
a = omp_init_allocator (omp_default_mem_space, 3, traits)
if (a == omp_null_allocator) stop 1
!$omp parallel num_threads(4)
block
integer :: n
real(8) :: r
type(c_ptr) :: cp, cq
real(8), pointer, volatile :: p(:), q(:)
n = omp_get_thread_num ()
if (mod (n, 2) /= 0) then
call omp_set_default_allocator (a)
else
call omp_set_default_allocator (omp_default_mem_alloc)
endif
cp = omp_alloc (1696_c_size_t, omp_null_allocator)
if (.not. c_associated (cp)) stop 2
call c_f_pointer (cp, p, [1696 / c_sizeof (r)])
p(1) = 1.0
p(1696 / c_sizeof (r)) = 2.0
!$omp barrier
if (mod (n, 2) /= 0) then
call omp_set_default_allocator (omp_default_mem_alloc)
else
call omp_set_default_allocator (a)
endif
cq = omp_alloc (1696_c_size_t, omp_null_allocator)
if (mod (n, 2) /= 0) then
if (.not. c_associated (cq)) stop 3
call c_f_pointer (cq, q, [1696 / c_sizeof (r)])
q(1) = 3.0
q(1696 / c_sizeof (r)) = 4.0
else if (c_associated (cq)) then
stop 4
end if
!$omp barrier
call omp_free (cp, omp_null_allocator)
call omp_free (cq, omp_null_allocator)
call omp_set_default_allocator (omp_default_mem_alloc)
end block
!$omp end parallel
call omp_destroy_allocator (a)
end program main

View File

@ -0,0 +1,23 @@
! { dg-set-target-env-var OMP_ALLOCATOR "omp_cgroup_mem_alloc" }
! { dg-set-target-env-var OMP_DISPLAY_ENV "true" }
program main
use omp_lib
implicit none (external, type)
character(len=255) :: mem_env
type (omp_alloctrait) :: traits(3)
integer (omp_allocator_handle_kind) :: a
call get_environment_variable ("OMP_ALLOCATOR", mem_env)
if (mem_env == "omp_cgroup_mem_alloc") then
if (omp_get_default_allocator () /= omp_cgroup_mem_alloc) stop 1
!$omp parallel num_threads (2)
if (omp_get_default_allocator () /= omp_cgroup_mem_alloc) stop 2
!$omp parallel num_threads (2)
if (omp_get_default_allocator () /= omp_cgroup_mem_alloc) stop 3
!$omp end parallel
!$omp end parallel
end if
end program