diff options
author | Tobias Burnus <tobias@codesourcery.com> | 2023-12-08 15:18:25 +0100 |
---|---|---|
committer | Tobias Burnus <tobias@codesourcery.com> | 2023-12-08 15:18:25 +0100 |
commit | d4b6d147920b93297e621124a99ed01e7e310d92 (patch) | |
tree | 330b3935af3a4ad4593ca48db70d71b1672a5dc9 /libgomp/testsuite/libgomp.fortran | |
parent | 47575ec9edcd3078f066aa54ba428420be796bef (diff) | |
download | gcc-d4b6d147920b93297e621124a99ed01e7e310d92.zip gcc-d4b6d147920b93297e621124a99ed01e7e310d92.tar.gz gcc-d4b6d147920b93297e621124a99ed01e7e310d92.tar.bz2 |
OpenMP/Fortran: Implement omp allocators/allocate for ptr/allocatables
This commit adds -fopenmp-allocators which enables support for
'omp allocators' and 'omp allocate' that are associated with a Fortran
allocate-stmt. If such a construct is encountered, an error is shown,
unless the -fopenmp-allocators flag is present.
With -fopenmp -fopenmp-allocators, those constructs get turned into
GOMP_alloc allocations, while -fopenmp-allocators (also without -fopenmp)
ensures deallocation and reallocation (via intrinsic assignments) are
properly directed to GOMP_free/omp_realloc - while normal Fortran
allocations are processed by free/realloc.
In order to distinguish a 'malloc'ed from a 'GOMP_alloc'ed memory, the
version field of the Fortran array discriptor is (mis)used: 0 indicates
the normal Fortran allocation while 1 denotes GOMP_alloc. For scalars,
there is record keeping in libgomp: GOMP_add_alloc(ptr) will add the
pointer address to a splay_tree while GOMP_is_alloc(ptr) will return
true it was previously added but also removes it from the list.
Besides Fortran FE work, BUILT_IN_GOMP_REALLOC is no part of
omp-builtins.def and libgomp gains the mentioned two new function.
gcc/ChangeLog:
* builtin-types.def (BT_FN_PTR_PTR_SIZE_PTRMODE_PTRMODE): New.
* omp-builtins.def (BUILT_IN_GOMP_REALLOC): New.
* builtins.cc (builtin_fnspec): Handle it.
* gimple-ssa-warn-access.cc (fndecl_alloc_p,
matching_alloc_calls_p): Likewise.
* gimple.cc (nonfreeing_call_p): Likewise.
* predict.cc (expr_expected_value_1): Likewise.
* tree-ssa-ccp.cc (evaluate_stmt): Likewise.
* tree.cc (fndecl_dealloc_argno): Likewise.
gcc/fortran/ChangeLog:
* dump-parse-tree.cc (show_omp_node): Handle EXEC_OMP_ALLOCATE
and EXEC_OMP_ALLOCATORS.
* f95-lang.cc (ATTR_ALLOC_WARN_UNUSED_RESULT_SIZE_2_NOTHROW_LIST):
Add 'ECF_LEAF | ECF_MALLOC' to existing 'ECF_NOTHROW'.
(ATTR_ALLOC_WARN_UNUSED_RESULT_SIZE_2_NOTHROW_LEAF_LIST): Define.
* gfortran.h (gfc_omp_clauses): Add contained_in_target_construct.
* invoke.texi (-fopenacc, -fopenmp): Update based on C version.
(-fopenmp-simd): New, based on C version.
(-fopenmp-allocators): New.
* lang.opt (fopenmp-allocators): Add.
* openmp.cc (resolve_omp_clauses): For allocators/allocate directive,
add target and no dynamic_allocators diagnostic and more invalid
diagnostic.
* parse.cc (decode_omp_directive): Set contains_teams_construct.
* trans-array.h (gfc_array_allocate): Update prototype.
(gfc_conv_descriptor_version): New prototype.
* trans-decl.cc (gfc_init_default_dt): Fix comment.
* trans-array.cc (gfc_conv_descriptor_version): New.
(gfc_array_allocate): Support GOMP_alloc allocation.
(gfc_alloc_allocatable_for_assignment, structure_alloc_comps):
Handle GOMP_free/omp_realloc as needed.
* trans-expr.cc (gfc_conv_procedure_call): Likewise.
(alloc_scalar_allocatable_for_assignment): Likewise.
* trans-intrinsic.cc (conv_intrinsic_move_alloc): Likewise.
* trans-openmp.cc (gfc_trans_omp_allocators,
gfc_trans_omp_directive): Handle allocators/allocate directive.
(gfc_omp_call_add_alloc, gfc_omp_call_is_alloc): New.
* trans-stmt.h (gfc_trans_allocate): Update prototype.
* trans-stmt.cc (gfc_trans_allocate): Support GOMP_alloc.
* trans-types.cc (gfc_get_dtype_rank_type): Set version field.
* trans.cc (gfc_allocate_using_malloc, gfc_allocate_allocatable):
Update to handle GOMP_alloc.
(gfc_deallocate_with_status, gfc_deallocate_scalar_with_status):
Handle GOMP_free.
(trans_code): Update call.
* trans.h (gfc_allocate_allocatable, gfc_allocate_using_malloc):
Update prototype.
(gfc_omp_call_add_alloc, gfc_omp_call_is_alloc): New prototype.
* types.def (BT_FN_PTR_PTR_SIZE_PTRMODE_PTRMODE): New.
libgomp/ChangeLog:
* allocator.c (struct fort_alloc_splay_tree_key_s,
fort_alloc_splay_compare, GOMP_add_alloc, GOMP_is_alloc): New.
* libgomp.h: Define splay_tree_static for 'reverse' splay tree.
* libgomp.map (GOMP_5.1.2): New; add GOMP_add_alloc and
GOMP_is_alloc; move GOMP_target_map_indirect_ptr from ...
(GOMP_5.1.1): ... here.
* libgomp.texi (Impl. Status, Memory management): Update for
allocators/allocate directives.
* splay-tree.c: Handle splay_tree_static define to declare all
functions as static.
(splay_tree_lookup_node): New.
* splay-tree.h: Handle splay_tree_decl_only define.
(splay_tree_lookup_node): New prototype.
* target.c: Define splay_tree_static for 'reverse'.
* testsuite/libgomp.fortran/allocators-1.f90: New test.
* testsuite/libgomp.fortran/allocators-2.f90: New test.
* testsuite/libgomp.fortran/allocators-3.f90: New test.
* testsuite/libgomp.fortran/allocators-4.f90: New test.
* testsuite/libgomp.fortran/allocators-5.f90: New test.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/allocate-14.f90: Add coarray and
not-listed tests.
* gfortran.dg/gomp/allocate-5.f90: Remove sorry dg-message.
* gfortran.dg/bind_c_array_params_2.f90: Update expected
dump for dtype '.version=0'.
* gfortran.dg/gomp/allocate-16.f90: New test.
* gfortran.dg/gomp/allocators-3.f90: New test.
* gfortran.dg/gomp/allocators-4.f90: New test.
Diffstat (limited to 'libgomp/testsuite/libgomp.fortran')
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/allocators-1.f90 | 68 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/allocators-2.f90 | 101 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/allocators-3.f90 | 25 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/allocators-4.f90 | 57 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/allocators-5.f90 | 27 |
5 files changed, 278 insertions, 0 deletions
diff --git a/libgomp/testsuite/libgomp.fortran/allocators-1.f90 b/libgomp/testsuite/libgomp.fortran/allocators-1.f90 new file mode 100644 index 0000000..935a37c --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocators-1.f90 @@ -0,0 +1,68 @@ +! { dg-additional-options "-fopenmp-allocators -fdump-tree-original" } +module m + use omp_lib + use iso_c_binding, only: c_intptr_t + implicit none (type,external) + integer(omp_allocator_handle_kind) :: handle + integer(c_intptr_t) :: iptr +end module m + +subroutine scalar + use m + implicit none (type,external) + integer :: i + integer, allocatable :: SSS + i = 5 ! required executive statement before 'omp allocators' + !$omp allocate allocator(handle) + allocate(SSS) + if (mod (loc (sss), 64) /= 0) stop 1 + deallocate(SSS) + allocate(SSS) +end +! { dg-final { scan-tree-dump-times "sss = \\(integer\\(kind=4\\) \\*\\) __builtin_GOMP_alloc \\(4, 4, D\\.\[0-9\]+\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "GOMP_add_alloc \\(sss\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "if \\(GOMP_is_alloc \\(sss\\)\\)" 2 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(sss, 0B\\);" 2 "original" } } + +subroutine array + use m + implicit none (type,external) + integer :: i + integer, allocatable :: A(:) + i = 5 ! required executive statement before 'omp allocators' + !$omp allocate allocator(handle) align(512) + allocate(A(5)) + if (mod (loc (A), 512) /= 0) stop 2 + A=[1] + if (mod (loc (A), 64) /= 0) stop 3 + deallocate(A) + A=[1] + deallocate(A) + call omp_set_default_allocator (handle) + !$omp allocate + allocate(A(7)) + if (mod (loc (A), 64) /= 0) stop 4 +end +! { dg-final { scan-tree-dump-times "a.dtype = {.elem_len=4, .version=0, .rank=1, .type=1};" 5 "original" } } +! { dg-final { scan-tree-dump-times "\\.elem_len=4" 5 "original" } } +! { dg-final { scan-tree-dump-times "a.data = \\(void \\* restrict\\) __builtin_GOMP_alloc \\(512, 20, D\\.\[0-9\]+\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "a.data = \\(void \\* restrict\\) __builtin_GOMP_alloc \\(4, 28, 0B\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "a.dtype.version = 1;" 2 "original" } } +! { dg-final { scan-tree-dump-times "a.data = \\(void \\* restrict\\) \\(a.dtype.version == 1 \\? __builtin_omp_realloc \\(\\(void \\*\\) a.data, 4, 0B, 0B\\) : __builtin_realloc \\(\\(void \\*\\) a.data, 4\\)\\);" 2 "original" } } +! { dg-final { scan-tree-dump-times "if \\(a.dtype.version == 1\\)" 3 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(\\(integer\\(kind=4\\)\\\[0:\\\] \\* restrict\\) a.data, 0B\\);" 3 "original" } } +! { dg-final { scan-tree-dump-times "a.dtype.version = 0;" 3 "original" } } + +program main + use m + implicit none (type,external) + external :: scalar, array + type (omp_alloctrait), parameter :: traits(*) & + = [omp_alloctrait(omp_atk_sync_hint, omp_atv_contended), & + omp_alloctrait(omp_atk_alignment, 64)] + handle = omp_init_allocator (omp_high_bw_mem_alloc, size(traits), traits) + call scalar + call array + call omp_destroy_allocator (handle) +end + diff --git a/libgomp/testsuite/libgomp.fortran/allocators-2.f90 b/libgomp/testsuite/libgomp.fortran/allocators-2.f90 new file mode 100644 index 0000000..c42fbd3 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocators-2.f90 @@ -0,0 +1,101 @@ +! { dg-additional-options "-fopenmp-allocators" } +module m + implicit none (type, external) + type t + integer, allocatable :: Acomp, Bcomp(:) + end type t + +contains + +subroutine intent_out(aa, bb, cc, dd, ee, ff) + integer, allocatable,intent(out) :: aa, bb(:) + type(t), intent(out) :: cc, dd(4) + type(t), allocatable, intent(out) :: ee, ff(:) +end + +subroutine q(qa, qb, qc, qd, qe, qf) + integer, allocatable :: qa, qb(:) + type(t) :: qc, qd(4) + type(t), allocatable :: qe, qf(:) + call intent_out (qa, qb, qc, qd, qe, qf) +end subroutine q + +subroutine r + integer, allocatable :: r1, r2(:) + type(t) :: r3, r4(4) + type(t), allocatable :: r5, r6(:) + + call q(r1,r2,r3,r4,r5,r6) + + allocate(r1,r2(3)) + allocate(r5,r6(4)) + allocate(r3%Acomp, r3%Bcomp(2)) + allocate(r4(2)%Acomp, r4(2)%Bcomp(2)) + allocate(r5%Acomp, r5%Bcomp(2)) + allocate(r6(3)%Acomp, r6(3)%Bcomp(2)) + !$omp allocate align(128) + allocate(r4(3)%Acomp, r4(3)%Bcomp(2), & + r6(1)%Acomp, r6(1)%Bcomp(2)) + if (mod (loc (r4(3)%Acomp), 128) /= 0) stop 1 + if (mod (loc (r4(3)%Bcomp), 128) /= 0) stop 2 + if (mod (loc (r6(1)%Acomp), 128) /= 0) stop 3 + if (mod (loc (r6(1)%Bcomp), 128) /= 0) stop 3 + call q(r1,r2,r3,r4,r5,r6) + + !$omp allocate align(64) + allocate(r1,r2(3)) + if (mod (loc (r1), 64) /= 0) stop 1 + if (mod (loc (r2), 64) /= 0) stop 1 + !$omp allocate align(64) + allocate(r5,r6(4)) + if (mod (loc (r5), 64) /= 0) stop 1 + if (mod (loc (r6), 64) /= 0) stop 1 + !$omp allocate align(64) + allocate(r3%Acomp, r3%Bcomp(2)) + if (mod (loc (r3%Acomp), 64) /= 0) stop 1 + if (mod (loc (r3%Bcomp), 64) /= 0) stop 1 + !$omp allocate align(64) + allocate(r4(2)%Acomp, r4(2)%Bcomp(2)) + if (mod (loc (r4(2)%Acomp), 64) /= 0) stop 1 + if (mod (loc (r4(2)%Bcomp), 64) /= 0) stop 1 + !$omp allocate align(64) + allocate(r5%Acomp, r5%Bcomp(2)) + if (mod (loc (r5%Acomp), 64) /= 0) stop 1 + if (mod (loc (r5%Bcomp), 64) /= 0) stop 1 + !$omp allocate align(64) + allocate(r6(3)%Acomp, r6(3)%Bcomp(2)) + if (mod (loc (r6(3)%Acomp), 64) /= 0) stop 1 + if (mod (loc (r6(3)%Bcomp), 64) /= 0) stop 1 + !$omp allocate align(128) + allocate(r4(3)%Acomp, r4(3)%Bcomp(2), & + r6(1)%Acomp, r6(1)%Bcomp(2)) + if (mod (loc (r4(3)%Acomp), 128) /= 0) stop 1 + if (mod (loc (r4(3)%Bcomp), 128) /= 0) stop 2 + if (mod (loc (r6(1)%Acomp), 128) /= 0) stop 3 + if (mod (loc (r6(1)%Bcomp), 128) /= 0) stop 3 + call q(r1,r2,r3,r4,r5,r6) +end subroutine r +end + +subroutine s + use m, only : t + implicit none (type, external) + type(t) :: xx + integer :: i, iiiiii + i = 4 + !$omp allocate + allocate(xx%Acomp, xx%Bcomp(4)) + deallocate(xx%Acomp, xx%Bcomp) + + !$omp allocate + allocate(xx%Acomp, xx%Bcomp(4)) + xx = t(1, [1,2]) +end + +program main + use m, only: r + implicit none (type, external) + external s + call s + call r +end diff --git a/libgomp/testsuite/libgomp.fortran/allocators-3.f90 b/libgomp/testsuite/libgomp.fortran/allocators-3.f90 new file mode 100644 index 0000000..2e05939 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocators-3.f90 @@ -0,0 +1,25 @@ +! { dg-additional-options "-fdump-tree-original -fopenmp-allocators" } + +subroutine s + character(:), allocatable :: s1,s2 + + !$omp allocators allocate(s1) + allocate(character(len=3) :: s1) + + !$omp allocators allocate(s2) + allocate(character(len=5) :: s2) + + s2(1:5) = "12" + s1 = trim(s2) +end +! { dg-final { scan-tree-dump-times "s1 = \\(character\\(kind=1\\)\\\[1:.s1\\\] \\*\\) __builtin_GOMP_alloc \\(1, 3, 0B\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "s2 = \\(character\\(kind=1\\)\\\[1:.s2\\\] \\*\\) __builtin_GOMP_alloc \\(1, 5, 0B\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "s1 = \\(character\\(kind=1\\)\\\[1:.s1\\\] \\*\\) \\(D\\.\[0-9\]+ \\? __builtin_omp_realloc \\(\\(void \\*\\) s1, MAX_EXPR <\\(sizetype\\) len.1, 1>, 0B, 0B\\) : __builtin_realloc \\(\\(void \\*\\) s1, MAX_EXPR <\\(sizetype\\) len.1, 1>\\)\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "GOMP_add_alloc \\(s1\\);" 2 "original" } } +! { dg-final { scan-tree-dump-times "OMP_add_alloc \\(s2\\);" 1 "original" } } +! { dg-final { scan-tree-dump-times "if \\(GOMP_is_alloc \\(s2\\)\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_GOMP_free \\(s2, 0B\\);" 1 "original" } } + + +call s +end diff --git a/libgomp/testsuite/libgomp.fortran/allocators-4.f90 b/libgomp/testsuite/libgomp.fortran/allocators-4.f90 new file mode 100644 index 0000000..12689ea --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocators-4.f90 @@ -0,0 +1,57 @@ +! { dg-additional-options "-fopenmp-allocators" } +module m +implicit none +type t + integer, allocatable :: Acomp, Bcomp(:) + class(*), allocatable :: Ccomp, Dcomp(:) +end type t +contains + +subroutine intout(c,d,e,f) +implicit none +class(t), intent(out) :: c,d(4) +class(t), allocatable, intent(out) :: e,f(:) +end + +subroutine q(c,d,e,f) +implicit none +class(t) :: c,d(4) +class(t), allocatable :: e,f(:) +call intout(c,d,e,f) +end subroutine q + +subroutine s +implicit none +type(t) :: xx +class(t), allocatable :: yy +integer :: i, iiiiii +i = 4 +!$omp allocate +allocate(xx%Acomp, xx%Bcomp(4)) +deallocate(xx%Acomp, xx%Bcomp) + +!$omp allocate +allocate(integer :: xx%Ccomp, xx%Dcomp(4)) +deallocate(xx%Ccomp, xx%Dcomp) + +!$omp allocators allocate(yy) +allocate(t :: yy) + +!$omp allocate +allocate(real :: xx%Ccomp, xx%Dcomp(4)) +deallocate(xx%Ccomp, xx%Dcomp) + +!$omp allocate +allocate(xx%Acomp, xx%Bcomp(4)) +!$omp allocate +allocate(logical :: xx%Ccomp, xx%Dcomp(4)) + +iiiiii = 555 +xx = t(1, [1,2]) +end + +end module + +use m +call s +end diff --git a/libgomp/testsuite/libgomp.fortran/allocators-5.f90 b/libgomp/testsuite/libgomp.fortran/allocators-5.f90 new file mode 100644 index 0000000..8708863 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocators-5.f90 @@ -0,0 +1,27 @@ +! { dg-additional-options "-fopenmp-allocators" } +module m +contains +subroutine s(a,b,c,d) +integer, allocatable :: A, B +integer, allocatable :: C(:), D(:) + +!$omp allocators allocate(A,B) +allocate(A,B) +call move_alloc(A,B) + +!$omp allocators allocate(C,D) +allocate(C(5),D(5)) +call move_alloc(C,D) +end + +subroutine q() +integer, allocatable :: A, B +integer, allocatable :: C(:), D(:) + +call s(a,b,c,d) +end +end + +use m +call q +end |