procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

tree-nested.c (convert_nonlocal_omp_clauses): Add support for OMP_CLAUSE_{NUM_GANGS,NUM_VECTORS,VECTOR_LENGTH,SEQ}.

Browse source 
gcc/
	* tree-nested.c (convert_nonlocal_omp_clauses): Add support for
	OMP_CLAUSE_{NUM_GANGS,NUM_VECTORS,VECTOR_LENGTH,SEQ}.
	(convert_local_omp_clauses): Likewise.

	gcc/fortran/
	* f95-lang.c (gfc_attribute_table): Add an "oacc function"
	attribute.
	* gfortran.h (symbol_attribute): Add an oacc_function bit-field.
	(gfc_oacc_routine_name): New struct;
	(gfc_get_oacc_routine_name): New macro.
	(gfc_namespace): Add oacc_routine_clauses, oacc_routine_names and
	oacc_routine fields.
	(gfc_exec_op): Add EXEC_OACC_ROUTINE.
	* openmp.c (OACC_ROUTINE_CLAUSES): New mask.
	(gfc_oacc_routine_dims): New function.
	(gfc_match_oacc_routine): Add support for named routines and the
	gang, worker vector and seq clauses.
	* parse.c (is_oacc): Add EXEC_OACC_ROUTINE.
	* resolve.c (gfc_resolve_blocks): Likewise.
	* st.c (gfc_free_statement): Likewise.
	* trans-decl.c (add_attributes_to_decl): Attach an 'oacc function'
	attribute and shape geometry for acc routine.

	gcc/testsuite/
	* gfortran.dg/goacc/routine-3.f90: New test.
	* gfortran.dg/goacc/routine-4.f90: New test.
	* gfortran.dg/goacc/routine-5.f90: New test.
	* gfortran.dg/goacc/routine-6.f90: New test.
	* gfortran.dg/goacc/subroutines: New test.

	libgomp/
	* libgomp.oacc-fortran/routine-5.f90: New test.
	* libgomp.oacc-fortran/routine-7.f90: New test.
	* libgomp.oacc-fortran/routine-9.f90: New test.

From-SVN: r231081
This commit is contained in:
Cesar Philippidis 2015-11-30 11:09:33 -08:00
parent 522cdabdea
commit db941d7ef7
20 changed files with 868 additions and 48 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
gcc/ChangeLog
View file

@ -1,3 +1,9 @@
2015-11-30 Cesar Philippidis <cesar@codesourcery.com>
* tree-nested.c (convert_nonlocal_omp_clauses): Add support for
OMP_CLAUSE_{NUM_GANGS,NUM_VECTORS,VECTOR_LENGTH,SEQ}.
(convert_local_omp_clauses): Likewise.
2015-11-30 Tom de Vries <tom@codesourcery.com>
PR tree-optimization/46032

22
gcc/fortran/ChangeLog
View file

@ -1,3 +1,25 @@
2015-11-30 Cesar Philippidis <cesar@codesourcery.com>
James Norris <jnorris@codesourcery.com>
Nathan Sidwell <nathan@codesourcery.com>
* f95-lang.c (gfc_attribute_table): Add an "oacc function"
attribute.
* gfortran.h (symbol_attribute): Add an oacc_function bit-field.
(gfc_oacc_routine_name): New struct;
(gfc_get_oacc_routine_name): New macro.
(gfc_namespace): Add oacc_routine_clauses, oacc_routine_names and
oacc_routine fields.
(gfc_exec_op): Add EXEC_OACC_ROUTINE.
* openmp.c (OACC_ROUTINE_CLAUSES): New mask.
(gfc_oacc_routine_dims): New function.
(gfc_match_oacc_routine): Add support for named routines and the
gang, worker vector and seq clauses.
* parse.c (is_oacc): Add EXEC_OACC_ROUTINE.
* resolve.c (gfc_resolve_blocks): Likewise.
* st.c (gfc_free_statement): Likewise.
* trans-decl.c (add_attributes_to_decl): Attach an 'oacc function'
attribute and shape geometry for acc routine.
2015-11-30 Paul Thomas <pault@gcc.gnu.org>
PR fortran/68534

