https://gcc.gnu.org/g:cfc8c8cc8de34519bb1d6787bc1f0082b0177e7e
commit cfc8c8cc8de34519bb1d6787bc1f0082b0177e7e Author: Kwok Cheung Yeung <[email protected]> Date: Sat May 3 21:03:33 2025 +0000 openmp, fortran: Add iterator support for Fortran deep-mapping of allocatables gcc/fortran/ * trans-openmp.cc (gfc_omp_deep_mapping_map): Remove const from ctx argument. Add arguments for iterators and the statement sequence to go into the iterator loop. Add statement sequence to iterator loop body. Generate iterator loop entries for generated maps, insert the map decls and sizes into the iterator element arrays, replace original decls with the address of the element arrays, and sizes/biases with SIZE_INT. (gfc_omp_deep_mapping_comps): Remove const from ctx. Add argument for iterators. Pass iterators to calls to gfc_omp_deep_mapping_item and gfc_omp_deep_mapping_comps. (gfc_omp_deep_mapping_item): Remove const from ctx. Add argument for iterators. Collect generated side-effect statements and pass to gfc_omp_deep_mapping_map along with the iterators. Pass iterators to gfc_omp_deep_mapping_comps. (gfc_omp_deep_mapping_do): Remove const from ctx. Pass iterators to gfc_omp_deep_mapping_item. (gfc_omp_deep_mapping_cnt): Remove const from ctx. (gfc_omp_deep_mapping): Likewise. * trans.h (gfc_omp_deep_mapping_cnt): Likewise. (gfc_omp_deep_mapping): Likewise. gcc/ * gimplify.cc (enter_omp_iterator_loop_context): New function variant. (enter_omp_iterator_loop_context): Delegate to new variant. (exit_omp_iterator_loop_context): New function variant. (exit_omp_iterator_loop_context): Delegate to new variant. (assign_to_iterator_elems_array): New. (add_new_omp_iterators_entry): New. (add_new_omp_iterators_clause): Delegate to add_new_omp_iterators_entry. * gimplify.h (enter_omp_iterator_loop_context): Adjust prototype. (exit_omp_iterator_loop_context): Remove argument. (assign_to_iterator_elems_array): New prototype. (add_new_omp_iterators_entry): New prototype. * langhooks-def.h (lhd_omp_deep_mapping_cnt): Remove const from argument. (lhd_omp_deep_mapping): Likewise. * langhooks.cc (lhd_omp_deep_mapping_cnt): Likewise. (lhd_omp_deep_mapping): Likewise. * langhooks.h (omp_deep_mapping_cnt): Likewise. (omp_deep_mapping): Likewise. Adjust comments. * omp-low.cc (lower_omp_map_iterator_expr): Delegate to assign_to_iterator_elems_array. (lower_omp_map_iterator_size): Likewise. (lower_omp_target): Remove sorry for deep mapping. Use a better name for the deep_map_cnt temporary to make dumps more readable. libgomp/ * testsuite/libgomp.fortran/allocatable-comp-iterators.f90: New. Co-authored-by: Sandra Loosemore <[email protected]> Diff: --- gcc/fortran/trans-openmp.cc | 95 ++++++++++++++----- gcc/fortran/trans.h | 4 +- gcc/gimplify.cc | 102 ++++++++++++++++----- gcc/gimplify.h | 8 +- gcc/langhooks-def.h | 4 +- gcc/langhooks.cc | 4 +- gcc/langhooks.h | 19 ++-- gcc/omp-low.cc | 52 +---------- .../libgomp.fortran/allocatable-comp-iterators.f90 | 60 ++++++++++++ 9 files changed, 238 insertions(+), 110 deletions(-) diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index 02352f711ec8..9ec06e99082a 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -1939,7 +1939,8 @@ static void gfc_omp_deep_mapping_map (tree data, tree size, unsigned HOST_WIDE_INT tkind, location_t loc, tree data_array, tree sizes_array, tree kinds_array, tree offset_data, tree offset, - gimple_seq *seq, const gimple *ctx) + gimple_seq *seq, gimple *ctx, + tree iterators, gimple_seq loops_pre_seq) { tree one = build_int_cst (size_type_node, 1); @@ -1950,26 +1951,64 @@ gfc_omp_deep_mapping_map (tree data, tree size, unsigned HOST_WIDE_INT tkind, data = TREE_OPERAND (data, 0); } + gimple_seq *loops_seq_p = gimple_omp_target_iterator_loops_ptr (ctx); + + if (loops_pre_seq) + { + gimple_seq *loop_body_p + = enter_omp_iterator_loop_context (iterators, loops_seq_p); + gimple_seq_add_seq (loop_body_p, loops_pre_seq); + exit_omp_iterator_loop_context (); + } + + tree data_expr = data; + tree data_iter = NULL_TREE; + if (iterators) + { + data_iter = add_new_omp_iterators_entry (iterators, loops_seq_p); + assign_to_iterator_elems_array (data_expr, data_iter, ctx, false); + data_expr = OMP_ITERATOR_ELEMS (data_iter); + if (TREE_CODE (TREE_TYPE (data_expr)) == ARRAY_TYPE) + data_expr = build_fold_addr_expr_with_type (data_expr, ptr_type_node); + } /* data_array[offset_data] = data; */ tree tmp = build4 (ARRAY_REF, TREE_TYPE (TREE_TYPE (data_array)), unshare_expr (data_array), offset_data, NULL_TREE, NULL_TREE); - gimplify_assign (tmp, data, seq); + gimplify_assign (tmp, data_expr, seq); /* offset_data++ */ tmp = build2_loc (loc, PLUS_EXPR, size_type_node, offset_data, one); gimplify_assign (offset_data, tmp, seq); + tree data_addr_expr = build_fold_addr_expr (data); + tree data_addr_iter = NULL_TREE; + if (iterators) + { + data_addr_iter = add_new_omp_iterators_entry (iterators, loops_seq_p); + assign_to_iterator_elems_array (data_addr_expr, data_addr_iter, ctx, + false); + data_addr_expr = OMP_ITERATOR_ELEMS (data_addr_iter); + if (TREE_CODE (TREE_TYPE (data_addr_expr)) == ARRAY_TYPE) + data_addr_expr = build_fold_addr_expr_with_type (data_addr_expr, + ptr_type_node); + } /* data_array[offset_data] = &data; */ tmp = build4 (ARRAY_REF, TREE_TYPE (TREE_TYPE (data_array)), unshare_expr (data_array), offset_data, NULL_TREE, NULL_TREE); - gimplify_assign (tmp, build_fold_addr_expr (data), seq); + gimplify_assign (tmp, data_addr_expr, seq); /* offset_data++ */ tmp = build2_loc (loc, PLUS_EXPR, size_type_node, offset_data, one); gimplify_assign (offset_data, tmp, seq); + tree size_expr = size; + if (iterators) + { + assign_to_iterator_elems_array (size_expr, data_iter, ctx, true); + size_expr = size_int (SIZE_MAX); + } /* sizes_array[offset] = size */ tmp = build2_loc (loc, MULT_EXPR, size_type_node, TYPE_SIZE_UNIT (size_type_node), offset); @@ -1979,7 +2018,7 @@ gfc_omp_deep_mapping_map (tree data, tree size, unsigned HOST_WIDE_INT tkind, tmp = force_gimple_operand (tmp, &seq2, true, NULL_TREE); gimple_seq_add_seq (seq, seq2); tmp = build_fold_indirect_ref_loc (loc, tmp); - gimplify_assign (tmp, size, seq); + gimplify_assign (tmp, size_expr, seq); /* FIXME: tkind |= talign << talign_shift; */ /* kinds_array[offset] = tkind. */ @@ -1997,6 +2036,12 @@ gfc_omp_deep_mapping_map (tree data, tree size, unsigned HOST_WIDE_INT tkind, tmp = build2_loc (loc, PLUS_EXPR, size_type_node, offset, one); gimplify_assign (offset, tmp, seq); + tree bias_expr = build_zero_cst (size_type_node); + if (iterators) + { + assign_to_iterator_elems_array (bias_expr, data_addr_iter, ctx, true); + bias_expr = size_int (SIZE_MAX); + } /* sizes_array[offset] = bias (= 0). */ tmp = build2_loc (loc, MULT_EXPR, size_type_node, TYPE_SIZE_UNIT (size_type_node), offset); @@ -2006,7 +2051,7 @@ gfc_omp_deep_mapping_map (tree data, tree size, unsigned HOST_WIDE_INT tkind, tmp = force_gimple_operand (tmp, &seq2, true, NULL_TREE); gimple_seq_add_seq (seq, seq2); tmp = build_fold_indirect_ref_loc (loc, tmp); - gimplify_assign (tmp, build_zero_cst (size_type_node), seq); + gimplify_assign (tmp, bias_expr, seq); gcc_assert (gimple_code (ctx) == GIMPLE_OMP_TARGET); tkind = (gimple_omp_target_kind (ctx) == GF_OMP_TARGET_KIND_EXIT_DATA @@ -2031,7 +2076,8 @@ gfc_omp_deep_mapping_map (tree data, tree size, unsigned HOST_WIDE_INT tkind, static void gfc_omp_deep_mapping_item (bool, bool, bool, location_t, tree, tree *, unsigned HOST_WIDE_INT, tree, tree, tree, tree, tree, tree, - gimple_seq *, const gimple *, bool *); + gimple_seq *, gimple *, bool *, + tree); /* Map allocatable components. */ static void @@ -2039,8 +2085,8 @@ gfc_omp_deep_mapping_comps (bool is_cnt, location_t loc, tree decl, tree *token, unsigned HOST_WIDE_INT tkind, tree data_array, tree sizes_array, tree kinds_array, tree offset_data, tree offset, tree num, - gimple_seq *seq, const gimple *ctx, - bool *poly_warned) + gimple_seq *seq, gimple *ctx, + bool *poly_warned, tree iterators) { tree type = TREE_TYPE (decl); if (TREE_CODE (type) != RECORD_TYPE) @@ -2058,7 +2104,7 @@ gfc_omp_deep_mapping_comps (bool is_cnt, location_t loc, tree decl, gfc_omp_deep_mapping_item (is_cnt, true, true, loc, tmp, token, tkind, data_array, sizes_array, kinds_array, offset_data, offset, num, - seq, ctx, poly_warned); + seq, ctx, poly_warned, iterators); } else if (GFC_DECL_GET_SCALAR_POINTER (field) || GFC_DESCRIPTOR_TYPE_P (type)) @@ -2071,12 +2117,12 @@ gfc_omp_deep_mapping_comps (bool is_cnt, location_t loc, tree decl, gfc_omp_deep_mapping_item (is_cnt, false, false, loc, tmp, token, tkind, data_array, sizes_array, kinds_array, offset_data, offset, num, - seq, ctx, poly_warned); + seq, ctx, poly_warned, iterators); else gfc_omp_deep_mapping_comps (is_cnt, loc, tmp, token, tkind, data_array, sizes_array, kinds_array, offset_data, offset, num, seq, ctx, - poly_warned); + poly_warned, iterators); } } } @@ -2219,7 +2265,8 @@ gfc_omp_deep_mapping_item (bool is_cnt, bool do_copy, bool do_alloc_check, unsigned HOST_WIDE_INT tkind, tree data_array, tree sizes_array, tree kinds_array, tree offset_data, tree offset, tree num, gimple_seq *seq, - const gimple *ctx, bool *poly_warned) + gimple *ctx, bool *poly_warned, + tree iterators) { tree tmp; tree type = TREE_TYPE (decl); @@ -2277,6 +2324,9 @@ gfc_omp_deep_mapping_item (bool is_cnt, bool do_copy, bool do_alloc_check, type = TREE_TYPE (decl); } + gimple_seq loops_pre_seq = NULL; + gimple_seq *loops_pre_seq_p = iterators ? &loops_pre_seq : seq; + if (is_cnt && do_copy) { tree tmp = fold_build2_loc (loc, PLUS_EXPR, size_type_node, @@ -2295,7 +2345,7 @@ gfc_omp_deep_mapping_item (bool is_cnt, bool do_copy, bool do_alloc_check, : gfc_conv_descriptor_elem_len (decl)); tmp = (POINTER_TYPE_P (TREE_TYPE (decl)) ? build_fold_indirect_ref (decl) : decl); - size = gfc_omp_get_array_size (loc, tmp, seq); + size = gfc_omp_get_array_size (loc, tmp, loops_pre_seq_p); bytesize = fold_build2_loc (loc, MULT_EXPR, size_type_node, fold_convert (size_type_node, size), fold_convert (size_type_node, elem_len)); @@ -2323,7 +2373,7 @@ gfc_omp_deep_mapping_item (bool is_cnt, bool do_copy, bool do_alloc_check, gfc_omp_deep_mapping_map (tmp, bytesize, tkind2, loc, data_array, sizes_array, kinds_array, offset_data, - offset, seq, ctx); + offset, seq, ctx, iterators, loops_pre_seq); } tmp = decl; @@ -2339,7 +2389,8 @@ gfc_omp_deep_mapping_item (bool is_cnt, bool do_copy, bool do_alloc_check, { elem_len = gfc_conv_descriptor_elem_len (decl); size = fold_convert (size_type_node, - gfc_omp_get_array_size (loc, decl, seq)); + gfc_omp_get_array_size (loc, decl, + loops_pre_seq_p)); } decl = gfc_conv_descriptor_data_get (decl); decl = gfc_omp_elmental_loop (loc, decl, size, elem_len, seq, &seq2); @@ -2362,7 +2413,7 @@ gfc_omp_deep_mapping_item (bool is_cnt, bool do_copy, bool do_alloc_check, gfc_omp_deep_mapping_comps (is_cnt, loc, decl, token, tkind, data_array, sizes_array, kinds_array, offset_data, offset, num, seq, ctx, - poly_warned); + poly_warned, iterators); gimple_seq_add_seq (seq, seq2); } if (end_label) @@ -2510,7 +2561,7 @@ gfc_omp_deep_mapping_p (const gimple *ctx, tree clause) /* Handle gfc_omp_deep_mapping{,_cnt} */ static tree -gfc_omp_deep_mapping_do (bool is_cnt, const gimple *ctx, tree clause, +gfc_omp_deep_mapping_do (bool is_cnt, gimple *ctx, tree clause, unsigned HOST_WIDE_INT tkind, tree data, tree sizes, tree kinds, tree offset_data, tree offset, gimple_seq *seq) @@ -2628,13 +2679,15 @@ gfc_omp_deep_mapping_do (bool is_cnt, const gimple *ctx, tree clause, gfc_omp_deep_mapping_item (is_cnt, do_copy, do_alloc_check, loc, decl, &token, tkind, data, sizes, kinds, offset_data, offset, num, seq, ctx, - &poly_warned); + &poly_warned, + OMP_CLAUSE_ITERATORS (clause)); gimple_seq_add_stmt (seq, gimple_build_label (end_label)); } else gfc_omp_deep_mapping_item (is_cnt, do_copy, do_alloc_check, loc, decl, &token, tkind, data, sizes, kinds, offset_data, - offset, num, seq, ctx, &poly_warned); + offset, num, seq, ctx, &poly_warned, + OMP_CLAUSE_ITERATORS (clause)); /* Multiply by 2 as there are two mappings: data + pointer assign. */ if (is_cnt) gimplify_assign (num, @@ -2653,7 +2706,7 @@ gfc_omp_deep_mapping_do (bool is_cnt, const gimple *ctx, tree clause, gimple code used for counting is added to SEQ. */ tree -gfc_omp_deep_mapping_cnt (const gimple *ctx, tree clause, gimple_seq *seq) +gfc_omp_deep_mapping_cnt (gimple *ctx, tree clause, gimple_seq *seq) { return gfc_omp_deep_mapping_do (true, ctx, clause, 0, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, seq); @@ -2670,7 +2723,7 @@ gfc_omp_deep_mapping_cnt (const gimple *ctx, tree clause, gimple_seq *seq) SIZES/KINDS, incrementing the offsets after each assignment. */ void -gfc_omp_deep_mapping (const gimple *ctx, tree clause, +gfc_omp_deep_mapping (gimple *ctx, tree clause, unsigned HOST_WIDE_INT tkind, tree data, tree sizes, tree kinds, tree offset_data, tree offset, gimple_seq *seq) diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 0bdee5820fdd..58b03d6c6fa4 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -840,8 +840,8 @@ tree gfc_omp_clause_linear_ctor (tree, tree, tree, tree); tree gfc_omp_clause_dtor (tree, tree); void gfc_omp_finish_clause (tree, gimple_seq *, bool); bool gfc_omp_deep_mapping_p (const gimple *, tree); -tree gfc_omp_deep_mapping_cnt (const gimple *, tree, gimple_seq *); -void gfc_omp_deep_mapping (const gimple *, tree, unsigned HOST_WIDE_INT, tree, +tree gfc_omp_deep_mapping_cnt (gimple *, tree, gimple_seq *); +void gfc_omp_deep_mapping (gimple *, tree, unsigned HOST_WIDE_INT, tree, tree, tree, tree, tree, gimple_seq *); bool gfc_omp_allocatable_p (tree); bool gfc_omp_scalar_p (tree, bool); diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc index 3a66223b1c49..cf10c73efbc7 100644 --- a/gcc/gimplify.cc +++ b/gcc/gimplify.cc @@ -10371,6 +10371,19 @@ enter_omp_iterator_loop_context_1 (tree iterator, gimple_seq *loops_seq_p) return NULL; } +/* Enter the gimplification context for ITERATOR. LOOPS_SEQ_P is the + iterator loop. */ + +gimple_seq * +enter_omp_iterator_loop_context (tree iterator, gimple_seq *loops_seq_p) +{ + push_gimplify_context (); + + gimple_seq *seq = enter_omp_iterator_loop_context_1 (iterator, loops_seq_p); + gcc_assert (seq); + return seq; +} + /* Enter the Gimplification context in LOOPS_SEQ_P for the iterator loop associated with OpenMP clause C. Returns the gimple_seq for the loop body if C has OpenMP iterators, or ALT_SEQ_P if not. */ @@ -10382,19 +10395,15 @@ enter_omp_iterator_loop_context (tree c, gimple_seq *loops_seq_p, if (!OMP_CLAUSE_HAS_ITERATORS (c)) return alt_seq_p; - push_gimplify_context (); - - gimple_seq *seq = enter_omp_iterator_loop_context_1 (OMP_CLAUSE_ITERATORS (c), - loops_seq_p); - gcc_assert (seq); - return seq; + return enter_omp_iterator_loop_context (OMP_CLAUSE_ITERATORS (c), + loops_seq_p); } /* Enter the Gimplification context in STMT for the iterator loop associated with OpenMP clause C. Returns the gimple_seq for the loop body if C has OpenMP iterators, or ALT_SEQ_P if not. */ -gimple_seq * +static gimple_seq * enter_omp_iterator_loop_context (tree c, gomp_target *stmt, gimple_seq *alt_seq_p) { @@ -10402,30 +10411,62 @@ enter_omp_iterator_loop_context (tree c, gomp_target *stmt, return enter_omp_iterator_loop_context (c, loops_seq_p, alt_seq_p); } -/* Exit the Gimplification context for the OpenMP clause C. */ - +/* Pop the current iterator loop gimplification context. */ void -exit_omp_iterator_loop_context (tree c) +exit_omp_iterator_loop_context (void) { - if (!OMP_CLAUSE_HAS_ITERATORS (c)) - return; while (!gimplify_ctxp->bind_expr_stack.is_empty ()) gimple_pop_bind_expr (); pop_gimplify_context (NULL); } -/* Insert new OpenMP clause C into pre-existing iterator loop LOOPS_SEQ_P. - If the clause has an iterator, then that iterator is assumed to be in - the expanded form (i.e. it has info regarding the loop, expanded elements - etc.). */ +/* Exit the Gimplification context for the OpenMP clause C. */ +static void +exit_omp_iterator_loop_context (tree c) +{ + if (!OMP_CLAUSE_HAS_ITERATORS (c)) + return; + exit_omp_iterator_loop_context (); +} +/* Store the value T in the elems array for ITERATOR in context STMT. + If SIZE_P is true, T is a size value and is stored at offset 1. + Otherwise T is interpreted as the address value and is stored at + offset 0. See the comment on omp_iterator_elems_length above for + the format of entries in the iterator elems array. */ void -add_new_omp_iterators_clause (tree c, gimple_seq *loops_seq_p) +assign_to_iterator_elems_array (tree t, tree iterator, gimple *stmt, + bool size_p) +{ + tree index = OMP_ITERATOR_INDEX (iterator); + if (size_p) + index = size_binop (PLUS_EXPR, index, size_one_node); + tree elems = OMP_ITERATOR_ELEMS (iterator); + gimple_seq *loop_body_p = gimple_omp_target_iterator_loops_ptr (stmt); + loop_body_p = enter_omp_iterator_loop_context (iterator, loop_body_p); + + /* IN LOOP BODY: */ + /* elems[index+index_offset] = t; */ + tree lhs; + if (TREE_CODE (TREE_TYPE (elems)) == ARRAY_TYPE) + lhs = build4 (ARRAY_REF, ptr_type_node, elems, index, NULL_TREE, NULL_TREE); + else + { + tree tmp = size_binop (MULT_EXPR, index, TYPE_SIZE_UNIT (ptr_type_node)); + tmp = size_binop (POINTER_PLUS_EXPR, elems, tmp); + lhs = build1 (INDIRECT_REF, ptr_type_node, tmp); + } + gimplify_assign (lhs, t, loop_body_p); + exit_omp_iterator_loop_context (); +} + +/* Insert new OpenMP iterators into pre-existing iterator loop LOOPS_SEQ_P. + ITERS is in the expanded form as stored in the OMP_CLAUSE_ITERATORS + field of a clause. */ +tree +add_new_omp_iterators_entry (tree iters, gimple_seq *loops_seq_p) { gimple_stmt_iterator gsi; - tree iters = OMP_CLAUSE_ITERATORS (c); - if (!iters) - return; gcc_assert (OMP_ITERATOR_EXPANDED_P (iters)); /* Search for <index> = -1. */ @@ -10462,10 +10503,25 @@ add_new_omp_iterators_clause (tree c, gimple_seq *loops_seq_p) gsi_insert_seq_after (&gsi, assign_seq, GSI_SAME_STMT); /* Update iterator information. */ - tree new_iterator = copy_omp_iterator (OMP_CLAUSE_ITERATORS (c)); + tree new_iterator = copy_omp_iterator (iters); OMP_ITERATOR_ELEMS (new_iterator) = elems; - TREE_CHAIN (new_iterator) = TREE_CHAIN (OMP_CLAUSE_ITERATORS (c)); - OMP_CLAUSE_ITERATORS (c) = new_iterator; + TREE_CHAIN (new_iterator) = TREE_CHAIN (iters); + + return new_iterator; +} + +/* Insert new OpenMP clause C into pre-existing iterator loop LOOPS_SEQ_P. + If the clause has an iterator, then that iterator is assumed to be in + the expanded form (i.e. it has info regarding the loop, expanded elements + etc.). */ + +static void +add_new_omp_iterators_clause (tree c, gimple_seq *loops_seq_p) +{ + tree iters = OMP_CLAUSE_ITERATORS (c); + if (!iters) + return; + OMP_CLAUSE_ITERATORS (c) = add_new_omp_iterators_entry (iters, loops_seq_p); } /* If *LIST_P contains any OpenMP depend clauses with iterators, diff --git a/gcc/gimplify.h b/gcc/gimplify.h index 2a095e85f5f8..23b5df82f1ac 100644 --- a/gcc/gimplify.h +++ b/gcc/gimplify.h @@ -80,9 +80,11 @@ extern tree omp_get_construct_context (void); int omp_has_novariants (void); extern tree omp_iterator_elems_length (tree count); -extern gimple_seq *enter_omp_iterator_loop_context (tree, gomp_target *, - gimple_seq * = NULL); -extern void exit_omp_iterator_loop_context (tree); +extern gimple_seq *enter_omp_iterator_loop_context (tree, gimple_seq *); + +extern void exit_omp_iterator_loop_context (void); +extern void assign_to_iterator_elems_array (tree, tree, gimple *, bool); +extern tree add_new_omp_iterators_entry (tree, gimple_seq *); extern void gimplify_type_sizes (tree, gimple_seq *); extern void gimplify_one_sizepos (tree *, gimple_seq *); diff --git a/gcc/langhooks-def.h b/gcc/langhooks-def.h index 33a99266187c..01bfab5011cb 100644 --- a/gcc/langhooks-def.h +++ b/gcc/langhooks-def.h @@ -87,8 +87,8 @@ extern tree lhd_omp_assignment (tree, tree, tree); extern void lhd_omp_finish_clause (tree, gimple_seq *, bool); extern tree lhd_omp_array_size (tree, gimple_seq *); 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, +extern tree lhd_omp_deep_mapping_cnt (gimple *, tree, gimple_seq *); +extern void lhd_omp_deep_mapping (gimple *, tree, unsigned HOST_WIDE_INT, tree, tree, tree, tree, tree, gimple_seq *); extern tree lhd_omp_mapper_lookup (tree, tree); extern tree lhd_omp_extract_mapper_directive (tree); diff --git a/gcc/langhooks.cc b/gcc/langhooks.cc index d55e2ca78560..87600af5fec8 100644 --- a/gcc/langhooks.cc +++ b/gcc/langhooks.cc @@ -659,7 +659,7 @@ lhd_omp_deep_mapping_p (const gimple *, tree) are required for the tree containing a map clause. */ tree -lhd_omp_deep_mapping_cnt (const gimple *, tree, gimple_seq *) +lhd_omp_deep_mapping_cnt (gimple *, tree, gimple_seq *) { return NULL_TREE; } @@ -668,7 +668,7 @@ lhd_omp_deep_mapping_cnt (const gimple *, tree, gimple_seq *) are required for the second argument that contains a map clause. */ void -lhd_omp_deep_mapping (const gimple *, tree, unsigned HOST_WIDE_INT, tree, tree, +lhd_omp_deep_mapping (gimple *, tree, unsigned HOST_WIDE_INT, tree, tree, tree, tree, tree, gimple_seq *) { } diff --git a/gcc/langhooks.h b/gcc/langhooks.h index b7a75a5e0427..2ef8955b782b 100644 --- a/gcc/langhooks.h +++ b/gcc/langhooks.h @@ -329,17 +329,18 @@ struct lang_hooks_for_decls 'map' CLAUSE; CTX_STMT is the gimple statement containing the clause. It is NULL_TREE if known that no such mapping are required and otherwise of type size_type_node and usually non-constant. */ - tree (*omp_deep_mapping_cnt) (const gimple *ctx_stmt, tree clause, + tree (*omp_deep_mapping_cnt) (gimple *ctx_stmt, tree clause, gimple_seq *seq); - /* If no additional data-mapping is required for the passed 'map' CLAUSE that - is part of the CTX_SMT gimple statement, the function has no effect. - Otherwise, DATA refers to a void-pointer array containing the address values - of the mapping while SIZE and KINDS are arrays for the to-be mapped size and - the map kind; OFFSET_DATA and OFFSET are size_type_node variable that refer - to the array index of DATA and SIZE/KIND, respectively and are incremented - whenever an element is added. New gimple code is added to SEQ. */ - void (*omp_deep_mapping) (const gimple *stmt, tree clause, + /* If no additional data-mapping is required for the passed 'map' CLAUSE + that is part of the CTX_SMT gimple statement with map-type TKIND, + the function has no effect. Otherwise, DATA refers to a void-pointer + array containing the address values of the mapping while SIZE and KINDS + are arrays for the to-be mapped size and the map kind; OFFSET_DATA + and OFFSET are size_type_node variable that refer to the array index + of DATA and SIZE/KIND, respectively and are incremented whenever + an element is added. New gimple code is added to SEQ. */ + void (*omp_deep_mapping) (gimple *ctx_stmt, tree clause, unsigned HOST_WIDE_INT tkind, tree data, tree sizes, tree kinds, tree offset_data, tree offset, gimple_seq *seq); diff --git a/gcc/omp-low.cc b/gcc/omp-low.cc index db29566946da..deb6f28356e7 100644 --- a/gcc/omp-low.cc +++ b/gcc/omp-low.cc @@ -12769,26 +12769,9 @@ lower_omp_map_iterator_expr (tree expr, tree c, gomp_target *stmt) return expr; tree iterator = OMP_CLAUSE_ITERATORS (c); - tree index = OMP_ITERATOR_INDEX (iterator); - tree elems = OMP_ITERATOR_ELEMS (iterator); - gimple_seq *loop_body_p = enter_omp_iterator_loop_context (c, stmt); - - /* IN LOOP BODY: */ - /* elems[idx] = <expr>; */ - tree lhs; - if (TREE_CODE (TREE_TYPE (elems)) == ARRAY_TYPE) - lhs = build4 (ARRAY_REF, ptr_type_node, elems, index, NULL_TREE, NULL_TREE); - else - { - tree tmp = size_binop (MULT_EXPR, index, TYPE_SIZE_UNIT (ptr_type_node)); - tmp = size_binop (POINTER_PLUS_EXPR, elems, tmp); - lhs = build1 (INDIRECT_REF, ptr_type_node, tmp); - } - tree mod_expr = build2_loc (OMP_CLAUSE_LOCATION (c), MODIFY_EXPR, - void_type_node, lhs, expr); - gimplify_and_add (mod_expr, loop_body_p); - exit_omp_iterator_loop_context (c); + assign_to_iterator_elems_array (expr, iterator, stmt, false); + tree elems = OMP_ITERATOR_ELEMS (iterator); if (TREE_CODE (TREE_TYPE (elems)) == ARRAY_TYPE) return build_fold_addr_expr_with_type (elems, ptr_type_node); else @@ -12807,29 +12790,7 @@ lower_omp_map_iterator_size (tree size, tree c, gomp_target *stmt) return size; tree iterator = OMP_CLAUSE_ITERATORS (c); - tree index = OMP_ITERATOR_INDEX (iterator); - tree elems = OMP_ITERATOR_ELEMS (iterator); - gimple_seq *loop_body_p = enter_omp_iterator_loop_context (c, stmt); - - /* IN LOOP BODY: */ - /* elems[idx+1] = <size>; */ - tree lhs; - if (TREE_CODE (TREE_TYPE (elems)) == ARRAY_TYPE) - lhs = build4 (ARRAY_REF, ptr_type_node, elems, - size_binop (PLUS_EXPR, index, size_int (1)), - NULL_TREE, NULL_TREE); - else - { - tree index_1 = size_binop (PLUS_EXPR, index, size_int (1)); - tree tmp = size_binop (MULT_EXPR, index_1, - TYPE_SIZE_UNIT (ptr_type_node)); - tmp = size_binop (POINTER_PLUS_EXPR, elems, tmp); - lhs = build1 (INDIRECT_REF, ptr_type_node, tmp); - } - tree mod_expr = build2_loc (OMP_CLAUSE_LOCATION (c), MODIFY_EXPR, - void_type_node, lhs, size); - gimplify_and_add (mod_expr, loop_body_p); - exit_omp_iterator_loop_context (c); + assign_to_iterator_elems_array (size, iterator, stmt, true); return size_int (SIZE_MAX); } @@ -13067,11 +13028,6 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) deep_map_cnt = extra; } - if (deep_map_cnt - && OMP_CLAUSE_HAS_ITERATORS (c)) - sorry ("iterators used together with deep mapping are not " - "supported yet"); - if (!DECL_P (var)) { if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_MAP @@ -13386,7 +13342,7 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) else if (deep_map_cnt) { gcc_assert (flexible_array_type_p (ctx->record_type)); - tree n = create_tmp_var_raw (size_type_node, "nn_map"); + tree n = create_tmp_var_raw (size_type_node, "deep_map_cnt"); gimple_add_tmp_var (n); gimplify_assign (n, deep_map_cnt, &ilist); deep_map_cnt = n; diff --git a/libgomp/testsuite/libgomp.fortran/allocatable-comp-iterators.f90 b/libgomp/testsuite/libgomp.fortran/allocatable-comp-iterators.f90 new file mode 100644 index 000000000000..483ab0c335b8 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/allocatable-comp-iterators.f90 @@ -0,0 +1,60 @@ +implicit none +integer, parameter :: N = 16 +type t + integer, allocatable :: a, b(:) +end type t +type(t) :: x(N), y(N), z(N) +integer :: i, j + +!$omp target map(iterator (it=1:N), to: x(it)) + do i = 1, N + if (allocated(x(i)%a)) stop 1 + if (allocated(x(i)%b)) stop 2 + end do +!$omp end target + +do i = 1, N + allocate(x(i)%a, x(i)%b(-4:6)) + x(i)%b(:) = [(i, i=-4,6)] +end do + +!$omp target map(iterator (it=2:N), to: x(it)) + do i = 2, N + if (.not. allocated(x(i)%a)) stop 3 + if (.not. allocated(x(i)%b)) stop 4 + if (lbound(x(i)%b,1) /= -4) stop 5 + if (ubound(x(i)%b,1) /= 6) stop 6 + if (any (x(i)%b /= [(i, i=-4,6)])) stop 7 + end do +!$omp end target + +!$omp target enter data map(iterator (it=3:N), to: y(it), z(it)) + +!$omp target map(iterator (it=3:N), to: y(it), z(it)) + do i = 3, N + if (allocated(y(i)%b)) stop 8 + if (allocated(z(i)%b)) stop 9 + end do +!$omp end target + +do i = 1, N + allocate(y(i)%b(5), z(i)%b(3)) + y(i)%b = 42 + z(i)%b = 99 +end do + +!$omp target map(iterator (it=3:N), to: y(it)) + do i = 3, N + if (.not.allocated(y(i)%b)) stop 10 + if (any (y(i)%b /= 42)) stop 11 + end do +!$omp end target + +!$omp target map(iterator (it=3:N), always, tofrom: z(it)) + do i = 3, N + if (.not.allocated(z(i)%b)) stop 12 + if (any (z(i)%b /= 99)) stop 13 + end do +!$omp end target + +end
