This patch adds support for non-constant iterator bounds to the Fortran
deep-mapping iterator support.
To do this, we need to keep track of the new iterator entries generated
during by the deep mapping. Code is generated by lower_omp_target to
allocate memory for each of these entries one-by-one, then freed after
the target code. allocate_omp_iterator_elems and free_omp_iterator_elems
are modified so that they work on a per-iterator basis rather than
per-clause.From a9236e9350dbe1c51d92c8301118fe7f36a371db Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcye...@baylibre.com>
Date: Sat, 3 May 2025 21:10:47 +0000
Subject: [PATCH 11/11] openmp, fortran: Add support for non-constant iterator
bounds in Fortran deep-mapping iterator support
gcc/fortran/
* trans-openmp.cc (gfc_omp_deep_mapping_map): Add new argument for
vector of newly created iterators. Push new iterators onto the
vector.
(gfc_omp_deep_mapping_comps): Add new argument for vector of new
iterators. Pass argument in calls to gfc_omp_deep_mapping_item and
gfc_omp_deep_mapping_comps.
(gfc_omp_deep_mapping_item): Add new argument for vector of new
iterators. Pass argument in calls to gfc_omp_deep_mapping_map and
gfc_omp_deep_mapping_comps.
(gfc_omp_deep_mapping_do): Add new argument for vector of new
iterators. Pass argument in calls to gfc_omp_deep_mapping_item.
(gfc_omp_deep_mapping_cnt): Pass NULL to new argument for
gfc_omp_deep_mapping_do.
(gfc_omp_deep_mapping): Add new argument for vector of new
iterators. Pass argument in calls to gfc_omp_deep_mapping_do.
* trans.h (gfc_omp_deep_mapping): Add new argument.
gcc/
* langhooks-def.h (lhd_omp_deep_mapping): Add new argument.
* langhooks.cc (lhd_omp_deep_mapping): Likewise.
* langhooks.h (omp_deep_mapping): Likewise.
* omp-low.cc (allocate_omp_iterator_elems): Work on the supplied
iterator set instead of the iterators in a supplied set of clauses.
(free_omp_iterator_elems): Likewise.
(lower_omp_target): Maintain vector of new iterators generated by
deep-mapping. Allocate and free iterator element arrays using
iterators found in clauses and in the new iterator vector.
libgomp/
* testsuite/libgomp.fortran/allocatable-comp-iterators.f90: Add test
for non-const iterator boundaries.
---
gcc/fortran/trans-openmp.cc | 38 ++++---
gcc/fortran/trans.h | 3 +-
gcc/langhooks-def.h | 3 +-
gcc/langhooks.cc | 2 +-
gcc/langhooks.h | 3 +-
gcc/omp-low.cc | 103 +++++++++---------
.../allocatable-comp-iterators.f90 | 3 +-
7 files changed, 83 insertions(+), 72 deletions(-)
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 96a9c63665b..7b0996b03e6 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -1854,7 +1854,8 @@ 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, gimple *ctx,
- tree iterators, gimple_seq loops_pre_seq)
+ tree iterators, gimple_seq loops_pre_seq,
+ vec<tree> *new_iterators)
{
tree one = build_int_cst (size_type_node, 1);
@@ -1880,6 +1881,7 @@ gfc_omp_deep_mapping_map (tree data, tree size, unsigned
HOST_WIDE_INT tkind,
if (iterators)
{
data_iter = add_new_omp_iterators_entry (iterators, loops_seq_p);
+ new_iterators->safe_push (data_iter);
assign_to_iterator_elems_array (data_expr, data_iter, ctx);
data_expr = OMP_ITERATORS_ELEMS (data_iter);
if (TREE_CODE (TREE_TYPE (data_expr)) == ARRAY_TYPE)
@@ -1900,6 +1902,7 @@ gfc_omp_deep_mapping_map (tree data, tree size, unsigned
HOST_WIDE_INT tkind,
if (iterators)
{
data_addr_iter = add_new_omp_iterators_entry (iterators, loops_seq_p);
+ new_iterators->safe_push (data_addr_iter);
assign_to_iterator_elems_array (data_addr_expr, data_addr_iter, ctx);
data_addr_expr = OMP_ITERATORS_ELEMS (data_addr_iter);
if (TREE_CODE (TREE_TYPE (data_addr_expr)) == ARRAY_TYPE)
@@ -1990,7 +1993,7 @@ 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 *, gimple *, bool *,
- tree);
+ tree, vec <tree> *);
/* Map allocatable components. */
static void
@@ -1999,7 +2002,8 @@ gfc_omp_deep_mapping_comps (bool is_cnt, location_t loc,
tree decl,
tree data_array, tree sizes_array, tree kinds_array,
tree offset_data, tree offset, tree num,
gimple_seq *seq, gimple *ctx,
- bool *poly_warned, tree iterators)
+ bool *poly_warned, tree iterators,
+ vec <tree> *new_iterators)
{
tree type = TREE_TYPE (decl);
if (TREE_CODE (type) != RECORD_TYPE)
@@ -2017,7 +2021,8 @@ 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, iterators);
+ seq, ctx, poly_warned, iterators,
+ new_iterators);
}
else if (GFC_DECL_GET_SCALAR_POINTER (field)
|| GFC_DESCRIPTOR_TYPE_P (type))
@@ -2030,12 +2035,13 @@ 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, iterators);
+ seq, ctx, poly_warned, iterators,
+ new_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, iterators);
+ poly_warned, iterators, new_iterators);
}
}
}
@@ -2179,7 +2185,7 @@ gfc_omp_deep_mapping_item (bool is_cnt, bool do_copy,
bool do_alloc_check,
tree sizes_array, tree kinds_array, tree offset_data,
tree offset, tree num, gimple_seq *seq,
gimple *ctx, bool *poly_warned,
- tree iterators)
+ tree iterators, vec<tree> *new_iterators)
{
tree tmp;
tree type = TREE_TYPE (decl);
@@ -2286,7 +2292,8 @@ 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, iterators, loops_pre_seq);
+ offset, seq, ctx, iterators, loops_pre_seq,
+ new_iterators);
}
tmp = decl;
@@ -2326,7 +2333,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, iterators);
+ poly_warned, iterators, new_iterators);
gimple_seq_add_seq (seq, seq2);
}
if (end_label)
@@ -2474,7 +2481,7 @@ static tree
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)
+ gimple_seq *seq, vec<tree> *new_iterators)
{
tree num = NULL_TREE;
location_t loc = OMP_CLAUSE_LOCATION (clause);
@@ -2590,14 +2597,15 @@ gfc_omp_deep_mapping_do (bool is_cnt, gimple *ctx, tree
clause,
&token, tkind, data, sizes, kinds,
offset_data, offset, num, seq, ctx,
&poly_warned,
- OMP_CLAUSE_ITERATORS (clause));
+ OMP_CLAUSE_ITERATORS (clause),
+ new_iterators);
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,
- OMP_CLAUSE_ITERATORS (clause));
+ OMP_CLAUSE_ITERATORS (clause), new_iterators);
/* Multiply by 2 as there are two mappings: data + pointer assign. */
if (is_cnt)
gimplify_assign (num,
@@ -2613,7 +2621,7 @@ tree
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);
+ NULL_TREE, NULL_TREE, NULL_TREE, seq, NULL);
}
/* Does the actual deep mapping. */
@@ -2621,10 +2629,10 @@ void
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)
+ gimple_seq *seq, vec<tree> *new_iterators)
{
(void) gfc_omp_deep_mapping_do (false, ctx, clause, tkind, data, sizes,
kinds,
- offset_data, offset, seq);
+ offset_data, offset, seq, new_iterators);
}
/* Return true if DECL is a scalar variable (for the purpose of
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 746f77cb458..197704b7098 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -843,7 +843,8 @@ void gfc_omp_finish_clause (tree, gimple_seq *, bool);
bool gfc_omp_deep_mapping_p (const gimple *, 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 *);
+ tree, tree, tree, tree, gimple_seq *,
+ vec<tree> *);
bool gfc_omp_allocatable_p (tree);
bool gfc_omp_scalar_p (tree, bool);
bool gfc_omp_scalar_target_p (tree);
diff --git a/gcc/langhooks-def.h b/gcc/langhooks-def.h
index 4b013af09f8..71290ef815f 100644
--- a/gcc/langhooks-def.h
+++ b/gcc/langhooks-def.h
@@ -89,7 +89,8 @@ 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 (gimple *, tree, gimple_seq *);
extern void lhd_omp_deep_mapping (gimple *, tree, unsigned HOST_WIDE_INT,
- tree, tree, tree, tree, tree, gimple_seq *);
+ tree, tree, tree, tree, tree, gimple_seq *,
+ vec<tree> *);
extern tree lhd_omp_mapper_lookup (tree, tree);
extern tree lhd_omp_extract_mapper_directive (tree);
extern tree lhd_omp_map_array_section (location_t, tree);
diff --git a/gcc/langhooks.cc b/gcc/langhooks.cc
index 2c62a077451..1695aed911b 100644
--- a/gcc/langhooks.cc
+++ b/gcc/langhooks.cc
@@ -665,7 +665,7 @@ lhd_omp_deep_mapping_cnt (gimple *, tree, gimple_seq *)
void
lhd_omp_deep_mapping (gimple *, tree, unsigned HOST_WIDE_INT, tree, tree,
- tree, tree, tree, gimple_seq *)
+ tree, tree, tree, gimple_seq *, vec<tree> *)
{
}
diff --git a/gcc/langhooks.h b/gcc/langhooks.h
index d6b51263d85..d95e5cb109a 100644
--- a/gcc/langhooks.h
+++ b/gcc/langhooks.h
@@ -326,7 +326,8 @@ struct lang_hooks_for_decls
void (*omp_deep_mapping) (gimple *stmt, tree clause,
unsigned HOST_WIDE_INT tkind,
tree data, tree sizes, tree kinds,
- tree offset_data, tree offset, gimple_seq *seq);
+ tree offset_data, tree offset, gimple_seq *seq,
+ vec<tree> *);
/* Finish language-specific processing on mapping nodes after expanding
user-defined mappers. */
diff --git a/gcc/omp-low.cc b/gcc/omp-low.cc
index 3c4835ab9bc..172845f84cf 100644
--- a/gcc/omp-low.cc
+++ b/gcc/omp-low.cc
@@ -12688,60 +12688,46 @@ lower_omp_map_iterator_size (tree size, tree c,
gomp_target *stmt)
}
static void
-allocate_omp_iterator_elems (tree clauses, gimple_seq loops_seq)
+allocate_omp_iterator_elems (tree iters, gimple_seq loops_seq)
{
- for (tree c = clauses; c ; c = OMP_CLAUSE_CHAIN (c))
- {
- if (!OMP_CLAUSE_HAS_ITERATORS (c))
- continue;
- tree iters = OMP_CLAUSE_ITERATORS (c);
- tree elems = OMP_ITERATORS_ELEMS (iters);
- if (!POINTER_TYPE_P (TREE_TYPE (elems)))
- continue;
- tree arr_length
- = omp_iterator_elems_length (OMP_ITERATORS_COUNT (iters));
- tree call = builtin_decl_explicit (BUILT_IN_MALLOC);
- tree size = fold_build2_loc (OMP_CLAUSE_LOCATION (c), MULT_EXPR,
- size_type_node, arr_length,
- TYPE_SIZE_UNIT (ptr_type_node));
- tree tmp = build_call_expr_loc (OMP_CLAUSE_LOCATION (c), call, 1,
- size);
-
- /* Find the first statement '<index> = -1' in the pre-loop statements.
*/
- tree index = OMP_ITERATORS_INDEX (iters);
- gimple_stmt_iterator gsi;
- for (gsi = gsi_start (loops_seq); !gsi_end_p (gsi); gsi_next (&gsi))
- {
- gimple *stmt = gsi_stmt (gsi);
- if (gimple_code (stmt) == GIMPLE_ASSIGN
- && gimple_assign_lhs (stmt) == index
- && gimple_assign_rhs1 (stmt) == size_int (-1))
- break;
- }
- gcc_assert (!gsi_end_p (gsi));
+ tree elems = OMP_ITERATORS_ELEMS (iters);
+ if (!POINTER_TYPE_P (TREE_TYPE (elems)))
+ return;
+ tree arr_length = omp_iterator_elems_length (OMP_ITERATORS_COUNT (iters));
+ tree call = builtin_decl_explicit (BUILT_IN_MALLOC);
+ tree size = fold_build2 (MULT_EXPR, size_type_node, arr_length,
+ TYPE_SIZE_UNIT (ptr_type_node));
+ tree tmp = build_call_expr (call, 1, size);
+
+ /* Find the first statement '<index> = -1' in the pre-loop statements. */
+ tree index = OMP_ITERATORS_INDEX (iters);
+ gimple_stmt_iterator gsi;
+ for (gsi = gsi_start (loops_seq); !gsi_end_p (gsi); gsi_next (&gsi))
+ {
+ gimple *stmt = gsi_stmt (gsi);
+ if (gimple_code (stmt) == GIMPLE_ASSIGN
+ && gimple_assign_lhs (stmt) == index
+ && gimple_assign_rhs1 (stmt) == size_int (-1))
+ break;
+ }
+ gcc_assert (!gsi_end_p (gsi));
- gimple_seq alloc_seq = NULL;
- gimplify_assign (elems, tmp, &alloc_seq);
- gsi_insert_seq_before (&gsi, alloc_seq, GSI_SAME_STMT);
- }
+ gimple_seq alloc_seq = NULL;
+ gimplify_assign (elems, tmp, &alloc_seq);
+ gsi_insert_seq_before (&gsi, alloc_seq, GSI_SAME_STMT);
}
static void
-free_omp_iterator_elems (tree clauses, gimple_seq *seq)
+free_omp_iterator_elems (tree iters, gimple_seq *seq)
{
- for (tree c = clauses; c ; c = OMP_CLAUSE_CHAIN (c))
- {
- if (!OMP_CLAUSE_HAS_ITERATORS (c))
- continue;
- tree elems = OMP_ITERATORS_ELEMS (OMP_CLAUSE_ITERATORS (c));
- if (!POINTER_TYPE_P (TREE_TYPE (elems)))
- continue;
- tree call = builtin_decl_explicit (BUILT_IN_FREE);
- call = build_call_expr_loc (OMP_CLAUSE_LOCATION (c), call, 1, elems);
- gimplify_and_add (call, seq);
- tree clobber = build_clobber (TREE_TYPE (elems));
- gimple_seq_add_stmt (seq, gimple_build_assign (elems, clobber));
- }
+ tree elems = OMP_ITERATORS_ELEMS (iters);
+ if (!POINTER_TYPE_P (TREE_TYPE (elems)))
+ return;
+ tree call = builtin_decl_explicit (BUILT_IN_FREE);
+ call = build_call_expr (call, 1, elems);
+ gimplify_and_add (call, seq);
+ tree clobber = build_clobber (TREE_TYPE (elems));
+ gimple_seq_add_stmt (seq, gimple_build_assign (elems, clobber));
}
/* Lower the GIMPLE_OMP_TARGET in the current statement
@@ -13147,6 +13133,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p,
omp_context *ctx)
record_vars_into (gimple_bind_vars (tgt_bind), child_fn);
}
+ auto_vec<tree> new_iterators;
+
if (ctx->record_type)
{
if (deep_map_cnt && TREE_CODE (deep_map_cnt) == INTEGER_CST)
@@ -13280,7 +13268,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p,
omp_context *ctx)
TREE_VEC_ELT (t, 1),
TREE_VEC_ELT (t, 2),
deep_map_offset_data,
- deep_map_offset, &ilist);
+ deep_map_offset, &ilist,
+ &new_iterators);
}
if (!DECL_P (ovar))
{
@@ -14424,12 +14413,22 @@ lower_omp_target (gimple_stmt_iterator *gsi_p,
omp_context *ctx)
gimple_omp_set_body (stmt, new_body);
}
- allocate_omp_iterator_elems (clauses,
- gimple_omp_target_iterator_loops (stmt));
+ for (c = clauses; c ; c = OMP_CLAUSE_CHAIN (c))
+ if (OMP_CLAUSE_HAS_ITERATORS (c))
+ allocate_omp_iterator_elems (OMP_CLAUSE_ITERATORS (c),
+ gimple_omp_target_iterator_loops (stmt));
+ unsigned i;
+ tree it;
+ FOR_EACH_VEC_ELT (new_iterators, i, it)
+ allocate_omp_iterator_elems (it, gimple_omp_target_iterator_loops (stmt));
gsi_insert_seq_before (gsi_p, gimple_omp_target_iterator_loops (stmt),
GSI_SAME_STMT);
gimple_omp_target_set_iterator_loops (stmt, NULL);
- free_omp_iterator_elems (clauses, &olist);
+ for (c = clauses; c ; c = OMP_CLAUSE_CHAIN (c))
+ if (OMP_CLAUSE_HAS_ITERATORS (c))
+ free_omp_iterator_elems (OMP_CLAUSE_ITERATORS (c), &olist);
+ FOR_EACH_VEC_ELT (new_iterators, i, it)
+ free_omp_iterator_elems (it, &olist);
bind = gimple_build_bind (NULL, NULL,
tgt_bind ? gimple_bind_block (tgt_bind)
diff --git a/libgomp/testsuite/libgomp.fortran/allocatable-comp-iterators.f90
b/libgomp/testsuite/libgomp.fortran/allocatable-comp-iterators.f90
index 483ab0c335b..120236ac3de 100644
--- a/libgomp/testsuite/libgomp.fortran/allocatable-comp-iterators.f90
+++ b/libgomp/testsuite/libgomp.fortran/allocatable-comp-iterators.f90
@@ -5,6 +5,7 @@ type t
end type t
type(t) :: x(N), y(N), z(N)
integer :: i, j
+integer :: lo = 3, hi = N
!$omp target map(iterator (it=1:N), to: x(it))
do i = 1, N
@@ -50,7 +51,7 @@ end do
end do
!$omp end target
-!$omp target map(iterator (it=3:N), always, tofrom: z(it))
+!$omp target map(iterator (it=lo:hi), always, tofrom: z(it))
do i = 3, N
if (.not.allocated(z(i)%b)) stop 12
if (any (z(i)%b /= 99)) stop 13
--
2.43.0
