This patch looks for malloc/free calls that were generated by allocate statement
that is associated with allocate directive and replaces them with GOMP_alloc
and GOMP_free.
gcc/ChangeLog:
* omp-low.c (scan_sharing_clauses): Handle OMP_CLAUSE_ALLOCATOR.
(scan_omp_allocate): New.
(scan_omp_1_stmt): Call it.
(lower_omp_allocate): New function.
(lower_omp_1): Call it.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/allocate-6.f90: Add tests.
libgomp/ChangeLog:
* testsuite/libgomp.fortran/allocate-1.c: New test.
* testsuite/libgomp.fortran/allocate-2.f90: New test.
---
gcc/omp-low.c | 125 ++++++++++++++++++
gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 | 9 ++
.../testsuite/libgomp.fortran/allocate-1.c | 7 +
.../testsuite/libgomp.fortran/allocate-2.f90 | 49 +++++++
4 files changed, 190 insertions(+)
create mode 100644 libgomp/testsuite/libgomp.fortran/allocate-1.c
create mode 100644 libgomp/testsuite/libgomp.fortran/allocate-2.f90
diff --git a/gcc/omp-low.c b/gcc/omp-low.c
index f2237428de1..8a0ae3932b9 100644
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -1684,6 +1684,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE_FINALIZE:
case OMP_CLAUSE_TASK_REDUCTION:
case OMP_CLAUSE_ALLOCATE:
+ case OMP_CLAUSE_ALLOCATOR:
break;
case OMP_CLAUSE_ALIGNED:
@@ -1892,6 +1893,7 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE_FINALIZE:
case OMP_CLAUSE_FILTER:
case OMP_CLAUSE__CONDTEMP_:
+ case OMP_CLAUSE_ALLOCATOR:
break;
case OMP_CLAUSE__CACHE_:
@@ -2962,6 +2964,16 @@ scan_omp_simd_scan (gimple_stmt_iterator *gsi, gomp_for
*stmt,
maybe_lookup_ctx (new_stmt)->for_simd_scan_phase = true;
}
+/* Scan an OpenMP allocate directive. */
+
+static void
+scan_omp_allocate (gomp_allocate *stmt, omp_context *outer_ctx)
+{
+ omp_context *ctx;
+ ctx = new_omp_context (stmt, outer_ctx);
+ scan_sharing_clauses (gimple_omp_allocate_clauses (stmt), ctx);
+}
+
/* Scan an OpenMP sections directive. */
static void
@@ -4247,6 +4259,9 @@ scan_omp_1_stmt (gimple_stmt_iterator *gsi, bool
*handled_ops_p,
insert_decl_map (&ctx->cb, var, var);
}
break;
+ case GIMPLE_OMP_ALLOCATE:
+ scan_omp_allocate (as_a <gomp_allocate *> (stmt), ctx);
+ break;
default:
*handled_ops_p = false;
break;
@@ -8680,6 +8695,111 @@ lower_omp_single_simple (gomp_single *single_stmt,
gimple_seq *pre_p)
gimple_seq_add_stmt (pre_p, gimple_build_label (flabel));
}
+static void
+lower_omp_allocate (gimple_stmt_iterator *gsi_p, omp_context *)
+{
+ gomp_allocate *st = as_a <gomp_allocate *> (gsi_stmt (*gsi_p));
+ tree clauses = gimple_omp_allocate_clauses (st);
+ int kind = gimple_omp_allocate_kind (st);
+ gcc_assert (kind == GF_OMP_ALLOCATE_KIND_ALLOCATE
+ || kind == GF_OMP_ALLOCATE_KIND_FREE);
+ bool allocate = (kind == GF_OMP_ALLOCATE_KIND_ALLOCATE);
+
+ for (tree c = clauses; c; c = OMP_CLAUSE_CHAIN (c))
+ {
+ if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_ALLOCATOR)
+ continue;
+ tree var = OMP_ALLOCATE_DECL (c);
+
+ gimple_stmt_iterator gsi = *gsi_p;
+ for (gsi_next (&gsi); !gsi_end_p (gsi); gsi_next (&gsi))
+ {
+ gimple *stmt = gsi_stmt (gsi);
+
+ if (gimple_code (stmt) != GIMPLE_CALL
+ || (allocate && gimple_call_fndecl (stmt)
+ != builtin_decl_explicit (BUILT_IN_MALLOC))
+ || (!allocate && gimple_call_fndecl (stmt)
+ != builtin_decl_explicit (BUILT_IN_FREE)))
+ continue;
+ const gcall *gs = as_a <const gcall *> (stmt);
+ tree allocator = OMP_ALLOCATE_ALLOCATOR (c)
+ ? OMP_ALLOCATE_ALLOCATOR (c)
+ : integer_zero_node;
+ if (allocate)
+ {
+ tree lhs = gimple_call_lhs (gs);
+ if (lhs && TREE_CODE (lhs) == SSA_NAME)
+ {
+ gimple_stmt_iterator gsi2 = gsi;
+ gsi_next (&gsi2);
+ gimple *assign = gsi_stmt (gsi2);
+ if (gimple_code (assign) == GIMPLE_ASSIGN)
+ {
+ lhs = gimple_assign_lhs (as_a <const gassign *> (assign));
+ if (lhs == NULL_TREE
+ || TREE_CODE (lhs) != COMPONENT_REF)
+ continue;
+ lhs = TREE_OPERAND (lhs, 0);
+ }
+ }
+
+ if (lhs == var)
+ {
+ unsigned HOST_WIDE_INT ialign = 0;
+ tree align;
+ if (TYPE_P (var))
+ ialign = TYPE_ALIGN_UNIT (var);
+ else
+ ialign = DECL_ALIGN_UNIT (var);
+ align = build_int_cst (size_type_node, ialign);
+ tree repl = builtin_decl_explicit (BUILT_IN_GOMP_ALLOC);
+ tree size = gimple_call_arg (gs, 0);
+ gimple *g = gimple_build_call (repl, 3, align, size,
+ allocator);
+ gimple_call_set_lhs (g, gimple_call_lhs (gs));
+ gimple_set_location (g, gimple_location (stmt));
+ gsi_replace (&gsi, g, true);
+ }
+ }
+ else
+ {
+ tree arg = gimple_call_arg (gs, 0);
+ if (arg && TREE_CODE (arg) == SSA_NAME)
+ {
+ gimple_stmt_iterator gsi2 = gsi;
+ gsi_prev (&gsi2);
+ if (!gsi_end_p (gsi2))
+ {
+ gimple *gs = gsi_stmt (gsi2);
+ if (gimple_code (gs) == GIMPLE_ASSIGN)
+ {
+ const gassign *assign = as_a <const gassign *> (gs);
+ tree rhs = gimple_assign_rhs1 (assign);
+ tree lhs = gimple_assign_lhs (assign);
+ if (lhs == arg && rhs
+ && TREE_CODE (rhs) == COMPONENT_REF)
+ arg = TREE_OPERAND (rhs, 0);
+ }
+ }
+ }
+
+ if (arg == var)
+ {
+ tree repl = builtin_decl_explicit (BUILT_IN_GOMP_FREE);
+ gimple *g = gimple_build_call (repl, 2,
+ gimple_call_arg (gs, 0),
+ allocator);
+ gimple_set_location (g, gimple_location (stmt));
+ gsi_replace (&gsi, g, true);
+ break;
+ }
+ }
+ }
+ }
+ gsi_replace (gsi_p, gimple_build_nop (), true);
+}
+
/* A subroutine of lower_omp_single. Expand the simple form of
a GIMPLE_OMP_SINGLE, with a copyprivate clause:
@@ -14179,6 +14299,11 @@ lower_omp_1 (gimple_stmt_iterator *gsi_p, omp_context
*ctx)
gcc_assert (ctx);
lower_omp_scope (gsi_p, ctx);
break;
+ case GIMPLE_OMP_ALLOCATE:
+ ctx = maybe_lookup_ctx (stmt);
+ gcc_assert (ctx);
+ lower_omp_allocate (gsi_p, ctx);
+ break;
case GIMPLE_OMP_SINGLE:
ctx = maybe_lookup_ctx (stmt);
gcc_assert (ctx);
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90
b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90
index 6957bc55da0..738d9936f6a 100644
--- a/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90
@@ -1,5 +1,6 @@
! { dg-do compile }
! { dg-additional-options "-fdump-tree-original -fdump-tree-gimple" }
+! { dg-additional-options "-fdump-tree-omplower" }
module omp_lib_kinds
use iso_c_binding, only: c_int, c_intptr_t
@@ -47,6 +48,7 @@ end type
real, allocatable :: var3(:,:)
type (my_type), allocatable :: var4
integer, pointer :: pii, parr(:)
+ integer, allocatable :: var
character, allocatable :: str1a, str1aarr(:)
character(len=5), allocatable :: str5a, str5aarr(:)
@@ -67,9 +69,16 @@ end type
!$omp allocate
allocate(pii, parr(5))
+
+ ! allocate statement not associated with an allocate directive
+ allocate(var)
end subroutine
! { dg-final { scan-tree-dump-times "#pragma omp allocate \\(kind=allocate\\)"
6 "original" } }
! { dg-final { scan-tree-dump "#pragma omp allocate \\(kind=free\\)"
"original" } }
! { dg-final { scan-tree-dump-times "#pragma omp allocate \\(kind=allocate\\)"
6 "gimple" } }
! { dg-final { scan-tree-dump "#pragma omp allocate \\(kind=free\\)" "gimple"
} }
+! { dg-final { scan-tree-dump-times "builtin_malloc" 11 "original" } }
+! { dg-final { scan-tree-dump-times "builtin_free" 9 "original" } }
+! { dg-final { scan-tree-dump-times "GOMP_alloc" 10 "omplower" } }
+! { dg-final { scan-tree-dump-times "GOMP_free" 8 "omplower" } }
diff --git a/libgomp/testsuite/libgomp.fortran/allocate-1.c
b/libgomp/testsuite/libgomp.fortran/allocate-1.c
new file mode 100644
index 00000000000..d33acc6feef
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocate-1.c
@@ -0,0 +1,7 @@
+#include <stdint.h>
+
+int
+is_64bit_aligned_ (uintptr_t a)
+{
+ return ( (a & 0x3f) == 0);
+}
diff --git a/libgomp/testsuite/libgomp.fortran/allocate-2.f90
b/libgomp/testsuite/libgomp.fortran/allocate-2.f90
new file mode 100644
index 00000000000..8678c53a34c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocate-2.f90
@@ -0,0 +1,49 @@
+! { dg-do run }
+! { dg-additional-sources allocate-1.c }
+! { dg-prune-output "command-line option '-fintrinsic-modules-path=.*' is
valid for Fortran but not for C" }
+
+module m
+ use omp_lib
+ use iso_c_binding
+ implicit none
+ interface
+ integer(c_int) function is_64bit_aligned (a) bind(C)
+ import :: c_int
+ integer :: a
+ end
+ end interface
+end module m
+
+subroutine foo (x, y, h)
+ use omp_lib
+ !use iso_c_binding
+ integer :: x
+ integer :: y
+ integer (kind=omp_allocator_handle_kind) :: h
+ integer, allocatable :: var1
+ !integer, allocatable :: var2(:)
+
+ !$omp allocate (var1) allocator(h)
+ allocate (var1)
+
+ !y = 1
+ if (is_64bit_aligned(var1) == 0) then
+ stop 19
+ end if
+
+end subroutine
+
+program main
+ use omp_lib
+ 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, 8192)]
+ a = omp_init_allocator (omp_default_mem_space, 3, traits)
+ if (a == omp_null_allocator) stop 1
+ !call omp_set_default_allocator (omp_default_mem_alloc);
+ call foo (42, 12, a);
+ call omp_destroy_allocator (a);
+end
--
2.25.1
