re PR fortran/35423 (Implement OpenMP workshare)
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. * testsuite/libgomp.fortran/workshare2.f90: New test. Co-Authored-By: Jakub Jelinek <jakub@redhat.com> From-SVN: r146397
This commit is contained in:
Vasilis Liaskovitis
Jakub Jelinek
parent
2907036db7
commit
34d01e1d17
9 changed files with 317 additions and 31 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
||||
/* Initialize the loopvar. */
|
||||
gfc_add_modify (&loop->code[n], loop->loopvar[n], loop->from[n]);
|
||||
/* 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;
|
||||
|
||||
exit_label = gfc_build_label_decl (NULL_TREE);
|
||||
/* Label for cycle statements (if needed). */
|
||||
tmp = build1_v (LABEL_EXPR, exit_label);
|
||||
gfc_add_expr_to_block (pbody, tmp);
|
||||
|
||||
/* Generate the loop body. */
|
||||
gfc_init_block (&block);
|
||||
stmt = make_node (OMP_FOR);
|
||||
|
||||
/* 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);
|
||||
TREE_TYPE (stmt) = void_type_node;
|
||||
OMP_FOR_BODY (stmt) = loopbody = gfc_finish_block (pbody);
|
||||
|
||||
/* The main body. */
|
||||
gfc_add_expr_to_block (&block, loopbody);
|
||||
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);
|
||||
|
||||
/* 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);
|
||||
/* 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;
|
||||
|
||||
/* Build the loop. */
|
||||
tmp = gfc_finish_block (&block);
|
||||
tmp = build1_v (LOOP_EXPR, tmp);
|
||||
gfc_add_expr_to_block (&loop->code[n], tmp);
|
||||
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]);
|
||||
|
||||
exit_label = gfc_build_label_decl (NULL_TREE);
|
||||
|
||||
/* 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 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);
|
||||
|
||||
/* 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);
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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 */
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
37
libgomp/testsuite/libgomp.fortran/workshare2.f90
Normal file
37
libgomp/testsuite/libgomp.fortran/workshare2.f90
Normal file
|
|
@ -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
|
||||
Loading…
Add table
Reference in a new issue