diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 17 | ||||
| -rw-r--r-- | gcc/fortran/trans-array.c | 107 | ||||
| -rw-r--r-- | gcc/fortran/trans-expr.c | 4 | ||||
| -rw-r--r-- | gcc/fortran/trans-openmp.c | 161 | ||||
| -rw-r--r-- | gcc/fortran/trans-stmt.c | 4 | ||||
| -rw-r--r-- | gcc/fortran/trans.c | 1 | ||||
| -rw-r--r-- | gcc/fortran/trans.h | 11 | ||||
| -rw-r--r-- | libgomp/ChangeLog | 6 | ||||
| -rw-r--r-- | libgomp/testsuite/libgomp.fortran/workshare2.f90 | 37 |
9 files changed, 317 insertions, 31 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ef53e2391a8..3384aad93a2 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 a96a48da2b7..47f4e0ce5b2 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 dcbccefcaea..2b67c6ddcd3 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 04ec4d4c12c..5ad2f9cc669 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 dd473ef73b0..e96c0afc4c7 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 ddbc730d9d8..e926a950fcf 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 aa217751a33..2c531ec2636 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 93d3330198b..e7183d589b6 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 00000000000..1b749a6cf05 --- /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 |
