+2025-04-17 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * gimplify.cc (compute_omp_iterator_count): Account for difference
+ in loop boundaries in Fortran.
+ (build_omp_iterator_loop): Change upper boundary condition for
+ Fortran. Insert block statements into innermost loop.
+ (remove_unused_omp_iterator_vars): Copy block subblocks of old
+ iterator to new iterator and remove original.
+ (contains_vars_1): New.
+ (contains_vars): New.
+ (extract_base_bit_offset): Add iterator argument. Remove iterator
+ variables from base. Do not set variable_offset if the offset
+ does not contain any remaining variables.
+ (omp_accumulate_sibling_list): Add iterator argument to
+ extract_base_bit_offset.
+ * tree-pretty-print.cc (dump_block_node): Ignore BLOCK_SUBBLOCKS
+ containing iterator block statements.
+
2025-04-17 Kwok Cheung Yeung <kcyeung@baylibre.com>
* gimplify.cc (gimplify_scan_omp_clauses): Add argument for iterator
+2025-04-17 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * dump-parse-tree.cc (show_omp_namelist): Add iterator support for
+ OMP_LIST_MAP.
+ * match.cc (gfc_free_namelist): Free namespace for OMP_LIST_MAP.
+ * openmp.cc (gfc_free_omp_clauses): Free namespace in namelist for
+ OMP_LIST_MAP.
+ (gfc_match_omp_clauses): Parse 'iterator' modifier for 'map' clause.
+ (resolve_omp_clauses): Resolve iterators for OMP_LIST_MAP.
+ * trans-openmp.cc: Include tree-ssa-loop-niter.h.
+ (gfc_trans_omp_array_section): Add iterator argument. Replace
+ instances of iterator variables with the initial value when
+ computing biases.
+ * trans-openmp.cc (gfc_trans_omp_clauses): Handle iterators in
+ OMP_LIST_MAP clauses. Add expressions to iter_block rather than
+ block. Do not apply iterators to firstprivate maps. Pass iterator
+ to gfc_trans_omp_array_section.
+
2025-04-17 Kwok Cheung Yeung <kcyeung@baylibre.com>
* trans-openmp.cc (gfc_trans_omp_array_section): Use temporaries only
for (; n; n = n->next)
{
gfc_current_ns = ns_curr;
- if (list_type == OMP_LIST_AFFINITY || list_type == OMP_LIST_DEPEND)
+ if (list_type == OMP_LIST_AFFINITY || list_type == OMP_LIST_DEPEND
+ || list_type == OMP_LIST_MAP)
{
gfc_current_ns = n->u2.ns ? n->u2.ns : ns_curr;
if (n->u2.ns != ns_iter)
fputs ("AFFINITY (", dumpfile);
else if (n->u.depend_doacross_op == OMP_DOACROSS_SINK_FIRST)
fputs ("DOACROSS (", dumpfile);
- else
+ else if (list_type == OMP_LIST_DEPEND)
fputs ("DEPEND (", dumpfile);
+ else if (list_type == OMP_LIST_MAP)
+ fputs ("MAP (", dumpfile);
+ else
+ gcc_unreachable ();
}
if (n->u2.ns)
{
void
gfc_free_omp_namelist (gfc_omp_namelist *name, int list)
{
- bool free_ns = (list == OMP_LIST_AFFINITY || list == OMP_LIST_DEPEND);
+ bool free_ns = (list == OMP_LIST_AFFINITY || list == OMP_LIST_DEPEND
+ || list == OMP_LIST_MAP);
bool free_mapper = (list == OMP_LIST_MAP
|| list == OMP_LIST_TO
|| list == OMP_LIST_FROM);
int close_modifier = 0;
int present_modifier = 0;
int mapper_modifier = 0;
+ int iterator_modifier = 0;
+ gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns;
locus second_always_locus = old_loc2;
locus second_close_locus = old_loc2;
locus second_mapper_locus = old_loc2;
locus second_present_locus = old_loc2;
+ locus second_iterator_locus = old_loc2;
char mapper_id[GFC_MAX_SYMBOL_LEN + 1] = { '\0' };
for (;;)
if (strcmp (mapper_id, "default") == 0)
mapper_id[0] = '\0';
}
+ else if (gfc_match_iterator (&ns_iter, true) == MATCH_YES)
+ {
+ if (iterator_modifier++ == 1)
+ second_iterator_locus = current_locus;
+ }
else
break;
gfc_match (", ");
&second_mapper_locus);
break;
}
+ if (iterator_modifier > 1)
+ {
+ gfc_error ("too many %<iterator%> modifiers at %L",
+ &second_iterator_locus);
+ break;
+ }
head = NULL;
- if (gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_MAP],
- false, NULL, &head,
- true, true) == MATCH_YES)
+ if (ns_iter)
+ gfc_current_ns = ns_iter;
+ m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_MAP],
+ false, NULL, &head, true, true);
+ gfc_current_ns = ns_curr;
+ if (m == MATCH_YES)
{
gfc_omp_namelist *n;
for (n = *head; n; n = n->next)
n->u3.udm->mapper_id
= gfc_get_string ("%s", mapper_id);
}
+ n->u2.ns = ns_iter;
+ if (ns_iter)
+ ns_iter->refs++;
}
continue;
}
break;
}
}
- if ((list == OMP_LIST_DEPEND || list == OMP_LIST_AFFINITY)
+ if ((list == OMP_LIST_DEPEND || list == OMP_LIST_AFFINITY
+ || list == OMP_LIST_MAP)
&& n->u2.ns && !n->u2.ns->resolved)
{
n->u2.ns->resolved = 1;
#include "gfortran.h"
#include "basic-block.h"
#include "tree-ssa.h"
+#include "tree-ssa-loop-niter.h" /* for simplify_replace_tree. */
#include "tree-pass.h" /* for PROP_gimple_any */
#include "function.h"
#include "gimple.h"
gfc_trans_omp_array_section (stmtblock_t *block, toc_directive cd,
gfc_omp_namelist *n, tree decl, bool element,
gomp_map_kind ptr_kind, tree &node,
- tree &node2, tree &node3, tree &node4)
+ tree &node2, tree &node3, tree &node4,
+ tree iterator)
{
bool openmp = (cd < TOC_OPENACC);
bool omp_exit_data = (cd == TOC_OPENMP_EXIT_DATA);
OMP_CLAUSE_DECL (node3) = decl;
}
+ for (tree it = iterator; it; it = TREE_CHAIN (it))
+ {
+ ptr = simplify_replace_tree (ptr, TREE_VEC_ELT (it, 0),
+ TREE_VEC_ELT (it, 1));
+ ptr2 = simplify_replace_tree (ptr2, TREE_VEC_ELT (it, 0),
+ TREE_VEC_ELT (it, 1));
+ }
ptr = fold_build2 (MINUS_EXPR, ptrdiff_type_node, ptr,
fold_convert (ptrdiff_type_node, ptr2));
if (!openmp)
}
break;
case OMP_LIST_MAP:
+ iterator = NULL_TREE;
+ prev = NULL;
+ prev_clauses = omp_clauses;
for (; n != NULL; n = n->next)
{
if (!n->sym->attr.referenced)
continue;
+ if (iterator && prev->u2.ns != n->u2.ns)
+ {
+ /* Finish previous iterator group. */
+ BLOCK_SUBBLOCKS (tree_block) = gfc_finish_block (&iter_block);
+ TREE_VEC_ELT (iterator, 5) = tree_block;
+ for (tree c = omp_clauses; c != prev_clauses;
+ c = OMP_CLAUSE_CHAIN (c))
+ if (OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_FIRSTPRIVATE_POINTER
+ && OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_FIRSTPRIVATE_REFERENCE)
+ OMP_CLAUSE_ITERATORS (c) = iterator;
+ prev_clauses = omp_clauses;
+ iterator = NULL_TREE;
+ }
+ if (n->u2.ns && (!prev || prev->u2.ns != n->u2.ns))
+ {
+ /* Start a new iterator group. */
+ gfc_init_block (&iter_block);
+ tree_block = make_node (BLOCK);
+ TREE_USED (tree_block) = 1;
+ BLOCK_VARS (tree_block) = NULL_TREE;
+ prev_clauses = omp_clauses;
+ iterator = handle_iterator (n->u2.ns, block, tree_block);
+ }
+ if (!iterator)
+ gfc_init_block (&iter_block);
+ prev = n;
+
/* We do not want to include allocatable vars in a synthetic
"acc data" region created for "!$acc declare create" vars.
Such variables are handled by augmenting allocate/deallocate
TRUTH_NOT_EXPR,
boolean_type_node,
present);
- gfc_add_expr_to_block (block,
+ gfc_add_expr_to_block (&iter_block,
build3_loc (input_location,
COND_EXPR,
void_type_node,
tree type = TREE_TYPE (decl);
tree ptr = gfc_conv_descriptor_data_get (decl);
if (present)
- ptr = gfc_build_cond_assign_expr (block, present, ptr,
+ ptr = gfc_build_cond_assign_expr (&iter_block,
+ present, ptr,
null_pointer_node);
gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
ptr = build_fold_indirect_ref (ptr);
ptr = gfc_conv_descriptor_data_get (decl);
ptr = gfc_build_addr_expr (NULL, ptr);
ptr = gfc_build_cond_assign_expr (
- block, present, ptr, null_pointer_node);
+ &iter_block, present, ptr, null_pointer_node);
ptr = build_fold_indirect_ref (ptr);
OMP_CLAUSE_DECL (node3) = ptr;
}
TRUTH_ANDIF_EXPR,
boolean_type_node,
present, cond);
- gfc_add_expr_to_block (block,
+ gfc_add_expr_to_block (&iter_block,
build3_loc (input_location,
COND_EXPR,
void_type_node,
tree cond = build3_loc (input_location, COND_EXPR,
void_type_node, present,
cond_body, NULL_TREE);
- gfc_add_expr_to_block (block, cond);
+ gfc_add_expr_to_block (&iter_block, cond);
OMP_CLAUSE_SIZE (node) = var;
}
else
{
- gfc_add_block_to_block (block, &cond_block);
+ gfc_add_block_to_block (&iter_block, &cond_block);
OMP_CLAUSE_SIZE (node) = size;
}
}
/* A single indirectref is handled by the middle end. */
gcc_assert (!POINTER_TYPE_P (TREE_TYPE (decl)));
tree tmp = TREE_OPERAND (decl, 0);
- tmp = gfc_build_cond_assign_expr (block, present, tmp,
- null_pointer_node);
+ tmp = gfc_build_cond_assign_expr (&iter_block,
+ present, tmp,
+ null_pointer_node);
OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (tmp);
}
else
size_type_node,
cond, size,
size_zero_node);
- size = gfc_evaluate_now (size, block);
+ size = gfc_evaluate_now (size, &iter_block);
OMP_CLAUSE_SIZE (node) = size;
}
if ((TREE_CODE (decl) != PARM_DECL
tmp = DECL_P (decl) ? DECL_SIZE_UNIT (decl)
: TYPE_SIZE_UNIT (TREE_TYPE (decl));
tree var = gfc_create_var (TREE_TYPE (tmp), NULL);
- gfc_add_modify_loc (input_location, block, var, tmp);
+ gfc_add_modify_loc (input_location, &iter_block,
+ var, tmp);
OMP_CLAUSE_SIZE (node) = var;
gfc_allocate_lang_decl (var);
if (TREE_CODE (decl) == INDIRECT_REF)
&& !(POINTER_TYPE_P (type)
&& GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (type))))
k = GOMP_MAP_FIRSTPRIVATE_POINTER;
- gfc_trans_omp_array_section (block, cd, n, decl, element,
- k, node, node2, node3, node4);
+ gfc_trans_omp_array_section (&iter_block,
+ cd, n, decl, element,
+ k, node, node2, node3, node4,
+ iterator);
}
else if (n->expr
&& n->expr->expr_type == EXPR_VARIABLE
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, n->expr);
- gfc_add_block_to_block (block, &se.pre);
+ gfc_add_block_to_block (&iter_block, &se.pre);
/* For BT_CHARACTER a pointer is returned. */
OMP_CLAUSE_DECL (node)
= POINTER_TYPE_P (TREE_TYPE (se.expr))
? build_fold_indirect_ref (se.expr) : se.expr;
- gfc_add_block_to_block (block, &se.post);
+ gfc_add_block_to_block (&iter_block, &se.post);
if (pointer || allocatable)
{
/* If it's a bare attach/detach clause, we just want
? DECL_SIZE_UNIT (se.expr)
: TYPE_SIZE_UNIT (TREE_TYPE (se.expr)));
tree var = gfc_create_var (TREE_TYPE (tmp), NULL);
- gfc_add_modify_loc (input_location, block, var, tmp);
+ gfc_add_modify_loc (input_location, &iter_block,
+ var, tmp);
OMP_CLAUSE_SIZE (node) = var;
gfc_allocate_lang_decl (var);
if (TREE_CODE (se.expr) == INDIRECT_REF)
to ensure that it is not gimplified + is a decl. */
tree tmp = OMP_CLAUSE_SIZE (node);
tree var = gfc_create_var (TREE_TYPE (tmp), NULL);
- gfc_add_modify_loc (input_location, block, var, tmp);
+ gfc_add_modify_loc (input_location, &iter_block,
+ var, tmp);
OMP_CLAUSE_SIZE (node) = var;
gfc_allocate_lang_decl (var);
if (TREE_CODE (inner) == INDIRECT_REF)
OMP_CLAUSE_DECL (node) = ptr;
int rank = GFC_TYPE_ARRAY_RANK (type);
OMP_CLAUSE_SIZE (node)
- = gfc_full_array_size (block, inner, rank);
+ = gfc_full_array_size (&iter_block, inner, rank);
tree elemsz
= TYPE_SIZE_UNIT (gfc_get_element_type (type));
map_kind = OMP_CLAUSE_MAP_KIND (node);
tree tmp = OMP_CLAUSE_SIZE (node);
tree var = gfc_create_var (TREE_TYPE (tmp),
NULL);
- gfc_add_modify_loc (input_location, block,
- var, tmp);
+ gfc_add_modify_loc (input_location,
+ &iter_block, var, tmp);
OMP_CLAUSE_SIZE (node) = var;
gfc_allocate_lang_decl (var);
GFC_DECL_SAVED_DESCRIPTOR (var) = inner;
/* An array element or section. */
bool element = lastref->u.ar.type == AR_ELEMENT;
gomp_map_kind kind = GOMP_MAP_ATTACH_DETACH;
- gfc_trans_omp_array_section (block, cd, n, inner, element,
+ gfc_trans_omp_array_section (&iter_block,
+ cd, n, inner, element,
kind, node, node2, node3,
- node4);
+ node4, iterator);
}
else
gcc_unreachable ();
finalize_map_clause:
+ if (!iterator)
+ gfc_add_block_to_block (block, &iter_block);
+
/* If we're processing an "omp declare mapper" directive, group
together multiple nodes used for some given map clause using
GOMP_MAP_MAPPING_GROUP. These are then either flattened or
omp_clauses = gfc_trans_add_clause (node5, omp_clauses);
}
}
+ if (iterator)
+ {
+ /* Finish last iterator group. */
+ BLOCK_SUBBLOCKS (tree_block) = gfc_finish_block (&iter_block);
+ TREE_VEC_ELT (iterator, 5) = tree_block;
+ for (tree c = omp_clauses; c != prev_clauses;
+ c = OMP_CLAUSE_CHAIN (c))
+ if (OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_FIRSTPRIVATE_POINTER
+ && OMP_CLAUSE_MAP_KIND (c) != GOMP_MAP_FIRSTPRIVATE_REFERENCE)
+ OMP_CLAUSE_ITERATORS (c) = iterator;
+ }
break;
case OMP_LIST_TO:
case OMP_LIST_FROM:
#include "context.h"
#include "tree-nested.h"
#include "dwarf2out.h"
+#include "tree-ssa-loop-niter.h" /* For simplify_replace_tree. */
/* Identifier for a basic condition, mapping it to other basic conditions of
its Boolean expression. Basic conditions given the same uid (in the same
endmbegin = fold_build2_loc (loc, POINTER_DIFF_EXPR, stype, end, begin);
else
endmbegin = fold_build2_loc (loc, MINUS_EXPR, type, end, begin);
- tree stepm1 = fold_build2_loc (loc, MINUS_EXPR, stype, step,
- build_int_cst (stype, 1));
- tree stepp1 = fold_build2_loc (loc, PLUS_EXPR, stype, step,
- build_int_cst (stype, 1));
+ /* Account for iteration stopping on the end value in Fortran rather
+ than before it. */
+ tree stepm1 = step;
+ tree stepp1 = step;
+ if (!lang_GNU_Fortran ())
+ {
+ stepm1 = fold_build2_loc (loc, MINUS_EXPR, stype, step,
+ build_int_cst (stype, 1));
+ stepp1 = fold_build2_loc (loc, PLUS_EXPR, stype, step,
+ build_int_cst (stype, 1));
+ }
tree pos = fold_build2_loc (loc, PLUS_EXPR, stype,
unshare_expr (endmbegin), stepm1);
pos = fold_build2_loc (loc, TRUNC_DIV_EXPR, stype, pos, step);
}
neg = fold_build2_loc (loc, TRUNC_DIV_EXPR, stype, neg, step);
step = NULL_TREE;
- tree cond = fold_build2_loc (loc, LT_EXPR, boolean_type_node, begin, end);
+ tree_code cmp_op = lang_GNU_Fortran () ? LE_EXPR : LT_EXPR;
+ tree cond = fold_build2_loc (loc, cmp_op, boolean_type_node, begin, end);
pos = fold_build3_loc (loc, COND_EXPR, stype, cond, pos,
build_int_cst (stype, 0));
- cond = fold_build2_loc (loc, LT_EXPR, boolean_type_node, end, begin);
+ cond = fold_build2_loc (loc, cmp_op, boolean_type_node, end, begin);
neg = fold_build3_loc (loc, COND_EXPR, stype, cond, neg,
build_int_cst (stype, 0));
tree osteptype = TREE_TYPE (orig_step);
if (*last_bind)
gimplify_and_add (*last_bind, pre_p);
tree block = TREE_VEC_ELT (it, 5);
+ tree block_stmts = lang_GNU_Fortran () ? BLOCK_SUBBLOCKS (block) : NULL_TREE;
*last_bind = build3 (BIND_EXPR, void_type_node,
BLOCK_VARS (block), NULL, block);
TREE_SIDE_EFFECTS (*last_bind) = 1;
tree end = TREE_VEC_ELT (it, 2);
tree step = TREE_VEC_ELT (it, 3);
tree orig_step = TREE_VEC_ELT (it, 4);
+ block = TREE_VEC_ELT (it, 5);
tree type = TREE_TYPE (var);
location_t loc = DECL_SOURCE_LOCATION (var);
/* Emit:
var = var + step;
cond_label:
if (orig_step > 0) {
- if (var < end) goto beg_label;
+ if (var < end) goto beg_label; // <= for Fortran
} else {
- if (var > end) goto beg_label;
+ if (var > end) goto beg_label; // >= for Fortran
}
for each iterator, with inner iterators added to
the ... above. */
append_to_statement_list_force (tem, p);
tem = build1 (LABEL_EXPR, void_type_node, cond_label);
append_to_statement_list (tem, p);
- tree cond = fold_build2_loc (loc, LT_EXPR, boolean_type_node, var, end);
+ tree cond = fold_build2_loc (loc, lang_GNU_Fortran () ? LE_EXPR : LT_EXPR,
+ boolean_type_node, var, end);
tree pos = fold_build3_loc (loc, COND_EXPR, void_type_node, cond,
build_and_jump (&beg_label), void_node);
- cond = fold_build2_loc (loc, GT_EXPR, boolean_type_node, var, end);
+ cond = fold_build2_loc (loc, lang_GNU_Fortran () ? GE_EXPR : GT_EXPR,
+ boolean_type_node, var, end);
tree neg = fold_build3_loc (loc, COND_EXPR, void_type_node, cond,
build_and_jump (&beg_label), void_node);
tree osteptype = TREE_TYPE (orig_step);
tem = fold_build3_loc (loc, COND_EXPR, void_type_node, cond, pos, neg);
append_to_statement_list_force (tem, p);
p = &BIND_EXPR_BODY (bind);
+ /* The Fortran front-end stashes statements into the BLOCK_SUBBLOCKS
+ of the last element of the first iterator. These should go into the
+ body of the innermost loop. */
+ if (!TREE_CHAIN (it))
+ append_to_statement_list_force (block_stmts, p);
}
return p;
i++;
}
}
+ tree old_block = TREE_VEC_ELT (OMP_CLAUSE_ITERATORS (c), 5);
tree new_block = make_node (BLOCK);
BLOCK_VARS (new_block) = new_vars;
+ if (BLOCK_SUBBLOCKS (old_block))
+ {
+ BLOCK_SUBBLOCKS (new_block) = BLOCK_SUBBLOCKS (old_block);
+ BLOCK_SUBBLOCKS (old_block) = NULL_TREE;
+ }
TREE_VEC_ELT (new_iters, 5) = new_block;
new_iterators.safe_push (new_iters);
iter_vars.safe_push (vars.copy ());
return c2;
}
+/* Callback for walk_tree. Return any VAR_DECLS found. */
+
+static tree
+contains_vars_1 (tree* tp, int *, void *)
+{
+ tree t = *tp;
+
+ if (TREE_CODE (t) != VAR_DECL)
+ return NULL_TREE;
+
+ return t;
+}
+
+/* Return true if there are any variables present in EXPR. */
+
+static bool
+contains_vars (tree expr)
+{
+ return walk_tree (&expr, contains_vars_1, NULL, NULL);
+}
+
/* Strip ARRAY_REFS or an indirect ref off BASE, find the containing object,
and set *BITPOSP and *POFFSETP to the bit offset of the access.
If BASE_REF is non-NULL and the containing object is a reference, set
static tree
extract_base_bit_offset (tree base, poly_int64 *bitposp,
poly_offset_int *poffsetp,
- bool *variable_offset)
+ bool *variable_offset,
+ tree iterator)
{
tree offset;
poly_int64 bitsize, bitpos;
STRIP_NOPS (base);
+ if (iterator)
+ {
+ /* Replace any iterator variables with constant zero. This will give us
+ the nominal offset and bit position of the first element, which is
+ all we should need to lay out the mappings. The actual locations
+ of the iterated mappings are elsewhere.
+ E.g. "array[i].field" gives "16" (say), not "i * 32 + 16". */
+ tree it;
+ for (it = iterator; it; it = TREE_CHAIN (it))
+ base = simplify_replace_tree (base, TREE_VEC_ELT (it, 0),
+ TREE_VEC_ELT (it, 1));
+ }
+
base = get_inner_reference (base, &bitsize, &bitpos, &offset, &mode,
&unsignedp, &reversep, &volatilep);
{
poffset = 0;
*variable_offset = (offset != NULL_TREE);
+ if (iterator && *variable_offset)
+ *variable_offset = contains_vars (offset);
}
if (maybe_ne (bitpos, 0))
}
bool variable_offset;
+ tree iterators = OMP_CLAUSE_HAS_ITERATORS (grp_end)
+ ? OMP_CLAUSE_ITERATORS (grp_end) : NULL_TREE;
tree base
- = extract_base_bit_offset (ocd, &cbitpos, &coffset, &variable_offset);
+ = extract_base_bit_offset (ocd, &cbitpos, &coffset, &variable_offset,
+ iterators);
int base_token;
for (base_token = addr_tokens.length () - 1; base_token >= 0; base_token--)
sc_decl = TREE_OPERAND (sc_decl, 0);
bool variable_offset2;
+ tree iterators2 = OMP_CLAUSE_HAS_ITERATORS (*sc)
+ ? OMP_CLAUSE_ITERATORS (*sc) : NULL_TREE;
+
tree base2 = extract_base_bit_offset (sc_decl, &bitpos, &offset,
- &variable_offset2);
+ &variable_offset2,
+ iterators2);
if (!base2 || !operand_equal_p (base2, base, 0))
break;
if (scp)
+2025-04-17 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * gfortran.dg/gomp/target-map-iterators-1.f90: New.
+ * gfortran.dg/gomp/target-map-iterators-2.f90: New.
+ * gfortran.dg/gomp/target-map-iterators-3.f90: New.
+ * gfortran.dg/gomp/target-map-iterators-4.f90: New.
+
2025-04-17 Kwok Cheung Yeung <kcyeung@baylibre.com>
* gfortran.dg/gomp/target-enter-exit-data.f90: Revert expected tree
--- /dev/null
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+program main
+ implicit none
+
+ integer, parameter :: DIM1 = 17
+ integer, parameter :: DIM2 = 39
+ type :: array_ptr
+ integer, pointer :: ptr(:)
+ end type
+
+ type (array_ptr) :: x(DIM1), y(DIM1)
+
+ !$omp target map (iterator(i=1:DIM1), to: x(i)%ptr(:))
+ !$omp end target
+
+ !$omp target map (iterator(i=1:DIM1), to: x(i)%ptr(:), y(i)%ptr(:))
+ !$omp end target
+
+ !$omp target map (iterator(i=1:DIM1), to: x(i)%ptr(:) + 3) ! { dg-error "Syntax error in OpenMP variable list at .1." }
+ !$omp end target ! { dg-error "Unexpected \\\!\\\$OMP END TARGET statement at .1." }
+
+ !$omp target map(iterator(i=1:DIM1), iterator(j=1:DIM2), to: x(i)%ptr(j)) ! { dg-error "too many 'iterator' modifiers at .1." }
+ !$omp end target ! { dg-error "Unexpected \\\!\\\$OMP END TARGET statement at .1." }
+end program
--- /dev/null
+! { dg-do compile }
+! { dg-options "-fopenmp -fdump-tree-gimple" }
+
+program main
+ implicit none
+
+ integer, parameter :: DIM = 40
+ type :: array_ptr
+ integer, pointer :: ptr(:)
+ end type
+
+ type (array_ptr) :: x(DIM), y(DIM), z(DIM)
+
+ !$omp target map(iterator(i=1:10), to: x) ! { dg-warning "iterator variable .i. not used in clause expression" }
+ ! Add a reference to x to ensure that the 'to' clause does not get dropped.
+ x(1)%ptr(1) = 0
+ !$omp end target
+
+ !$omp target map(iterator(i2=1:10, j2=1:20), from: x(i2)) ! { dg-warning "iterator variable .j2. not used in clause expression" }
+ !$omp end target
+
+ !$omp target map(iterator(i3=1:10, j3=1:20, k3=1:30), to: x(i3+j3), y(j3+k3), z(k3+i3))
+ !$omp end target
+ ! { dg-warning "iterator variable .i3. not used in clause expression" "" { target *-*-* } .-2 }
+ ! { dg-warning "iterator variable .j3. not used in clause expression" "" { target *-*-* } .-3 }
+ ! { dg-warning "iterator variable .k3. not used in clause expression" "" { target *-*-* } .-4 }
+end program
+
+! { dg-final { scan-tree-dump-times "map\\\(to:x" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\\(iterator\\\(integer\\\(kind=4\\\) i2=1:10:1, loop_label=\[^\\\)\]+\\\):from:" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\\(iterator\\\(integer\\\(kind=4\\\) j3=1:20:1, integer\\\(kind=4\\\) i3=1:10:1, loop_label=\[^\\\)\]+\\\):to:" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\\(iterator\\\(integer\\\(kind=4\\\) k3=1:30:1, integer\\\(kind=4\\\) j3=1:20:1, loop_label=\[^\\\)\]+\\\):to:" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\\(iterator\\\(integer\\\(kind=4\\\) k3=1:30:1, integer\\\(kind=4\\\) i3=1:10:1, loop_label=\[^\\\)\]+\\\):to:" 1 "gimple" } }
--- /dev/null
+! { dg-do compile }
+! { dg-options "-fopenmp -fdump-tree-gimple" }
+
+program main
+ implicit none
+
+ integer, parameter :: DIM1 = 17
+ integer, parameter :: DIM2 = 27
+ type :: ptr_t
+ integer, pointer :: ptr(:)
+ end type
+
+ type (ptr_t) :: x(DIM1), y(DIM2)
+
+ !$omp target map(iterator(i=1:DIM1), to: x(i)%ptr(:)) map(iterator(i=1:DIM2), from: y(i)%ptr(:))
+ !$omp end target
+end program
+
+! { dg-final { scan-tree-dump-times "if \\(i <= 17\\) goto <D\\\.\[0-9\]+>; else goto <D\\\.\[0-9\]+>;" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "if \\(i <= 27\\) goto <D\\\.\[0-9\]+>; else goto <D\\\.\[0-9\]+>;" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\(iterator\\(integer\\(kind=4\\) i=1:17:1, loop_label=<D\\\.\[0-9\]+>, elems=omp_iter_data\\\.\[0-9\]+, index=D\\.\[0-9\]+\\):to:MEM <\[^>\]+> \\\[\\\(\[^ \]+ \\\*\\\)D\\\.\[0-9\]+\\\]" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\(iterator\\(integer\\(kind=4\\) i=1:27:1, loop_label=<D\\\.\[0-9\]+>, elems=omp_iter_data\\\.\[0-9\]+, index=D\\.\[0-9\]+\\):from:MEM <\[^>\]+> \\\[\\\(\[^ \]+ \\\*\\\)D\\\.\[0-9\]+\\\]" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\(iterator\\(integer\\(kind=4\\) i=1:17:1, loop_label=<D\\\.\[0-9\]+>, elems=omp_iter_data\\\.\[0-9\]+, index=D\\.\[0-9\]+\\):attach:x\\\[D\\\.\[0-9\]+\\\]\.ptr\.data" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\(iterator\\(integer\\(kind=4\\) i=1:27:1, loop_label=<D\\\.\[0-9\]+>, elems=omp_iter_data\\\.\[0-9\]+, index=D\\.\[0-9\]+\\):attach:y\\\[D\\\.\[0-9\]+\\\]\.ptr\.data" 1 "gimple" } }
--- /dev/null
+! { dg-do compile }
+! { dg-options "-fopenmp -fdump-tree-gimple" }
+
+module m
+ !$omp declare target (baz)
+ interface
+ subroutine baz (x, p)
+ integer, intent(in) :: x
+ integer, pointer :: p(:)
+ end subroutine
+ integer function bar (x, i)
+ integer :: x, i
+ end function
+ end interface
+contains
+ subroutine foo (x, p)
+ integer :: x
+ integer, pointer :: p(:)
+
+ !$omp target map (iterator (i=1:4), to: p(bar (x, i)))
+ ! FIXME: These warnings are due to implicit clauses generated that do
+ ! not use the iterator variable i.
+ ! { dg-warning "iterator variable .i. not used in clause expression" "" { target *-*-* } .-3 }
+ call baz (x, p)
+ !$omp end target
+ end subroutine
+end module
+
+! { dg-final { scan-tree-dump "firstprivate\\\(x\\\)" "gimple" } }
+! { dg-final { scan-tree-dump-times "bar \\\(x, &" 2 "gimple" } }
+! { dg-final { scan-tree-dump "map\\\(iterator\\\(integer\\\(kind=4\\\) i=1:4:1, loop_label=" "gimple" } }
newline_and_indent (pp, spc + 2);
}
- if (BLOCK_SUBBLOCKS (block))
+ if (BLOCK_SUBBLOCKS (block)
+ && (!lang_GNU_Fortran ()
+ || TREE_CODE (BLOCK_SUBBLOCKS (block)) != STATEMENT_LIST))
{
pp_string (pp, "SUBBLOCKS: ");
for (t = BLOCK_SUBBLOCKS (block); t; t = BLOCK_CHAIN (t))
+2025-04-17 Kwok Cheung Yeung <kcyeung@baylibre.com>
+
+ * target.c (kind_to_name): Handle GOMP_MAP_STRUCT and
+ GOMP_MAP_STRUCT_UNORD.
+ (gomp_add_map): New.
+ (gomp_merge_iterator_maps): Expand fields of a struct mapping
+ breadth-first.
+ * testsuite/libgomp.fortran/target-map-iterators-1.f90: New.
+ * testsuite/libgomp.fortran/target-map-iterators-2.f90: New.
+ * testsuite/libgomp.fortran/target-map-iterators-3.f90: New.
+
2025-04-17 Kwok Cheung Yeung <kcyeung@baylibre.com>
* target.c (gomp_update): Call gomp_merge_iterator_maps. Free
case GOMP_MAP_POINTER: return "GOMP_MAP_POINTER";
case GOMP_MAP_ATTACH: return "GOMP_MAP_ATTACH";
case GOMP_MAP_DETACH: return "GOMP_MAP_DETACH";
+ case GOMP_MAP_STRUCT: return "GOMP_MAP_STRUCT";
+ case GOMP_MAP_STRUCT_UNORD: return "GOMP_MAP_STRUCT_UNORD";
default: return "unknown";
}
}
+static void
+gomp_add_map (size_t idx, size_t *new_idx,
+ void ***hostaddrs, size_t **sizes, unsigned short **skinds,
+ void ***new_hostaddrs, size_t **new_sizes,
+ unsigned short **new_kinds, size_t *iterator_count)
+{
+ if ((*sizes)[idx] == SIZE_MAX)
+ {
+ uintptr_t *iterator_array = (*hostaddrs)[idx];
+ size_t count = *iterator_array++;
+ for (size_t i = 0; i < count; i++)
+ {
+ (*new_hostaddrs)[*new_idx] = (void *) *iterator_array++;
+ (*new_sizes)[*new_idx] = *iterator_array++;
+ (*new_kinds)[*new_idx] = (*skinds)[idx];
+ iterator_count[*new_idx] = i + 1;
+ gomp_debug (1,
+ "Expanding map %u <%s>: "
+ "hostaddrs[%u] = %p, sizes[%u] = %lu\n",
+ (int) idx, kind_to_name ((*new_kinds)[*new_idx]),
+ (int) *new_idx, (*new_hostaddrs)[*new_idx],
+ (int) *new_idx, (unsigned long) (*new_sizes)[*new_idx]);
+ (*new_idx)++;
+ }
+ }
+ else
+ {
+ (*new_hostaddrs)[*new_idx] = (*hostaddrs)[idx];
+ (*new_sizes)[*new_idx] = (*sizes)[idx];
+ (*new_kinds)[*new_idx] = (*skinds)[idx];
+ iterator_count[*new_idx] = 0;
+ (*new_idx)++;
+ }
+}
+
+
/* Map entries containing expanded iterators will be flattened and merged into
HOSTADDRS, SIZES and KINDS, and MAPNUM updated. Returns true if there are
any iterators found. ITERATOR_COUNT holds the iteration count of the
for (size_t i = 0; i < *mapnum; i++)
{
- if ((*sizes)[i] == SIZE_MAX)
+ int map_type = get_kind (true, *skinds, i) & 0xff;
+ if (map_type == GOMP_MAP_STRUCT || map_type == GOMP_MAP_STRUCT_UNORD)
{
- uintptr_t *iterator_array = (*hostaddrs)[i];
- size_t count = *iterator_array++;
- for (size_t j = 0; j < count; j++)
+ size_t field_count = (*sizes)[i];
+ size_t idx_i = new_idx;
+
+ gomp_add_map (i, &new_idx, hostaddrs, sizes, skinds,
+ &new_hostaddrs, &new_sizes, &new_kinds,
+ *iterator_count);
+
+ for (size_t j = i + 1; j <= i + field_count; j++)
{
- new_hostaddrs[new_idx] = (void *) *iterator_array++;
- new_sizes[new_idx] = *iterator_array++;
- new_kinds[new_idx] = (*skinds)[i];
- (*iterator_count)[new_idx] = j + 1;
- gomp_debug (1,
- "Expanding map %u <%s>: "
- "hostaddrs[%u] = %p, sizes[%u] = %lu\n",
- (int) i, kind_to_name (new_kinds[new_idx]),
- (int) new_idx, new_hostaddrs[new_idx],
- (int) new_idx, (unsigned long) new_sizes[new_idx]);
- new_idx++;
+ if ((*sizes)[j] == SIZE_MAX)
+ {
+ uintptr_t *iterator_array = (*hostaddrs)[j];
+ size_t count = iterator_array[0];
+ new_sizes[idx_i] += count - 1;
+ }
+ gomp_add_map (j, &new_idx, hostaddrs, sizes, skinds,
+ &new_hostaddrs, &new_sizes, &new_kinds,
+ *iterator_count);
}
+ gomp_debug (1, "Map %u: new field count = %lu\n",
+ (int) i, (unsigned long) new_sizes[idx_i]);
+ i += field_count;
}
else
- {
- new_hostaddrs[new_idx] = (*hostaddrs)[i];
- new_sizes[new_idx] = (*sizes)[i];
- new_kinds[new_idx] = (*skinds)[i];
- (*iterator_count)[new_idx] = 0;
- new_idx++;
- }
+ gomp_add_map (i, &new_idx, hostaddrs, sizes, skinds,
+ &new_hostaddrs, &new_sizes, &new_kinds, *iterator_count);
}
*mapnum = map_count;
--- /dev/null
+! { dg-do run }
+
+! Test transfer of dynamically-allocated arrays to target using map
+! iterators.
+
+program test
+ implicit none
+
+ integer, parameter :: DIM1 = 8
+ integer, parameter :: DIM2 = 15
+
+ type :: array_ptr
+ integer, pointer :: arr(:)
+ end type
+
+ type (array_ptr) :: x(DIM1)
+ integer :: expected, sum, i, j
+
+ expected = mkarray ()
+
+ !$omp target map(iterator(i=1:DIM1), to: x(i)%arr(:)) map(from: sum)
+ sum = 0
+ do i = 1, DIM1
+ do j = 1, DIM2
+ sum = sum + x(i)%arr(j)
+ end do
+ end do
+ !$omp end target
+
+ if (sum .ne. expected) stop 1
+contains
+ integer function mkarray ()
+ integer :: exp = 0
+
+ do i = 1, DIM1
+ allocate (x(i)%arr(DIM2))
+ do j = 1, DIM2
+ x(i)%arr(j) = i * j
+ exp = exp + x(i)%arr(j)
+ end do
+ end do
+
+ mkarray = exp
+ end function
+end program
--- /dev/null
+! { dg-do run }
+
+! Test transfer of dynamically-allocated arrays from target using map
+! iterators.
+
+program test
+ implicit none
+
+ integer, parameter :: DIM1 = 8
+ integer, parameter :: DIM2 = 15
+
+ type :: array_ptr
+ integer, pointer :: arr(:)
+ end type
+
+ type (array_ptr) :: x(DIM1)
+ integer :: expected, sum, i, j
+
+ call mkarray
+
+ !$omp target map(iterator(i=1:DIM1), from: x(i)%arr(:)) map(from: expected)
+ expected = 0
+ do i = 1, DIM1
+ do j = 1, DIM2
+ x(i)%arr(j) = (i+1) * (j+1)
+ expected = expected + x(i)%arr(j)
+ end do
+ end do
+ !$omp end target
+
+ sum = 0
+ do i = 1, DIM1
+ do j = 1, DIM2
+ sum = sum + x(i)%arr(j)
+ end do
+ end do
+
+ if (sum .ne. expected) stop 1
+contains
+ subroutine mkarray
+ do i = 1, DIM1
+ allocate (x(i)%arr(DIM2))
+ end do
+ end subroutine
+end program
--- /dev/null
+! { dg-do run }
+
+! Test transfer of dynamically-allocated arrays to target using map
+! iterators, with multiple iterators and function calls in the iterator
+! expression.
+
+program test
+ implicit none
+
+ integer, parameter :: DIM1 = 16
+ integer, parameter :: DIM2 = 4
+
+ type :: array_ptr
+ integer, pointer :: arr(:)
+ end type
+
+ type (array_ptr) :: x(DIM1), y(DIM1)
+ integer :: expected, sum, i, j, k
+
+ expected = mkarrays ()
+
+ !$omp target map(iterator(i=0:DIM1/4-1, j=0:3), to: x(f (i, j))%arr(:)) &
+ !$omp map(iterator(k=1:DIM1), to: y(k)%arr(:)) &
+ !$omp map(from: sum)
+ sum = 0
+ do i = 1, DIM1
+ do j = 1, DIM2
+ sum = sum + x(i)%arr(j) * y(i)%arr(j)
+ end do
+ end do
+ !$omp end target
+
+ if (sum .ne. expected) stop 1
+contains
+ integer function mkarrays ()
+ integer :: exp = 0
+
+ do i = 1, DIM1
+ allocate (x(i)%arr(DIM2))
+ allocate (y(i)%arr(DIM2))
+ do j = 1, DIM2
+ x(i)%arr(j) = i * j
+ y(i)%arr(j) = i + j
+ exp = exp + x(i)%arr(j) * y(i)%arr(j)
+ end do
+ end do
+
+ mkarrays = exp
+ end function
+
+ integer function f (i, j)
+ integer, intent(in) :: i, j
+
+ f = i * 4 + j + 1
+ end function
+end program
projects / thirdparty / gcc.git / commitdiff
