diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index de27ed52c02..3ee63e416ed 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -2728,6 +2728,28 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, } } break; + case OMP_LIST_ALLOCATOR: + for (; n != NULL; n = n->next) + if (n->sym->attr.referenced) + { + tree t = gfc_trans_omp_variable (n->sym, false); + if (t != error_mark_node) + { + tree node = build_omp_clause (input_location, + OMP_CLAUSE_ALLOCATOR); + OMP_ALLOCATE_DECL (node) = t; + if (n->expr) + { + tree allocator_; + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, n->expr); + allocator_ = gfc_evaluate_now (se.expr, block); + OMP_ALLOCATE_ALLOCATOR (node) = allocator_; + } + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + } + } + break; case OMP_LIST_LINEAR: { gfc_expr *last_step_expr = NULL; @@ -4982,6 +5004,26 @@ gfc_trans_omp_atomic (gfc_code *code) return gfc_finish_block (&block); } +static tree +gfc_trans_omp_allocate (gfc_code *code) +{ + stmtblock_t block; + tree stmt; + + gfc_omp_clauses *clauses = code->ext.omp_clauses; + gcc_assert (clauses); + + gfc_start_block (&block); + stmt = make_node (OMP_ALLOCATE); + TREE_TYPE (stmt) = void_type_node; + OMP_ALLOCATE_CLAUSES (stmt) = gfc_trans_omp_clauses (&block, clauses, + code->loc, false, + true); + gfc_add_expr_to_block (&block, stmt); + gfc_merge_block_scope (&block); + return gfc_finish_block (&block); +} + static tree gfc_trans_omp_barrier (void) { @@ -7488,6 +7530,8 @@ gfc_trans_omp_directive (gfc_code *code) { switch (code->op) { + case EXEC_OMP_ALLOCATE: + return gfc_trans_omp_allocate (code); case EXEC_OMP_ATOMIC: return gfc_trans_omp_atomic (code); case EXEC_OMP_BARRIER: diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 new file mode 100644 index 00000000000..2de2b52ee44 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 @@ -0,0 +1,72 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +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_allocator_handle_kind = c_intptr_t + + 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 +end module + + +subroutine foo(x, y, al) + use omp_lib_kinds + implicit none + +type :: my_type + integer :: i + integer :: j + real :: x +end type + + integer :: x + integer :: y + integer (kind=omp_allocator_handle_kind) :: al + + integer, allocatable :: var1 + integer, allocatable :: var2 + real, allocatable :: var3(:,:) + type (my_type), allocatable :: var4 + integer, pointer :: pii, parr(:) + + character, allocatable :: str1a, str1aarr(:) + character(len=5), allocatable :: str5a, str5aarr(:) + + !$omp allocate + allocate(str1a, str1aarr(10), str5a, str5aarr(10)) + + !$omp allocate (var1) allocator(omp_default_mem_alloc) + !$omp allocate (var2) allocator(omp_large_cap_mem_alloc) + allocate (var1, var2) + + !$omp allocate (var4) allocator(omp_low_lat_mem_alloc) + allocate (var4) + var4%i = 5 + + !$omp allocate (var3) allocator(omp_low_lat_mem_alloc) + allocate (var3(x,y)) + + !$omp allocate + allocate(pii, parr(5)) +end subroutine + +! { dg-final { scan-tree-dump-times "#pragma omp allocate" 6 "original" } } diff --git a/gcc/tree-core.h b/gcc/tree-core.h index ab5fa01e5cb..774bf0d7658 100644 --- a/gcc/tree-core.h +++ b/gcc/tree-core.h @@ -522,6 +522,9 @@ enum omp_clause_code { /* OpenACC clause: nohost. */ OMP_CLAUSE_NOHOST, + + /* OpenMP clause: allocator. */ + OMP_CLAUSE_ALLOCATOR }; #undef DEFTREESTRUCT diff --git a/gcc/tree-pretty-print.cc b/gcc/tree-pretty-print.cc index 47371d8bcbe..4d21babbd34 100644 --- a/gcc/tree-pretty-print.cc +++ b/gcc/tree-pretty-print.cc @@ -767,6 +767,20 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags) pp_right_paren (pp); break; + case OMP_CLAUSE_ALLOCATOR: + pp_string (pp, "("); + dump_generic_node (pp, OMP_ALLOCATE_DECL (clause), + spc, flags, false); + if (OMP_ALLOCATE_ALLOCATOR (clause)) + { + pp_string (pp, ":allocator("); + dump_generic_node (pp, OMP_ALLOCATE_ALLOCATOR (clause), + spc, flags, false); + pp_right_paren (pp); + } + pp_right_paren (pp); + break; + case OMP_CLAUSE_ALLOCATE: pp_string (pp, "allocate("); if (OMP_CLAUSE_ALLOCATE_ALLOCATOR (clause)) @@ -3525,6 +3539,11 @@ dump_generic_node (pretty_printer *pp, tree node, int spc, dump_flags_t flags, dump_omp_clauses (pp, OACC_CACHE_CLAUSES (node), spc, flags); break; + case OMP_ALLOCATE: + pp_string (pp, "#pragma omp allocate "); + dump_omp_clauses (pp, OMP_ALLOCATE_CLAUSES (node), spc, flags); + break; + case OMP_PARALLEL: pp_string (pp, "#pragma omp parallel"); dump_omp_clauses (pp, OMP_PARALLEL_CLAUSES (node), spc, flags); diff --git a/gcc/tree.cc b/gcc/tree.cc index 84000dd8b69..6dc1cf4d9b3 100644 --- a/gcc/tree.cc +++ b/gcc/tree.cc @@ -351,6 +351,7 @@ unsigned const char omp_clause_num_ops[] = 0, /* OMP_CLAUSE_IF_PRESENT */ 0, /* OMP_CLAUSE_FINALIZE */ 0, /* OMP_CLAUSE_NOHOST */ + 2, /* OMP_CLAUSE_ALLOCATOR */ }; const char * const omp_clause_code_name[] = diff --git a/gcc/tree.def b/gcc/tree.def index 62650b6934b..b4d2f7a575d 100644 --- a/gcc/tree.def +++ b/gcc/tree.def @@ -1307,6 +1307,10 @@ DEFTREECODE (OMP_ATOMIC_READ, "omp_atomic_read", tcc_statement, 1) DEFTREECODE (OMP_ATOMIC_CAPTURE_OLD, "omp_atomic_capture_old", tcc_statement, 2) DEFTREECODE (OMP_ATOMIC_CAPTURE_NEW, "omp_atomic_capture_new", tcc_statement, 2) +/* OpenMP - #pragma omp allocate + Operand 0: Clauses. */ +DEFTREECODE (OMP_ALLOCATE, "omp allocate", tcc_statement, 1) + /* OpenMP clauses. */ DEFTREECODE (OMP_CLAUSE, "omp_clause", tcc_exceptional, 0) diff --git a/gcc/tree.h b/gcc/tree.h index 6f6ad5a3a5f..b2575c18693 100644 --- a/gcc/tree.h +++ b/gcc/tree.h @@ -1466,6 +1466,8 @@ class auto_suppress_location_wrappers #define OACC_UPDATE_CLAUSES(NODE) \ TREE_OPERAND (OACC_UPDATE_CHECK (NODE), 0) +#define OMP_ALLOCATE_CLAUSES(NODE) TREE_OPERAND (OMP_ALLOCATE_CHECK (NODE), 0) + #define OMP_PARALLEL_BODY(NODE) TREE_OPERAND (OMP_PARALLEL_CHECK (NODE), 0) #define OMP_PARALLEL_CLAUSES(NODE) TREE_OPERAND (OMP_PARALLEL_CHECK (NODE), 1) @@ -1872,6 +1874,15 @@ class auto_suppress_location_wrappers #define OMP_CLAUSE_ALLOCATE_ALIGN(NODE) \ OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_ALLOCATE), 2) +/* May be we can use OMP_CLAUSE_DECL but the I am not sure where to place + OMP_CLAUSE_ALLOCATOR in omp_clause_code. */ + +#define OMP_ALLOCATE_DECL(NODE) \ + OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_ALLOCATOR), 0) + +#define OMP_ALLOCATE_ALLOCATOR(NODE) \ + OMP_CLAUSE_OPERAND (OMP_CLAUSE_SUBCODE_CHECK (NODE, OMP_CLAUSE_ALLOCATOR), 1) + /* True if an ALLOCATE clause was present on a combined or composite construct and the code for splitting the clauses has already performed checking if the listed variable has explicit privatization on the