From patchwork Thu Jul 7 10:34:42 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andrew Stubbs X-Patchwork-Id: 55830 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 25D5F383664F for ; Thu, 7 Jul 2022 10:37:45 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa2.mentor.iphmx.com (esa2.mentor.iphmx.com [68.232.141.98]) by sourceware.org (Postfix) with ESMTPS id B2A25384189D for ; Thu, 7 Jul 2022 10:37:27 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org B2A25384189D Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com X-IronPort-AV: E=Sophos;i="5.92,252,1650960000"; d="scan'208";a="78448931" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa2.mentor.iphmx.com with ESMTP; 07 Jul 2022 02:37:10 -0800 IronPort-SDR: 6pRn9wCFnfMbwJM35bgfDGTPCNrVLgfJ/73714OGJceq+s+6tVLU1YV4G/gCvjTjj02VB08WQK deuWuDNtcXAIogdN6TTnjQYSiaZwbegPL7pqWe9ZBb7M84BW0sOgQF2qPXapSAsm3DV3JIDnwz cxyJcV0sBfS1QRR3LwvqGxvvRt2CkmtmlMHc2DWO2hPIJupjOu9Rj+GftzBt93Wg6tusnje6cy /eFRbPM3iORzzs0FdlPmcdnZZeS/l6opyPj7na9V5Mh9+jA4PPgQOCJe5beWlkFwsUk8uu3/Tz JME= From: Andrew Stubbs To: Subject: [PATCH 11/17] Translate allocate directive (OpenMP 5.0). Date: Thu, 7 Jul 2022 11:34:42 +0100 Message-ID: <6a5caebc7e24c68f4bf788ae2cd5ee2faf868051.1657188329.git.ams@codesourcery.com> X-Mailer: git-send-email 2.33.0 In-Reply-To: References: MIME-Version: 1.0 X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-10.mgc.mentorg.com (139.181.222.10) To svr-ies-mbx-11.mgc.mentorg.com (139.181.222.11) X-Spam-Status: No, score=-11.5 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, RCVD_IN_MSPIKE_H2, SPF_HELO_PASS, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" gcc/fortran/ChangeLog: * trans-openmp.cc (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.cc (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.cc (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.cc | 44 ++++++++++++ gcc/testsuite/gfortran.dg/gomp/allocate-6.f90 | 72 +++++++++++++++++++ gcc/tree-core.h | 3 + gcc/tree-pretty-print.cc | 19 +++++ gcc/tree.cc | 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.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