Commit 2a70708e by Cesar Philippidis Committed by Cesar Philippidis

dump-parse-tree.c (show_omp_clauses): Handle optional num and static arguments for the gang clause.

	gcc/fortran/
	* dump-parse-tree.c (show_omp_clauses): Handle optional num and static
	arguments for the gang clause.
	* gfortran.h (gfc_omp_clauses): Rename gang_expr as gang_num_expr.
	Add gang_static_expr.
	* openmp.c (gfc_free_omp_clauses): Update to free gang_num_expr and
	gang_static_expr.
	(match_oacc_clause_gang): Update to support both num and static in
	the same clause.
	(resolve_omp_clauses): Formatting.  Also handle gang_num_expr and
	gang_static_expr.
	(resolve_oacc_params_in_parallel): New const char arg argument.
	Use it to report more accurate gang, worker and vector clause errors.
	(resolve_oacc_loop_blocks): Update calls to
	resolve_oacc_params_in_parallel.
	* trans-openmp.c (gfc_trans_omp_clauses): Update the gimplification of
	the gang clause.
	(gfc_trans_oacc_combined_directive): Make use of gang_num_expr and
	gang_static_expr.  Remove OMP_LIST_REDUCTION from construct_clauses.

	gcc/testsuite/
	* gfortran.dg/goacc/gang-static.f95: Add tests for gang num arguments.
	* gfortran.dg/goacc/loop-2.f95: Update expected diagnostics.
	* gfortran.dg/goacc/loop-6.f95: Likewise.
	* gfortran.dg/goacc/loop-7.f95: New test.
	* gfortran.dg/goacc/reduction-2.f95: New test.

