From patchwork Fri Sep 11 18:13:54 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 1362642 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=sourceware.org; envelope-from=gcc-patches-bounces@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Received: from sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4Bp3mp1CRWz9sTM for ; Sat, 12 Sep 2020 04:14:17 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 7C1DB3986437; Fri, 11 Sep 2020 18:14:11 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa4.mentor.iphmx.com (esa4.mentor.iphmx.com [68.232.137.252]) by sourceware.org (Postfix) with ESMTPS id 962D1395CC49; Fri, 11 Sep 2020 18:14:07 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 962D1395CC49 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=Tobias_Burnus@mentor.com IronPort-SDR: L68L9kaz6Vr7gug+NLLCy3XU+fs0Ie2GeNbMohk28GZ1JveXDnqALd8INZyCY2fTpjgJ3ERZZw bbDTTepQ6BbPA3R5djrzN0UTX7d7Vhl/GsZLIly9FxgCqNEKUg7rDwu2qIWGTD1oGr9+K2aOAg 5dLTWx8wfLwUwJtm0XswEFViWnp6RnMnsRpeoMefX1bMs68TrF+ojUPY3U4dzYThNJr7I6/d5R RWht/dIbs7KJjUoPk8q9+rVJJSvI2C1cUWfQ16BJCeF+v0OTJd4jxUnknzxm70d3OuQFYi7448 dJQ= X-IronPort-AV: E=Sophos;i="5.76,416,1592899200"; d="diff'?scan'208";a="52941834" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa4.mentor.iphmx.com with ESMTP; 11 Sep 2020 10:14:06 -0800 IronPort-SDR: 2xkrvDxPZR7jVEEZ018vOnAKDueLlmnq5FWt8uqrBYbXHZpr1BU3pQ4F1HEJioh2VWzzACHbEP nSeYl8BwZSkheqf0Hj579OP9GmmvOUkDgdzpu2oOSbagFEEnXG4B+RmPGOwvZcPYf7g8V/owFa bo2nIruwuvyljYsxfVxyeL22HeC/4bcmO9WDaDSm2iatlS286JoUz+Hs8WGQbO1Yx+0ZUwKhsc tASpyu85kpX4HiHKs3a7PJ624ZR1QmzESQZ+TiCBPyMbaGP761hGwqk/P8+YOKqaD+myRjyM6J BAg= From: Tobias Burnus Subject: [Patch] OpenMP/Fortran: Fix (re)mapping of allocatable/pointer arrays [PR96668] To: gcc-patches , fortran , Jakub Jelinek Message-ID: <34d058a5-aa21-2ef9-d644-f95723c54e61@codesourcery.com> Date: Fri, 11 Sep 2020 20:13:54 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:68.0) Gecko/20100101 Thunderbird/68.11.0 MIME-Version: 1.0 Content-Language: en-US X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: SVR-IES-MBX-03.mgc.mentorg.com (139.181.222.3) To svr-ies-mbx-01.mgc.mentorg.com (139.181.222.1) X-Spam-Status: No, score=-12.0 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.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) 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@gcc.gnu.org Sender: "Gcc-patches" This is a first attempt to improve the OpenMP mapping for allocatables and pointers; there are some more issues – cf. PR and for scalars PR 97021. In real world code, a usage like the following is not uncommon: real, allocatable :: A(:,:) !$omp target enter data map(to: A) This maps an unallocated array (a.data == NULL), the array descriptor itself ("a", pointer set) and then pointer associates on the device the mapped data (well, NULL) with the device's "a.data" That works well – and one can now use A on the device and allocate it (and, before, 'end target' deallocate it). However, many programs now do on the host: allocate(A(n,m)) !$omp target do i = ... do j = ... A(j,i) = ... !$omp end target which gets an implicit "map(tofrom:A)". While "a.data" now gets mapped, the "a" is not updated as it is already present and pointer-setting 'a.data' on the device is also not needed as it is already there. As written, such code is rather common and other compilers handle this. The Fortran spec between OpenMP 4.5 and TR 8 is a bit unclear; in TR 9 (not yet available), the code above is only valid with map(always, tofrom: A) (or 'to:') where the 'always' is required. The general notion is that it should be also valid for the case above, but allocatable components of derived types should not always be rechecked/remapped every time map(dt) is used. — Hence, this was deferred and only the 'always' part was clarified in the draft for the upcoming TR 9. Additionally, for POINTER there is already the following wording in the spec, which implies that the pointer has to be (potentially) updated every time: "If a list item in a map clause is an associated pointer and the pointer is not the base pointer of another list item in a map clause on the same construct, then it is treated as if its pointer target is implicitly mapped in the same clause. For the purposes of the map clause, the mapped pointer target is treated as if its base pointer is the associated pointer." OK? Tobias ----------------- Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter OpenMP/Fortran: Fix (re)mapping of allocatable/pointer arrays [PR96668] gcc/fortran/ChangeLog: PR fortran/96668 * trans-openmp.c (gfc_omp_finish_clause): Use GOMP_MAP_ALWAYS_POINTER with PSET for pointers. (gfc_trans_omp_clauses): Likewise and also if the always modifier is used. gcc/ChangeLog: PR fortran/96668 * gimplify.c (gimplify_scan_omp_clauses): Handle GOMP_MAP_ALWAYS_POINTER like GOMP_MAP_POINTER for target exit data. include/ChangeLog: PR fortran/96668 * gomp-constants.h (GOMP_MAP_ALWAYS_POINTER_P): New define. libgomp/ChangeLog: PR fortran/96668 * libgomp.h (struct target_var_desc): Add has_null_ptr_assoc member. * target.c (gomp_map_vars_existing): Add always_to_flag flag. (gomp_map_vars_existing): Update call to it. (gomp_map_fields_existing): Likewise (gomp_map_vars_internal): Update PSET handling such that if a nullptr is now allocated or if GOMP_MAP_POINTER is used PSET is updated and pointer remapped. (GOMP_target_enter_exit_data): Hanlde GOMP_MAP_ALWAYS_POINTER like GOMP_MAP_POINTER. * testsuite/libgomp.fortran/map-alloc-ptr-1.f90: New test. gcc/fortran/trans-openmp.c | 28 +++- gcc/gimplify.c | 1 + include/gomp-constants.h | 3 + libgomp/libgomp.h | 3 + libgomp/target.c | 173 ++++++++++++++++----- .../testsuite/libgomp.fortran/map-alloc-ptr-1.f90 | 114 ++++++++++++++ 6 files changed, 282 insertions(+), 40 deletions(-) diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 0e1da04..268467d 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -1357,6 +1357,15 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p) tree type = TREE_TYPE (decl); tree ptr = gfc_conv_descriptor_data_get (decl); + /* OpenMP: automatically map pointer targets with the pointer; + hence, always update the descriptor/pointer itself. + NOTE: This also remaps the pointer for allocatable arrays with + 'target' attribute which also don't have the 'restrict' qualifier. */ + bool always_modifier = false; + + if (flag_openmp && !(TYPE_QUALS (TREE_TYPE (ptr)) & TYPE_QUAL_RESTRICT)) + always_modifier = true; + if (present) ptr = gfc_build_cond_assign_expr (&block, present, ptr, null_pointer_node); @@ -1376,7 +1385,8 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p) OMP_CLAUSE_DECL (c2) = decl; OMP_CLAUSE_SIZE (c2) = TYPE_SIZE_UNIT (type); c3 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP); - OMP_CLAUSE_SET_MAP_KIND (c3, GOMP_MAP_POINTER); + OMP_CLAUSE_SET_MAP_KIND (c3, always_modifier ? GOMP_MAP_ALWAYS_POINTER + : GOMP_MAP_POINTER); if (present) { ptr = gfc_conv_descriptor_data_get (decl); @@ -2549,11 +2559,19 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if (!n->sym->attr.referenced) continue; + bool always_modifier = false; tree node = build_omp_clause (input_location, OMP_CLAUSE_MAP); tree node2 = NULL_TREE; tree node3 = NULL_TREE; tree node4 = NULL_TREE; + /* OpenMP: automatically map pointer targets with the pointer; + hence, always update the descriptor/pointer itself. */ + if (!openacc + && ((n->expr == NULL && n->sym->attr.pointer) + || (n->expr && gfc_expr_attr (n->expr).pointer))) + always_modifier = true; + switch (n->u.map_op) { case OMP_MAP_ALLOC: @@ -2575,12 +2593,15 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_TOFROM); break; case OMP_MAP_ALWAYS_TO: + always_modifier = true; OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_TO); break; case OMP_MAP_ALWAYS_FROM: + always_modifier = true; OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_FROM); break; case OMP_MAP_ALWAYS_TOFROM: + always_modifier = true; OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_TOFROM); break; case OMP_MAP_RELEASE: @@ -2760,7 +2781,10 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, goto finalize_map_clause; } else - OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_POINTER); + OMP_CLAUSE_SET_MAP_KIND (node3, + always_modifier + ? GOMP_MAP_ALWAYS_POINTER + : GOMP_MAP_POINTER); /* We have to check for n->sym->attr.dimension because of scalar coarrays. */ diff --git a/gcc/gimplify.c b/gcc/gimplify.c index 23d0e25..108525c 100644 --- a/gcc/gimplify.c +++ b/gcc/gimplify.c @@ -8803,6 +8803,7 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p, ? GOMP_MAP_DELETE : GOMP_MAP_RELEASE); else if ((code == OMP_TARGET_EXIT_DATA || code == OMP_TARGET_UPDATE) && (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_POINTER + || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_ALWAYS_POINTER || OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_TO_PSET)) remove = true; diff --git a/include/gomp-constants.h b/include/gomp-constants.h index 16f2d13..309cbca 100644 --- a/include/gomp-constants.h +++ b/include/gomp-constants.h @@ -171,6 +171,9 @@ enum gomp_map_kind (!((X) & GOMP_MAP_FLAG_SPECIAL) \ && ((X) & GOMP_MAP_FLAG_FROM)) +#define GOMP_MAP_ALWAYS_POINTER_P(X) \ + ((X) == GOMP_MAP_ALWAYS_POINTER) + #define GOMP_MAP_POINTER_P(X) \ ((X) == GOMP_MAP_POINTER) diff --git a/libgomp/libgomp.h b/libgomp/libgomp.h index f9080e9..87f939a 100644 --- a/libgomp/libgomp.h +++ b/libgomp/libgomp.h @@ -954,6 +954,9 @@ struct target_var_desc { bool always_copy_from; /* True if this is for OpenACC 'attach'. */ bool is_attach; + /* If GOMP_MAP_TO_PSET had a NULL pointer; used for Fortran descriptors, + which were initially unallocated. */ + bool has_null_ptr_assoc; /* Relative offset against key host_start. */ uintptr_t offset; /* Actual length. */ diff --git a/libgomp/target.c b/libgomp/target.c index 3e292eb..faef15b 100644 --- a/libgomp/target.c +++ b/libgomp/target.c @@ -1,3 +1,4 @@ +#pragma GCC optimize("O0") /* Copyright (C) 2013-2020 Free Software Foundation, Inc. Contributed by Jakub Jelinek . @@ -355,7 +356,8 @@ static inline void gomp_map_vars_existing (struct gomp_device_descr *devicep, struct goacc_asyncqueue *aq, splay_tree_key oldn, splay_tree_key newn, struct target_var_desc *tgt_var, - unsigned char kind, struct gomp_coalesce_buf *cbuf) + unsigned char kind, bool always_to_flag, + struct gomp_coalesce_buf *cbuf) { assert (kind != GOMP_MAP_ATTACH); @@ -377,7 +379,7 @@ gomp_map_vars_existing (struct gomp_device_descr *devicep, (void *) oldn->host_start, (void *) oldn->host_end); } - if (GOMP_MAP_ALWAYS_TO_P (kind)) + if (GOMP_MAP_ALWAYS_TO_P (kind) || always_to_flag) gomp_copy_host2dev (devicep, aq, (void *) (oldn->tgt->tgt_start + oldn->tgt_offset + newn->host_start - oldn->host_start), @@ -456,8 +458,8 @@ gomp_map_fields_existing (struct target_mem_desc *tgt, && n2->tgt == n->tgt && n2->host_start - n->host_start == n2->tgt_offset - n->tgt_offset) { - gomp_map_vars_existing (devicep, aq, n2, &cur_node, - &tgt->list[i], kind & typemask, cbuf); + gomp_map_vars_existing (devicep, aq, n2, &cur_node, &tgt->list[i], + kind & typemask, false, cbuf); return; } if (sizes[i] == 0) @@ -472,8 +474,8 @@ gomp_map_fields_existing (struct target_mem_desc *tgt, && n2->host_start - n->host_start == n2->tgt_offset - n->tgt_offset) { - gomp_map_vars_existing (devicep, aq, n2, &cur_node, - &tgt->list[i], kind & typemask, cbuf); + gomp_map_vars_existing (devicep, aq, n2, &cur_node, &tgt->list[i], + kind & typemask,false, cbuf); return; } } @@ -485,7 +487,7 @@ gomp_map_fields_existing (struct target_mem_desc *tgt, && n2->host_start - n->host_start == n2->tgt_offset - n->tgt_offset) { gomp_map_vars_existing (devicep, aq, n2, &cur_node, &tgt->list[i], - kind & typemask, cbuf); + kind & typemask, false, cbuf); return; } } @@ -661,6 +663,7 @@ gomp_map_vars_internal (struct gomp_device_descr *devicep, { size_t i, tgt_align, tgt_size, not_found_cnt = 0; bool has_firstprivate = false; + bool has_always_ptrset = false; const int rshift = short_mapkind ? 8 : 3; const int typemask = short_mapkind ? 0xff : 0x7; struct splay_tree_s *mem_map = &devicep->mem_map; @@ -848,8 +851,46 @@ gomp_map_vars_internal (struct gomp_device_descr *devicep, else n = splay_tree_lookup (mem_map, &cur_node); if (n && n->refcount != REFCOUNT_LINK) - gomp_map_vars_existing (devicep, aq, n, &cur_node, &tgt->list[i], - kind & typemask, NULL); + { + int always_to_cnt = 0; + if ((kind & typemask) == GOMP_MAP_TO_PSET) + { + bool has_nullptr; + size_t j; + for (j = 0; j < n->tgt->list_count; j++) + if (n->tgt->list[j].key == n) + { + has_nullptr = n->tgt->list[j].has_null_ptr_assoc; + break; + } + assert (j < n->tgt->list_count); + /* Re-map the data if there is an 'always' modifier or if it a + null pointer was there and non a nonnull has been found; that + permits transparent re-mapping for Fortran array descriptors + which were previously mapped unallocated. */ + for (j = i + 1; j < mapnum; j++) + { + int ptr_kind = get_kind (short_mapkind, kinds, j) & typemask; + if (!GOMP_MAP_ALWAYS_POINTER_P (ptr_kind) + && (!has_nullptr + || !GOMP_MAP_POINTER_P (ptr_kind) + || *(void **) hostaddrs[j] == NULL)) + break; + else if ((uintptr_t) hostaddrs[j] < cur_node.host_start + || ((uintptr_t) hostaddrs[j] + sizeof (void *) + > cur_node.host_end)) + break; + else + { + has_always_ptrset = true; + ++always_to_cnt; + } + } + } + gomp_map_vars_existing (devicep, aq, n, &cur_node, &tgt->list[i], + kind & typemask, always_to_cnt > 0, NULL); + i += always_to_cnt; + } else { tgt->list[i].key = NULL; @@ -881,9 +922,11 @@ gomp_map_vars_internal (struct gomp_device_descr *devicep, if ((kind & typemask) == GOMP_MAP_TO_PSET) { size_t j; + int kind; for (j = i + 1; j < mapnum; j++) - if (!GOMP_MAP_POINTER_P (get_kind (short_mapkind, kinds, j) - & typemask)) + if (!GOMP_MAP_POINTER_P ((kind = (get_kind (short_mapkind, + kinds, j)) & typemask)) + && !GOMP_MAP_ALWAYS_POINTER_P (kind)) break; else if ((uintptr_t) hostaddrs[j] < cur_node.host_start || ((uintptr_t) hostaddrs[j] + sizeof (void *) @@ -951,7 +994,7 @@ gomp_map_vars_internal (struct gomp_device_descr *devicep, tgt_size = mapnum * sizeof (void *); tgt->array = NULL; - if (not_found_cnt || has_firstprivate) + if (not_found_cnt || has_firstprivate || has_always_ptrset) { if (not_found_cnt) tgt->array = gomp_malloc (not_found_cnt * sizeof (*tgt->array)); @@ -960,7 +1003,55 @@ gomp_map_vars_internal (struct gomp_device_descr *devicep, uintptr_t field_tgt_base = 0; for (i = 0; i < mapnum; i++) - if (tgt->list[i].key == NULL) + if (has_always_ptrset + && tgt->list[i].key + && (get_kind (short_mapkind, kinds, i) & typemask) + == GOMP_MAP_TO_PSET) + { + splay_tree_key k = tgt->list[i].key; + bool has_nullptr; + size_t j; + for (j = 0; j < k->tgt->list_count; j++) + if (k->tgt->list[j].key == k) + { + has_nullptr = k->tgt->list[j].has_null_ptr_assoc; + break; + } + assert (j < k->tgt->list_count); + + tgt->list[i].has_null_ptr_assoc = false; + for (j = i + 1; j < mapnum; j++) + { + int ptr_kind = get_kind (short_mapkind, kinds, j) & typemask; + if (!GOMP_MAP_ALWAYS_POINTER_P (ptr_kind) + && (!has_nullptr + || !GOMP_MAP_POINTER_P (ptr_kind) + || *(void **) hostaddrs[j] == NULL)) + break; + else if ((uintptr_t) hostaddrs[j] < k->host_start + || ((uintptr_t) hostaddrs[j] + sizeof (void *) + > k->host_end)) + break; + else + { + if (*(void **) hostaddrs[j] == NULL) + tgt->list[i].has_null_ptr_assoc = true; + tgt->list[j].key = k; + tgt->list[j].copy_from = false; + tgt->list[j].always_copy_from = false; + tgt->list[j].is_attach = false; + if (k->refcount != REFCOUNT_INFINITY) + k->refcount++; + gomp_map_pointer (k->tgt, aq, + (uintptr_t) *(void **) hostaddrs[j], + k->tgt_offset + ((uintptr_t) hostaddrs[j] + - k->host_start), + sizes[j], cbufp); + } + } + i = j - 1; + } + else if (tgt->list[i].key == NULL) { int kind = get_kind (short_mapkind, kinds, i); if (hostaddrs[i] == NULL) @@ -1120,7 +1211,7 @@ gomp_map_vars_internal (struct gomp_device_descr *devicep, splay_tree_key n = splay_tree_lookup (mem_map, k); if (n && n->refcount != REFCOUNT_LINK) gomp_map_vars_existing (devicep, aq, n, k, &tgt->list[i], - kind & typemask, cbufp); + kind & typemask, false, cbufp); else { k->aux = NULL; @@ -1192,32 +1283,37 @@ gomp_map_vars_internal (struct gomp_device_descr *devicep, + k->tgt_offset), (void *) k->host_start, k->host_end - k->host_start, cbufp); + tgt->list[i].has_null_ptr_assoc = false; for (j = i + 1; j < mapnum; j++) - if (!GOMP_MAP_POINTER_P (get_kind (short_mapkind, kinds, - j) - & typemask)) - break; - else if ((uintptr_t) hostaddrs[j] < k->host_start - || ((uintptr_t) hostaddrs[j] + sizeof (void *) - > k->host_end)) - break; - else - { - tgt->list[j].key = k; - tgt->list[j].copy_from = false; - tgt->list[j].always_copy_from = false; - tgt->list[j].is_attach = false; - if (k->refcount != REFCOUNT_INFINITY) - k->refcount++; - gomp_map_pointer (tgt, aq, - (uintptr_t) *(void **) hostaddrs[j], - k->tgt_offset - + ((uintptr_t) hostaddrs[j] - - k->host_start), - sizes[j], cbufp); - i++; + { + int ptr_kind = (get_kind (short_mapkind, kinds, j) + & typemask); + if (!GOMP_MAP_POINTER_P (ptr_kind) + && !GOMP_MAP_ALWAYS_POINTER_P (ptr_kind)) + break; + else if ((uintptr_t) hostaddrs[j] < k->host_start + || ((uintptr_t) hostaddrs[j] + sizeof (void *) + > k->host_end)) + break; + else + { + tgt->list[j].key = k; + tgt->list[j].copy_from = false; + tgt->list[j].always_copy_from = false; + tgt->list[j].is_attach = false; + tgt->list[i].has_null_ptr_assoc |= !(*(void **) hostaddrs[j]); + if (k->refcount != REFCOUNT_INFINITY) + k->refcount++; + gomp_map_pointer (tgt, aq, + (uintptr_t) *(void **) hostaddrs[j], + k->tgt_offset + + ((uintptr_t) hostaddrs[j] + - k->host_start), + sizes[j], cbufp); + } } + i = j - 1; break; case GOMP_MAP_FORCE_PRESENT: { @@ -2481,7 +2577,8 @@ GOMP_target_enter_exit_data (int device, size_t mapnum, void **hostaddrs, else if ((kinds[i] & 0xff) == GOMP_MAP_TO_PSET) { for (j = i + 1; j < mapnum; j++) - if (!GOMP_MAP_POINTER_P (get_kind (true, kinds, j) & 0xff)) + if (!GOMP_MAP_POINTER_P (get_kind (true, kinds, j) & 0xff) + && !GOMP_MAP_ALWAYS_POINTER_P (get_kind (true, kinds, j) & 0xff)) break; gomp_map_vars (devicep, j-i, &hostaddrs[i], NULL, &sizes[i], &kinds[i], true, GOMP_MAP_VARS_ENTER_DATA); diff --git a/libgomp/testsuite/libgomp.fortran/map-alloc-ptr-1.f90 b/libgomp/testsuite/libgomp.fortran/map-alloc-ptr-1.f90 new file mode 100644 index 0000000..a1ff1d6 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/map-alloc-ptr-1.f90 @@ -0,0 +1,114 @@ +! { dg-do run } +! +! PR fortran/96668 + +implicit none + integer, pointer :: p1(:), p2(:), p3(:) + integer, allocatable :: a1(:), a2(:) + p1 => null() + p3 => null() + + !$omp target enter data map(to:p3) + + !$omp target data map(a1, a2, p1) + !$omp target + if (allocated (a1)) stop 1 + if (allocated (a2)) stop 1 + if (associated (p1)) stop 1 + if (associated (p3)) stop 1 + !$omp end target + + allocate (a1, source=[10,11,12,13,14]) + allocate (a2, source=[10,11,12,13,14]) + allocate (p1, source=[9,8,7,6,5,4]) + allocate (p3, source=[4,5,6]) + p2 => p1 + + !$omp target enter data map(to:p3) + + ! allocatable, TR9 requires 'always' modifier: + !$omp target map(always, tofrom: a1) + if (.not. allocated(a1)) stop 2 + if (size(a1) /= 5) stop 3 + if (any (a1 /= [10,11,12,13,14])) stop 5 + a1(:) = [101, 102, 103, 104, 105] + !$omp end target + + ! allocatable, extension (OpenMP 6.0?): without 'always' + !$omp target + if (.not. allocated(a2)) stop 2 + if (size(a2) /= 5) stop 3 + if (any (a2 /= [10,11,12,13,14])) stop 5 + a2(:) = [101, 102, 103, 104, 105] + !$omp end target + + ! pointer: target is automatically mapped + ! without requiring an explicit mapping or even the always modifier + !$omp target !! map(always, tofrom: p1) + if (.not. associated(p1)) stop 7 + if (size(p1) /= 6) stop 8 + if (any (p1 /= [9,8,7,6,5,4])) stop 10 + p1(:) = [-1, -2, -3, -4, -5, -6] + !$omp end target + + !$omp target !! map(always, tofrom: p3) + if (.not. associated(p3)) stop 7 + if (size(p3) /= 3) stop 8 + if (any (p3 /= [4,5,6])) stop 10 + p3(:) = [23,24,25] + !$omp end target + + if (any (p1 /= [-1, -2, -3, -4, -5, -6])) stop 141 + + !$omp target exit data map(from:p3) + !$omp target exit data map(from:p3) + if (any (p3 /= [23,24,25])) stop 141 + + allocate (p1, source=[99,88,77,66,55,44,33]) + + !$omp target ! And this also should work + if (.not. associated(p1)) stop 7 + if (size(p1) /= 7) stop 8 + if (any (p1 /= [99,88,77,66,55,44,33])) stop 10 + p1(:) = [-11, -22, -33, -44, -55, -66, -77] + !$omp end target + !$omp end target data + + if (any (a1 /= [101, 102, 103, 104, 105])) stop 12 + if (any (a2 /= [101, 102, 103, 104, 105])) stop 12 + + if (any (p1 /= [-11, -22, -33, -44, -55, -66, -77])) stop 142 + if (any (p2 /= [-1, -2, -3, -4, -5, -6])) stop 143 + + + block + integer, pointer :: tmp(:), tmp2(:), tmp3(:) + tmp => p1 + tmp2 => p2 + tmp3 => p3 + !$omp target enter data map(to:p3) + + !$omp target data map(to: p1, p2) + p1 => null () + p2 => null () + p3 => null () + !$omp target map(always, tofrom: p1) + if (associated (p1)) stop 22 + !$omp end target + if (associated (p1)) stop 22 + + !$omp target + if (associated (p2)) stop 22 + !$omp end target + if (associated (p2)) stop 22 + + !$omp target + if (associated (p3)) stop 22 + !$omp end target + if (associated (p3)) stop 22 + !$omp end target data + !$omp target exit data map(from:p3) + deallocate(tmp, tmp2, tmp3) + end block + deallocate(a1, a2) +end