2
gcc/fortran/f95-lang.c
View file

@ -93,6 +93,8 @@ static const struct attribute_spec gfc_attribute_table[] =
affects_type_identity } */
{ "omp declare target", 0, 0, true, false, false,
gfc_handle_omp_declare_target_attribute, false },
{ "oacc function", 0, -1, true, false, false,
gfc_handle_omp_declare_target_attribute, false },
{ NULL, 0, 0, false, false, false, NULL, false }
};

24
gcc/fortran/gfortran.h
View file

@ -848,6 +848,9 @@ typedef struct
unsigned oacc_declare_device_resident:1;
unsigned oacc_declare_link:1;
/* This is an OpenACC acclerator function at level N - 1 */
unsigned oacc_function:3;
/* Attributes set by compiler extensions (!GCC$ ATTRIBUTES). */
unsigned ext_attr:EXT_ATTR_NUM;
@ -1606,6 +1609,16 @@ gfc_dt_list;
/* A list of all derived types. */
extern gfc_dt_list *gfc_derived_types;
typedef struct gfc_oacc_routine_name
{
struct gfc_symbol *sym;
struct gfc_omp_clauses *clauses;
struct gfc_oacc_routine_name *next;
}
gfc_oacc_routine_name;
#define gfc_get_oacc_routine_name() XCNEW (gfc_oacc_routine_name)
/* A namespace describes the contents of procedure, module, interface block
or BLOCK construct. */
/* ??? Anything else use these? */
@ -1672,6 +1685,12 @@ typedef struct gfc_namespace
/* !$ACC DECLARE. */
gfc_oacc_declare *oacc_declare;
/* !$ACC ROUTINE clauses. */
gfc_omp_clauses *oacc_routine_clauses;
/* !$ACC ROUTINE names. */
gfc_oacc_routine_name *oacc_routine_names;
gfc_charlen *cl_list, *old_cl_list;
gfc_dt_list *derived_types;
@ -1717,6 +1736,9 @@ typedef struct gfc_namespace
/* Set to 1 for !$OMP DECLARE REDUCTION namespaces. */
unsigned omp_udr_ns:1;
/* Set to 1 for !$ACC ROUTINE namespaces. */
unsigned oacc_routine:1;
}
gfc_namespace;
@ -2344,7 +2366,7 @@ enum gfc_exec_op
EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END,
EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH,
EXEC_LOCK, EXEC_UNLOCK,
EXEC_OACC_KERNELS_LOOP, EXEC_OACC_PARALLEL_LOOP,
EXEC_OACC_KERNELS_LOOP, EXEC_OACC_PARALLEL_LOOP, EXEC_OACC_ROUTINE,
EXEC_OACC_PARALLEL, EXEC_OACC_KERNELS, EXEC_OACC_DATA, EXEC_OACC_HOST_DATA,
EXEC_OACC_LOOP, EXEC_OACC_UPDATE, EXEC_OACC_WAIT, EXEC_OACC_CACHE,
EXEC_OACC_ENTER_DATA, EXEC_OACC_EXIT_DATA, EXEC_OACC_ATOMIC,

144
gcc/fortran/openmp.c
View file

@ -1318,6 +1318,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
| OMP_CLAUSE_DELETE)
#define OACC_WAIT_CLAUSES \
(OMP_CLAUSE_ASYNC)
#define OACC_ROUTINE_CLAUSES \
(OMP_CLAUSE_GANG | OMP_CLAUSE_WORKER | OMP_CLAUSE_VECTOR | OMP_CLAUSE_SEQ)
match
@ -1619,13 +1621,44 @@ gfc_match_oacc_cache (void)
return MATCH_YES;
}
/* Determine the loop level for a routine. */
static int
gfc_oacc_routine_dims (gfc_omp_clauses *clauses)
{
int level = -1;
if (clauses)
{
unsigned mask = 0;
if (clauses->gang)
level = GOMP_DIM_GANG, mask |= GOMP_DIM_MASK (level);
if (clauses->worker)
level = GOMP_DIM_WORKER, mask |= GOMP_DIM_MASK (level);
if (clauses->vector)
level = GOMP_DIM_VECTOR, mask |= GOMP_DIM_MASK (level);
if (clauses->seq)
level = GOMP_DIM_MAX, mask |= GOMP_DIM_MASK (level);
if (mask != (mask & -mask))
gfc_error ("Multiple loop axes specified for routine");
}
if (level < 0)
level = GOMP_DIM_MAX;
return level;
}
match
gfc_match_oacc_routine (void)
{
locus old_loc;
gfc_symbol *sym;
gfc_symbol *sym = NULL;
match m;
gfc_omp_clauses *c = NULL;
gfc_oacc_routine_name *n = NULL;
old_loc = gfc_current_locus;
@ -1640,52 +1673,85 @@ gfc_match_oacc_routine (void)
goto cleanup;
}
if (m == MATCH_NO
&& gfc_current_ns->proc_name
&& gfc_match_omp_eos () == MATCH_YES)
if (m == MATCH_YES)
{
char buffer[GFC_MAX_SYMBOL_LEN + 1];
gfc_symtree *st;
m = gfc_match_name (buffer);
if (m == MATCH_YES)
{
st = gfc_find_symtree (gfc_current_ns->sym_root, buffer);
if (st)
{
sym = st->n.sym;
if (strcmp (sym->name, gfc_current_ns->proc_name->name) == 0)
sym = NULL;
}
if (st == NULL
|| (sym
&& !sym->attr.external
&& !sym->attr.function
&& !sym->attr.subroutine))
{
gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, "
"invalid function name %s",
(sym) ? sym->name : buffer);
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
}
else
{
gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C");
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
if (gfc_match_char (')') != MATCH_YES)
{
gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, expecting"
" ')' after NAME");
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
}
if (gfc_match_omp_eos () != MATCH_YES
&& (gfc_match_omp_clauses (&c, OACC_ROUTINE_CLAUSES, false, false, true)
!= MATCH_YES))
return MATCH_ERROR;
if (sym != NULL)
{
n = gfc_get_oacc_routine_name ();
n->sym = sym;
n->clauses = NULL;
n->next = NULL;
if (gfc_current_ns->oacc_routine_names != NULL)
n->next = gfc_current_ns->oacc_routine_names;
gfc_current_ns->oacc_routine_names = n;
}
else if (gfc_current_ns->proc_name)
{
if (!gfc_add_omp_declare_target (&gfc_current_ns->proc_name->attr,
gfc_current_ns->proc_name->name,
&old_loc))
goto cleanup;
return MATCH_YES;
gfc_current_ns->proc_name->attr.oacc_function
= gfc_oacc_routine_dims (c) + 1;
}
if (m != MATCH_YES)
return m;
if (n)
n->clauses = c;
else if (gfc_current_ns->oacc_routine)
gfc_current_ns->oacc_routine_clauses = c;
/* Scan for a function name. */
m = gfc_match_symbol (&sym, 0);
if (m != MATCH_YES)
{
gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C");
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
if (!sym->attr.external && !sym->attr.function && !sym->attr.subroutine)
{
gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, invalid"
" function name %qs", sym->name);
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
if (gfc_match_char (')') != MATCH_YES)
{
gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, expecting"
" ')' after NAME");
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
if (gfc_match_omp_eos () != MATCH_YES)
{
gfc_error ("Unexpected junk after !$ACC ROUTINE at %C");
goto cleanup;
}
return MATCH_YES;
new_st.op = EXEC_OACC_ROUTINE;
new_st.ext.omp_clauses = c;
return MATCH_YES;
cleanup:
gfc_current_locus = old_loc;

1
gcc/fortran/parse.c
View file

@ -5786,6 +5786,7 @@ is_oacc (gfc_state_data *sd)
case EXEC_OACC_ENTER_DATA:
case EXEC_OACC_EXIT_DATA:
case EXEC_OACC_ATOMIC:
case EXEC_OACC_ROUTINE:
return true;
default:

1
gcc/fortran/resolve.c
View file

@ -9373,6 +9373,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
case EXEC_OACC_ENTER_DATA:
case EXEC_OACC_EXIT_DATA:
case EXEC_OACC_ATOMIC:
case EXEC_OACC_ROUTINE:
case EXEC_OMP_ATOMIC:
case EXEC_OMP_CRITICAL:
case EXEC_OMP_DISTRIBUTE:

1
gcc/fortran/st.c
View file

@ -202,6 +202,7 @@ gfc_free_statement (gfc_code *p)
case EXEC_OACC_CACHE:
case EXEC_OACC_ENTER_DATA:
case EXEC_OACC_EXIT_DATA:
case EXEC_OACC_ROUTINE:
case EXEC_OMP_CANCEL:
case EXEC_OMP_CANCELLATION_POINT:
case EXEC_OMP_DISTRIBUTE:

15
gcc/fortran/trans-decl.c
View file

@ -44,6 +44,7 @@ along with GCC; see the file COPYING3. If not see
#include "trans-const.h"
/* Only for gfc_trans_code. Shouldn't need to include this. */
#include "trans-stmt.h"
#include "gomp-constants.h"
#define MAX_LABEL_VALUE 99999
@ -1304,6 +1305,20 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list)
list = tree_cons (get_identifier ("omp declare target"),
NULL_TREE, list);
if (sym_attr.oacc_function)
{
tree dims = NULL_TREE;
int ix;
int level = sym_attr.oacc_function - 1;
for (ix = GOMP_DIM_MAX; ix--;)
dims = tree_cons (build_int_cst (boolean_type_node, ix >= level),
integer_zero_node, dims);
list = tree_cons (get_identifier ("oacc function"),
dims, list);
}
return list;
}