From-SVN: r231112
parent 4f0a0218
2015-12-01 Cesar Philippidis <cesar@codesourcery.com>
* dump-parse-tree.c (show_omp_clauses): Handle optional num and static
arguments for the gang clause.
* gfortran.h (gfc_omp_clauses): Rename gang_expr as gang_num_expr.
Add gang_static_expr.
* openmp.c (gfc_free_omp_clauses): Update to free gang_num_expr and
gang_static_expr.
(match_oacc_clause_gang): Update to support both num and static in
the same clause.
(resolve_omp_clauses): Formatting. Also handle gang_num_expr and
gang_static_expr.
(resolve_oacc_params_in_parallel): New const char arg argument.
Use it to report more accurate gang, worker and vector clause errors.
(resolve_oacc_loop_blocks): Update calls to
resolve_oacc_params_in_parallel.
* trans-openmp.c (gfc_trans_omp_clauses): Update the gimplification of
the gang clause.
(gfc_trans_oacc_combined_directive): Make use of gang_num_expr and
gang_static_expr. Remove OMP_LIST_REDUCTION from construct_clauses.
2015-11-30 Cesar Philippidis <cesar@codesourcery.com>
James Norris <jnorris@codesourcery.com>
Nathan Sidwell <nathan@codesourcery.com>
......
......@@ -1146,10 +1146,24 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
if (omp_clauses->gang)
{
fputs (" GANG", dumpfile);
if (omp_clauses->gang_expr)
if (omp_clauses->gang_num_expr || omp_clauses->gang_static_expr)
{
fputc ('(', dumpfile);
show_expr (omp_clauses->gang_expr);
if (omp_clauses->gang_num_expr)
{
fprintf (dumpfile, "num:");
show_expr (omp_clauses->gang_num_expr);
}
if (omp_clauses->gang_num_expr && omp_clauses->gang_static)
fputc (',', dumpfile);
if (omp_clauses->gang_static)
{
fprintf (dumpfile, "static:");
if (omp_clauses->gang_static_expr)
show_expr (omp_clauses->gang_static_expr);
else
fputc ('*', dumpfile);
}
fputc (')', dumpfile);
}
}
......
......@@ -1229,7 +1229,8 @@ typedef struct gfc_omp_clauses
/* OpenACC. */
struct gfc_expr *async_expr;
struct gfc_expr *gang_expr;
struct gfc_expr *gang_static_expr;
struct gfc_expr *gang_num_expr;
struct gfc_expr *worker_expr;
struct gfc_expr *vector_expr;
struct gfc_expr *num_gangs_expr;
......
......@@ -77,7 +77,8 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
gfc_free_expr (c->thread_limit);
gfc_free_expr (c->dist_chunk_size);
gfc_free_expr (c->async_expr);
gfc_free_expr (c->gang_expr);
gfc_free_expr (c->gang_num_expr);
gfc_free_expr (c->gang_static_expr);
gfc_free_expr (c->worker_expr);
gfc_free_expr (c->vector_expr);
gfc_free_expr (c->num_gangs_expr);
......@@ -395,21 +396,41 @@ cleanup:
static match
match_oacc_clause_gang (gfc_omp_clauses *cp)
{
if (gfc_match_char ('(') != MATCH_YES)
match ret = MATCH_YES;
if (gfc_match (" ( ") != MATCH_YES)
return MATCH_NO;
if (gfc_match (" num :") == MATCH_YES)
{
cp->gang_static = false;
return gfc_match (" %e )", &cp->gang_expr);
}
if (gfc_match (" static :") == MATCH_YES)
/* The gang clause accepts two optional arguments, num and static.
The num argument may either be explicit (num: <val>) or
implicit without (<val> without num:). */
while (ret == MATCH_YES)
{
cp->gang_static = true;
if (gfc_match (" * )") != MATCH_YES)
return gfc_match (" %e )", &cp->gang_expr);
return MATCH_YES;
if (gfc_match (" static :") == MATCH_YES)
{
if (cp->gang_static)
return MATCH_ERROR;
else
cp->gang_static = true;
if (gfc_match_char ('*') == MATCH_YES)
cp->gang_static_expr = NULL;
else if (gfc_match (" %e ", &cp->gang_static_expr) != MATCH_YES)
return MATCH_ERROR;
}
else
{
/* This is optional. */
if (cp->gang_num_expr || gfc_match (" num :") == MATCH_ERROR)
return MATCH_ERROR;
else if (gfc_match (" %e ", &cp->gang_num_expr) != MATCH_YES)
return MATCH_ERROR;
}
ret = gfc_match (" , ");
}
return gfc_match (" %e )", &cp->gang_expr);
return gfc_match (" ) ");
}
static match
......@@ -3726,11 +3747,15 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
if (omp_clauses->num_gangs_expr)
resolve_oacc_positive_int_expr (omp_clauses->num_gangs_expr, "NUM_GANGS");
if (omp_clauses->num_workers_expr)
resolve_oacc_positive_int_expr (omp_clauses->num_workers_expr, "NUM_WORKERS");
resolve_oacc_positive_int_expr (omp_clauses->num_workers_expr,
"NUM_WORKERS");
if (omp_clauses->vector_length_expr)
resolve_oacc_positive_int_expr (omp_clauses->vector_length_expr, "VECTOR_LENGTH");
if (omp_clauses->gang_expr)
resolve_oacc_positive_int_expr (omp_clauses->gang_expr, "GANG");
resolve_oacc_positive_int_expr (omp_clauses->vector_length_expr,
"VECTOR_LENGTH");
if (omp_clauses->gang_num_expr)
resolve_oacc_positive_int_expr (omp_clauses->gang_num_expr, "GANG");
if (omp_clauses->gang_static_expr)
resolve_oacc_positive_int_expr (omp_clauses->gang_static_expr, "GANG");
if (omp_clauses->worker_expr)
resolve_oacc_positive_int_expr (omp_clauses->worker_expr, "WORKER");
if (omp_clauses->vector_expr)
......@@ -4705,20 +4730,21 @@ resolve_oacc_nested_loops (gfc_code *code, gfc_code* do_code, int collapse,
static void
resolve_oacc_params_in_parallel (gfc_code *code, const char *clause)
resolve_oacc_params_in_parallel (gfc_code *code, const char *clause,
const char *arg)
{
fortran_omp_context *c;
if (oacc_is_parallel (code))
gfc_error ("!$ACC LOOP %s in PARALLEL region doesn't allow "
"non-static arguments at %L", clause, &code->loc);
"%s arguments at %L", clause, arg, &code->loc);
for (c = omp_current_ctx; c; c = c->previous)
{
if (oacc_is_loop (c->code))
break;
if (oacc_is_parallel (c->code))
gfc_error ("!$ACC LOOP %s in PARALLEL region doesn't allow "
"non-static arguments at %L", clause, &code->loc);
"%s arguments at %L", clause, arg, &code->loc);
}
}
......@@ -4801,13 +4827,16 @@ resolve_oacc_loop_blocks (gfc_code *code)
"vectors at the same time at %L", &code->loc);
if (code->ext.omp_clauses->gang
&& code->ext.omp_clauses->gang_expr
&& !code->ext.omp_clauses->gang_static)
resolve_oacc_params_in_parallel (code, "GANG");
&& code->ext.omp_clauses->gang_num_expr)
resolve_oacc_params_in_parallel (code, "GANG", "num");
if (code->ext.omp_clauses->worker
&& code->ext.omp_clauses->worker_expr)
resolve_oacc_params_in_parallel (code, "WORKER");
resolve_oacc_params_in_parallel (code, "WORKER", "num");
if (code->ext.omp_clauses->vector
&& code->ext.omp_clauses->vector_expr)
resolve_oacc_params_in_parallel (code, "VECTOR", "length");
if (code->ext.omp_clauses->tile_list)
{
......
......@@ -2630,28 +2630,20 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
}
if (clauses->gang)
{
if (clauses->gang_expr)
{
tree gang_var
= gfc_convert_expr_to_tree (block, clauses->gang_expr);
c = build_omp_clause (where.lb->location, OMP_CLAUSE_GANG);
if (clauses->gang_static)
OMP_CLAUSE_GANG_STATIC_EXPR (c) = gang_var;
else
OMP_CLAUSE_GANG_EXPR (c) = gang_var;
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
else if (clauses->gang_static)
tree arg;
c = build_omp_clause (where.lb->location, OMP_CLAUSE_GANG);
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
if (clauses->gang_num_expr)
{
/* This corresponds to gang (static: *). */
c = build_omp_clause (where.lb->location, OMP_CLAUSE_GANG);
OMP_CLAUSE_GANG_STATIC_EXPR (c) = integer_minus_one_node;
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
arg = gfc_convert_expr_to_tree (block, clauses->gang_num_expr);
OMP_CLAUSE_GANG_EXPR (c) = arg;
}
else
if (clauses->gang_static)
{
c = build_omp_clause (where.lb->location, OMP_CLAUSE_GANG);
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
arg = clauses->gang_static_expr
? gfc_convert_expr_to_tree (block, clauses->gang_static_expr)
: integer_minus_one_node;
OMP_CLAUSE_GANG_STATIC_EXPR (c) = arg;
}
}
......@@ -3476,8 +3468,9 @@ gfc_trans_oacc_combined_directive (gfc_code *code)
sizeof (construct_clauses));
loop_clauses.collapse = construct_clauses.collapse;
loop_clauses.gang = construct_clauses.gang;
loop_clauses.gang_expr = construct_clauses.gang_expr;
loop_clauses.gang_static = construct_clauses.gang_static;
loop_clauses.gang_num_expr = construct_clauses.gang_num_expr;
loop_clauses.gang_static_expr = construct_clauses.gang_static_expr;
loop_clauses.vector = construct_clauses.vector;
loop_clauses.vector_expr = construct_clauses.vector_expr;
loop_clauses.worker = construct_clauses.worker;
......@@ -3491,8 +3484,9 @@ gfc_trans_oacc_combined_directive (gfc_code *code)
loop_clauses.lists[OMP_LIST_REDUCTION]
= construct_clauses.lists[OMP_LIST_REDUCTION];
construct_clauses.gang = false;
construct_clauses.gang_expr = NULL;
construct_clauses.gang_static = false;
construct_clauses.gang_num_expr = NULL;
construct_clauses.gang_static_expr = NULL;
construct_clauses.vector = false;
construct_clauses.vector_expr = NULL;
construct_clauses.worker = false;
......@@ -3503,6 +3497,7 @@ gfc_trans_oacc_combined_directive (gfc_code *code)
construct_clauses.independent = false;
construct_clauses.tile_list = NULL;
construct_clauses.lists[OMP_LIST_PRIVATE] = NULL;
construct_clauses.lists[OMP_LIST_REDUCTION] = NULL;
oacc_clauses = gfc_trans_omp_clauses (&block, &construct_clauses,
code->loc);
}
......
2015-12-01 Cesar Philippidis <cesar@codesourcery.com>
* gfortran.dg/goacc/gang-static.f95: Add tests for gang num arguments.
* gfortran.dg/goacc/loop-2.f95: Update expected diagnostics.
* gfortran.dg/goacc/loop-6.f95: Likewise.
* gfortran.dg/goacc/loop-7.f95: New test.
* gfortran.dg/goacc/reduction-2.f95: New test.
2015-12-01 Richard Biener <rguenther@suse.de>
PR tree-optimization/68379
......
......@@ -47,6 +47,18 @@ program main
end do
!$acc end parallel loop
!$acc kernels loop gang (num:5, static:*)
do i = 1, n
a(i) = b(i) + 20
end do
!$acc end kernels loop
!$acc kernels loop gang (static:20, num:30)
do i = 1, n
a(i) = b(i) + 20
end do
!$acc end kernels loop
call test (a, b, 20, n)
end program main
......@@ -66,3 +78,5 @@ end subroutine test
! { dg-final { scan-tree-dump-times "gang\\(static:2\\)" 1 "omplower" } }
! { dg-final { scan-tree-dump-times "gang\\(static:5\\)" 1 "omplower" } }
! { dg-final { scan-tree-dump-times "gang\\(static:20\\)" 1 "omplower" } }
! { dg-final { scan-tree-dump-times "gang\\(num: 5 static:\\\*\\)" 1 "omplower" } }
! { dg-final { scan-tree-dump-times "gang\\(num: 30 static:20\\)" 1 "omplower" } }
......@@ -187,10 +187,10 @@ program test
!$acc loop gang
DO i = 1,10
ENDDO
!$acc loop gang(5) ! { dg-error "non-static" }
!$acc loop gang(5) ! { dg-error "num arguments" }
DO i = 1,10
ENDDO
!$acc loop gang(num:5) ! { dg-error "non-static" }
!$acc loop gang(num:5) ! { dg-error "num arguments" }
DO i = 1,10
ENDDO
!$acc loop gang(static:5)
......@@ -218,10 +218,10 @@ program test
!$acc loop worker
DO i = 1,10
ENDDO
!$acc loop worker(5) ! { dg-error "non-static" }
!$acc loop worker(5) ! { dg-error "num arguments" }
DO i = 1,10
ENDDO
!$acc loop worker(num:5) ! { dg-error "non-static" }
!$acc loop worker(num:5) ! { dg-error "num arguments" }
DO i = 1,10
ENDDO
!$acc loop worker
......@@ -246,10 +246,10 @@ program test
!$acc loop vector
DO i = 1,10
ENDDO
!$acc loop vector(5)
!$acc loop vector(5) ! { dg-error "length arguments" }
DO i = 1,10
ENDDO
!$acc loop vector(length:5)
!$acc loop vector(length:5) ! { dg-error "length arguments" }
DO i = 1,10
ENDDO
!$acc loop vector
......@@ -501,10 +501,10 @@ program test
!$acc parallel loop gang
DO i = 1,10
ENDDO
!$acc parallel loop gang(5) ! { dg-error "non-static" }
!$acc parallel loop gang(5) ! { dg-error "num arguments" }
DO i = 1,10
ENDDO
!$acc parallel loop gang(num:5) ! { dg-error "non-static" }
!$acc parallel loop gang(num:5) ! { dg-error "num arguments" }
DO i = 1,10
ENDDO
!$acc parallel loop gang(static:5)
......@@ -526,10 +526,10 @@ program test
!$acc parallel loop worker
DO i = 1,10
ENDDO
!$acc parallel loop worker(5) ! { dg-error "non-static" }
!$acc parallel loop worker(5) ! { dg-error "num arguments" }
DO i = 1,10
ENDDO
!$acc parallel loop worker(num:5) ! { dg-error "non-static" }
!$acc parallel loop worker(num:5) ! { dg-error "num arguments" }
DO i = 1,10
ENDDO
!$acc parallel loop worker
......@@ -551,10 +551,10 @@ program test
!$acc parallel loop vector
DO i = 1,10
ENDDO
!$acc parallel loop vector(5)
!$acc parallel loop vector(5) ! { dg-error "length arguments" }
DO i = 1,10
ENDDO
!$acc parallel loop vector(length:5)
!$acc parallel loop vector(length:5) ! { dg-error "length arguments" }
DO i = 1,10
ENDDO
!$acc parallel loop vector
......
......@@ -49,10 +49,10 @@ program test
!$acc loop vector
DO i = 1,10
ENDDO
!$acc loop vector(5) ! { dg-error "argument not permitted" }
!$acc loop vector(5) ! { dg-error "length arguments" }
DO i = 1,10
ENDDO
!$acc loop vector(length:5) ! { dg-error "argument not permitted" }
!$acc loop vector(length:5) ! { dg-error "length arguments" }
DO i = 1,10
ENDDO
!$acc loop vector
......@@ -73,10 +73,10 @@ program test
!$acc parallel loop vector
DO i = 1,10
ENDDO
!$acc parallel loop vector(5) ! { dg-error "argument not permitted" }
!$acc parallel loop vector(5) ! { dg-error "length arguments" }
DO i = 1,10
ENDDO
!$acc parallel loop vector(length:5) ! { dg-error "argument not permitted" }
!$acc parallel loop vector(length:5) ! { dg-error "length arguments" }
DO i = 1,10
ENDDO
end
! { dg-do compile }
! { dg-additional-options "-fmax-errors=100" }
program test
implicit none
integer :: i, j, static, num, length
!$acc kernels
!$acc loop gang(static:static)
DO i = 1,10
ENDDO
!$acc loop gang(static:*)
DO i = 1,10
ENDDO
!$acc loop gang(static:1)
DO i = 1,10
ENDDO
!$acc loop gang(,static:1) ! { dg-error "Invalid character" }
DO i = 1,10
ENDDO
!$acc loop gang(static:1,) ! { dg-error "Invalid character" }
DO i = 1,10
ENDDO
!$acc loop gang(static:*, num:5)
DO i = 1,10
ENDDO
!$acc loop gang(static:1, 5)
DO i = 1,10
ENDDO
!$acc loop gang(num:num, static:1)
DO i = 1,10
ENDDO
!$acc loop gang(static:*, num:5, static:5) ! { dg-error "Unclassifiable OpenACC directive" }
DO i = 1,10
ENDDO
!$acc loop gang(1, num:2, static:3) ! { dg-error "Unclassifiable OpenACC directive" }
DO i = 1,10
ENDDO
!$acc loop gang(num:num static:1) ! { dg-error "Unclassifiable OpenACC directive" }
DO i = 1,10
ENDDO
!$acc loop gang(num)
DO i = 1,10
ENDDO
!$acc loop gang(num:num+1, static:1+num)
DO i = 1,10
ENDDO
!$acc loop gang(length:num) ! { dg-error "Unclassifiable OpenACC directive" }
DO i = 1,10
ENDDO
!$acc loop worker
DO i = 1,10
ENDDO
!$acc loop worker (5)
DO i = 1,10
ENDDO
!$acc loop worker (num)
DO i = 1,10
ENDDO
!$acc loop worker (static:num) ! { dg-error "Unclassifiable OpenACC directive" }
DO i = 1,10
ENDDO
!$acc loop worker (num:,) ! { dg-error "Invalid character" }
DO i = 1,10
ENDDO
!$acc loop worker (num:num:num) ! { dg-error "Unclassifiable OpenACC directive" }
DO i = 1,10
ENDDO
!$acc loop worker (num:num*num)
DO i = 1,10
ENDDO
!$acc loop worker (length:num*num) ! { dg-error "Unclassifiable OpenACC directive" }
DO i = 1,10
ENDDO
!$acc loop worker (num:*) ! { dg-error "Invalid character" }
DO i = 1,10
ENDDO
!$acc loop worker (num:5)
DO i = 1,10
ENDDO
!$acc loop vector
DO i = 1,10
ENDDO
!$acc loop vector (32)
DO i = 1,10
ENDDO
!$acc loop vector (length)
DO i = 1,10
ENDDO
!$acc loop vrctor (static:num) ! { dg-error "Unclassifiable OpenACC directive" }
DO i = 1,10
ENDDO
!$acc loop vector (length:,) ! { dg-error "Invalid character" }
DO i = 1,10
ENDDO
!$acc loop vector (length:num:num) ! { dg-error "Unclassifiable OpenACC directive" }
DO i = 1,10
ENDDO
!$acc loop vector (length:static*num)
DO i = 1,10
ENDDO
!$acc loop vector (length:length)
DO i = 1,10
ENDDO
!$acc loop vector (length:32)
DO i = 1,10
ENDDO
!$acc loop vector (num:num*num) ! { dg-error "Unclassifiable OpenACC directive" }
DO i = 1,10
ENDDO
!$acc loop vector (length:*) ! { dg-error "Invalid character" }
DO i = 1,10
ENDDO
!$acc loop auto
DO i = 1,10
ENDDO
!$acc end kernels
end
! { dg-do compile }
! { dg-additional-options "-fdump-tree-gimple" }
subroutine foo ()
implicit none
integer :: p,k
integer :: a
!$acc parallel loop reduction(+:a)
do p = 1,5
enddo
!$acc end parallel loop
!$acc kernels loop reduction(+:a)
do k = 2,6
enddo
!$acc end kernels loop
end subroutine
! { dg-final { scan-tree-dump-times "target oacc_parallel firstprivate.a." 1 "gimple" } }
! { dg-final { scan-tree-dump-times "acc loop private.p. reduction..:a." 1 "gimple" } }
! { dg-final { scan-tree-dump-times "target oacc_kernels map.tofrom:a .len: 4.." 1 "gimple" } }
! { dg-final { scan-tree-dump-times "acc loop private.k. reduction..:a." 1 "gimple" } }
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment