diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ef53e2391a8b528bd4ae705cb4d724841858ef0a..3384aad93a22114ccdb81167f4e1d379ae67f8b5 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,20 @@
+2009-04-20 Vasilis Liaskovitis <vliaskov@gmail.com>
+ Jakub Jelinek <jakub@redhat.com>
+
+ PR fortran/35423
+ * trans.h (OMPWS_WORKSHARE_FLAG, OMPWS_CURR_SINGLEUNIT,
+ OMPWS_SCALARIZER_WS, OMPWS_NOWAIT): Define.
+ (ompws_flags): New extern decl.
+ * trans-array.c (gfc_trans_scalarized_loop_end): Build OMP_FOR
+ for the outer dimension if ompws_flags allow it.
+ * trans.c (gfc_generate_code): Clear ompws_flags.
+ * trans-expr.c (gfc_trans_assignment_1): Allow worksharing
+ array assignments inside of !$omp workshare.
+ * trans-stmt.c (gfc_trans_where_3): Similarly for where statements
+ and constructs.
+ * trans-openmp.c (ompws_flags): New variable.
+ (gfc_trans_omp_workshare): Rewritten.
+
2009-04-11 Daniel Kraft <d@domob.eu>
PR fortran/37746
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index a96a48da2b76f7873f33cfc67f3f2f472992b7f4..47f4e0ce5b2fbe5bbe5996cd971e974a956f60bc 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -2697,41 +2697,96 @@ gfc_trans_scalarized_loop_end (gfc_loopinfo * loop, int n,
tree tmp;
tree loopbody;
tree exit_label;
+ tree stmt;
+ tree init;
+ tree incr;
- loopbody = gfc_finish_block (pbody);
+ if ((ompws_flags & (OMPWS_WORKSHARE_FLAG | OMPWS_SCALARIZER_WS))
+ == (OMPWS_WORKSHARE_FLAG | OMPWS_SCALARIZER_WS)
+ && n == loop->dimen - 1)
+ {
+ /* We create an OMP_FOR construct for the outermost scalarized loop. */
+ init = make_tree_vec (1);
+ cond = make_tree_vec (1);
+ incr = make_tree_vec (1);
+
+ /* Cycle statement is implemented with a goto. Exit statement must not
+ be present for this loop. */
+ exit_label = gfc_build_label_decl (NULL_TREE);
+ TREE_USED (exit_label) = 1;
+
+ /* Label for cycle statements (if needed). */
+ tmp = build1_v (LABEL_EXPR, exit_label);
+ gfc_add_expr_to_block (pbody, tmp);
+
+ stmt = make_node (OMP_FOR);
+
+ TREE_TYPE (stmt) = void_type_node;
+ OMP_FOR_BODY (stmt) = loopbody = gfc_finish_block (pbody);
+
+ OMP_FOR_CLAUSES (stmt) = build_omp_clause (OMP_CLAUSE_SCHEDULE);
+ OMP_CLAUSE_SCHEDULE_KIND (OMP_FOR_CLAUSES (stmt))
+ = OMP_CLAUSE_SCHEDULE_STATIC;
+ if (ompws_flags & OMPWS_NOWAIT)
+ OMP_CLAUSE_CHAIN (OMP_FOR_CLAUSES (stmt))
+ = build_omp_clause (OMP_CLAUSE_NOWAIT);
+
+ /* Initialize the loopvar. */
+ TREE_VEC_ELT (init, 0) = build2_v (MODIFY_EXPR, loop->loopvar[n],
+ loop->from[n]);
+ OMP_FOR_INIT (stmt) = init;
+ /* The exit condition. */
+ TREE_VEC_ELT (cond, 0) = build2 (LE_EXPR, boolean_type_node,
+ loop->loopvar[n], loop->to[n]);
+ OMP_FOR_COND (stmt) = cond;
+ /* Increment the loopvar. */
+ tmp = build2 (PLUS_EXPR, gfc_array_index_type,
+ loop->loopvar[n], gfc_index_one_node);
+ TREE_VEC_ELT (incr, 0) = fold_build2 (MODIFY_EXPR,
+ void_type_node, loop->loopvar[n], tmp);
+ OMP_FOR_INCR (stmt) = incr;
+
+ ompws_flags &= ~OMPWS_CURR_SINGLEUNIT;
+ gfc_add_expr_to_block (&loop->code[n], stmt);
+ }
+ else
+ {
+ loopbody = gfc_finish_block (pbody);
- /* Initialize the loopvar. */
- gfc_add_modify (&loop->code[n], loop->loopvar[n], loop->from[n]);
+ /* Initialize the loopvar. */
+ gfc_add_modify (&loop->code[n], loop->loopvar[n], loop->from[n]);
- exit_label = gfc_build_label_decl (NULL_TREE);
+ exit_label = gfc_build_label_decl (NULL_TREE);
- /* Generate the loop body. */
- gfc_init_block (&block);
+ /* Generate the loop body. */
+ gfc_init_block (&block);
- /* The exit condition. */
- cond = fold_build2 (GT_EXPR, boolean_type_node,
- loop->loopvar[n], loop->to[n]);
- tmp = build1_v (GOTO_EXPR, exit_label);
- TREE_USED (exit_label) = 1;
- tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
- gfc_add_expr_to_block (&block, tmp);
+ /* The exit condition. */
+ cond = fold_build2 (GT_EXPR, boolean_type_node,
+ loop->loopvar[n], loop->to[n]);
+ tmp = build1_v (GOTO_EXPR, exit_label);
+ TREE_USED (exit_label) = 1;
+ tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
+ gfc_add_expr_to_block (&block, tmp);
- /* The main body. */
- gfc_add_expr_to_block (&block, loopbody);
+ /* The main body. */
+ gfc_add_expr_to_block (&block, loopbody);
- /* Increment the loopvar. */
- tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
- loop->loopvar[n], gfc_index_one_node);
- gfc_add_modify (&block, loop->loopvar[n], tmp);
+ /* Increment the loopvar. */
+ tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
+ loop->loopvar[n], gfc_index_one_node);
+ gfc_add_modify (&block, loop->loopvar[n], tmp);
- /* Build the loop. */
- tmp = gfc_finish_block (&block);
- tmp = build1_v (LOOP_EXPR, tmp);
- gfc_add_expr_to_block (&loop->code[n], tmp);
+ /* Build the loop. */
+ tmp = gfc_finish_block (&block);
+ tmp = build1_v (LOOP_EXPR, tmp);
+ gfc_add_expr_to_block (&loop->code[n], tmp);
+
+ /* Add the exit label. */
+ tmp = build1_v (LABEL_EXPR, exit_label);
+ gfc_add_expr_to_block (&loop->code[n], tmp);
+ }
- /* Add the exit label. */
- tmp = build1_v (LABEL_EXPR, exit_label);
- gfc_add_expr_to_block (&loop->code[n], tmp);
}
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index dcbccefcaea039f30885fe97130849a230bcb13c..2b67c6ddcd3c34cd49c24d09b005d18cd40f160a 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -4598,6 +4598,10 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag)
rss = NULL;
if (lss != gfc_ss_terminator)
{
+ /* Allow the scalarizer to workshare array assignments. */
+ if (ompws_flags & OMPWS_WORKSHARE_FLAG)
+ ompws_flags |= OMPWS_SCALARIZER_WS;
+
/* The assignment needs scalarization. */
lss_section = lss;
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 04ec4d4c12c36c785f90dae62301eb8a45a6d474..5ad2f9cc6697a7ddc66cfd66624dcec571d2925f 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -1,5 +1,5 @@
/* OpenMP directive translation -- generate GCC trees from gfc_code.
- Copyright (C) 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+ Copyright (C) 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
Contributed by Jakub Jelinek <jakub@redhat.com>
This file is part of GCC.
@@ -35,6 +35,7 @@ along with GCC; see the file COPYING3. If not see
#include "trans-const.h"
#include "arith.h"
+int ompws_flags;
/* True if OpenMP should privatize what this DECL points to rather
than the DECL itself. */
@@ -1544,8 +1545,162 @@ gfc_trans_omp_taskwait (void)
static tree
gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses)
{
- /* XXX */
- return gfc_trans_omp_single (code, clauses);
+ tree res, tmp, stmt;
+ stmtblock_t block, *pblock = NULL;
+ stmtblock_t singleblock;
+ int saved_ompws_flags;
+ bool singleblock_in_progress = false;
+ /* True if previous gfc_code in workshare construct is not workshared. */
+ bool prev_singleunit;
+
+ code = code->block->next;
+
+ pushlevel (0);
+
+ if (!code)
+ return build_empty_stmt ();
+
+ gfc_start_block (&block);
+ pblock = █
+
+ ompws_flags = OMPWS_WORKSHARE_FLAG;
+ prev_singleunit = false;
+
+ /* Translate statements one by one to trees until we reach
+ the end of the workshare construct. Adjacent gfc_codes that
+ are a single unit of work are clustered and encapsulated in a
+ single OMP_SINGLE construct. */
+ for (; code; code = code->next)
+ {
+ if (code->here != 0)
+ {
+ res = gfc_trans_label_here (code);
+ gfc_add_expr_to_block (pblock, res);
+ }
+
+ /* No dependence analysis, use for clauses with wait.
+ If this is the last gfc_code, use default omp_clauses. */
+ if (code->next == NULL && clauses->nowait)
+ ompws_flags |= OMPWS_NOWAIT;
+
+ /* By default, every gfc_code is a single unit of work. */
+ ompws_flags |= OMPWS_CURR_SINGLEUNIT;
+ ompws_flags &= ~OMPWS_SCALARIZER_WS;
+
+ switch (code->op)
+ {
+ case EXEC_NOP:
+ res = NULL_TREE;
+ break;
+
+ case EXEC_ASSIGN:
+ res = gfc_trans_assign (code);
+ break;
+
+ case EXEC_POINTER_ASSIGN:
+ res = gfc_trans_pointer_assign (code);
+ break;
+
+ case EXEC_INIT_ASSIGN:
+ res = gfc_trans_init_assign (code);
+ break;
+
+ case EXEC_FORALL:
+ res = gfc_trans_forall (code);
+ break;
+
+ case EXEC_WHERE:
+ res = gfc_trans_where (code);
+ break;
+
+ case EXEC_OMP_ATOMIC:
+ res = gfc_trans_omp_directive (code);
+ break;
+
+ case EXEC_OMP_PARALLEL:
+ case EXEC_OMP_PARALLEL_DO:
+ case EXEC_OMP_PARALLEL_SECTIONS:
+ case EXEC_OMP_PARALLEL_WORKSHARE:
+ case EXEC_OMP_CRITICAL:
+ saved_ompws_flags = ompws_flags;
+ ompws_flags = 0;
+ res = gfc_trans_omp_directive (code);
+ ompws_flags = saved_ompws_flags;
+ break;
+
+ default:
+ internal_error ("gfc_trans_omp_workshare(): Bad statement code");
+ }
+
+ gfc_set_backend_locus (&code->loc);
+
+ if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
+ {
+ if (TREE_CODE (res) == STATEMENT_LIST)
+ tree_annotate_all_with_location (&res, input_location);
+ else
+ SET_EXPR_LOCATION (res, input_location);
+
+ if (prev_singleunit)
+ {
+ if (ompws_flags & OMPWS_CURR_SINGLEUNIT)
+ /* Add current gfc_code to single block. */
+ gfc_add_expr_to_block (&singleblock, res);
+ else
+ {
+ /* Finish single block and add it to pblock. */
+ tmp = gfc_finish_block (&singleblock);
+ tmp = build2 (OMP_SINGLE, void_type_node, tmp, NULL_TREE);
+ gfc_add_expr_to_block (pblock, tmp);
+ /* Add current gfc_code to pblock. */
+ gfc_add_expr_to_block (pblock, res);
+ singleblock_in_progress = false;
+ }
+ }
+ else
+ {
+ if (ompws_flags & OMPWS_CURR_SINGLEUNIT)
+ {
+ /* Start single block. */
+ gfc_init_block (&singleblock);
+ gfc_add_expr_to_block (&singleblock, res);
+ singleblock_in_progress = true;
+ }
+ else
+ /* Add the new statement to the block. */
+ gfc_add_expr_to_block (pblock, res);
+ }
+ prev_singleunit = (ompws_flags & OMPWS_CURR_SINGLEUNIT) != 0;
+ }
+ }
+
+ /* Finish remaining SINGLE block, if we were in the middle of one. */
+ if (singleblock_in_progress)
+ {
+ /* Finish single block and add it to pblock. */
+ tmp = gfc_finish_block (&singleblock);
+ tmp = build2 (OMP_SINGLE, void_type_node, tmp,
+ clauses->nowait
+ ? build_omp_clause (OMP_CLAUSE_NOWAIT) : NULL_TREE);
+ gfc_add_expr_to_block (pblock, tmp);
+ }
+
+ stmt = gfc_finish_block (pblock);
+ if (TREE_CODE (stmt) != BIND_EXPR)
+ {
+ if (!IS_EMPTY_STMT (stmt))
+ {
+ tree bindblock = poplevel (1, 0, 0);
+ stmt = build3_v (BIND_EXPR, NULL, stmt, bindblock);
+ }
+ else
+ poplevel (0, 0, 0);
+ }
+ else
+ poplevel (0, 0, 0);
+
+ ompws_flags = 0;
+ return stmt;
}
tree
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index dd473ef73b04dd396ced46e966613bf503a16f0e..e96c0afc4c7f1ee2dc68d620f561fedc92ebfa8f 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -3696,6 +3696,10 @@ gfc_trans_where_3 (gfc_code * cblock, gfc_code * eblock)
gfc_ss *edss = 0;
gfc_ss *esss = 0;
+ /* Allow the scalarizer to workshare simple where loops. */
+ if (ompws_flags & OMPWS_WORKSHARE_FLAG)
+ ompws_flags |= OMPWS_SCALARIZER_WS;
+
cond = cblock->expr;
tdst = cblock->next->expr;
tsrc = cblock->next->expr2;
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index ddbc730d9d8097d96a3bc4e5b663e218e2ae6507..e926a950fcf415a93100958cf33979dd9f09ca19 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -1259,6 +1259,7 @@ gfc_trans_code (gfc_code * code)
void
gfc_generate_code (gfc_namespace * ns)
{
+ ompws_flags = 0;
if (ns->is_block_data)
{
gfc_generate_block_data (ns);
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index aa217751a33b92be9816dbb45542b34987b6bdda..2c531ec263672df84cb0571d38fc81b3662a4386 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -1,6 +1,6 @@
/* Header for code translation functions
- Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software
- Foundation, Inc.
+ Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
+ Free Software Foundation, Inc.
Contributed by Paul Brook
This file is part of GCC.
@@ -766,5 +766,12 @@ extern const char gfc_msg_bounds[];
extern const char gfc_msg_fault[];
extern const char gfc_msg_wrong_return[];
+#define OMPWS_WORKSHARE_FLAG 1 /* Set if in a workshare construct. */
+#define OMPWS_CURR_SINGLEUNIT 2 /* Set if current gfc_code in workshare
+ construct is not workshared. */
+#define OMPWS_SCALARIZER_WS 4 /* Set if scalarizer should attempt
+ to create parallel loops. */
+#define OMPWS_NOWAIT 8 /* Use NOWAIT on OMP_FOR. */
+extern int ompws_flags;
#endif /* GFC_TRANS_H */
diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog
index 93d3330198b04e7bcdecba837b15104f648c609d..e7183d589b67eb400d05d56206b254c6c96ca6d7 100644
--- a/libgomp/ChangeLog
+++ b/libgomp/ChangeLog
@@ -1,3 +1,9 @@
+2009-04-20 Vasilis Liaskovitis <vliaskov@gmail.com>
+ Jakub Jelinek <jakub@redhat.com>
+
+ PR fortran/35423
+ * testsuite/libgomp.fortran/workshare2.f90: New test.
+
2009-04-09 Nick Clifton <nickc@redhat.com>
* iter.c: Change copyright header to refer to version 3 of the
diff --git a/libgomp/testsuite/libgomp.fortran/workshare2.f90 b/libgomp/testsuite/libgomp.fortran/workshare2.f90
new file mode 100644
index 0000000000000000000000000000000000000000..1b749a6cf0571caa1e3edfdd29328f6895fdf8c2
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/workshare2.f90
@@ -0,0 +1,37 @@
+subroutine f1
+ integer a(20:50,70:90)
+!$omp parallel workshare
+ a(:,:) = 17
+!$omp end parallel workshare
+ if (any (a.ne.17)) call abort
+end subroutine f1
+subroutine f2
+ integer a(20:50,70:90),d(15),e(15),f(15)
+ integer b, c, i
+!$omp parallel workshare
+ c = 5
+ a(:,:) = 17
+ b = 4
+ d = (/ 0, 1, 2, 3, 4, 0, 6, 7, 8, 9, 10, 0, 0, 13, 14 /)
+ forall (i=1:15, d(i) /= 0)
+ d(i) = 0
+ end forall
+ e = (/ 4, 5, 2, 6, 4, 5, 2, 6, 4, 5, 2, 6, 4, 5, 2 /)
+ f = 7
+ where (e.ge.5) f = f + 1
+!$omp end parallel workshare
+ if (any (a.ne.17)) call abort
+ if (c.ne.5.or.b.ne.4) call abort
+ if (any(d.ne.0)) call abort
+ do i = 1, 15
+ if (e(i).ge.5) then
+ if (f(i).ne.8) call abort
+ else
+ if (f(i).ne.7) call abort
+ end if
+ end do
+end subroutine f2
+
+ call f1
+ call f2
+end