9
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,12 @@
2015-11-30 Cesar Philippidis <cesar@codesourcery.com>
Nathan Sidwell <nathan@codesourcery.com>
* gfortran.dg/goacc/routine-3.f90: New test.
* gfortran.dg/goacc/routine-4.f90: New test.
* gfortran.dg/goacc/routine-5.f90: New test.
* gfortran.dg/goacc/routine-6.f90: New test.
* gfortran.dg/goacc/subroutines: New test.
2015-11-30 Tom de Vries <tom@codesourcery.com>
* gcc.dg/pr46032-2.c: New test.

13
gcc/testsuite/gfortran.dg/goacc/routine-3.f90 Normal file
View file

@ -0,0 +1,13 @@
PROGRAM nested_gwv
CONTAINS
SUBROUTINE gwv
INTEGER :: i
REAL(KIND=8), ALLOCATABLE :: un(:), ua(:)
!$acc parallel num_gangs(2) num_workers(4) vector_length(32)
DO jj = 1, 100
un(i) = ua(i)
END DO
!$acc end parallel
END SUBROUTINE gwv
END PROGRAM nested_gwv

160
gcc/testsuite/gfortran.dg/goacc/routine-4.f90 Normal file
View file

@ -0,0 +1,160 @@
! Test invalid calls to routines.
module param
integer, parameter :: N = 32
end module param
program main
use param
integer :: i
integer :: a(N)
do i = 1, N
a(i) = i
end do
!
! Seq routine tests.
!
!$acc parallel copy (a)
!$acc loop
do i = 1, N
call seq (a)
end do
!$acc loop gang
do i = 1, N
call seq (a)
end do
!$acc loop worker
do i = 1, N
call seq (a)
end do
!$acc loop vector
do i = 1, N
call seq (a)
end do
!$acc end parallel
!
! Gang routines loops.
!
!$acc parallel copy (a)
!$acc loop ! { dg-warning "insufficient partitioning" }
do i = 1, N
call gang (a)
end do
!$acc loop gang ! { dg-message "containing loop" }
do i = 1, N
call gang (a) ! { dg-error "routine call uses same" }
end do
!$acc loop worker ! { dg-message "containing loop" }
do i = 1, N
call gang (a) ! { dg-error "routine call uses same" }
end do
!$acc loop vector ! { dg-message "containing loop" }
do i = 1, N
call gang (a) ! { dg-error "routine call uses same" }
end do
!$acc end parallel
!
! Worker routines loops.
!
!$acc parallel copy (a)
!$acc loop
do i = 1, N
call worker (a)
end do
!$acc loop gang
do i = 1, N
call worker (a)
end do
!$acc loop worker ! { dg-message "containing loop" }
do i = 1, N
call worker (a) ! { dg-error "routine call uses same" }
end do
!$acc loop vector ! { dg-message "containing loop" }
do i = 1, N
call worker (a) ! { dg-error "routine call uses same" }
end do
!$acc end parallel
!
! Vector routines loops.
!
!$acc parallel copy (a)
!$acc loop
do i = 1, N
call vector (a)
end do
!$acc loop gang
do i = 1, N
call vector (a)
end do
!$acc loop worker
do i = 1, N
call vector (a)
end do
!$acc loop vector ! { dg-message "containing loop" }
do i = 1, N
call vector (a) ! { dg-error "routine call uses same" }
end do
!$acc end parallel
contains
subroutine gang (a) ! { dg-message "declared here" 3 }
!$acc routine gang
integer, intent (inout) :: a(N)
integer :: i
do i = 1, N
a(i) = a(i) - a(i)
end do
end subroutine gang
subroutine worker (a) ! { dg-message "declared here" 2 }
!$acc routine worker
integer, intent (inout) :: a(N)
integer :: i
do i = 1, N
a(i) = a(i) - a(i)
end do
end subroutine worker
subroutine vector (a) ! { dg-message "declared here" }
!$acc routine vector
integer, intent (inout) :: a(N)
integer :: i
do i = 1, N
a(i) = a(i) - a(i)
end do
end subroutine vector
subroutine seq (a)
!$acc routine seq
integer, intent (inout) :: a(N)
integer :: i
do i = 1, N
a(i) = a(i) - a(i)
end do
end subroutine seq
end program main

