From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1729) id 95C373851C13; Wed, 29 Jun 2022 14:46:46 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 95C373851C13 Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit From: Kwok Yeung To: gcc-cvs@gcc.gnu.org Subject: [gcc/devel/omp/gcc-12] OpenMP: Handle descriptors in target's firstprivate [PR104949] X-Act-Checkin: gcc X-Git-Author: Tobias Burnus X-Git-Refname: refs/heads/devel/omp/gcc-12 X-Git-Oldrev: 213577701d178daf01480859a27303b680122b91 X-Git-Newrev: 2bdbbdb63eb5dd7b27a60311154e1cd6e3702659 Message-Id: <20220629144646.95C373851C13@sourceware.org> Date: Wed, 29 Jun 2022 14:46:46 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Wed, 29 Jun 2022 14:46:46 -0000 https://gcc.gnu.org/g:2bdbbdb63eb5dd7b27a60311154e1cd6e3702659 commit 2bdbbdb63eb5dd7b27a60311154e1cd6e3702659 Author: Tobias Burnus Date: Mon May 23 10:54:32 2022 +0200 OpenMP: Handle descriptors in target's firstprivate [PR104949] For allocatable/pointer arrays, a firstprivate to a device not only needs to privatize the descriptor but also the actual data. This is implemented as: firstprivate(x) firstprivate(x.data) attach(x [bias: &x.data-&x) where the address of x in device memory is saved in hostaddrs[i] by libgomp and the middle end actually passes hostaddrs[i]' to attach. As side effect, has_device_addr(array_desc) had to be changed: before, it was converted to firstprivate in the front end; now it is handled in omp-low.cc as has_device_addr requires a shallow firstprivate (not touching the data pointer) while the normal firstprivate requires (now) a deep firstprivate. gcc/fortran/ChangeLog: PR fortran/104949 * f95-lang.cc (LANG_HOOKS_OMP_ARRAY_SIZE): Redefine. * trans-openmp.cc (gfc_omp_array_size): New. (gfc_trans_omp_variable_list): Never turn has_device_addr to firstprivate. * trans.h (gfc_omp_array_size): New. gcc/ChangeLog: PR fortran/104949 * langhooks-def.h (lhd_omp_array_size): New. (LANG_HOOKS_OMP_ARRAY_SIZE): Define. (LANG_HOOKS_DECLS): Add it. * langhooks.cc (lhd_omp_array_size): New. * langhooks.h (struct lang_hooks_for_decls): Add hook. * omp-low.cc (scan_sharing_clauses, lower_omp_target): Handle GOMP_MAP_FIRSTPRIVATE for array descriptors. libgomp/ChangeLog: PR fortran/104949 * target.c (gomp_map_vars_internal, copy_firstprivate_data): Support attach for GOMP_MAP_FIRSTPRIVATE. * testsuite/libgomp.fortran/target-firstprivate-1.f90: New test. * testsuite/libgomp.fortran/target-firstprivate-2.f90: New test. * testsuite/libgomp.fortran/target-firstprivate-3.f90: New test. (cherry picked from commit 49d1a2f91325fa8cc011149e27e5093a988b3a49) Diff: --- gcc/ChangeLog.omp | 13 +++ gcc/fortran/ChangeLog.omp | 12 +++ gcc/fortran/f95-lang.cc | 2 + gcc/fortran/trans-openmp.cc | 53 ++++++++-- gcc/fortran/trans.h | 1 + gcc/langhooks-def.h | 3 + gcc/langhooks.cc | 8 ++ gcc/langhooks.h | 5 + gcc/omp-low.cc | 102 ++++++++++++++++++- libgomp/ChangeLog.omp | 12 +++ libgomp/target.c | 22 ++++ .../libgomp.fortran/target-firstprivate-1.f90 | 33 ++++++ .../libgomp.fortran/target-firstprivate-2.f90 | 113 +++++++++++++++++++++ .../libgomp.fortran/target-firstprivate-3.f90 | 24 +++++ 14 files changed, 392 insertions(+), 11 deletions(-) diff --git a/gcc/ChangeLog.omp b/gcc/ChangeLog.omp index 4d0adc49825..fc0554be6bf 100644 --- a/gcc/ChangeLog.omp +++ b/gcc/ChangeLog.omp @@ -1,3 +1,16 @@ +2022-05-23 Tobias Burnus + + Backport from mainline: + 2022-05-23 Tobias Burnus + + * langhooks-def.h (lhd_omp_array_size): New. + (LANG_HOOKS_OMP_ARRAY_SIZE): Define. + (LANG_HOOKS_DECLS): Add it. + * langhooks.cc (lhd_omp_array_size): New. + * langhooks.h (struct lang_hooks_for_decls): Add hook. + * omp-low.cc (scan_sharing_clauses, lower_omp_target): + Handle GOMP_MAP_FIRSTPRIVATE for array descriptors. + 2022-05-09 Kwok Cheung Yeung Backport from master: diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp index 9d5d2547767..c14aebb6fff 100644 --- a/gcc/fortran/ChangeLog.omp +++ b/gcc/fortran/ChangeLog.omp @@ -1,3 +1,15 @@ +2022-05-23 Tobias Burnus + + Backport from mainline: + 2022-05-23 Tobias Burnus + + PR fortran/104949 + * f95-lang.cc (LANG_HOOKS_OMP_ARRAY_SIZE): Redefine. + * trans-openmp.cc (gfc_omp_array_size): New. + (gfc_trans_omp_variable_list): Never turn has_device_addr + to firstprivate. + * trans.h (gfc_omp_array_size): New. + 2022-05-12 Tobias Burnus * trans-array.cc (gfc_scalar_elemental_arg_saved_as_reference): diff --git a/gcc/fortran/f95-lang.cc b/gcc/fortran/f95-lang.cc index 3db062e270d..d380d3ed151 100644 --- a/gcc/fortran/f95-lang.cc +++ b/gcc/fortran/f95-lang.cc @@ -114,6 +114,7 @@ static const struct attribute_spec gfc_attribute_table[] = #undef LANG_HOOKS_TYPE_FOR_SIZE #undef LANG_HOOKS_INIT_TS #undef LANG_HOOKS_OMP_ARRAY_DATA +#undef LANG_HOOKS_OMP_ARRAY_SIZE #undef LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR #undef LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT #undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE @@ -155,6 +156,7 @@ static const struct attribute_spec gfc_attribute_table[] = #define LANG_HOOKS_TYPE_FOR_SIZE gfc_type_for_size #define LANG_HOOKS_INIT_TS gfc_init_ts #define LANG_HOOKS_OMP_ARRAY_DATA gfc_omp_array_data +#define LANG_HOOKS_OMP_ARRAY_SIZE gfc_omp_array_size #define LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR gfc_omp_is_allocatable_or_ptr #define LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT gfc_omp_check_optional_argument #define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE gfc_omp_privatize_by_reference diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index ef9888354a3..28485172f93 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -182,6 +182,48 @@ gfc_omp_array_data (tree decl, bool type_only) return decl; } +/* Return the byte-size of the passed array descriptor. */ + +tree +gfc_omp_array_size (tree decl, gimple_seq *pre_p) +{ + stmtblock_t block; + if (POINTER_TYPE_P (TREE_TYPE (decl))) + decl = build_fold_indirect_ref (decl); + tree type = TREE_TYPE (decl); + gcc_assert (GFC_DESCRIPTOR_TYPE_P (type)); + bool allocatable = (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE + || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER + || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT); + gfc_init_block (&block); + tree size = gfc_full_array_size (&block, decl, + GFC_TYPE_ARRAY_RANK (TREE_TYPE (decl))); + size = fold_convert (size_type_node, size); + tree elemsz = gfc_get_element_type (TREE_TYPE (decl)); + if (TREE_CODE (elemsz) == ARRAY_TYPE && TYPE_STRING_FLAG (elemsz)) + elemsz = gfc_conv_descriptor_elem_len (decl); + else + elemsz = TYPE_SIZE_UNIT (elemsz); + size = fold_build2 (MULT_EXPR, size_type_node, size, elemsz); + if (!allocatable) + gimplify_and_add (gfc_finish_block (&block), pre_p); + else + { + tree var = create_tmp_var (size_type_node); + gfc_add_expr_to_block (&block, build2 (MODIFY_EXPR, sizetype, var, size)); + tree tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, + gfc_conv_descriptor_data_get (decl), + null_pointer_node); + tmp = build3_loc (input_location, COND_EXPR, void_type_node, tmp, + gfc_finish_block (&block), + build2 (MODIFY_EXPR, sizetype, var, size_zero_node)); + gimplify_and_add (tmp, pre_p); + size = var; + } + return size; +} + + /* True if OpenMP should privatize what this DECL points to rather than the DECL itself. */ @@ -3276,16 +3318,7 @@ gfc_trans_omp_variable_list (enum omp_clause_code code, if (t != error_mark_node) { tree node; - /* For HAS_DEVICE_ADDR of an array descriptor, firstprivatize the - descriptor such that the bounds are available; its data component - is unmodified; it is handled as device address inside target. */ - if (code == OMP_CLAUSE_HAS_DEVICE_ADDR - && (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (t)) - || (POINTER_TYPE_P (TREE_TYPE (t)) - && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (t)))))) - node = build_omp_clause (input_location, OMP_CLAUSE_FIRSTPRIVATE); - else - node = build_omp_clause (input_location, code); + node = build_omp_clause (input_location, code); OMP_CLAUSE_DECL (node) = t; list = gfc_trans_add_clause (node, list); diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 30adedd91ac..2833459b07c 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -809,6 +809,7 @@ bool gfc_get_array_descr_info (const_tree, struct array_descr_info *); bool gfc_omp_is_allocatable_or_ptr (const_tree); tree gfc_omp_check_optional_argument (tree, bool); tree gfc_omp_array_data (tree, bool); +tree gfc_omp_array_size (tree, gimple_seq *); bool gfc_omp_privatize_by_reference (const_tree); enum omp_clause_default_kind gfc_omp_predetermined_sharing (tree); enum omp_clause_defaultmap_kind gfc_omp_predetermined_mapping (tree); diff --git a/gcc/langhooks-def.h b/gcc/langhooks-def.h index c8d6a8d44b6..a8ef426c26d 100644 --- a/gcc/langhooks-def.h +++ b/gcc/langhooks-def.h @@ -88,6 +88,7 @@ extern bool lhd_omp_deep_mapping_p (const gimple *, tree); extern tree lhd_omp_deep_mapping_cnt (const gimple *, tree, gimple_seq *); extern void lhd_omp_deep_mapping (const gimple *, tree, unsigned HOST_WIDE_INT, tree, tree, tree, tree, tree, gimple_seq *); +extern tree lhd_omp_array_size (tree, gimple_seq *); struct gimplify_omp_ctx; extern void lhd_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *, tree); @@ -261,6 +262,7 @@ extern tree lhd_unit_size_without_reusable_padding (tree); #define LANG_HOOKS_POST_COMPILATION_PARSING_CLEANUPS NULL #define LANG_HOOKS_DECL_OK_FOR_SIBCALL lhd_decl_ok_for_sibcall #define LANG_HOOKS_OMP_ARRAY_DATA hook_tree_tree_bool_null +#define LANG_HOOKS_OMP_ARRAY_SIZE lhd_omp_array_size #define LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR hook_bool_const_tree_false #define LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT hook_tree_tree_bool_null #define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE hook_bool_const_tree_false @@ -297,6 +299,7 @@ extern tree lhd_unit_size_without_reusable_padding (tree); LANG_HOOKS_POST_COMPILATION_PARSING_CLEANUPS, \ LANG_HOOKS_DECL_OK_FOR_SIBCALL, \ LANG_HOOKS_OMP_ARRAY_DATA, \ + LANG_HOOKS_OMP_ARRAY_SIZE, \ LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR, \ LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT, \ LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE, \ diff --git a/gcc/langhooks.cc b/gcc/langhooks.cc index 38fc32bfacc..fc1f6216cfe 100644 --- a/gcc/langhooks.cc +++ b/gcc/langhooks.cc @@ -658,6 +658,14 @@ lhd_omp_deep_mapping (const gimple *, tree, unsigned HOST_WIDE_INT, tree, tree, { } +/* Return array size; cf. omp_array_data. */ + +tree +lhd_omp_array_size (tree, gimple_seq *) +{ + return NULL_TREE; +} + /* Return true if DECL is a scalar variable (for the purpose of implicit firstprivatization & mapping). Only if alloc_ptr_ok are allocatables and pointers accepted. */ diff --git a/gcc/langhooks.h b/gcc/langhooks.h index bbcdda8cde2..1c6380dc4cf 100644 --- a/gcc/langhooks.h +++ b/gcc/langhooks.h @@ -246,6 +246,11 @@ struct lang_hooks_for_decls is true, only the TREE_TYPE is returned without generating a new tree. */ tree (*omp_array_data) (tree, bool); + /* Return a tree for the actual data of an array descriptor - or NULL_TREE + if original tree is not an array descriptor. If the second argument + is true, only the TREE_TYPE is returned without generating a new tree. */ + tree (*omp_array_size) (tree, gimple_seq *pre_p); + /* True if OpenMP should regard this DECL as being a scalar which has Fortran's allocatable or pointer attribute. */ bool (*omp_is_allocatable_or_ptr) (const_tree); diff --git a/gcc/omp-low.cc b/gcc/omp-low.cc index 8e4adad3156..590ad749e4a 100644 --- a/gcc/omp-low.cc +++ b/gcc/omp-low.cc @@ -1618,7 +1618,9 @@ scan_sharing_clauses (tree clauses, omp_context *ctx, || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_HAS_DEVICE_ADDR) && is_gimple_omp_offloaded (ctx->stmt)) { - if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FIRSTPRIVATE) + if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FIRSTPRIVATE + || (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_HAS_DEVICE_ADDR + && lang_hooks.decls.omp_array_data (decl, true))) { /* OpenACC firstprivate clauses are later processed with same code path as map clauses in lower_omp_target, so follow @@ -1675,6 +1677,15 @@ scan_sharing_clauses (tree clauses, omp_context *ctx, install_var_field (decl, by_ref, 3, ctx); } install_var_local (decl, ctx); + /* For descr arrays on target: firstprivatize data + attach ptr. */ + if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FIRSTPRIVATE + && is_gimple_omp_offloaded (ctx->stmt) + && !is_gimple_omp_oacc (ctx->stmt) + && lang_hooks.decls.omp_array_data (decl, true)) + { + install_var_field (decl, false, 16 | 3, ctx); + install_var_field (decl, true, 8 | 3, ctx); + } break; case OMP_CLAUSE_USE_DEVICE_PTR: @@ -13738,6 +13749,7 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) break; case OMP_CLAUSE_FIRSTPRIVATE: + omp_firstprivate_recv: gcc_checking_assert (offloaded); if (is_gimple_omp_oacc (ctx->stmt)) { @@ -13767,6 +13779,10 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) SET_DECL_VALUE_EXPR (new_var, x); DECL_HAS_VALUE_EXPR_P (new_var) = 1; } + /* Fortran array descriptors: firstprivate of data + attach. */ + if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_HAS_DEVICE_ADDR + && lang_hooks.decls.omp_array_data (var, true)) + map_cnt += 2; break; case OMP_CLAUSE_PRIVATE: @@ -13804,6 +13820,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) while (TREE_CODE (var) == INDIRECT_REF || TREE_CODE (var) == ARRAY_REF) var = TREE_OPERAND (var, 0); + if (lang_hooks.decls.omp_array_data (var, true)) + goto omp_firstprivate_recv; } map_cnt++; if (is_variable_sized (var)) @@ -14359,6 +14377,7 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) break; case OMP_CLAUSE_FIRSTPRIVATE: + omp_has_device_addr_descr: if (is_gimple_omp_oacc (ctx->stmt)) goto oacc_firstprivate_map; ovar = OMP_CLAUSE_DECL (c); @@ -14424,6 +14443,82 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) <= tree_to_uhwi (TYPE_MAX_VALUE (tkind_type))); CONSTRUCTOR_APPEND_ELT (vkind, purpose, build_int_cstu (tkind_type, tkind)); + /* Fortran array descriptors: firstprivate of data + attach. */ + if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_HAS_DEVICE_ADDR + && lang_hooks.decls.omp_array_data (ovar, true)) + { + tree not_null_lb, null_lb, after_lb; + tree var1, var2, size1, size2; + tree present = omp_check_optional_argument (ovar, true); + if (present) + { + location_t clause_loc = OMP_CLAUSE_LOCATION (c); + not_null_lb = create_artificial_label (clause_loc); + null_lb = create_artificial_label (clause_loc); + after_lb = create_artificial_label (clause_loc); + gimple_seq seq = NULL; + present = force_gimple_operand (present, &seq, true, + NULL_TREE); + gimple_seq_add_seq (&ilist, seq); + gimple_seq_add_stmt (&ilist, + gimple_build_cond_from_tree (present, + not_null_lb, null_lb)); + gimple_seq_add_stmt (&ilist, + gimple_build_label (not_null_lb)); + } + var1 = lang_hooks.decls.omp_array_data (var, false); + size1 = lang_hooks.decls.omp_array_size (var, &ilist); + var2 = build_fold_addr_expr (x); + if (!POINTER_TYPE_P (TREE_TYPE (var))) + var = build_fold_addr_expr (var); + size2 = fold_build2 (POINTER_DIFF_EXPR, ssizetype, + build_fold_addr_expr (var1), var); + size2 = fold_convert (sizetype, size2); + if (present) + { + tree tmp = create_tmp_var (TREE_TYPE (var1)); + gimplify_assign (tmp, var1, &ilist); + var1 = tmp; + tmp = create_tmp_var (TREE_TYPE (var2)); + gimplify_assign (tmp, var2, &ilist); + var2 = tmp; + tmp = create_tmp_var (TREE_TYPE (size1)); + gimplify_assign (tmp, size1, &ilist); + size1 = tmp; + tmp = create_tmp_var (TREE_TYPE (size2)); + gimplify_assign (tmp, size2, &ilist); + size2 = tmp; + gimple_seq_add_stmt (&ilist, gimple_build_goto (after_lb)); + gimple_seq_add_stmt (&ilist, gimple_build_label (null_lb)); + gimplify_assign (var1, null_pointer_node, &ilist); + gimplify_assign (var2, null_pointer_node, &ilist); + gimplify_assign (size1, size_zero_node, &ilist); + gimplify_assign (size2, size_zero_node, &ilist); + gimple_seq_add_stmt (&ilist, gimple_build_label (after_lb)); + } + x = build_sender_ref ((splay_tree_key) &DECL_NAME (ovar), ctx); + gimplify_assign (x, var1, &ilist); + tkind = GOMP_MAP_FIRSTPRIVATE; + talign = DECL_ALIGN_UNIT (ovar); + talign = ceil_log2 (talign); + tkind |= talign << talign_shift; + gcc_checking_assert (tkind + <= tree_to_uhwi ( + TYPE_MAX_VALUE (tkind_type))); + purpose = size_int (map_idx++); + CONSTRUCTOR_APPEND_ELT (vsize, purpose, size1); + if (TREE_CODE (size1) != INTEGER_CST) + TREE_STATIC (TREE_VEC_ELT (t, 1)) = 0; + CONSTRUCTOR_APPEND_ELT (vkind, purpose, + build_int_cstu (tkind_type, tkind)); + x = build_sender_ref ((splay_tree_key) &DECL_UID (ovar), ctx); + gimplify_assign (x, var2, &ilist); + tkind = GOMP_MAP_ATTACH; + purpose = size_int (map_idx++); + CONSTRUCTOR_APPEND_ELT (vsize, purpose, size2); + CONSTRUCTOR_APPEND_ELT (vkind, purpose, + build_int_cstu (tkind_type, tkind)); + } break; case OMP_CLAUSE_USE_DEVICE_PTR: @@ -14433,6 +14528,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) ovar = OMP_CLAUSE_DECL (c); if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_HAS_DEVICE_ADDR) { + if (lang_hooks.decls.omp_array_data (ovar, true)) + goto omp_has_device_addr_descr; while (TREE_CODE (ovar) == INDIRECT_REF || TREE_CODE (ovar) == ARRAY_REF) ovar = TREE_OPERAND (ovar, 0); @@ -14670,6 +14767,7 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) default: break; case OMP_CLAUSE_FIRSTPRIVATE: + omp_firstprivatize_data_region: if (is_gimple_omp_oacc (ctx->stmt)) break; var = OMP_CLAUSE_DECL (c); @@ -14764,6 +14862,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) do_optional_check = false; var = OMP_CLAUSE_DECL (c); is_array_data = lang_hooks.decls.omp_array_data (var, true) != NULL; + if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_HAS_DEVICE_ADDR && is_array_data) + goto omp_firstprivatize_data_region; if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_IS_DEVICE_PTR && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_HAS_DEVICE_ADDR) diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp index d191f7dc67f..73dcbe3cc9a 100644 --- a/libgomp/ChangeLog.omp +++ b/libgomp/ChangeLog.omp @@ -1,3 +1,15 @@ +2022-05-23 Tobias Burnus + + Backport from mainline: + 2022-05-23 Tobias Burnus + + PR fortran/104949 + * target.c (gomp_map_vars_internal, copy_firstprivate_data): + Support attach for GOMP_MAP_FIRSTPRIVATE. + * testsuite/libgomp.fortran/target-firstprivate-1.f90: New test. + * testsuite/libgomp.fortran/target-firstprivate-2.f90: New test. + * testsuite/libgomp.fortran/target-firstprivate-3.f90: New test. + 2022-05-09 Kwok Cheung Yeung Backport from master: diff --git a/libgomp/target.c b/libgomp/target.c index 69ff9534b1c..93e904725b8 100644 --- a/libgomp/target.c +++ b/libgomp/target.c @@ -1435,7 +1435,24 @@ gomp_map_vars_internal (struct gomp_device_descr *devicep, gomp_copy_host2dev (devicep, aq, (void *) (tgt->tgt_start + tgt_size), (void *) hostaddrs[i], len, false, cbufp); + /* Save device address in hostaddr to permit latter availablity + when doing a deep-firstprivate with pointer attach. */ + hostaddrs[i] = (void *) (tgt->tgt_start + tgt_size); tgt_size += len; + + /* If followed by GOMP_MAP_ATTACH, pointer assign this + firstprivate to hostaddrs[i+1], which is assumed to contain a + device address. */ + if (i + 1 < mapnum + && (GOMP_MAP_ATTACH + == (typemask & get_kind (short_mapkind, kinds, i+1)))) + { + uintptr_t target = (uintptr_t) hostaddrs[i]; + void *devptr = *(void**) hostaddrs[i+1] + sizes[i+1]; + gomp_copy_host2dev (devicep, aq, devptr, &target, + sizeof (void *), false, cbufp); + ++i; + } continue; case GOMP_MAP_FIRSTPRIVATE_INT: case GOMP_MAP_ZERO_LEN_ARRAY_SECTION: @@ -2734,6 +2751,11 @@ copy_firstprivate_data (char *tgt, size_t mapnum, void **hostaddrs, memcpy (tgt + tgt_size, hostaddrs[i], sizes[i]); hostaddrs[i] = tgt + tgt_size; tgt_size = tgt_size + sizes[i]; + if (i + 1 < mapnum && (kinds[i+1] & 0xff) == GOMP_MAP_ATTACH) + { + *(*(uintptr_t**) hostaddrs[i+1] + sizes[i+1]) = (uintptr_t) hostaddrs[i]; + ++i; + } } } diff --git a/libgomp/testsuite/libgomp.fortran/target-firstprivate-1.f90 b/libgomp/testsuite/libgomp.fortran/target-firstprivate-1.f90 new file mode 100644 index 00000000000..7b77992a21d --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/target-firstprivate-1.f90 @@ -0,0 +1,33 @@ +! PR fortran/104949 + +implicit none (type,external) +integer, allocatable :: A(:) +A = [1,2,3,4,5,6] + +!$omp parallel firstprivate(A) +!$omp master + if (any (A /= [1,2,3,4,5])) error stop + A(:) = [99,88,77,66,55] +!$omp end master +!$omp end parallel + +!$omp target firstprivate(A) + if (any (A /= [1,2,3,4,5])) error stop + A(:) = [99,88,77,66,55] +!$omp end target +if (any (A /= [1,2,3,4,5])) error stop + +!$omp parallel default(firstprivate) +!$omp master + if (any (A /= [1,2,3,4,5])) error stop + A(:) = [99,88,77,66,55] +!$omp end master +!$omp end parallel +if (any (A /= [1,2,3,4,5])) error stop + +!$omp target defaultmap(firstprivate) + if (any (A /= [1,2,3,4,5])) error stop + A(:) = [99,88,77,66,55] +!$omp end target +if (any (A /= [1,2,3,4,5])) error stop +end diff --git a/libgomp/testsuite/libgomp.fortran/target-firstprivate-2.f90 b/libgomp/testsuite/libgomp.fortran/target-firstprivate-2.f90 new file mode 100644 index 00000000000..d00b4070c11 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/target-firstprivate-2.f90 @@ -0,0 +1,113 @@ +! PR fortran/104949 + +module m +use omp_lib +implicit none (type, external) + +contains +subroutine one + integer, allocatable :: x(:) + integer :: i + + do i = 1, omp_get_num_devices() + 1 + !$omp target firstprivate(x) + if (allocated(x)) error stop + !$omp end target + if (allocated(x)) error stop + end do + + do i = 1, omp_get_num_devices() + 1 + !$omp target firstprivate(x, i) + if (allocated(x)) error stop + x = [10,20,30,40] + i + if (any (x /= [10,20,30,40] + i)) error stop + ! This leaks memory! + ! deallocate(x) + !$omp end target + if (allocated(x)) error stop + end do + + x = [1,2,3,4] + + do i = 1, omp_get_num_devices() + 1 + !$omp target firstprivate(x, i) + if (i <= 0) error stop + if (.not.allocated(x)) error stop + if (size(x) /= 4) error stop + if (lbound(x,1) /= 1) error stop + if (any (x /= [1,2,3,4])) error stop + ! no reallocation, just malloced + assignment + x = [10,20,30,40] + i + if (any (x /= [10,20,30,40] + i)) error stop + ! This leaks memory! + ! deallocate(x) + !$omp end target + if (.not.allocated(x)) error stop + if (size(x) /= 4) error stop + if (lbound(x,1) /= 1) error stop + if (any (x /= [1,2,3,4])) error stop + end do + deallocate(x) +end + +subroutine two + character(len=:), allocatable :: x(:) + character(len=5) :: str + integer :: i + + str = "abcde" ! work around for PR fortran/91544 + do i = 1, omp_get_num_devices() + 1 + !$omp target firstprivate(x) + if (allocated(x)) error stop + !$omp end target + if (allocated(x)) error stop + end do + + do i = 1, omp_get_num_devices() + 1 + !$omp target firstprivate(x, i) + if (allocated(x)) error stop + ! no reallocation, just malloced + assignment + x = [character(len=2+i) :: str,"fhji","klmno"] + if (len(x) /= 2+i) error stop + if (any (x /= [character(len=2+i) :: str,"fhji","klmno"])) error stop + ! This leaks memory! + ! deallocate(x) + !$omp end target + if (allocated(x)) error stop + end do + + x = [character(len=4) :: "ABCDE","FHJI","KLMNO"] + + do i = 1, omp_get_num_devices() + 1 + !$omp target firstprivate(x, i) + if (i <= 0) error stop + if (.not.allocated(x)) error stop + if (size(x) /= 3) error stop + if (lbound(x,1) /= 1) error stop + if (len(x) /= 4) error stop + if (any (x /= [character(len=4) :: "ABCDE","FHJI","KLMNO"])) error stop + !! Reallocation runs into the issue PR fortran/105538 + !! + !!x = [character(len=2+i) :: str,"fhji","klmno"] + !!if (len(x) /= 2+i) error stop + !!if (any (x /= [character(len=2+i) :: str,"fhji","klmno"])) error stop + !! This leaks memory! + !! deallocate(x) + ! Just assign: + x = [character(len=4) :: "abcde","fhji","klmno"] + if (any (x /= [character(len=4) :: "abcde","fhji","klmno"])) error stop + !$omp end target + if (.not.allocated(x)) error stop + if (lbound(x,1) /= 1) error stop + if (size(x) /= 3) error stop + if (len(x) /= 4) error stop + if (any (x /= [character(len=4) :: "ABCDE","FHJI","KLMNO"])) error stop + end do + deallocate(x) +end +end module m + +use m +call one +call two +end diff --git a/libgomp/testsuite/libgomp.fortran/target-firstprivate-3.f90 b/libgomp/testsuite/libgomp.fortran/target-firstprivate-3.f90 new file mode 100644 index 00000000000..7406cdc4e41 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/target-firstprivate-3.f90 @@ -0,0 +1,24 @@ +implicit none + integer, allocatable :: x(:) + x = [1,2,3,4] + call foo(x) + if (any (x /= [1,2,3,4])) error stop + call foo() +contains +subroutine foo(c) + integer, allocatable, optional :: c(:) + logical :: is_present + is_present = present (c) + !$omp target firstprivate(c) + if (is_present) then + if (.not. allocated(c)) error stop + if (any (c /= [1,2,3,4])) error stop + c = [99,88,77,66] + if (any (c /= [99,88,77,66])) error stop + end if + !$omp end target + if (is_present) then + if (any (c /= [1,2,3,4])) error stop + end if +end +end