From: Tobias Burnus Date: Wed, 15 Jul 2020 06:33:20 +0000 (+0200) Subject: libgomp: Add Fortran routine support for allocators X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=fff15bad1ab571906c37b88380431768d917dcb0;p=gcc.git 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. --- diff --git a/libgomp/Makefile.in b/libgomp/Makefile.in index b570a942cff..bc044b1820a 100644 --- a/libgomp/Makefile.in +++ b/libgomp/Makefile.in @@ -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@ diff --git a/libgomp/allocator.c b/libgomp/allocator.c index 76feba71082..7166538b1de 100644 --- a/libgomp/allocator.c +++ b/libgomp/allocator.c @@ -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) { diff --git a/libgomp/configure b/libgomp/configure index fd65828136d..d85023f4f05 100755 --- a/libgomp/configure +++ b/libgomp/configure @@ -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. diff --git a/libgomp/configure.ac b/libgomp/configure.ac index 201d26fff7a..d1034dab7f8 100644 --- a/libgomp/configure.ac +++ b/libgomp/configure.ac @@ -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) diff --git a/libgomp/fortran.c b/libgomp/fortran.c index 3705ff62b75..9d838b3b56f 100644 --- a/libgomp/fortran.c +++ b/libgomp/fortran.c @@ -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 (); +} diff --git a/libgomp/icv.c b/libgomp/icv.c index b13289b47a7..3c16abb9123 100644 --- a/libgomp/icv.c +++ b/libgomp/icv.c @@ -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) diff --git a/libgomp/libgomp.map b/libgomp/libgomp.map index 012e3d645fe..c808e810702 100644 --- a/libgomp/libgomp.map +++ b/libgomp/libgomp.map @@ -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; diff --git a/libgomp/omp_lib.f90.in b/libgomp/omp_lib.f90.in index fdbc0f4657d..666b5152a5f 100644 --- a/libgomp/omp_lib.f90.in +++ b/libgomp/omp_lib.f90.in @@ -24,13 +24,19 @@ ! . 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 diff --git a/libgomp/omp_lib.h.in b/libgomp/omp_lib.h.in index 673b1573909..34babe93ab9 100644 --- a/libgomp/omp_lib.h.in +++ b/libgomp/omp_lib.h.in @@ -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 diff --git a/libgomp/testsuite/Makefile.in b/libgomp/testsuite/Makefile.in index 52aa6c5fbc9..bbec6aeca00 100644 --- a/libgomp/testsuite/Makefile.in +++ b/libgomp/testsuite/Makefile.in @@ -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@ diff --git a/libgomp/testsuite/libgomp.c-c++-common/alloc-2.c b/libgomp/testsuite/libgomp.c-c++-common/alloc-2.c index ee539580f2b..c5c090f2613 100644 --- a/libgomp/testsuite/libgomp.c-c++-common/alloc-2.c +++ b/libgomp/testsuite/libgomp.c-c++-common/alloc-2.c @@ -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 (); diff --git a/libgomp/testsuite/libgomp.fortran/alloc-1.F90 b/libgomp/testsuite/libgomp.fortran/alloc-1.F90 new file mode 100644 index 00000000000..e19077a78d0 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/alloc-1.F90 @@ -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 diff --git a/libgomp/testsuite/libgomp.fortran/alloc-2.F90 b/libgomp/testsuite/libgomp.fortran/alloc-2.F90 new file mode 100644 index 00000000000..d18453cb847 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/alloc-2.F90 @@ -0,0 +1,3 @@ +! { dg-additional-options "-fdefault-integer-8 -Wall -Wextra -Wno-maybe-uninitialized -DDEFAULT_INTEGER_8=1" } + +#include "alloc-1.F90" diff --git a/libgomp/testsuite/libgomp.fortran/alloc-3.F b/libgomp/testsuite/libgomp.fortran/alloc-3.F new file mode 100644 index 00000000000..76166fa5e39 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/alloc-3.F @@ -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" diff --git a/libgomp/testsuite/libgomp.fortran/alloc-4.f90 b/libgomp/testsuite/libgomp.fortran/alloc-4.f90 new file mode 100644 index 00000000000..ce353b55eb0 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/alloc-4.f90 @@ -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 diff --git a/libgomp/testsuite/libgomp.fortran/alloc-5.f90 b/libgomp/testsuite/libgomp.fortran/alloc-5.f90 new file mode 100644 index 00000000000..9a1d36b0798 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/alloc-5.f90 @@ -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