109
gcc/testsuite/gfortran.dg/goacc/routine-5.f90 Normal file
View file

@ -0,0 +1,109 @@
! Test invalid intra-routine parallellism.
module param
integer, parameter :: N = 32
end module param
subroutine gang (a)
!$acc routine gang
integer, intent (inout) :: a(N)
integer :: i
!$acc loop
do i = 1, N
a(i) = a(i) - a(i)
end do
!$acc loop gang
do i = 1, N
a(i) = a(i) - a(i)
end do
!$acc loop worker
do i = 1, N
a(i) = a(i) - a(i)
end do
!$acc loop vector
do i = 1, N
a(i) = a(i) - a(i)
end do
end subroutine gang
subroutine worker (a)
!$acc routine worker
integer, intent (inout) :: a(N)
integer :: i
!$acc loop
do i = 1, N
a(i) = a(i) - a(i)
end do
!$acc loop gang ! { dg-error "disallowed by containing routine" }
do i = 1, N
a(i) = a(i) - a(i)
end do
!$acc loop worker
do i = 1, N
a(i) = a(i) - a(i)
end do
!$acc loop vector
do i = 1, N
a(i) = a(i) - a(i)
end do
end subroutine worker
subroutine vector (a)
!$acc routine vector
integer, intent (inout) :: a(N)
integer :: i
!$acc loop
do i = 1, N
a(i) = a(i) - a(i)
end do
!$acc loop gang ! { dg-error "disallowed by containing routine" }
do i = 1, N
a(i) = a(i) - a(i)
end do
!$acc loop worker ! { dg-error "disallowed by containing routine" }
do i = 1, N
a(i) = a(i) - a(i)
end do
!$acc loop vector
do i = 1, N
a(i) = a(i) - a(i)
end do
end subroutine vector
subroutine seq (a)
!$acc routine seq
integer, intent (inout) :: a(N)
integer :: i
!$acc loop ! { dg-warning "insufficient partitioning" }
do i = 1, N
a(i) = a(i) - a(i)
end do
!$acc loop gang ! { dg-error "disallowed by containing routine" }
do i = 1, N
a(i) = a(i) - a(i)
end do
!$acc loop worker ! { dg-error "disallowed by containing routine" }
do i = 1, N
a(i) = a(i) - a(i)
end do
!$acc loop vector ! { dg-error "disallowed by containing routine" }
do i = 1, N
a(i) = a(i) - a(i)
end do
end subroutine seq

