From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from esa4.mentor.iphmx.com (esa4.mentor.iphmx.com [68.232.137.252]) by sourceware.org (Postfix) with ESMTPS id E9A2939518B9; Thu, 13 Jan 2022 14:53:47 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org E9A2939518B9 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com IronPort-SDR: uVEb5gu556p6hGN+SxOW+Esb7fFs7utmsR5PB3Mi+wlChlSHu7XfX1V5BAwwlpwLbtfbWTsoJ6 TmKiLfi35Foh48b6nkphJPRP+42LX+wzn0JsVy3Fr+e+SW4W1n1BfIlGgtp2aHMzpHHkhbBXhh vtZYkG7Vk0od6TZaWXSuHWo9lX7ZZPqcrqkGfBvoq5xcb45Bt+qeHEp4GHlnnWGSBTJUaz+uxi 2N1cr+7eEpBDc9AkssXP1CqPc+EaC3wwFpizkF81hgT+0LGaydemHV3deJVkfNYG2JjHEHAHc/ 46VFJJSCMhdY9IN/jXI6z4Rc X-IronPort-AV: E=Sophos;i="5.88,286,1635235200"; d="scan'208";a="70723178" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa4.mentor.iphmx.com with ESMTP; 13 Jan 2022 06:53:45 -0800 IronPort-SDR: Aqqhs3TUt5Xwibez/RzIB+qic2jCWyusrUmt2SS1/Af9iTmMKurR1jhAxCsRjrs54Fye0pb+uo lZw6SspZ2l+hjkbayhjQ+wPN6OQfAcFR28GSR/rMmX9Np9V5HiDMUsbEHJh6p5pXDiWRCxUACA qKCH0O89YFxbSNHlT0adA6Jz70PrSRYbxUO4E37e2c5ShSGN0lTiw8DhfBkt5qT3R6rEngxNY6 aZpZYhgqus+1EBU8Mg0b8vmOxKA3k37EzRbjeegeeWOgVfMPR6zYAkzZkXICvyHdTsf1oOSuqh Ptc= From: Hafiz Abid Qadeer To: , CC: , Subject: [PATCH 2/5] [gfortran] Translate allocate directive (OpenMP 5.0). Date: Thu, 13 Jan 2022 14:53:17 +0000 Message-ID: <20220113145320.3153087-3-abidh@codesourcery.com> X-Mailer: git-send-email 2.25.1 In-Reply-To: <20220113145320.3153087-1-abidh@codesourcery.com> References: <20220113145320.3153087-1-abidh@codesourcery.com> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit Content-Type: text/plain X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-14.mgc.mentorg.com (139.181.222.14) To SVR-IES-MBX-03.mgc.mentorg.com (139.181.222.3) X-Spam-Status: No, score=-12.5 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_PASS, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on server2.sourceware.org X-BeenThere: fortran@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Fortran mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Thu, 13 Jan 2022 14:53:50 -0000 gcc/fortran/ChangeLog: * trans-openmp.c (gfc_trans_omp_clauses): Handle OMP_LIST_ALLOCATOR. (gfc_trans_omp_allocate): New function. (gfc_trans_omp_directive): Handle EXEC_OMP_ALLOCATE. gcc/ChangeLog: * tree-pretty-print.c (dump_omp_clause): Handle OMP_CLAUSE_ALLOCATOR. (dump_generic_node): Handle OMP_ALLOCATE. * tree.def (OMP_ALLOCATE): New. * tree.h (OMP_ALLOCATE_CLAUSES): Likewise. (OMP_ALLOCATE_DECL): Likewise. (OMP_ALLOCATE_ALLOCATOR): Likewise. * tree.c (omp_clause_num_ops): Add entry for OMP_CLAUSE_ALLOCATOR. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/allocate-6.f90: New test. --- gcc/fortran/trans-openmp.c | 44 ++++++++++++ gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 | 72 +++++++++++++++++++ gcc/tree-core.h | 3 + gcc/tree-pretty-print.c | 19 +++++ gcc/tree.c | 1 + gcc/tree.def | 4 ++ gcc/tree.h | 11 +++ 7 files changed, 154 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 9661c77f905..cb389f40370 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -2649,6 +2649,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; @@ -4888,6 +4910,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) { @@ -7280,6 +7322,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 61ae4bd931b..5bd5501e346 100644 --- a/gcc/tree-core.h +++ b/gcc/tree-core.h @@ -519,6 +519,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.c b/gcc/tree-pretty-print.c index 352662567b4..c3891a359f2 100644 --- a/gcc/tree-pretty-print.c +++ b/gcc/tree-pretty-print.c @@ -740,6 +740,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)) @@ -3484,6 +3498,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.c b/gcc/tree.c index d98b77db50b..75141756d87 100644 --- a/gcc/tree.c +++ b/gcc/tree.c @@ -363,6 +363,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 33eb3b7beff..9768bc29dec 100644 --- a/gcc/tree.def +++ b/gcc/tree.def @@ -1301,6 +1301,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 318019c4dc5..2ec0b8c9240 100644 --- a/gcc/tree.h +++ b/gcc/tree.h @@ -1405,6 +1405,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) @@ -1801,6 +1803,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 -- 2.25.1