@@ -1359,7 +1359,8 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
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)
@@ -1371,8 +1372,12 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
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)
{
@@ -193,7 +193,8 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
gfc_free_expr (c->vector_length_expr);
for (i = 0; i < OMP_LIST_NUM; i++)
gfc_free_omp_namelist (c->lists[i],
- i == OMP_LIST_AFFINITY || i == OMP_LIST_DEPEND,
+ i == OMP_LIST_AFFINITY || i == OMP_LIST_DEPEND
+ || i == OMP_LIST_MAP,
i == OMP_LIST_ALLOCATE,
i == OMP_LIST_USES_ALLOCATORS,
i == OMP_LIST_INIT);
@@ -3472,9 +3473,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
int always_modifier = 0;
int close_modifier = 0;
int present_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_present_locus = old_loc2;
+ locus second_iterator_locus = old_loc2;
for (;;)
{
@@ -3494,6 +3498,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
if (present_modifier++ == 1)
second_present_locus = current_locus;
}
+ else if (gfc_match_iterator (&ns_iter, true) == MATCH_YES)
+ {
+ if (iterator_modifier++ == 1)
+ second_iterator_locus = current_locus;
+ }
else
break;
gfc_match (", ");
@@ -3550,15 +3559,30 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
&second_present_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],
+ if (ns_iter)
+ gfc_current_ns = ns_iter;
+ m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_MAP],
false, NULL, &head,
- true, true) == MATCH_YES)
+ true, true);
+ gfc_current_ns = ns_curr;
+ if (m == MATCH_YES)
{
gfc_omp_namelist *n;
for (n = *head; n; n = n->next)
- n->u.map.op = map_op;
+ {
+ n->u.map.op = map_op;
+ n->u2.ns = ns_iter;
+ if (ns_iter)
+ ns_iter->refs++;
+ }
continue;
}
gfc_current_locus = old_loc;
@@ -8869,7 +8893,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
case OMP_LIST_CACHE:
for (; n != NULL; n = n->next)
{
- 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;
@@ -2699,7 +2699,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
locus where, bool declare_simd = false,
bool openacc = false, gfc_exec_op op = EXEC_NOP)
{
- tree omp_clauses = NULL_TREE, prev_clauses, chunk_size, c;
+ tree omp_clauses = NULL_TREE, prev_clauses = NULL_TREE, chunk_size, c;
tree iterator = NULL_TREE;
tree tree_block = NULL_TREE;
stmtblock_t iter_block;
@@ -3178,11 +3178,39 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
}
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))
+ 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;
+
bool always_modifier = false;
tree node = build_omp_clause (input_location, OMP_CLAUSE_MAP);
tree node2 = NULL_TREE;
@@ -3381,7 +3409,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
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,
@@ -3441,7 +3469,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
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);
@@ -3469,7 +3498,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
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;
}
@@ -3558,7 +3587,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
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,
@@ -3587,12 +3616,12 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
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;
}
}
@@ -3604,7 +3633,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
/* A single indirectref is handled by the middle end. */
gcc_assert (!POINTER_TYPE_P (TREE_TYPE (decl)));
decl = TREE_OPERAND (decl, 0);
- decl = gfc_build_cond_assign_expr (block, present, decl,
+ decl = gfc_build_cond_assign_expr (&iter_block,
+ present, decl,
null_pointer_node);
OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (decl);
}
@@ -3638,7 +3668,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
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;
}
}
@@ -3657,7 +3687,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
&& !(POINTER_TYPE_P (type)
&& GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (type))))
k = GOMP_MAP_FIRSTPRIVATE_POINTER;
- gfc_trans_omp_array_section (block, op, n, decl, element,
+ gfc_trans_omp_array_section (&iter_block,
+ op, n, decl, element,
!openacc, k, node, node2,
node3, node4);
}
@@ -3675,12 +3706,12 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
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
@@ -3892,7 +3923,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
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);
@@ -4030,7 +4061,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
/* 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, op, n, inner, element,
+ gfc_trans_omp_array_section (&iter_block,
+ op, n, inner, element,
!openacc, kind, node, node2,
node3, node4);
}
@@ -4042,6 +4074,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
finalize_map_clause:
+ if (!iterator)
+ gfc_add_block_to_block (block, &iter_block);
omp_clauses = gfc_trans_add_clause (node, omp_clauses);
if (node2)
omp_clauses = gfc_trans_add_clause (node2, omp_clauses);
@@ -4052,6 +4086,15 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
if (node5)
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))
+ OMP_CLAUSE_ITERATORS (c) = iterator;
+ }
break;
case OMP_LIST_TO:
case OMP_LIST_FROM:
@@ -9039,10 +9039,17 @@ compute_omp_iterator_count (tree it, gimple_seq *pre_p)
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);
@@ -9086,6 +9093,7 @@ build_omp_iterator_loop (tree it, gimple_seq *pre_p, tree *last_bind)
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;
@@ -9097,6 +9105,7 @@ build_omp_iterator_loop (tree it, gimple_seq *pre_p, tree *last_bind)
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:
@@ -9107,9 +9116,9 @@ build_omp_iterator_loop (tree it, gimple_seq *pre_p, tree *last_bind)
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. */
@@ -9135,10 +9144,12 @@ build_omp_iterator_loop (tree it, gimple_seq *pre_p, tree *last_bind)
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);
@@ -9147,6 +9158,11 @@ build_omp_iterator_loop (tree it, gimple_seq *pre_p, tree *last_bind)
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;
@@ -9287,8 +9303,14 @@ remove_unused_omp_iterator_vars (tree *list_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 ());
@@ -9951,6 +9973,34 @@ build_omp_struct_comp_nodes (enum tree_code code, tree grp_start, tree grp_end,
return c2;
}
+/* Callback for walk_tree. Return any VAR_DECLS that are not found in the
+ iterators stored in DATA. */
+
+static tree
+contains_only_iterator_vars_1 (tree* tp, int *, void *data)
+{
+ tree iterators = (tree) data;
+ tree t = *tp;
+
+ if (TREE_CODE (t) != VAR_DECL)
+ return NULL_TREE;
+
+ for (tree it = iterators; it; it = TREE_CHAIN (it))
+ if (t == TREE_VEC_ELT (it, 0))
+ return NULL_TREE;
+
+ return t;
+}
+
+/* Return true if the only variables present in EXPR are iterator variables in
+ ITERATORS. */
+
+static bool
+contains_only_iterator_vars (tree expr, tree iterators)
+{
+ return !walk_tree (&expr, contains_only_iterator_vars_1, iterators, 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
@@ -9961,7 +10011,8 @@ build_omp_struct_comp_nodes (enum tree_code code, tree grp_start, tree grp_end,
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;
@@ -9985,6 +10036,8 @@ extract_base_bit_offset (tree base, poly_int64 *bitposp,
{
poffset = 0;
*variable_offset = (offset != NULL_TREE);
+ if (iterator && *variable_offset)
+ *variable_offset = !contains_only_iterator_vars (offset, iterator);
}
if (maybe_ne (bitpos, 0))
@@ -11790,8 +11843,11 @@ omp_accumulate_sibling_list (enum omp_region_type region_type,
}
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--)
@@ -12124,8 +12180,12 @@ omp_accumulate_sibling_list (enum omp_region_type region_type,
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)
new file mode 100644
@@ -0,0 +1,26 @@
+! { 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
new file mode 100644
@@ -0,0 +1,33 @@
+! { 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" } }
new file mode 100644
@@ -0,0 +1,24 @@
+! { 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=D\\\.\[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=D\\\.\[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=D\\\.\[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=D\\\.\[0-9\]+, index=D\\.\[0-9\]+\\):attach:y\\\[D\\\.\[0-9\]+\\\]\.ptr\.data" 1 "gimple" } }
new file mode 100644
@@ -0,0 +1,31 @@
+! { 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, &i\\\)" 2 "gimple" } }
+! { dg-final { scan-tree-dump-times "map\\\(iterator\\\(integer\\\(kind=4\\\) i=1:4:1, loop_label=" 2 "gimple" } }
@@ -1781,7 +1781,9 @@ dump_block_node (pretty_printer *pp, tree block, int spc, dump_flags_t flags)
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))
@@ -993,10 +993,48 @@ kind_to_name (unsigned short kind)
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
@@ -1037,33 +1075,34 @@ gomp_merge_iterator_maps (size_t *mapnum, void ***hostaddrs, size_t **sizes,
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];
+
+ 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[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[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;
new file mode 100644
@@ -0,0 +1,45 @@
+! { 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
new file mode 100644
@@ -0,0 +1,45 @@
+! { 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
new file mode 100644
@@ -0,0 +1,56 @@
+! { 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