89
gcc/testsuite/gfortran.dg/goacc/routine-6.f90 Normal file
View file

@ -0,0 +1,89 @@
module m
integer m1int
contains
subroutine subr5 (x)
implicit none
!$acc routine (subr5)
!$acc routine (m1int) ! { dg-error "invalid function name" }
integer, intent(inout) :: x
if (x < 1) then
x = 1
else
x = x * x - 1
end if
end subroutine subr5
end module m
program main
implicit none
interface
function subr6 (x)
!$acc routine (subr6) ! { dg-error "without list is allowed in interface" }
integer, intent (in) :: x
integer :: subr6
end function subr6
end interface
integer, parameter :: n = 10
integer :: a(n), i
!$acc routine (subr1) ! { dg-error "invalid function name" }
external :: subr2
!$acc routine (subr2)
!$acc parallel
!$acc loop
do i = 1, n
call subr1 (i)
call subr2 (i)
end do
!$acc end parallel
end program main
subroutine subr1 (x)
!$acc routine
integer, intent(inout) :: x
if (x < 1) then
x = 1
else
x = x * x - 1
end if
end subroutine subr1
subroutine subr2 (x)
!$acc routine (subr1) ! { dg-error "invalid function name" }
integer, intent(inout) :: x
if (x < 1) then
x = 1
else
x = x * x - 1
end if
end subroutine subr2
subroutine subr3 (x)
!$acc routine (subr3)
integer, intent(inout) :: x
if (x < 1) then
x = 1
else
call subr4 (x)
end if
end subroutine subr3
subroutine subr4 (x)
!$acc routine (subr4)
integer, intent(inout) :: x
if (x < 1) then
x = 1
else
x = x * x - 1
end if
end subroutine subr4
subroutine subr10 (x)
!$acc routine (subr10) device ! { dg-error "Unclassifiable OpenACC directive" }
integer, intent(inout) :: x
if (x < 1) then
x = 1
else
x = x * x - 1
end if
end subroutine subr10

73
gcc/testsuite/gfortran.dg/goacc/subroutines.f90 Normal file
View file

@ -0,0 +1,73 @@
! Exercise how tree-nested.c handles gang, worker vector and seq.
! { dg-do compile }
program main
integer, parameter :: N = 100
integer :: nonlocal_arg
integer :: nonlocal_a(N)
integer :: nonlocal_i
integer :: nonlocal_j
nonlocal_a (:) = 5
nonlocal_arg = 5
call local ()
call nonlocal ()
contains
subroutine local ()
integer :: local_i
integer :: local_arg
integer :: local_a(N)
integer :: local_j
local_a (:) = 5
local_arg = 5
!$acc kernels loop gang(num:local_arg) worker(local_arg) vector(local_arg)
do local_i = 1, N
local_a(local_i) = 100
!$acc loop seq
do local_j = 1, N
enddo
enddo
!$acc end kernels loop
!$acc kernels loop gang(static:local_arg) worker(local_arg) &
!$acc vector(local_arg)
do local_i = 1, N
local_a(local_i) = 100
!$acc loop seq
do local_j = 1, N
enddo
enddo
!$acc end kernels loop
end subroutine local
subroutine nonlocal ()
nonlocal_a (:) = 5
nonlocal_arg = 5
!$acc kernels loop gang(num:nonlocal_arg) worker(nonlocal_arg) &
!$acc vector(nonlocal_arg)
do nonlocal_i = 1, N
nonlocal_a(nonlocal_i) = 100
!$acc loop seq
do nonlocal_j = 1, N
enddo
enddo
!$acc end kernels loop
!$acc kernels loop gang(static:nonlocal_arg) worker(nonlocal_arg) &
!$acc vector(nonlocal_arg)
do nonlocal_i = 1, N
nonlocal_a(nonlocal_i) = 100
!$acc loop seq
do nonlocal_j = 1, N
enddo
enddo
!$acc end kernels loop
end subroutine nonlocal
end program main

