From patchwork Wed Apr 20 13:19:38 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 53071 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 C2C783856DF8 for ; Wed, 20 Apr 2022 13:20:18 +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 1C2373858C53; Wed, 20 Apr 2022 13:19:53 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 1C2373858C53 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.90,275,1643702400"; d="diff'?scan'208";a="74750423" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa2.mentor.iphmx.com with ESMTP; 20 Apr 2022 05:19:51 -0800 IronPort-SDR: A8YJz7fcb1aEzgllaSMajcF8HmqGIJ46sPJt1vDDgX1lNggMKY9/5AENsnmF2LbJ3irMtyKnD7 fJscaUmUH4RXV4jObkqX8NlV0QBgYnqzCCZZ98zCUZnZzym+8KiPxA4vdPVgp8fYzpdZumVrX+ vDWj0Nn0MOGTZA02L+sEyI36KIaE6Wjg9GXqZ7z1uj22913yGLTey9DoO1vfMD0kndKYP0cXKf lD+dFxvUobqPkNCWqBur1KdahJT7rlXLtq0NHqstqS1mL73meE9oZKWt6F+HB1Bx0DaRmujLww +9U= Message-ID: Date: Wed, 20 Apr 2022 15:19:38 +0200 MIME-Version: 1.0 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:91.0) Gecko/20100101 Thunderbird/91.8.1 Content-Language: en-US To: gcc-patches , fortran , Jakub Jelinek From: Tobias Burnus Subject: [Patch] OpenMP: Fix use_device_{addr,ptr} with in-data-sharing arg X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-14.mgc.mentorg.com (139.181.222.14) To svr-ies-mbx-12.mgc.mentorg.com (139.181.222.12) X-Spam-Status: No, score=-11.4 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_PASS, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE 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: , Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" For omp parallel shared(array_desc_var) the shared-variable is passed to the generated function as argument - and replaced by a DECL_VALUE_EXPR inside the parallel region. If inside the parallel region, a omp target data has_device_addr(array_descr_var) is used, the latter generates a omp_arr->array_descr_var = &array_descr_var.data; ... tmp_desc = array_descr_var tmp_desc.data = omp_o->array_descr_var that is: 'tmp_desc' gets assigned the original descriptor and only the data components is updated. However, if that's inside the parallel region, not 'array_descr_var' has to be used – but the value expression ('omp_i->array_descr_var'). Fixed by searching the variable used in use_device_{addr,ptr} in the outer OpenMP context – and then checking for a DECL_VALUE_EXPR. OK? Tobias ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955 OpenMP: Fix use_device_{addr,ptr} with in-data-sharing arg For array-descriptor vars, the descriptor is assigned to a temporary. However, this failed when the clause's argument was in turn in a data-sharing clause as the outer context's VALUE_EXPR wasn't used. gcc/ChangeLog: * omp-low.cc (lower_omp_target): Fix use_device_{addr,ptr} with list item that is in an outer data-sharing clause. libgomp/ChangeLog: * testsuite/libgomp.fortran/use_device_addr-5.f90: New test. gcc/omp-low.cc | 22 ++-- .../libgomp.fortran/use_device_addr-5.f90 | 143 +++++++++++++++++++++ 2 files changed, 156 insertions(+), 9 deletions(-) diff --git a/gcc/omp-low.cc b/gcc/omp-low.cc index bf5779b6543..6e387fd9a61 100644 --- a/gcc/omp-low.cc +++ b/gcc/omp-low.cc @@ -13656,26 +13656,30 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) new_var = lookup_decl (var, ctx); new_var = DECL_VALUE_EXPR (new_var); tree v = new_var; + tree v2 = var; + if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_PTR + || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR) + { + v2 = maybe_lookup_decl_in_outer_ctx (var, ctx); + if (DECL_HAS_VALUE_EXPR_P (v2)) + v2 = DECL_VALUE_EXPR (v2); + } if (is_ref) { - var = build_fold_indirect_ref (var); - gimplify_expr (&var, &assign_body, NULL, is_gimple_val, - fb_rvalue); - v = create_tmp_var_raw (TREE_TYPE (var), get_name (var)); + v2 = build_fold_indirect_ref (v2); + v = create_tmp_var_raw (TREE_TYPE (v2), get_name (var)); gimple_add_tmp_var (v); TREE_ADDRESSABLE (v) = 1; - gimple_seq_add_stmt (&assign_body, - gimple_build_assign (v, var)); + gimplify_assign (v, v2, &assign_body); tree rhs = build_fold_addr_expr (v); gimple_seq_add_stmt (&assign_body, gimple_build_assign (new_var, rhs)); } else - gimple_seq_add_stmt (&assign_body, - gimple_build_assign (new_var, var)); + gimplify_assign (new_var, v2, &assign_body); - tree v2 = lang_hooks.decls.omp_array_data (unshare_expr (v), false); + v2 = lang_hooks.decls.omp_array_data (unshare_expr (v), false); gcc_assert (v2); gimplify_expr (&x, &assign_body, NULL, is_gimple_val, fb_rvalue); gimple_seq_add_stmt (&assign_body, diff --git a/libgomp/testsuite/libgomp.fortran/use_device_addr-5.f90 b/libgomp/testsuite/libgomp.fortran/use_device_addr-5.f90 new file mode 100644 index 00000000000..1def70a1bc0 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/use_device_addr-5.f90 @@ -0,0 +1,143 @@ +program main + use omp_lib + implicit none + integer, allocatable :: aaa(:,:,:) + integer :: i + + allocate (aaa(-4:10,-3:8,2)) + aaa(:,:,:) = reshape ([(i, i = 1, size(aaa))], shape(aaa)) + + do i = 0, omp_get_num_devices() + !$omp target data map(to: aaa) + call test_addr (aaa, i) + call test_ptr (aaa, i) + !$omp end target data + end do + deallocate (aaa) + +contains + + subroutine test_addr (aaaa, dev) + use iso_c_binding + integer, target, allocatable :: aaaa(:,:,:), bbbb(:,:,:) + integer, value :: dev + integer :: i + type(c_ptr) :: ptr + logical :: is_shared + + is_shared = .false. + !$omp target device(dev) map(to: is_shared) + is_shared = .true. + !$omp end target + + allocate (bbbb(-4:10,-3:8,2)) + bbbb(:,:,:) = reshape ([(-i, i = 1, size(bbbb))], shape(bbbb)) + !$omp target enter data map(to: bbbb) device(dev) + if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 1 + if (any (shape (aaaa) /= [15, 12, 2])) error stop 2 + if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 3 + if (any (shape (bbbb) /= [15, 12, 2])) error stop 4 + if (any (aaaa /= -bbbb)) error stop 5 + if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) & + error stop 6 + + !$omp parallel do shared(bbbb, aaaa) + do i = 1,1 + if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 5 + if (any (shape (aaaa) /= [15, 12, 2])) error stop 6 + if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 7 + if (any (shape (bbbb) /= [15, 12, 2])) error stop 8 + if (any (aaaa /= -bbbb)) error stop 5 + if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) & + error stop 6 + ptr = c_loc (aaaa) + !$omp target data use_device_addr(bbbb, aaaa) device(dev) + if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 9 + if (any (shape (aaaa) /= [15, 12, 2])) error stop 10 + if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 11 + if (any (shape (bbbb) /= [15, 12, 2])) error stop 12 + if (is_shared) then + if (any (aaaa /= -bbbb)) error stop 5 + if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) & + error stop 6 + end if + if (is_shared .neqv. c_associated (ptr, c_loc (aaaa))) error stop + + !$omp target has_device_addr(bbbb, aaaa) device(dev) + if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 9 + if (any (shape (aaaa) /= [15, 12, 2])) error stop 10 + if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 11 + if (any (shape (bbbb) /= [15, 12, 2])) error stop 12 + if (any (aaaa /= -bbbb)) error stop 5 + if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) & + error stop 6 + !$omp end target + !$omp end target data + end do + !$omp target exit data map(delete: bbbb) device(dev) + deallocate (bbbb) + end subroutine test_addr + + subroutine test_ptr (aaaa, dev) + use iso_c_binding + integer, target, allocatable :: aaaa(:,:,:), bbbb(:,:,:) + integer, value :: dev + integer :: i + type(c_ptr) :: ptr + logical :: is_shared + + is_shared = .false. + !$omp target device(dev) map(to: is_shared) + is_shared = .true. + !$omp end target + + allocate (bbbb(-4:10,-3:8,2)) + bbbb(:,:,:) = reshape ([(-i, i = 1, size(bbbb))], shape(bbbb)) + !$omp target enter data map(to: bbbb) device(dev) + if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 1 + if (any (shape (aaaa) /= [15, 12, 2])) error stop 2 + if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 3 + if (any (shape (bbbb) /= [15, 12, 2])) error stop 4 + if (any (aaaa /= -bbbb)) error stop 5 + if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) & + error stop 6 + + !$omp parallel do shared(bbbb, aaaa) + do i = 1,1 + if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 5 + if (any (shape (aaaa) /= [15, 12, 2])) error stop 6 + if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 7 + if (any (shape (bbbb) /= [15, 12, 2])) error stop 8 + if (any (aaaa /= -bbbb)) error stop 5 + if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) & + error stop 6 + ptr = c_loc (aaaa) + !$omp target data use_device_ptr(bbbb, aaaa) device(dev) + if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 9 + if (any (shape (aaaa) /= [15, 12, 2])) error stop 10 + if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 11 + if (any (shape (bbbb) /= [15, 12, 2])) error stop 12 + if (is_shared) then + if (any (aaaa /= -bbbb)) error stop 5 + if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) & + error stop 6 + end if + if (is_shared .neqv. c_associated (ptr, c_loc (aaaa))) error stop + + ! Uses has_device_addr due to PR fortran/105318 + !!$omp target is_device_ptr(bbbb, aaaa) device(dev) + !$omp target has_device_addr(bbbb, aaaa) device(dev) + if (any (lbound (aaaa) /= [-4, -3, 1])) error stop 9 + if (any (shape (aaaa) /= [15, 12, 2])) error stop 10 + if (any (lbound (bbbb) /= [-4, -3, 1])) error stop 11 + if (any (shape (bbbb) /= [15, 12, 2])) error stop 12 + if (any (aaaa /= -bbbb)) error stop 5 + if (any (aaaa /= reshape ([(i, i = 1, size(aaaa))], shape(aaaa)))) & + error stop 6 + !$omp end target + !$omp end target data + end do + !$omp target exit data map(delete: bbbb) device(dev) + deallocate (bbbb) + end subroutine test_ptr +end program main