From patchwork Thu Jan 13 14:53:20 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Abid Qadeer X-Patchwork-Id: 49974 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 55A783951C7E for ; Thu, 13 Jan 2022 14:57:26 +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 079163951C3C; Thu, 13 Jan 2022 14:54:03 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 079163951C3C 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: L4J9X2OfC5eOFSrFad8iP4H6cWwuVDCvUIivoX+j7iQe5go5rCPntgiIbUQqzxjIbjcpCtnd1K GP9cY1ecjojkXbi8AKp9v+RON2fsMMoqhQMSxVfM8ZFLbdXTvqhKmsAlhEsb6VPaJ3+Tf3NpmL ldsUJ+c43dOj2MOgVEpfqhTeBwp9/AJARTulF9L0k/90a1CFvQrYXyZYTZC5gc3NRGL4E7YSdq 5xm/W/i0xYnROLhZUAKeIowIPCXdXiX0ydSiqzvNmLUAU7uTz2LfkYcIK7A3VrZFvPdnbI/CLx 3+o/0OwhEmZLTHhr0pLD/351 X-IronPort-AV: E=Sophos;i="5.88,286,1635235200"; d="scan'208";a="70725145" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa2.mentor.iphmx.com with ESMTP; 13 Jan 2022 06:54:03 -0800 IronPort-SDR: IRrTiz563tFhqIgg4l3qnfCNPwFtemjIFP2pgxnFL9bRC9AJmNmxGKxAcVJUvaBoSBmc4KDVIw GvR/pA3UVYpD3qPIGvrpx+HDwUSdC6bcrYFqgKK1oYTqzgaAR/N0k7FDCXySS75Ag4vrpsB7QJ vBZFZJwZnGkj7GnnOt6tC1/i1AHocBSK5DPcqj9djOHGRmZg6M18mMxIG23PxR/uQ3F/1BjM4j Pk/Kw+NqcS7RsaqICnnSSfPmwziU0VSvFEYaIAiDtTiLxVdSAmjvlNnZKwPcoO53gT967QviIF 4PA= From: Hafiz Abid Qadeer To: , Subject: [PATCH 5/5] [gfortran] Lower allocate directive (OpenMP 5.0). Date: Thu, 13 Jan 2022 14:53:20 +0000 Message-ID: <20220113145320.3153087-6-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 X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-15.mgc.mentorg.com (139.181.222.15) To SVR-IES-MBX-03.mgc.mentorg.com (139.181.222.3) X-Spam-Status: No, score=-2.6 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_PASS, SPF_PASS, TXREP, UNWANTED_LANGUAGE_BODY 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: 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: , Cc: jakub@redhat.com, tobias@codesourcery.com Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" 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 (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 (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 (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 (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 (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 + +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