60
gcc/tree-nested.c
View file

@ -1108,10 +1108,31 @@ convert_nonlocal_omp_clauses (tree *pclauses, struct walk_stmt_info *wi)
case OMP_CLAUSE_NUM_TASKS:
case OMP_CLAUSE_HINT:
case OMP_CLAUSE__CILK_FOR_COUNT_:
wi->val_only = true;
wi->is_lhs = false;
convert_nonlocal_reference_op (&OMP_CLAUSE_OPERAND (clause, 0),
&dummy, wi);
case OMP_CLAUSE_NUM_GANGS:
case OMP_CLAUSE_NUM_WORKERS:
case OMP_CLAUSE_VECTOR_LENGTH:
case OMP_CLAUSE_GANG:
case OMP_CLAUSE_WORKER:
case OMP_CLAUSE_VECTOR:
/* Several OpenACC clauses have optional arguments. Check if they
are present. */
if (OMP_CLAUSE_OPERAND (clause, 0))
{
wi->val_only = true;
wi->is_lhs = false;
convert_nonlocal_reference_op (&OMP_CLAUSE_OPERAND (clause, 0),
&dummy, wi);
}
/* The gang clause accepts two arguments. */
if (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_GANG
&& OMP_CLAUSE_GANG_STATIC_EXPR (clause))
{
wi->val_only = true;
wi->is_lhs = false;
convert_nonlocal_reference_op
(&OMP_CLAUSE_GANG_STATIC_EXPR (clause), &dummy, wi);
}
break;
case OMP_CLAUSE_DIST_SCHEDULE:
@ -1175,6 +1196,7 @@ convert_nonlocal_omp_clauses (tree *pclauses, struct walk_stmt_info *wi)
case OMP_CLAUSE_THREADS:
case OMP_CLAUSE_SIMD:
case OMP_CLAUSE_DEFAULTMAP:
case OMP_CLAUSE_SEQ:
break;
default:
@ -1762,10 +1784,31 @@ convert_local_omp_clauses (tree *pclauses, struct walk_stmt_info *wi)
case OMP_CLAUSE_NUM_TASKS:
case OMP_CLAUSE_HINT:
case OMP_CLAUSE__CILK_FOR_COUNT_:
wi->val_only = true;
wi->is_lhs = false;
convert_local_reference_op (&OMP_CLAUSE_OPERAND (clause, 0), &dummy,
wi);
case OMP_CLAUSE_NUM_GANGS:
case OMP_CLAUSE_NUM_WORKERS:
case OMP_CLAUSE_VECTOR_LENGTH:
case OMP_CLAUSE_GANG:
case OMP_CLAUSE_WORKER:
case OMP_CLAUSE_VECTOR:
/* Several OpenACC clauses have optional arguments. Check if they
are present. */
if (OMP_CLAUSE_OPERAND (clause, 0))
{
wi->val_only = true;
wi->is_lhs = false;
convert_local_reference_op (&OMP_CLAUSE_OPERAND (clause, 0),
&dummy, wi);
}
/* The gang clause accepts two arguments. */
if (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_GANG
&& OMP_CLAUSE_GANG_STATIC_EXPR (clause))
{
wi->val_only = true;
wi->is_lhs = false;
convert_nonlocal_reference_op
(&OMP_CLAUSE_GANG_STATIC_EXPR (clause), &dummy, wi);
}
break;
case OMP_CLAUSE_DIST_SCHEDULE:
@ -1834,6 +1877,7 @@ convert_local_omp_clauses (tree *pclauses, struct walk_stmt_info *wi)
case OMP_CLAUSE_THREADS:
case OMP_CLAUSE_SIMD:
case OMP_CLAUSE_DEFAULTMAP:
case OMP_CLAUSE_SEQ:
break;
default:

