This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[gomp] Handle assumed-shape-array reductions (add OMP_CLAUSE_REDUCTION_{INIT,MERGE,PLACEHOLDER})
- From: Jakub Jelinek <jakub at redhat dot com>
- To: Richard Henderson <rth at redhat dot com>, Diego Novillo <dnovillo at redhat dot com>
- Cc: gcc-patches at gcc dot gnu dot org
- Date: Thu, 3 Nov 2005 13:57:25 -0500
- Subject: [gomp] Handle assumed-shape-array reductions (add OMP_CLAUSE_REDUCTION_{INIT,MERGE,PLACEHOLDER})
- Reply-to: Jakub Jelinek <jakub at redhat dot com>
Hi!
Assumed-shape array reductions really can't be expanded in the middle-end.
So, either we can expand the sequences for them in the frontend when
we still have frontend trees handy and stick them into the
OMP_CLAUSE_REDUCTION's operand for later use by the middle-end,
or we would need a bunch of langhooks that would
1) gather what shared resp. firstprivate variables the sequences will need,
arrange all of that to be omp_notice_variable'd
2) expand the sequences in other langhooks (and replicate a lot of code
already present in the FE for expansion of them)
reduction6.f90 still doesn't work with this patch: there are 2 issues
- one is that walk_tree only walks the first omp clause and not the
rest, so things don't get unshared when they should be (I have
a temporary patch in my tree to overcome that) and then reduction6.f90
suffers from the exact same problem as vla1.f90. All other
reduction*.f90 etc. testcases work (and this code is used for all array
reductions) though and I have eyeballed reduction6.f90.t18.omplower
and the output looks good except of the vla1.f90-ish bug.
Ok for gomp?
2005-11-03 Jakub Jelinek <jakub@redhat.com>
* tree.h (OMP_CLAUSE_REDUCTION_INIT, OMP_CLAUSE_REDUCTION_MERGE,
OMP_CLAUSE_REDUCTION_PLACEHOLDER): Define.
* tree.def (OMP_CLAUSE_REDUCTION): Add 3 extra operands, update
comment.
* gimplify.c (gimplify_scan_omp_clauses): Call omp_add_variable
on OMP_CLAUSE_REDUCTION_PLACEHOLDER, gimplify
OMP_CLAUSE_REDUCTION_{INIT,MERGE} to notice all used variables.
* tree-gimple.h (omp_reduction_init): New prototype.
* omp-low.c (scan_sharing_clauses): Call scan_omp at the end on
OMP_CLAUSE_REDUCTION_{INIT,MERGE}.
(build_reduction_init): Renamed to...
(omp_reduction_init): ... this. No longer static. Don't handle
ARRAY_TYPE here.
(array_reduction_init, array_reduction_op): Removed.
(expand_rec_input_clauses): Don't call array_reduction_init,
instead gimplify OMP_CLAUSE_REDUCTION_INIT if non-NULL, in
the second pass.
(expand_reduction_clauses): Don't call array_reduction_op,
instead gimplify OMP_CLAUSE_REDUCTION_MERGE if non-NULL.
fortran/
* trans-openmp.c (gfc_omp_privatize_by_reference): Return
true if a pointer has GFC_DECL_SAVED_DESCRIPTOR set.
(gfc_trans_omp_array_reduction, gfc_trans_omp_reduction_list): New
functions.
(gfc_trans_omp_clauses): Add WHERE argument. Call
gfc_trans_omp_reduction_list rather than gfc_trans_omp_variable_list
for reductions.
(gfc_trans_omp_do, gfc_trans_omp_parallel, gfc_trans_omp_parallel_do,
gfc_trans_omp_parallel_sections, gfc_trans_omp_parallel_workshare,
gfc_trans_omp_sections, gfc_trans_omp_single): Adjust
gfc_trans_omp_clauses callers.
--- gcc/omp-low.c.jj 2005-11-02 08:38:00.000000000 +0100
+++ gcc/omp-low.c 2005-11-03 19:35:49.000000000 +0100
@@ -569,6 +569,7 @@ static void
scan_sharing_clauses (tree clauses, omp_context *ctx)
{
tree c, decl;
+ bool scan_array_reductions = false;
for (c = clauses; c; c = OMP_CLAUSE_CHAIN (c))
{
@@ -672,6 +673,9 @@ scan_sharing_clauses (tree clauses, omp_
fixup_remapped_decl (decl, ctx,
TREE_CODE (c) == OMP_CLAUSE_PRIVATE
&& OMP_CLAUSE_PRIVATE_DEBUG (c));
+ if (TREE_CODE (c) == OMP_CLAUSE_REDUCTION
+ && OMP_CLAUSE_REDUCTION_PLACEHOLDER (c))
+ scan_array_reductions = true;
break;
case OMP_CLAUSE_SHARED:
@@ -693,6 +697,15 @@ scan_sharing_clauses (tree clauses, omp_
gcc_unreachable ();
}
}
+
+ if (scan_array_reductions)
+ for (c = clauses; c; c = OMP_CLAUSE_CHAIN (c))
+ if (TREE_CODE (c) == OMP_CLAUSE_REDUCTION
+ && OMP_CLAUSE_REDUCTION_PLACEHOLDER (c))
+ {
+ scan_omp (&OMP_CLAUSE_REDUCTION_INIT (c), ctx);
+ scan_omp (&OMP_CLAUSE_REDUCTION_MERGE (c), ctx);
+ }
}
/* Create a new name for omp child function. Returns an identifier. */
@@ -1239,12 +1252,9 @@ maybe_lookup_ctx (tree stmt)
/* Construct the initialization value for reduction CLAUSE. */
-static tree
-build_reduction_init (tree clause, tree type)
+tree
+omp_reduction_init (tree clause, tree type)
{
- while (TREE_CODE (type) == ARRAY_TYPE)
- type = TREE_TYPE (type);
-
switch (OMP_CLAUSE_REDUCTION_CODE (clause))
{
case PLUS_EXPR:
@@ -1306,59 +1316,6 @@ build_reduction_init (tree clause, tree
}
}
-/* Initialize all entries of array VAR to value X. */
-
-static void
-array_reduction_init (tree var, tree x, tree *stmt_list)
-{
- tree ptr_type, array = var, ptr;
- tree test_label = NULL, loop_label, end_label = NULL;
- tree stmt, end, cond;
-
- while (TREE_CODE (TREE_TYPE (array)) == ARRAY_TYPE)
- {
- tree type_domain = TYPE_DOMAIN (TREE_TYPE (array));
- tree min_val = size_zero_node;
- if (type_domain && TYPE_MIN_VALUE (type_domain))
- min_val = TYPE_MIN_VALUE (type_domain);
- array = build4 (ARRAY_REF, TREE_TYPE (TREE_TYPE (array)),
- array, min_val, NULL_TREE, NULL_TREE);
- }
- array = build_fold_addr_expr (array);
- ptr_type = TREE_TYPE (array);
- ptr = create_tmp_var (ptr_type, NULL);
-
- stmt = build2 (MODIFY_EXPR, void_type_node, ptr, array);
- gimplify_and_add (stmt, stmt_list);
-
- append_to_statement_list (build_and_jump (&test_label), stmt_list);
-
- loop_label = create_artificial_label ();
- stmt = build1 (LABEL_EXPR, void_type_node, loop_label);
- append_to_statement_list (stmt, stmt_list);
-
- stmt = build2 (MODIFY_EXPR, void_type_node,
- build_fold_indirect_ref (ptr), x);
- gimplify_and_add (stmt, stmt_list);
-
- stmt = build2 (POSTINCREMENT_EXPR, ptr_type, ptr,
- fold_convert (ptr_type, TYPE_SIZE_UNIT (TREE_TYPE (x))));
- gimplify_and_add (stmt, stmt_list);
-
- stmt = build1 (LABEL_EXPR, void_type_node, test_label);
- append_to_statement_list (stmt, stmt_list);
-
- end = build2 (PLUS_EXPR, ptr_type, array,
- fold_convert (ptr_type, TYPE_SIZE_UNIT (TREE_TYPE (var))));
- cond = build2 (GT_EXPR, boolean_type_node, end, ptr);
- stmt = build3 (COND_EXPR, void_type_node, cond,
- build_and_jump (&loop_label), build_and_jump (&end_label));
- gimplify_and_add (stmt, stmt_list);
-
- stmt = build1 (LABEL_EXPR, void_type_node, end_label);
- append_to_statement_list (stmt, stmt_list);
-}
-
/* Generate code to implement the input clauses, FIRSTPRIVATE and COPYIN,
from the receiver (aka child) side and initializers for REFERENCE_TYPE
private variables. Initialization statements go in ILIST, while calls
@@ -1469,6 +1426,12 @@ expand_rec_input_clauses (tree clauses,
new_var = build_fold_indirect_ref (new_var);
}
+ else if (c_kind == OMP_CLAUSE_REDUCTION
+ && OMP_CLAUSE_REDUCTION_PLACEHOLDER (c))
+ {
+ if (pass == 0)
+ continue;
+ }
else if (pass != 0)
continue;
@@ -1521,11 +1484,15 @@ expand_rec_input_clauses (tree clauses,
break;
case OMP_CLAUSE_REDUCTION:
- x = build_reduction_init (c, TREE_TYPE (new_var));
- if (TREE_CODE (TREE_TYPE (new_var)) == ARRAY_TYPE)
- array_reduction_init (new_var, x, ilist);
+ if (OMP_CLAUSE_REDUCTION_PLACEHOLDER (c))
+ {
+ gimplify_and_add (OMP_CLAUSE_REDUCTION_INIT (c), ilist);
+ OMP_CLAUSE_REDUCTION_INIT (c) = NULL;
+ }
else
{
+ x = omp_reduction_init (c, TREE_TYPE (new_var));
+ gcc_assert (TREE_CODE (TREE_TYPE (new_var)) != ARRAY_TYPE);
x = build2 (MODIFY_EXPR, void_type_node, new_var, x);
gimplify_and_add (x, ilist);
}
@@ -1611,78 +1578,6 @@ expand_lastprivate_clauses (tree clauses
gimplify_and_add (x, stmt_list);
}
-/* Perform DST[x] = DST[x] OP SRC[x] on all entries of the arrays. */
-
-static void
-array_reduction_op (enum tree_code op, tree dst, tree src, tree *stmt_list)
-{
- tree ptr_type, dst_array = dst, src_array = src, dstp, srcp;
- tree test_label = NULL, loop_label, end_label = NULL;
- tree stmt, end, cond, x, size;
-
- while (TREE_CODE (TREE_TYPE (src_array)) == ARRAY_TYPE)
- {
- tree type_domain = TYPE_DOMAIN (TREE_TYPE (src_array));
- tree min_val = size_zero_node;
- if (type_domain && TYPE_MIN_VALUE (type_domain))
- min_val = TYPE_MIN_VALUE (type_domain);
- src_array = build4 (ARRAY_REF, TREE_TYPE (TREE_TYPE (src_array)),
- src_array, min_val, NULL_TREE, NULL_TREE);
- }
- while (TREE_CODE (TREE_TYPE (dst_array)) == ARRAY_TYPE)
- {
- tree type_domain = TYPE_DOMAIN (TREE_TYPE (dst_array));
- tree min_val = size_zero_node;
- if (type_domain && TYPE_MIN_VALUE (type_domain))
- min_val = TYPE_MIN_VALUE (type_domain);
- dst_array = build4 (ARRAY_REF, TREE_TYPE (TREE_TYPE (dst_array)),
- dst_array, min_val, NULL_TREE, NULL_TREE);
- }
- src_array = build_fold_addr_expr (src_array);
- dst_array = build_fold_addr_expr (dst_array);
- ptr_type = TREE_TYPE (src_array);
- srcp = create_tmp_var (ptr_type, NULL);
- dstp = create_tmp_var (ptr_type, NULL);
-
- stmt = build2 (MODIFY_EXPR, void_type_node, srcp, src_array);
- gimplify_and_add (stmt, stmt_list);
-
- stmt = build2 (MODIFY_EXPR, void_type_node, dstp, dst_array);
- gimplify_and_add (stmt, stmt_list);
-
- append_to_statement_list (build_and_jump (&test_label), stmt_list);
-
- loop_label = create_artificial_label ();
- stmt = build1 (LABEL_EXPR, void_type_node, loop_label);
- append_to_statement_list (stmt, stmt_list);
-
- x = build2 (op, TREE_TYPE (ptr_type), build_fold_indirect_ref (dstp),
- build_fold_indirect_ref (srcp));
- stmt = build2 (MODIFY_EXPR, void_type_node,
- build_fold_indirect_ref (dstp), x);
- gimplify_and_add (stmt, stmt_list);
-
- size = fold_convert (ptr_type, TYPE_SIZE_UNIT (TREE_TYPE (ptr_type)));
- stmt = build2 (POSTINCREMENT_EXPR, ptr_type, srcp, size);
- gimplify_and_add (stmt, stmt_list);
-
- stmt = build2 (POSTINCREMENT_EXPR, ptr_type, dstp, size);
- gimplify_and_add (stmt, stmt_list);
-
- stmt = build1 (LABEL_EXPR, void_type_node, test_label);
- append_to_statement_list (stmt, stmt_list);
-
- end = build2 (PLUS_EXPR, ptr_type, src_array,
- fold_convert (ptr_type, TYPE_SIZE_UNIT (TREE_TYPE (src))));
- cond = build2 (GT_EXPR, boolean_type_node, end, srcp);
- stmt = build3 (COND_EXPR, void_type_node, cond,
- build_and_jump (&loop_label), build_and_jump (&end_label));
- gimplify_and_add (stmt, stmt_list);
-
- stmt = build1 (LABEL_EXPR, void_type_node, end_label);
- append_to_statement_list (stmt, stmt_list);
-}
-
/* Generate code to implement the REDUCTION clauses. */
static void
@@ -1696,12 +1591,9 @@ expand_reduction_clauses (tree clauses,
for (c = clauses; c && count < 2; c = OMP_CLAUSE_CHAIN (c))
if (TREE_CODE (c) == OMP_CLAUSE_REDUCTION)
{
- tree type = TREE_TYPE (OMP_CLAUSE_DECL (c));
- if (is_reference (OMP_CLAUSE_DECL (c)))
- type = TREE_TYPE (type);
- /* Never use OMP_ATOMIC for array reductions. */
- if (TREE_CODE (type) == ARRAY_TYPE)
+ if (OMP_CLAUSE_REDUCTION_PLACEHOLDER (c))
{
+ /* Never use OMP_ATOMIC for array reductions. */
count = -1;
break;
}
@@ -1737,9 +1629,16 @@ expand_reduction_clauses (tree clauses,
return;
}
- if (TREE_CODE (TREE_TYPE (new_var)) == ARRAY_TYPE)
- array_reduction_op (OMP_CLAUSE_REDUCTION_CODE (c),
- ref, new_var, &sub_list);
+ if (OMP_CLAUSE_REDUCTION_PLACEHOLDER (c))
+ {
+ tree placeholder = OMP_CLAUSE_REDUCTION_PLACEHOLDER (c);
+
+ SET_DECL_VALUE_EXPR (placeholder, ref);
+ DECL_HAS_VALUE_EXPR_P (placeholder) = 1;
+ gimplify_and_add (OMP_CLAUSE_REDUCTION_MERGE (c), &sub_list);
+ OMP_CLAUSE_REDUCTION_MERGE (c) = NULL;
+ OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) = NULL;
+ }
else
{
x = build2 (OMP_CLAUSE_REDUCTION_CODE (c),
--- gcc/tree.h.jj 2005-11-01 20:01:13.000000000 +0100
+++ gcc/tree.h 2005-11-03 10:27:44.000000000 +0100
@@ -1451,6 +1451,12 @@ struct tree_constructor GTY(())
#define OMP_CLAUSE_REDUCTION_CODE(NODE) \
(OMP_CLAUSE_REDUCTION_CHECK (NODE)->exp.complexity)
+#define OMP_CLAUSE_REDUCTION_INIT(NODE) \
+ TREE_OPERAND (OMP_CLAUSE_REDUCTION_CHECK (NODE), 1)
+#define OMP_CLAUSE_REDUCTION_MERGE(NODE) \
+ TREE_OPERAND (OMP_CLAUSE_REDUCTION_CHECK (NODE), 2)
+#define OMP_CLAUSE_REDUCTION_PLACEHOLDER(NODE) \
+ TREE_OPERAND (OMP_CLAUSE_REDUCTION_CHECK (NODE), 3)
enum omp_clause_schedule_kind
{
--- gcc/fortran/trans-openmp.c.jj 2005-11-01 20:01:13.000000000 +0100
+++ gcc/fortran/trans-openmp.c 2005-11-03 18:31:51.000000000 +0100
@@ -48,10 +48,22 @@ gfc_omp_privatize_by_reference (tree dec
if (TREE_CODE (type) == REFERENCE_TYPE)
return true;
- /* POINTER/ALLOCATABLE have aggregate types, all user variables
- that have POINTER_TYPE type are supposed to be privatized
- by reference. */
- return !DECL_ARTIFICIAL (decl) && TREE_CODE (type) == POINTER_TYPE;
+ if (TREE_CODE (type) == POINTER_TYPE)
+ {
+ /* POINTER/ALLOCATABLE have aggregate types, all user variables
+ that have POINTER_TYPE type are supposed to be privatized
+ by reference. */
+ if (!DECL_ARTIFICIAL (decl))
+ return true;
+
+ /* Some arrays are expanded as DECL_ARTIFICIAL pointers
+ by the frontend. */
+ if (DECL_LANG_SPECIFIC (decl)
+ && GFC_DECL_SAVED_DESCRIPTOR (decl))
+ return true;
+ }
+
+ return false;
}
/* True if OpenMP sharing attribute of DECL is predetermined. */
@@ -156,8 +168,201 @@ gfc_trans_omp_variable_list (enum tree_c
return list;
}
+static void
+gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
+{
+ gfc_symtree *root1 = NULL, *root2 = NULL, *root3 = NULL, *root4 = NULL;
+ gfc_symtree *symtree1, *symtree2, *symtree3, *symtree4 = NULL;
+ gfc_symbol init_val_sym, outer_sym, intrinsic_sym;
+ gfc_expr *e1, *e2, *e3, *e4;
+ gfc_ref *ref;
+ tree decl, backend_decl;
+ locus old_loc = gfc_current_locus;
+ const char *iname;
+ try t;
+
+ decl = OMP_CLAUSE_DECL (c);
+ gfc_current_locus = where;
+
+ /* Create a fake symbol for init value. */
+ memset (&init_val_sym, 0, sizeof (init_val_sym));
+ init_val_sym.ns = sym->ns;
+ init_val_sym.name = sym->name;
+ init_val_sym.ts = sym->ts;
+ init_val_sym.attr.referenced = 1;
+ init_val_sym.declared_at = where;
+ backend_decl = omp_reduction_init (c, gfc_sym_type (&init_val_sym));
+ init_val_sym.backend_decl = backend_decl;
+
+ /* Create a fake symbol for the outer array reference. */
+ outer_sym = *sym;
+ outer_sym.as = gfc_copy_array_spec (sym->as);
+ outer_sym.attr.dummy = 0;
+ outer_sym.attr.result = 0;
+ outer_sym.backend_decl = create_tmp_var_raw (TREE_TYPE (decl), NULL);
+
+ /* Create fake symtrees for it. */
+ symtree1 = gfc_new_symtree (&root1, sym->name);
+ symtree1->n.sym = sym;
+ gcc_assert (symtree1 == root1);
+
+ symtree2 = gfc_new_symtree (&root2, sym->name);
+ symtree2->n.sym = &init_val_sym;
+ gcc_assert (symtree2 == root2);
+
+ symtree3 = gfc_new_symtree (&root3, sym->name);
+ symtree3->n.sym = &outer_sym;
+ gcc_assert (symtree3 == root3);
+
+ /* Create expressions. */
+ e1 = gfc_get_expr ();
+ e1->expr_type = EXPR_VARIABLE;
+ e1->where = where;
+ e1->symtree = symtree1;
+ e1->ts = sym->ts;
+ e1->ref = ref = gfc_get_ref ();
+ ref->u.ar.where = where;
+ ref->u.ar.as = sym->as;
+ ref->u.ar.type = AR_FULL;
+ ref->u.ar.dimen = 0;
+ t = gfc_resolve_expr (e1);
+ gcc_assert (t == SUCCESS);
+
+ e2 = gfc_get_expr ();
+ e2->expr_type = EXPR_VARIABLE;
+ e2->where = where;
+ e2->symtree = symtree2;
+ e2->ts = sym->ts;
+ t = gfc_resolve_expr (e2);
+ gcc_assert (t == SUCCESS);
+
+ e3 = gfc_copy_expr (e1);
+ e3->symtree = symtree3;
+ t = gfc_resolve_expr (e3);
+ gcc_assert (t == SUCCESS);
+
+ iname = NULL;
+ switch (OMP_CLAUSE_REDUCTION_CODE (c))
+ {
+ case PLUS_EXPR:
+ e4 = gfc_add (e3, e1);
+ break;
+ case MINUS_EXPR:
+ e4 = gfc_subtract (e3, e1);
+ break;
+ case MULT_EXPR:
+ e4 = gfc_multiply (e3, e1);
+ break;
+ case TRUTH_ANDIF_EXPR:
+ e4 = gfc_and (e3, e1);
+ break;
+ case TRUTH_ORIF_EXPR:
+ e4 = gfc_or (e3, e1);
+ break;
+ case EQ_EXPR:
+ e4 = gfc_eqv (e3, e1);
+ break;
+ case NE_EXPR:
+ e4 = gfc_neqv (e3, e1);
+ break;
+ case MIN_EXPR:
+ iname = "min";
+ break;
+ case MAX_EXPR:
+ iname = "max";
+ break;
+ case BIT_AND_EXPR:
+ iname = "iand";
+ break;
+ case BIT_IOR_EXPR:
+ iname = "ior";
+ break;
+ case BIT_XOR_EXPR:
+ iname = "ieor";
+ break;
+ default:
+ gcc_unreachable ();
+ }
+ if (iname != NULL)
+ {
+ memset (&intrinsic_sym, 0, sizeof (intrinsic_sym));
+ intrinsic_sym.ns = sym->ns;
+ intrinsic_sym.name = iname;
+ intrinsic_sym.ts = sym->ts;
+ intrinsic_sym.attr.referenced = 1;
+ intrinsic_sym.attr.intrinsic = 1;
+ intrinsic_sym.attr.function = 1;
+ intrinsic_sym.result = &intrinsic_sym;
+ intrinsic_sym.declared_at = where;
+
+ symtree4 = gfc_new_symtree (&root4, iname);
+ symtree4->n.sym = &intrinsic_sym;
+ gcc_assert (symtree4 == root4);
+
+ e4 = gfc_get_expr ();
+ e4->expr_type = EXPR_FUNCTION;
+ e4->where = where;
+ e4->symtree = symtree4;
+ e4->value.function.isym = gfc_find_function (iname);
+ e4->value.function.actual = gfc_get_actual_arglist ();
+ e4->value.function.actual->expr = e3;
+ e4->value.function.actual->next = gfc_get_actual_arglist ();
+ e4->value.function.actual->next->expr = e1;
+ }
+ /* e1 and e3 have been stored as arguments of e4, avoid sharing. */
+ e1 = gfc_copy_expr (e1);
+ e3 = gfc_copy_expr (e3);
+ t = gfc_resolve_expr (e4);
+ gcc_assert (t == SUCCESS);
+
+ /* Create the init statement list. */
+ OMP_CLAUSE_REDUCTION_INIT (c) = gfc_trans_assignment (e1, e2);
+
+ /* Create the merge statement list. */
+ OMP_CLAUSE_REDUCTION_MERGE (c) = gfc_trans_assignment (e3, e4);
+
+ /* And stick the placeholder VAR_DECL into the clause as well. */
+ OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) = outer_sym.backend_decl;
+
+ gfc_current_locus = old_loc;
+
+ gfc_free_expr (e1);
+ gfc_free_expr (e2);
+ gfc_free_expr (e3);
+ gfc_free_expr (e4);
+ gfc_free (symtree1);
+ gfc_free (symtree2);
+ gfc_free (symtree3);
+ if (symtree4)
+ gfc_free (symtree4);
+ gfc_free_array_spec (outer_sym.as);
+}
+
+static tree
+gfc_trans_omp_reduction_list (enum tree_code code, gfc_namelist *namelist,
+ tree list, enum tree_code reduction_code,
+ locus where)
+{
+ for (; namelist != NULL; namelist = namelist->next)
+ if (namelist->sym->attr.referenced)
+ {
+ tree t = gfc_get_symbol_decl (namelist->sym);
+ if (t != error_mark_node)
+ {
+ tree node = make_node (code);
+ OMP_CLAUSE_DECL (node) = t;
+ OMP_CLAUSE_REDUCTION_CODE (node) = reduction_code;
+ if (namelist->sym->attr.dimension)
+ gfc_trans_omp_array_reduction (node, namelist->sym, where);
+ list = gfc_trans_add_clause (node, list);
+ }
+ }
+ return list;
+}
+
static tree
-gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses)
+gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
+ locus where)
{
tree omp_clauses = NULL_TREE, chunk_size, c, old_clauses;
int list;
@@ -220,10 +425,9 @@ gfc_trans_omp_clauses (stmtblock_t *bloc
}
old_clauses = omp_clauses;
omp_clauses
- = gfc_trans_omp_variable_list (OMP_CLAUSE_REDUCTION, n,
- omp_clauses);
- for (c = omp_clauses; c != old_clauses; c = OMP_CLAUSE_CHAIN (c))
- OMP_CLAUSE_REDUCTION_CODE (c) = reduction_code;
+ = gfc_trans_omp_reduction_list (OMP_CLAUSE_REDUCTION, n,
+ omp_clauses, reduction_code,
+ where);
continue;
}
switch (list)
@@ -581,7 +785,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_om
gfc_start_block (&block);
- omp_clauses = gfc_trans_omp_clauses (&block, clauses);
+ omp_clauses = gfc_trans_omp_clauses (&block, clauses, code->loc);
if (clauses)
{
gfc_namelist *n;
@@ -740,7 +944,8 @@ gfc_trans_omp_parallel (gfc_code *code)
tree stmt, omp_clauses;
gfc_start_block (&block);
- omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses);
+ omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
+ code->loc);
stmt = gfc_trans_omp_code (code->block->next, true);
stmt = build2_v (OMP_PARALLEL, stmt, omp_clauses);
gfc_add_expr_to_block (&block, stmt);
@@ -767,7 +972,8 @@ gfc_trans_omp_parallel_do (gfc_code *cod
parallel_clauses.sched_kind = OMP_SCHED_NONE;
parallel_clauses.chunk_size = NULL;
parallel_clauses.ordered = false;
- omp_clauses = gfc_trans_omp_clauses (&block, ¶llel_clauses);
+ omp_clauses = gfc_trans_omp_clauses (&block, ¶llel_clauses,
+ code->loc);
}
do_clauses.nowait = true;
pushlevel (0);
@@ -792,7 +998,8 @@ gfc_trans_omp_parallel_sections (gfc_cod
section_clauses.nowait = true;
gfc_start_block (&block);
- omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses);
+ omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
+ code->loc);
pushlevel (0);
stmt = gfc_trans_omp_sections (code, §ion_clauses);
if (TREE_CODE (stmt) != BIND_EXPR)
@@ -815,7 +1022,8 @@ gfc_trans_omp_parallel_workshare (gfc_co
workshare_clauses.nowait = true;
gfc_start_block (&block);
- omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses);
+ omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
+ code->loc);
pushlevel (0);
stmt = gfc_trans_omp_workshare (code, &workshare_clauses);
if (TREE_CODE (stmt) != BIND_EXPR)
@@ -836,7 +1044,7 @@ gfc_trans_omp_sections (gfc_code *code,
gfc_start_block (&block);
- omp_clauses = gfc_trans_omp_clauses (&block, clauses);
+ omp_clauses = gfc_trans_omp_clauses (&block, clauses, code->loc);
gfc_init_block (&body);
for (code = code->block; code; code = code->block)
@@ -862,7 +1070,7 @@ gfc_trans_omp_sections (gfc_code *code,
static tree
gfc_trans_omp_single (gfc_code *code, gfc_omp_clauses *clauses)
{
- tree omp_clauses = gfc_trans_omp_clauses (NULL, clauses);
+ tree omp_clauses = gfc_trans_omp_clauses (NULL, clauses, code->loc);
tree stmt = gfc_trans_omp_code (code->block->next, true);
stmt = build2_v (OMP_SINGLE, stmt, omp_clauses);
return stmt;
--- gcc/tree.def.jj 2005-10-28 23:06:47.000000000 +0200
+++ gcc/tree.def 2005-11-03 10:27:25.000000000 +0100
@@ -1025,8 +1025,13 @@ DEFTREECODE (OMP_CLAUSE_FIRSTPRIVATE, "f
DEFTREECODE (OMP_CLAUSE_LASTPRIVATE, "lastprivate", tcc_expression, 1)
/* OpenMP clause: reduction (operator:variable_list).
- OMP_CLAUSE_REDUCTION_CODE: The tree_code of the operator. */
-DEFTREECODE (OMP_CLAUSE_REDUCTION, "reduction", tcc_expression, 1)
+ OMP_CLAUSE_REDUCTION_CODE: The tree_code of the operator.
+ Operand 1: OMP_CLAUSE_REDUCTION_INIT: Stmt-list to initialize the var.
+ Operand 2: OMP_CLAUSE_REDUCTION_MERGE:
+ Stmt-list to merge private var into the shared one.
+ Operand 3: OMP_CLAUSE_REDUCTION_PLACEHOLDER:
+ A dummy VAR_DECL placeholder used in OMP_CLAUSE_REDUCTION_MERGE. */
+DEFTREECODE (OMP_CLAUSE_REDUCTION, "reduction", tcc_expression, 4)
/* OpenMP clause: copyin (variable_list). */
DEFTREECODE (OMP_CLAUSE_COPYIN, "copyin", tcc_expression, 1)
--- gcc/gimplify.c.jj 2005-11-01 20:01:13.000000000 +0100
+++ gcc/gimplify.c 2005-11-03 11:50:22.000000000 +0100
@@ -4450,6 +4450,20 @@ gimplify_scan_omp_clauses (tree *list_p,
break;
}
omp_add_variable (ctx, decl, flags);
+ if (TREE_CODE (c) == OMP_CLAUSE_REDUCTION
+ && OMP_CLAUSE_REDUCTION_PLACEHOLDER (c))
+ {
+ omp_add_variable (ctx, OMP_CLAUSE_REDUCTION_PLACEHOLDER (c),
+ GOVD_LOCAL);
+ gimplify_omp_ctxp = ctx;
+ push_gimplify_context ();
+ gimplify_stmt (&OMP_CLAUSE_REDUCTION_INIT (c));
+ pop_gimplify_context (OMP_CLAUSE_REDUCTION_INIT (c));
+ push_gimplify_context ();
+ gimplify_stmt (&OMP_CLAUSE_REDUCTION_MERGE (c));
+ pop_gimplify_context (OMP_CLAUSE_REDUCTION_MERGE (c));
+ gimplify_omp_ctxp = outer_ctx;
+ }
if (notice_outer)
goto do_notice;
break;
--- gcc/tree-gimple.h.jj 2005-10-28 23:06:47.000000000 +0200
+++ gcc/tree-gimple.h 2005-11-03 08:29:57.000000000 +0100
@@ -132,6 +132,7 @@ extern enum gimplify_status gimplify_va_
/* In omp-low.c. */
extern tree find_omp_clause (tree, enum tree_code);
extern void diagnose_omp_structured_block_errors (tree);
+extern tree omp_reduction_init (tree, tree);
/* In tree-nested.c. */
extern void lower_nested_functions (tree);
Jakub