8
libgomp/ChangeLog
View file

@ -1,3 +1,11 @@
2015-11-30 James Norris <jnorris@codesourcery.com>
Cesar Philippidis <cesar@codesourcery.com>
libgomp/
* libgomp.oacc-fortran/routine-5.f90: New test.
* libgomp.oacc-fortran/routine-7.f90: New test.
* libgomp.oacc-fortran/routine-9.f90: New test.
2015-11-30 Tom de Vries <tom@codesourcery.com>
PR tree-optimization/46032

27
libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90 Normal file
View file

@ -0,0 +1,27 @@
! { dg-do run }
! { dg-options "-fno-inline" }
program main
integer :: n
n = 5
!$acc parallel copy (n)
n = func (n)
!$acc end parallel
if (n .ne. 6) call abort
contains
function func (n) result (rc)
!$acc routine
integer, intent (in) :: n
integer :: rc
rc = n
rc = rc + 1
end function
end program

121
libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90 Normal file
View file

@ -0,0 +1,121 @@
! { dg-do run }
! { dg-additional-options "-cpp" }
#define M 8
#define N 32
program main
integer :: i
integer :: a(N)
integer :: b(M * N)
do i = 1, N
a(i) = 0
end do
!$acc parallel copy (a)
!$acc loop seq
do i = 1, N
call seq (a)
end do
!$acc end parallel
do i = 1, N
if (a(i) .ne.N) call abort
end do
!$acc parallel copy (a)
!$acc loop seq
do i = 1, N
call gang (a)
end do
!$acc end parallel
do i = 1, N
if (a(i) .ne. (N + (N * (-1 * i)))) call abort
end do
do i = 1, N
b(i) = i
end do
!$acc parallel copy (b)
!$acc loop
do i = 1, N
call worker (b)
end do
!$acc end parallel
do i = 1, N
if (b(i) .ne. N + i) call abort
end do
do i = 1, N
a(i) = i
end do
!$acc parallel copy (a)
!$acc loop
do i = 1, N
call vector (a)
end do
!$acc end parallel
do i = 1, N
if (a(i) .ne. 0) call abort
end do
contains
subroutine vector (a)
!$acc routine vector
integer, intent (inout) :: a(N)
integer :: i
!$acc loop vector
do i = 1, N
a(i) = a(i) - a(i)
end do
end subroutine vector
subroutine worker (b)
!$acc routine worker
integer, intent (inout) :: b(M*N)
integer :: i, j
!$acc loop worker
do i = 1, N
!$acc loop vector
do j = 1, M
b(j + ((i - 1) * M)) = b(j + ((i - 1) * M)) + 1
end do
end do
end subroutine worker
subroutine gang (a)
!$acc routine gang
integer, intent (inout) :: a(N)
integer :: i
!$acc loop gang
do i = 1, N
a(i) = a(i) - i
end do
end subroutine gang
subroutine seq (a)
!$acc routine seq
integer, intent (inout) :: a(M)
integer :: i
do i = 1, N
a(i) = a(i) + 1
end do
end subroutine seq
end program main

31
libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90 Normal file
View file

@ -0,0 +1,31 @@
! { dg-do run }
! { dg-options "-fno-inline" }
program main
implicit none
integer, parameter :: n = 10
integer :: a(n), i
integer, external :: fact
!$acc routine (fact)
!$acc parallel
!$acc loop
do i = 1, n
a(i) = fact (i)
end do
!$acc end parallel
do i = 1, n
if (a(i) .ne. fact(i)) call abort
end do
end program main
recursive function fact (x) result (res)
implicit none
!$acc routine (fact)
integer, intent(in) :: x
integer :: res
if (x < 1) then
res = 1
else
res = x * fact(x - 1)
end if
end function fact