* [openacc] Teach gfortran to lower OpenACC routine dims
@ 2018-09-05 19:52 Cesar Philippidis
2018-09-19 22:30 ` Bernhard Reutner-Fischer
0 siblings, 1 reply; 6+ messages in thread
From: Cesar Philippidis @ 2018-09-05 19:52 UTC (permalink / raw)
To: gcc-patches, Fortran List, Jakub Jelinek
[-- Attachment #1: Type: text/plain, Size: 605 bytes --]
At present, gfortran does not encode the gang, worker or vector
parallelism clauses when it creates acc routines dim attribute for
subroutines and functions. While support for acc routine is lacking in
other areas in gfortran (including modules), this patch is important
because it encodes the parallelism attributes using the same function as
the C and C++ FEs. This will become important with the forthcoming nvptx
vector length extensions, because large vectors are not supported in acc
routines yet.
Is this OK for trunk? I regtested and bootstrapped for x86_64 with nvptx
offloading.
Thanks,
Cesar
[-- Attachment #2: 0001-openacc-Make-GFC-default-to-1-for-OpenACC-routine-di.patch --]
[-- Type: text/x-patch, Size: 20378 bytes --]
[openacc] Teach gfortran to lower OpenACC routine dims
gcc/fortran/
* gfortran.h (oacc_function): New enum.
(gfc_oacc_routine_name): Add locus loc field.
* openmp.c (gfc_oacc_routine_dims): Return oacc_function.
(gfc_match_oacc_routine): Update routine clause syntax checking.
Populate oacc_function attribute with dims.
* trans-decl.c (add_attributes_to_decl): Use oacc_build_routine_dims
to construct routine dims.
gcc/testsuite/
* gfortran.dg/goacc/classify-routine.f95: Adjust test.
* gfortran.dg/goacc/pr71704.f90: Likewise.
* gfortran.dg/goacc/routine-6.f90: Likewise.
* gfortran.dg/goacc/routine-8.f90: Likewise.
* gfortran.dg/goacc/routine-level-of-parallelism-1.f90: Likewise.
libgomp/
* testsuite/libgomp.oacc-fortran/routine-1.f90: Adjust test.
* testsuite/libgomp.oacc-fortran/routine-2.f90: Likewise.
* testsuite/libgomp.oacc-fortran/routine-3.f90: Likewise.
* testsuite/libgomp.oacc-fortran/routine-4.f90: Likewise.
* testsuite/libgomp.oacc-fortran/routine-5.f90: Likewise.
* testsuite/libgomp.oacc-fortran/routine-7.f90: Likewise.
* testsuite/libgomp.oacc-fortran/routine-9.f90: Likewise.
* libgomp.oacc-fortran/host_data-2.f90: Likewise.
* libgomp.oacc-fortran/host_data-3.f: Likewise.
* libgomp.oacc-fortran/host_data-4.f90: Likewise.
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 04b0024a992..3675f2e8d52 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -316,6 +316,16 @@ enum save_state
{ SAVE_NONE = 0, SAVE_EXPLICIT, SAVE_IMPLICIT
};
+/* Flags to keep track of ACC routine states. */
+enum oacc_function
+{ OACC_FUNCTION_NONE = 0,
+ OACC_FUNCTION_GANG,
+ OACC_FUNCTION_WORKER,
+ OACC_FUNCTION_VECTOR,
+ OACC_FUNCTION_SEQ,
+ OACC_FUNCTION_AUTO
+};
+
/* Strings for all symbol attributes. We use these for dumping the
parse tree, in error messages, and also when reading and writing
modules. In symbol.c. */
@@ -1726,6 +1736,7 @@ typedef struct gfc_oacc_routine_name
struct gfc_symbol *sym;
struct gfc_omp_clauses *clauses;
struct gfc_oacc_routine_name *next;
+ locus loc;
}
gfc_oacc_routine_name;
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 94a7f7eaa50..d48c9351e25 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -2234,34 +2234,45 @@ gfc_match_oacc_cache (void)
return MATCH_YES;
}
-/* Determine the loop level for a routine. */
+/* Determine the loop level for a routine. Returns OACC_FUNCTION_NONE
+ if any error is detected. */
-static int
+static oacc_function
gfc_oacc_routine_dims (gfc_omp_clauses *clauses)
{
int level = -1;
+ oacc_function ret = OACC_FUNCTION_AUTO;
if (clauses)
{
unsigned mask = 0;
if (clauses->gang)
- level = GOMP_DIM_GANG, mask |= GOMP_DIM_MASK (level);
+ {
+ level = GOMP_DIM_GANG, mask |= GOMP_DIM_MASK (level);
+ ret = OACC_FUNCTION_GANG;
+ }
if (clauses->worker)
- level = GOMP_DIM_WORKER, mask |= GOMP_DIM_MASK (level);
+ {
+ level = GOMP_DIM_WORKER, mask |= GOMP_DIM_MASK (level);
+ ret = OACC_FUNCTION_WORKER;
+ }
if (clauses->vector)
- level = GOMP_DIM_VECTOR, mask |= GOMP_DIM_MASK (level);
+ {
+ level = GOMP_DIM_VECTOR, mask |= GOMP_DIM_MASK (level);
+ ret = OACC_FUNCTION_VECTOR;
+ }
if (clauses->seq)
- level = GOMP_DIM_MAX, mask |= GOMP_DIM_MASK (level);
+ {
+ level = GOMP_DIM_MAX, mask |= GOMP_DIM_MASK (level);
+ ret = OACC_FUNCTION_SEQ;
+ }
if (mask != (mask & -mask))
- gfc_error ("Multiple loop axes specified for routine");
+ ret = OACC_FUNCTION_NONE;
}
- if (level < 0)
- level = GOMP_DIM_MAX;
-
- return level;
+ return ret;
}
match
@@ -2272,6 +2283,8 @@ gfc_match_oacc_routine (void)
match m;
gfc_omp_clauses *c = NULL;
gfc_oacc_routine_name *n = NULL;
+ oacc_function dims = OACC_FUNCTION_NONE;
+ bool seen_error = false;
old_loc = gfc_current_locus;
@@ -2318,17 +2331,15 @@ gfc_match_oacc_routine (void)
}
else
{
- gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C");
- gfc_current_locus = old_loc;
- return MATCH_ERROR;
+ gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %L", &old_loc);
+ goto cleanup;
}
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;
+ gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %L, expecting"
+ " ')' after NAME", &old_loc);
+ goto cleanup;
}
}
@@ -2337,26 +2348,83 @@ gfc_match_oacc_routine (void)
!= MATCH_YES))
return MATCH_ERROR;
+ /* Scan for invalid routine geometry. */
+ dims = gfc_oacc_routine_dims (c);
+ if (dims == OACC_FUNCTION_NONE)
+ {
+ gfc_error ("Multiple loop axes specified in !$ACC ROUTINE at %L",
+ &old_loc);
+
+ /* Don't abort early, because it's important to let the user
+ know of any potential duplicate routine directives. */
+ seen_error = true;
+ }
+ else if (dims == OACC_FUNCTION_AUTO)
+ {
+ gfc_warning (0, "Expected one of %<gang%>, %<worker%>, %<vector%> or "
+ "%<seq%> clauses in !$ACC ROUTINE at %L", &old_loc);
+ dims = OACC_FUNCTION_SEQ;
+ }
+
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;
+ bool needs_entry = true;
+
+ /* Scan for any repeated routine directives on 'sym' and report
+ an error if necessary. TODO: Extend this function to scan
+ for compatible DEVICE_TYPE dims. */
+ for (n = gfc_current_ns->oacc_routine_names; n; n = n->next)
+ if (n->sym == sym)
+ {
+ needs_entry = false;
+ if (dims != gfc_oacc_routine_dims (n->clauses))
+ {
+ gfc_error ("$!ACC ROUTINE already applied at %L", &old_loc);
+ goto cleanup;
+ }
+ }
+
+ if (needs_entry)
+ {
+ n = gfc_get_oacc_routine_name ();
+ n->sym = sym;
+ n->clauses = c;
+ n->next = NULL;
+ n->loc = old_loc;
+
+ if (gfc_current_ns->oacc_routine_names != NULL)
+ n->next = gfc_current_ns->oacc_routine_names;
+
+ gfc_current_ns->oacc_routine_names = n;
+ }
+
+ if (seen_error)
+ goto cleanup;
}
else if (gfc_current_ns->proc_name)
{
+ if (gfc_current_ns->proc_name->attr.oacc_function != OACC_FUNCTION_NONE
+ && !seen_error)
+ {
+ gfc_error ("!$ACC ROUTINE already applied at %L", &old_loc);
+ goto cleanup;
+ }
+
if (!gfc_add_omp_declare_target (&gfc_current_ns->proc_name->attr,
gfc_current_ns->proc_name->name,
&old_loc))
goto cleanup;
+
gfc_current_ns->proc_name->attr.oacc_function
- = gfc_oacc_routine_dims (c) + 1;
+ = seen_error ? OACC_FUNCTION_SEQ : dims;
+
+ if (seen_error)
+ goto cleanup;
}
+ else
+ /* Something has gone wrong. Perhaps there was a syntax error
+ in the program-stmt. */
+ goto cleanup;
if (n)
n->clauses = c;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index eea6b81ebfa..eed868f475b 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -46,6 +46,7 @@ along with GCC; see the file COPYING3. If not see
#include "trans-stmt.h"
#include "gomp-constants.h"
#include "gimplify.h"
+#include "omp-general.h"
#define MAX_LABEL_VALUE 99999
@@ -1403,16 +1404,29 @@ 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)
+ if (sym_attr.oacc_function != OACC_FUNCTION_NONE)
{
- tree dims = NULL_TREE;
- int ix;
- int level = sym_attr.oacc_function - 1;
+ omp_clause_code code = OMP_CLAUSE_ERROR;
+ tree clause, dims;
- for (ix = GOMP_DIM_MAX; ix--;)
- dims = tree_cons (build_int_cst (boolean_type_node, ix >= level),
- integer_zero_node, dims);
+ switch (sym_attr.oacc_function)
+ {
+ case OACC_FUNCTION_GANG:
+ code = OMP_CLAUSE_GANG;
+ break;
+ case OACC_FUNCTION_WORKER:
+ code = OMP_CLAUSE_WORKER;
+ break;
+ case OACC_FUNCTION_VECTOR:
+ code = OMP_CLAUSE_VECTOR;
+ break;
+ case OACC_FUNCTION_SEQ:
+ default:
+ code = OMP_CLAUSE_SEQ;
+ }
+ clause = build_omp_clause (UNKNOWN_LOCATION, code);
+ dims = oacc_build_routine_dims (clause);
list = tree_cons (get_identifier ("oacc function"),
dims, list);
}
diff --git a/gcc/testsuite/gfortran.dg/goacc/classify-routine.f95 b/gcc/testsuite/gfortran.dg/goacc/classify-routine.f95
index 4ca406742f9..445ff9afd4e 100644
--- a/gcc/testsuite/gfortran.dg/goacc/classify-routine.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/classify-routine.f95
@@ -20,10 +20,10 @@ subroutine ROUTINE
end subroutine ROUTINE
! Check the offloaded function's attributes.
-! { dg-final { scan-tree-dump-times "(?n)__attribute__\\(\\(omp declare target, oacc function \\(0 0, 1 0, 1 0\\)\\)\\)" 1 "ompexp" } }
+! { dg-final { scan-tree-dump-times "(?n)__attribute__\\(\\(omp declare target, oacc function \\(0 1, 1 0, 1 0\\)\\)\\)" 1 "ompexp" } }
! Check the offloaded function's classification and compute dimensions (will
! always be 1 x 1 x 1 for non-offloading compilation).
! { dg-final { scan-tree-dump-times "(?n)Function is OpenACC routine level 1" 1 "oaccdevlow" } }
! { dg-final { scan-tree-dump-times "(?n)Compute dimensions \\\[1, 1, 1\\\]" 1 "oaccdevlow" } }
-! { dg-final { scan-tree-dump-times "(?n)__attribute__\\(\\(oacc function \\(0 1, 1 1, 1 1\\), omp declare target, oacc function \\(0 0, 1 0, 1 0\\)\\)\\)" 1 "oaccdevlow" } }
+! { dg-final { scan-tree-dump-times "(?n)__attribute__\\(\\(oacc function \\(0 1, 1 1, 1 1\\), omp declare target, oacc function \\(0 1, 1 0, 1 0\\)\\)\\)" 1 "oaccdevlow" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr71704.f90 b/gcc/testsuite/gfortran.dg/goacc/pr71704.f90
index 0235e85d42a..92d0c71d75c 100644
--- a/gcc/testsuite/gfortran.dg/goacc/pr71704.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/pr71704.f90
@@ -2,7 +2,7 @@
! { dg-do compile }
real function f1 ()
-!$acc routine (f1)
+!$acc routine (f1) seq
f1 = 1
end
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-6.f90
index 10943cff304..5c1f652ff6d 100644
--- a/gcc/testsuite/gfortran.dg/goacc/routine-6.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-6.f90
@@ -4,8 +4,7 @@ module m
contains
subroutine subr5 (x)
implicit none
- !$acc routine (subr5)
- !$acc routine (m1int) ! { dg-error "invalid function name" }
+ !$acc routine (subr5) seq
integer, intent(inout) :: x
if (x < 1) then
x = 1
@@ -19,22 +18,21 @@ program main
implicit none
interface
function subr6 (x)
- !$acc routine (subr6) ! { dg-error "without list is allowed in interface" }
+ !$acc routine (subr6) seq ! { 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 routine (subr2) seq
external :: R1, R2
- !$acc routine (R1 R2 R3) ! { dg-error "Syntax error in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), expecting .\\). after NAME" }
- !$acc routine (R1, R2, R3) ! { dg-error "Syntax error in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), expecting .\\). after NAME" }
- !$acc routine (R1)
- !$acc routine (R2)
+ !$acc routine (R1 R2 R3) seq ! { dg-error "Syntax error in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), expecting .\\). after NAME" }
+ !$acc routine (R1, R2, R3) seq ! { dg-error "Syntax error in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), expecting .\\). after NAME" }
+ !$acc routine (R1) seq
+ !$acc routine (R2) seq
!$acc parallel
!$acc loop
@@ -46,7 +44,7 @@ program main
end program main
subroutine subr1 (x)
- !$acc routine
+ !$acc routine seq
integer, intent(inout) :: x
if (x < 1) then
x = 1
@@ -56,7 +54,6 @@ subroutine subr1 (x)
end subroutine subr1
subroutine subr2 (x)
- !$acc routine (subr1) ! { dg-error "invalid function name" }
integer, intent(inout) :: x
if (x < 1) then
x = 1
@@ -66,7 +63,7 @@ subroutine subr2 (x)
end subroutine subr2
subroutine subr3 (x)
- !$acc routine (subr3)
+ !$acc routine (subr3) seq
integer, intent(inout) :: x
if (x < 1) then
x = 1
@@ -76,7 +73,7 @@ subroutine subr3 (x)
end subroutine subr3
subroutine subr4 (x)
- !$acc routine (subr4)
+ !$acc routine (subr4) seq
integer, intent(inout) :: x
if (x < 1) then
x = 1
@@ -86,7 +83,6 @@ subroutine subr4 (x)
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
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-8.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-8.f90
index c9039153885..beca43f2d60 100644
--- a/gcc/testsuite/gfortran.dg/goacc/routine-8.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-8.f90
@@ -4,7 +4,7 @@ program main
interface
function s_1 (a)
integer a
- !$acc routine
+ !$acc routine seq
end function s_1
end interface
@@ -18,7 +18,7 @@ program main
interface
function s_3 (a)
integer a
- !$acc routine (s_3) ! { dg-error "Only the ..ACC ROUTINE form without list is allowed in interface block" }
+ !$acc routine (s_3) seq ! { dg-error "Only the ..ACC ROUTINE form without list is allowed in interface block" }
end function s_3
end interface
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-level-of-parallelism-1.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-level-of-parallelism-1.f90
index 75dd1b01f6f..efc1b400add 100644
--- a/gcc/testsuite/gfortran.dg/goacc/routine-level-of-parallelism-1.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-level-of-parallelism-1.f90
@@ -7,7 +7,7 @@ subroutine g_1
end subroutine g_1
subroutine s_1_2a
- !$acc routine
+ !$acc routine seq
end subroutine s_1_2a
subroutine s_1_2b
@@ -15,7 +15,7 @@ subroutine s_1_2b
end subroutine s_1_2b
subroutine s_1_2c
- !$acc routine (s_1_2c)
+ !$acc routine (s_1_2c) seq
end subroutine s_1_2c
subroutine s_1_2d
@@ -25,7 +25,7 @@ end subroutine s_1_2d
module s_2
contains
subroutine s_2_1a
- !$acc routine
+ !$acc routine seq
end subroutine s_2_1a
subroutine s_2_1b
@@ -33,7 +33,7 @@ contains
end subroutine s_2_1b
subroutine s_2_1c
- !$acc routine (s_2_1c)
+ !$acc routine (s_2_1c) seq
end subroutine s_2_1c
subroutine s_2_1d
@@ -48,7 +48,7 @@ subroutine test
interface
function s_3_1a (a)
integer a
- !$acc routine
+ !$acc routine seq
end function s_3_1a
end interface
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/host_data-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/host_data-2.f90
index ff0921863f6..4cdaa0c4d60 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/host_data-2.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/host_data-2.f90
@@ -81,7 +81,7 @@ subroutine saxpy (nn, aa, xx, yy)
integer :: nn
real*4 :: aa, xx(nn), yy(nn)
integer i
- !$acc routine
+ !$acc routine seq
do i = 1, nn
yy(i) = yy(i) + aa * xx(i)
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/host_data-3.f b/libgomp/testsuite/libgomp.oacc-fortran/host_data-3.f
index 05ed949ee5c..fe0b904bb91 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/host_data-3.f
+++ b/libgomp/testsuite/libgomp.oacc-fortran/host_data-3.f
@@ -67,7 +67,7 @@
integer :: nn
real*4 :: aa, xx(nn), yy(nn)
integer i
-!$acc routine
+!$acc routine seq
do i = 1, nn
yy(i) = yy(i) + aa * xx(i)
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/host_data-4.f90 b/libgomp/testsuite/libgomp.oacc-fortran/host_data-4.f90
index 6e379b5485b..e192c59a97c 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/host_data-4.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/host_data-4.f90
@@ -21,7 +21,7 @@ contains
integer :: nn
real*4 :: aa, xx(nn), yy(nn)
integer i
- !$acc routine
+ !$acc routine seq
do i = 1, nn
yy(i) = yy(i) + aa * xx(i)
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-1.f90
index 6a573218b7a..346e875ba00 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-1.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-1.f90
@@ -3,7 +3,7 @@
interface
recursive function fact (x)
- !$acc routine
+ !$acc routine seq
integer, intent(in) :: x
integer :: fact
end function fact
@@ -21,7 +21,7 @@
end do
end
recursive function fact (x) result (res)
- !$acc routine
+ !$acc routine seq
integer, intent(in) :: x
integer :: res
if (x < 1) then
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-2.f90
index b6979747902..1391979291c 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-2.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-2.f90
@@ -4,7 +4,7 @@
module m1
contains
recursive function fact (x) result (res)
- !$acc routine
+ !$acc routine seq
integer, intent(in) :: x
integer :: res
if (x < 1) then
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-3.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-3.f90
index e7b9d8ab364..6f49db97b80 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-3.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-3.f90
@@ -4,7 +4,7 @@
integer, parameter :: n = 10
integer :: a(n), i
integer, external :: fact
- !$acc routine (fact)
+ !$acc routine (fact) seq
!$acc parallel
!$acc loop
do i = 1, n
@@ -16,7 +16,7 @@
end do
end
recursive function fact (x) result (res)
- !$acc routine
+ !$acc routine seq
integer, intent(in) :: x
integer :: res
if (x < 1) then
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-4.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-4.f90
index a96363b8cde..85bdb2a0a07 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-4.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-4.f90
@@ -17,7 +17,7 @@
end do
end
subroutine incr (x)
- !$acc routine
+ !$acc routine seq
integer, intent(inout) :: x
x = x + 1
end subroutine incr
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90
index a803ad96bb5..88d65741b7c 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90
@@ -15,7 +15,7 @@ program main
contains
function func (n) result (rc)
- !$acc routine
+ !$acc routine seq
integer, intent (in) :: n
integer :: rc
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90
index f58a95fe670..a83e92ab129 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90
@@ -1,4 +1,3 @@
-
! { dg-do run }
! { dg-additional-options "-cpp" }
@@ -100,7 +99,7 @@ subroutine gang (a)
integer, intent (inout) :: a(N)
integer :: i
- !$acc loop gang
+ !$acc loop gang worker vector
do i = 1, N
a(i) = a(i) - i
end do
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90
index b1a1338dd8c..4a1250405cb 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90
@@ -6,7 +6,7 @@ program main
integer, parameter :: n = 10
integer :: a(n), i
integer, external :: fact
- !$acc routine (fact)
+ !$acc routine (fact) seq
!$acc parallel
!$acc loop
do i = 1, n
@@ -20,7 +20,7 @@ end program main
recursive function fact (x) result (res)
implicit none
- !$acc routine (fact)
+ !$acc routine (fact) seq
integer, intent(in) :: x
integer :: res
if (x < 1) then
--
2.17.1
^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: [openacc] Teach gfortran to lower OpenACC routine dims
2018-09-05 19:52 [openacc] Teach gfortran to lower OpenACC routine dims Cesar Philippidis
@ 2018-09-19 22:30 ` Bernhard Reutner-Fischer
2018-09-20 14:41 ` Cesar Philippidis
0 siblings, 1 reply; 6+ messages in thread
From: Bernhard Reutner-Fischer @ 2018-09-19 22:30 UTC (permalink / raw)
To: Cesar Philippidis; +Cc: gcc-patches, Fortran List, Jakub Jelinek
On Wed, 5 Sep 2018 12:52:03 -0700
Cesar Philippidis <cesar@codesourcery.com> wrote:
> At present, gfortran does not encode the gang, worker or vector
> parallelism clauses when it creates acc routines dim attribute for
> subroutines and functions. While support for acc routine is lacking in
> other areas in gfortran (including modules), this patch is important
> because it encodes the parallelism attributes using the same function
> as the C and C++ FEs. This will become important with the forthcoming
> nvptx vector length extensions, because large vectors are not
> supported in acc routines yet.
>
> Is this OK for trunk? I regtested and bootstrapped for x86_64 with
> nvptx offloading.
> diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
> index 94a7f7eaa50..d48c9351e25 100644
> --- a/gcc/fortran/openmp.c
> +++ b/gcc/fortran/openmp.c
> @@ -2234,34 +2234,45 @@ gfc_match_oacc_cache (void)
> return MATCH_YES;
> }
>
> -/* Determine the loop level for a routine. */
> +/* Determine the loop level for a routine. Returns
> OACC_FUNCTION_NONE
> + if any error is detected. */
>
> -static int
> +static oacc_function
> gfc_oacc_routine_dims (gfc_omp_clauses *clauses)
> {
> int level = -1;
> + oacc_function ret = OACC_FUNCTION_AUTO;
>
> if (clauses)
> {
> unsigned mask = 0;
>
> if (clauses->gang)
> - level = GOMP_DIM_GANG, mask |= GOMP_DIM_MASK (level);
> + {
> + level = GOMP_DIM_GANG, mask |= GOMP_DIM_MASK (level);
> + ret = OACC_FUNCTION_GANG;
> + }
> if (clauses->worker)
> - level = GOMP_DIM_WORKER, mask |= GOMP_DIM_MASK (level);
> + {
> + level = GOMP_DIM_WORKER, mask |= GOMP_DIM_MASK (level);
> + ret = OACC_FUNCTION_WORKER;
> + }
> if (clauses->vector)
> - level = GOMP_DIM_VECTOR, mask |= GOMP_DIM_MASK (level);
> + {
> + level = GOMP_DIM_VECTOR, mask |= GOMP_DIM_MASK (level);
> + ret = OACC_FUNCTION_VECTOR;
> + }
> if (clauses->seq)
> - level = GOMP_DIM_MAX, mask |= GOMP_DIM_MASK (level);
> + {
> + level = GOMP_DIM_MAX, mask |= GOMP_DIM_MASK (level);
> + ret = OACC_FUNCTION_SEQ;
> + }
>
> if (mask != (mask & -mask))
> - gfc_error ("Multiple loop axes specified for routine");
> + ret = OACC_FUNCTION_NONE;
> }
>
> - if (level < 0)
> - level = GOMP_DIM_MAX;
> -
> - return level;
> + return ret;
> }
>
> match
> @@ -2272,6 +2283,8 @@ gfc_match_oacc_routine (void)
> match m;
> gfc_omp_clauses *c = NULL;
> gfc_oacc_routine_name *n = NULL;
> + oacc_function dims = OACC_FUNCTION_NONE;
Unneeded initialisation of dims.
> + bool seen_error = false;
>
> old_loc = gfc_current_locus;
>
> @@ -2318,17 +2331,15 @@ gfc_match_oacc_routine (void)
> }
> else
> {
> - gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C");
> - gfc_current_locus = old_loc;
> - return MATCH_ERROR;
> + gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %L",
> &old_loc);
> + goto cleanup;
> }
>
> 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;
> + gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %L,
> expecting"
> + " ')' after NAME", &old_loc);
> + goto cleanup;
> }
> }
>
> @@ -2337,26 +2348,83 @@ gfc_match_oacc_routine (void)
> != MATCH_YES))
> return MATCH_ERROR;
>
> + /* Scan for invalid routine geometry. */
> + dims = gfc_oacc_routine_dims (c);
> + if (dims == OACC_FUNCTION_NONE)
> + {
> + gfc_error ("Multiple loop axes specified in !$ACC ROUTINE at
> %L",
> + &old_loc);
> +
> + /* Don't abort early, because it's important to let the user
> + know of any potential duplicate routine directives. */
> + seen_error = true;
> + }
> + else if (dims == OACC_FUNCTION_AUTO)
> + {
> + gfc_warning (0, "Expected one of %<gang%>, %<worker%>,
> %<vector%> or "
> + "%<seq%> clauses in !$ACC ROUTINE at %L",
> &old_loc);
> + dims = OACC_FUNCTION_SEQ;
> + }
> +
> 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;
> + bool needs_entry = true;
> +
> + /* Scan for any repeated routine directives on 'sym' and report
> + an error if necessary. TODO: Extend this function to scan
> + for compatible DEVICE_TYPE dims. */
> + for (n = gfc_current_ns->oacc_routine_names; n; n = n->next)
> + if (n->sym == sym)
> + {
> + needs_entry = false;
> + if (dims != gfc_oacc_routine_dims (n->clauses))
> + {
> + gfc_error ("$!ACC ROUTINE already applied at %L",
> &old_loc);
> + goto cleanup;
> + }
> + }
> +
> + if (needs_entry)
> + {
> + n = gfc_get_oacc_routine_name ();
> + n->sym = sym;
> + n->clauses = c;
> + n->next = NULL;
> + n->loc = old_loc;
> +
> + if (gfc_current_ns->oacc_routine_names != NULL)
> + n->next = gfc_current_ns->oacc_routine_names;
Just omit n->next = NULL above and unconditionally set ->next to current
ns' routine names.
> +
> + gfc_current_ns->oacc_routine_names = n;
> + }
> +
> + if (seen_error)
> + goto cleanup;
> }
> else if (gfc_current_ns->proc_name)
> {
> + if (gfc_current_ns->proc_name->attr.oacc_function !=
> OACC_FUNCTION_NONE
> + && !seen_error)
> + {
> + gfc_error ("!$ACC ROUTINE already applied at %L",
> &old_loc);
> + goto cleanup;
I'd move both this gfc_error and the one above to a duplicate_routine
label before the cleanup label and jump to that here and for the
identical gfc_error above.
> + }
> +
> if (!gfc_add_omp_declare_target
> (&gfc_current_ns->proc_name->attr, gfc_current_ns->proc_name->name,
> &old_loc))
> goto cleanup;
> +
> gfc_current_ns->proc_name->attr.oacc_function
> - = gfc_oacc_routine_dims (c) + 1;
> + = seen_error ? OACC_FUNCTION_SEQ : dims;
why can't you use dims unconditionally after branching to cleanup if
seen_error? I.e. move the seen_error check below to above the
attr.oacc_function setting?
> +
> + if (seen_error)
> + goto cleanup;
> }
> + else
> + /* Something has gone wrong. Perhaps there was a syntax error
> + in the program-stmt. */
> + goto cleanup;
>
> if (n)
> n->clauses = c;
> diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
> index eea6b81ebfa..eed868f475b 100644
> --- a/gcc/fortran/trans-decl.c
> +++ b/gcc/fortran/trans-decl.c
> @@ -46,6 +46,7 @@ along with GCC; see the file COPYING3. If not see
> #include "trans-stmt.h"
> #include "gomp-constants.h"
> #include "gimplify.h"
> +#include "omp-general.h"
hmz. so the gomp-constants.h include would be redundant, but do we
really need omp-general.h?
Doesn't this suggest to move this oacc dims lowering to trans-openmp.c
instead, please?
>
> #define MAX_LABEL_VALUE 99999
>
> @@ -1403,16 +1404,29 @@ 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)
> + if (sym_attr.oacc_function != OACC_FUNCTION_NONE)
> {
> - tree dims = NULL_TREE;
> - int ix;
> - int level = sym_attr.oacc_function - 1;
> + omp_clause_code code = OMP_CLAUSE_ERROR;
redundant initialization.
> + tree clause, dims;
>
> - for (ix = GOMP_DIM_MAX; ix--;)
> - dims = tree_cons (build_int_cst (boolean_type_node, ix >=
> level),
> - integer_zero_node, dims);
> + switch (sym_attr.oacc_function)
> + {
> + case OACC_FUNCTION_GANG:
> + code = OMP_CLAUSE_GANG;
> + break;
> + case OACC_FUNCTION_WORKER:
> + code = OMP_CLAUSE_WORKER;
> + break;
> + case OACC_FUNCTION_VECTOR:
> + code = OMP_CLAUSE_VECTOR;
> + break;
> + case OACC_FUNCTION_SEQ:
> + default:
> + code = OMP_CLAUSE_SEQ;
> + }
>
> + clause = build_omp_clause (UNKNOWN_LOCATION, code);
> + dims = oacc_build_routine_dims (clause);
> list = tree_cons (get_identifier ("oacc function"),
> dims, list);
> }
btw.. the OACC merge from the gomp4 branch added a copy'n paste error
in an error message. May i ask you to regtest and install the below:
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index fcfe671be8b..ac1f4fc7619 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -5848,13 +5848,13 @@ resolve_oacc_loop_blocks (gfc_code *code)
if (c->code->ext.omp_clauses->worker)
gfc_error ("Loop parallelized across gangs is not
allowed " "inside loop parallelized across workers at %L",
&code->loc);
if (c->code->ext.omp_clauses->vector)
gfc_error ("Loop parallelized across gangs is not
allowed "
- "inside loop parallelized across workers
at %L",
+ "inside loop parallelized across vectors
at %L", &code->loc);
}
if (code->ext.omp_clauses->worker)
{
if (c->code->ext.omp_clauses->worker)
gfc_error ("Loop parallelized across workers is not
allowed "
thanks,
^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: [openacc] Teach gfortran to lower OpenACC routine dims
2018-09-19 22:30 ` Bernhard Reutner-Fischer
@ 2018-09-20 14:41 ` Cesar Philippidis
2018-09-20 16:20 ` Bernhard Reutner-Fischer
0 siblings, 1 reply; 6+ messages in thread
From: Cesar Philippidis @ 2018-09-20 14:41 UTC (permalink / raw)
To: Bernhard Reutner-Fischer; +Cc: gcc-patches, Fortran List, Jakub Jelinek
On 09/19/2018 03:27 PM, Bernhard Reutner-Fischer wrote:
> On Wed, 5 Sep 2018 12:52:03 -0700
> Cesar Philippidis <cesar@codesourcery.com> wrote:
>
>> At present, gfortran does not encode the gang, worker or vector
>> parallelism clauses when it creates acc routines dim attribute for
>> subroutines and functions. While support for acc routine is lacking in
>> other areas in gfortran (including modules), this patch is important
>> because it encodes the parallelism attributes using the same function
>> as the C and C++ FEs. This will become important with the forthcoming
>> nvptx vector length extensions, because large vectors are not
>> supported in acc routines yet.
>>
>> Is this OK for trunk? I regtested and bootstrapped for x86_64 with
>> nvptx offloading.
>
>> diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
>> index 94a7f7eaa50..d48c9351e25 100644
>> --- a/gcc/fortran/openmp.c
>> +++ b/gcc/fortran/openmp.c
>> @@ -2234,34 +2234,45 @@ gfc_match_oacc_cache (void)
>> return MATCH_YES;
>> }
>>
>> -/* Determine the loop level for a routine. */
>> +/* Determine the loop level for a routine. Returns
>> OACC_FUNCTION_NONE
>> + if any error is detected. */
>>
>> -static int
>> +static oacc_function
>> gfc_oacc_routine_dims (gfc_omp_clauses *clauses)
>> {
>> int level = -1;
>> + oacc_function ret = OACC_FUNCTION_AUTO;
>>
>> if (clauses)
>> {
>> unsigned mask = 0;
>>
>> if (clauses->gang)
>> - level = GOMP_DIM_GANG, mask |= GOMP_DIM_MASK (level);
>> + {
>> + level = GOMP_DIM_GANG, mask |= GOMP_DIM_MASK (level);
>> + ret = OACC_FUNCTION_GANG;
>> + }
>> if (clauses->worker)
>> - level = GOMP_DIM_WORKER, mask |= GOMP_DIM_MASK (level);
>> + {
>> + level = GOMP_DIM_WORKER, mask |= GOMP_DIM_MASK (level);
>> + ret = OACC_FUNCTION_WORKER;
>> + }
>> if (clauses->vector)
>> - level = GOMP_DIM_VECTOR, mask |= GOMP_DIM_MASK (level);
>> + {
>> + level = GOMP_DIM_VECTOR, mask |= GOMP_DIM_MASK (level);
>> + ret = OACC_FUNCTION_VECTOR;
>> + }
>> if (clauses->seq)
>> - level = GOMP_DIM_MAX, mask |= GOMP_DIM_MASK (level);
>> + {
>> + level = GOMP_DIM_MAX, mask |= GOMP_DIM_MASK (level);
>> + ret = OACC_FUNCTION_SEQ;
>> + }
>>
>> if (mask != (mask & -mask))
>> - gfc_error ("Multiple loop axes specified for routine");
>> + ret = OACC_FUNCTION_NONE;
>> }
>>
>> - if (level < 0)
>> - level = GOMP_DIM_MAX;
>> -
>> - return level;
>> + return ret;
>> }
>>
>> match
>> @@ -2272,6 +2283,8 @@ gfc_match_oacc_routine (void)
>> match m;
>> gfc_omp_clauses *c = NULL;
>> gfc_oacc_routine_name *n = NULL;
>> + oacc_function dims = OACC_FUNCTION_NONE;
>
> Unneeded initialisation of dims.
ACK.
>> + bool seen_error = false;
>>
>> old_loc = gfc_current_locus;
>>
>> @@ -2318,17 +2331,15 @@ gfc_match_oacc_routine (void)
>> }
>> else
>> {
>> - gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C");
>> - gfc_current_locus = old_loc;
>> - return MATCH_ERROR;
>> + gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %L",
>> &old_loc);
>> + goto cleanup;
>> }
>>
>> 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;
>> + gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %L,
>> expecting"
>> + " ')' after NAME", &old_loc);
>> + goto cleanup;
>> }
>> }
>>
>> @@ -2337,26 +2348,83 @@ gfc_match_oacc_routine (void)
>> != MATCH_YES))
>> return MATCH_ERROR;
>>
>> + /* Scan for invalid routine geometry. */
>> + dims = gfc_oacc_routine_dims (c);
>> + if (dims == OACC_FUNCTION_NONE)
>> + {
>> + gfc_error ("Multiple loop axes specified in !$ACC ROUTINE at
>> %L",
>> + &old_loc);
>> +
>> + /* Don't abort early, because it's important to let the user
>> + know of any potential duplicate routine directives. */
>> + seen_error = true;
>> + }
>> + else if (dims == OACC_FUNCTION_AUTO)
>> + {
>> + gfc_warning (0, "Expected one of %<gang%>, %<worker%>,
>> %<vector%> or "
>> + "%<seq%> clauses in !$ACC ROUTINE at %L",
>> &old_loc);
>> + dims = OACC_FUNCTION_SEQ;
>> + }
>> +
>> 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;
>> + bool needs_entry = true;
>> +
>> + /* Scan for any repeated routine directives on 'sym' and report
>> + an error if necessary. TODO: Extend this function to scan
>> + for compatible DEVICE_TYPE dims. */
>> + for (n = gfc_current_ns->oacc_routine_names; n; n = n->next)
>> + if (n->sym == sym)
>> + {
>> + needs_entry = false;
>> + if (dims != gfc_oacc_routine_dims (n->clauses))
>> + {
>> + gfc_error ("$!ACC ROUTINE already applied at %L",
>> &old_loc);
>> + goto cleanup;
>> + }
>> + }
>> +
>> + if (needs_entry)
>> + {
>> + n = gfc_get_oacc_routine_name ();
>> + n->sym = sym;
>> + n->clauses = c;
>> + n->next = NULL;
>> + n->loc = old_loc;
>> +
>> + if (gfc_current_ns->oacc_routine_names != NULL)
>> + n->next = gfc_current_ns->oacc_routine_names;
>
> Just omit n->next = NULL above and unconditionally set ->next to current
> ns' routine names.
ACK.
>> +
>> + gfc_current_ns->oacc_routine_names = n;
>> + }
>> +
>> + if (seen_error)
>> + goto cleanup;
>> }
>> else if (gfc_current_ns->proc_name)
>> {
>> + if (gfc_current_ns->proc_name->attr.oacc_function !=
>> OACC_FUNCTION_NONE
>> + && !seen_error)
>> + {
>> + gfc_error ("!$ACC ROUTINE already applied at %L",
>> &old_loc);
>> + goto cleanup;
>
> I'd move both this gfc_error and the one above to a duplicate_routine
> label before the cleanup label and jump to that here and for the
> identical gfc_error above.
I did it this way because we have a forthcoming patch which adds support
for Fortran modules, and that patch has a different set of errors. That
said, I'll incorporate those changes and modify the patch.
>> + }
>> +
>> if (!gfc_add_omp_declare_target
>> (&gfc_current_ns->proc_name->attr, gfc_current_ns->proc_name->name,
>> &old_loc))
>> goto cleanup;
>> +
>> gfc_current_ns->proc_name->attr.oacc_function
>> - = gfc_oacc_routine_dims (c) + 1;
>> + = seen_error ? OACC_FUNCTION_SEQ : dims;
>
> why can't you use dims unconditionally after branching to cleanup if
> seen_error? I.e. move the seen_error check below to above the
> attr.oacc_function setting?
Yeah, it probably doesn't matter much if the function returns
MATCH_ERROR. I'll change it.
>> +
>> + if (seen_error)
>> + goto cleanup;
>> }
>> + else
>> + /* Something has gone wrong. Perhaps there was a syntax error
>> + in the program-stmt. */
>> + goto cleanup;
>>
>> if (n)
>> n->clauses = c;
>> diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
>> index eea6b81ebfa..eed868f475b 100644
>> --- a/gcc/fortran/trans-decl.c
>> +++ b/gcc/fortran/trans-decl.c
>> @@ -46,6 +46,7 @@ along with GCC; see the file COPYING3. If not see
>> #include "trans-stmt.h"
>> #include "gomp-constants.h"
>> #include "gimplify.h"
>> +#include "omp-general.h"
>
> hmz. so the gomp-constants.h include would be redundant, but do we
> really need omp-general.h?
Good point. omp-general.h is required for oacc_build_routine_dims.
> Doesn't this suggest to move this oacc dims lowering to trans-openmp.c
> instead, please?
So something like adding a new gfc_add_omp_offload_attributes to
trans-openmp.c and call it from add_attributes_to_decl?
>> #define MAX_LABEL_VALUE 99999
>>
>> @@ -1403,16 +1404,29 @@ 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)
>> + if (sym_attr.oacc_function != OACC_FUNCTION_NONE)
>> {
>> - tree dims = NULL_TREE;
>> - int ix;
>> - int level = sym_attr.oacc_function - 1;
>> + omp_clause_code code = OMP_CLAUSE_ERROR;
>
> redundant initialization.
ACK.
>> + tree clause, dims;
>>
>> - for (ix = GOMP_DIM_MAX; ix--;)
>> - dims = tree_cons (build_int_cst (boolean_type_node, ix >=
>> level),
>> - integer_zero_node, dims);
>> + switch (sym_attr.oacc_function)
>> + {
>> + case OACC_FUNCTION_GANG:
>> + code = OMP_CLAUSE_GANG;
>> + break;
>> + case OACC_FUNCTION_WORKER:
>> + code = OMP_CLAUSE_WORKER;
>> + break;
>> + case OACC_FUNCTION_VECTOR:
>> + code = OMP_CLAUSE_VECTOR;
>> + break;
>> + case OACC_FUNCTION_SEQ:
>> + default:
>> + code = OMP_CLAUSE_SEQ;
>> + }
>>
>> + clause = build_omp_clause (UNKNOWN_LOCATION, code);
>> + dims = oacc_build_routine_dims (clause);
>> list = tree_cons (get_identifier ("oacc function"),
>> dims, list);
>> }
On a related note, I noticed that I forgot to incorporate this change in
gfortran.h:
@@ -902,7 +912,7 @@ typedef struct
unsigned oacc_declare_link:1;
/* This is an OpenACC acclerator function at level N - 1 */
- unsigned oacc_function:3;
+ ENUM_BITFIELD (oacc_function) oacc_function:3;
It's probably not huge, but I noticed that some other enum bitfields are
declared that way.
> btw.. the OACC merge from the gomp4 branch added a copy'n paste error
> in an error message. May i ask you to regtest and install the below:
>
> diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
> index fcfe671be8b..ac1f4fc7619 100644
> --- a/gcc/fortran/openmp.c
> +++ b/gcc/fortran/openmp.c
> @@ -5848,13 +5848,13 @@ resolve_oacc_loop_blocks (gfc_code *code)
> if (c->code->ext.omp_clauses->worker)
> gfc_error ("Loop parallelized across gangs is not
> allowed " "inside loop parallelized across workers at %L",
> &code->loc);
> if (c->code->ext.omp_clauses->vector)
> gfc_error ("Loop parallelized across gangs is not
> allowed "
> - "inside loop parallelized across workers
> at %L",
> + "inside loop parallelized across vectors
> at %L", &code->loc);
> }
> if (code->ext.omp_clauses->worker)
> {
> if (c->code->ext.omp_clauses->worker)
> gfc_error ("Loop parallelized across workers is not
> allowed "
Sure. That looks reasonable. I'll also update and/or add new tests as
necessary.
Thanks for the review. I have couple in my queue already, but I hope to
have both my updated patch and your patch ready early next week. This
week I've been preparing a bunch of miscellaneous OpenACC patches, but
next week return to OpenACC routine patches. In terms of Fortran, I have
a patch that introduces support for the nohost routine clause (and the
bind clause, but bind hasn't been implemented in the middle end yet, so
I won't include it), as well as a patch the aforementioned routine
support in Fortran modules.
Cesar
^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: [openacc] Teach gfortran to lower OpenACC routine dims
2018-09-20 14:41 ` Cesar Philippidis
@ 2018-09-20 16:20 ` Bernhard Reutner-Fischer
2018-09-24 14:49 ` Cesar Philippidis
0 siblings, 1 reply; 6+ messages in thread
From: Bernhard Reutner-Fischer @ 2018-09-20 16:20 UTC (permalink / raw)
To: Cesar Philippidis; +Cc: gcc-patches, Fortran List, Jakub Jelinek
On Thu, 20 Sep 2018 07:41:08 -0700
Cesar Philippidis <cesar@codesourcery.com> wrote:
> On 09/19/2018 03:27 PM, Bernhard Reutner-Fischer wrote:
> > On Wed, 5 Sep 2018 12:52:03 -0700
> > Cesar Philippidis <cesar@codesourcery.com> wrote:
> >> diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
> >> index eea6b81ebfa..eed868f475b 100644
> >> --- a/gcc/fortran/trans-decl.c
> >> +++ b/gcc/fortran/trans-decl.c
> >> @@ -46,6 +46,7 @@ along with GCC; see the file COPYING3. If not
> >> see #include "trans-stmt.h"
> >> #include "gomp-constants.h"
> >> #include "gimplify.h"
> >> +#include "omp-general.h"
> >
> > hmz. so the gomp-constants.h include would be redundant, but do we
> > really need omp-general.h?
>
> Good point. omp-general.h is required for oacc_build_routine_dims.
>
> > Doesn't this suggest to move this oacc dims lowering to
> > trans-openmp.c instead, please?
>
> So something like adding a new gfc_add_omp_offload_attributes to
> trans-openmp.c and call it from add_attributes_to_decl?
yes.
> On a related note, I noticed that I forgot to incorporate this change
> in gfortran.h:
>
> @@ -902,7 +912,7 @@ typedef struct
> unsigned oacc_declare_link:1;
>
> /* This is an OpenACC acclerator function at level N - 1 */
> - unsigned oacc_function:3;
> + ENUM_BITFIELD (oacc_function) oacc_function:3;
>
> It's probably not huge, but I noticed that some other enum bitfields
> are declared that way.
yea, some compilers had trouble with enum bitfields (where plain int
bitfields like here worked fine, IIRC) but i'm not sure if it's
considered legacy these days. Fine with me to be safe.
>
> > btw.. the OACC merge from the gomp4 branch added a copy'n paste
> > error in an error message. May i ask you to regtest and install the
> > below:
> Sure. That looks reasonable. I'll also update and/or add new tests as
> necessary.
TIA and cheers,
^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: [openacc] Teach gfortran to lower OpenACC routine dims
2018-09-20 16:20 ` Bernhard Reutner-Fischer
@ 2018-09-24 14:49 ` Cesar Philippidis
2018-09-25 7:08 ` Bernhard Reutner-Fischer
0 siblings, 1 reply; 6+ messages in thread
From: Cesar Philippidis @ 2018-09-24 14:49 UTC (permalink / raw)
To: Bernhard Reutner-Fischer; +Cc: gcc-patches, Fortran List, Jakub Jelinek
[-- Attachment #1: Type: text/plain, Size: 1826 bytes --]
On 09/20/2018 09:10 AM, Bernhard Reutner-Fischer wrote:
> On Thu, 20 Sep 2018 07:41:08 -0700
> Cesar Philippidis <cesar@codesourcery.com> wrote:
>
>> On 09/19/2018 03:27 PM, Bernhard Reutner-Fischer wrote:
>>> On Wed, 5 Sep 2018 12:52:03 -0700
>>> Cesar Philippidis <cesar@codesourcery.com> wrote:
>
>>>> diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
>>>> index eea6b81ebfa..eed868f475b 100644
>>>> --- a/gcc/fortran/trans-decl.c
>>>> +++ b/gcc/fortran/trans-decl.c
>>>> @@ -46,6 +46,7 @@ along with GCC; see the file COPYING3. If not
>>>> see #include "trans-stmt.h"
>>>> #include "gomp-constants.h"
>>>> #include "gimplify.h"
>>>> +#include "omp-general.h"
>>>
>>> hmz. so the gomp-constants.h include would be redundant, but do we
>>> really need omp-general.h?
>>
>> Good point. omp-general.h is required for oacc_build_routine_dims.
>>
>>> Doesn't this suggest to move this oacc dims lowering to
>>> trans-openmp.c instead, please?
>>
>> So something like adding a new gfc_add_omp_offload_attributes to
>> trans-openmp.c and call it from add_attributes_to_decl?
>
> yes.
>
>> On a related note, I noticed that I forgot to incorporate this change
>> in gfortran.h:
>>
>> @@ -902,7 +912,7 @@ typedef struct
>> unsigned oacc_declare_link:1;
>>
>> /* This is an OpenACC acclerator function at level N - 1 */
>> - unsigned oacc_function:3;
>> + ENUM_BITFIELD (oacc_function) oacc_function:3;
>>
>> It's probably not huge, but I noticed that some other enum bitfields
>> are declared that way.
>
> yea, some compilers had trouble with enum bitfields (where plain int
> bitfields like here worked fine, IIRC) but i'm not sure if it's
> considered legacy these days. Fine with me to be safe.
I updated the patch by incorporating all of those changes. Is it OK for
trunk?
Thanks,
Cesar
[-- Attachment #2: 0001-openacc-Make-GFC-default-to-1-for-OpenACC-routine-di.patch --]
[-- Type: text/x-patch, Size: 22791 bytes --]
[openacc] Make GFC default to -1 for OpenACC routine dims
2018-09-24 Cesar Philippidis <cesar@codesourcery.com>
* gfortran.h (enum oacc_function): New enum.
(gfc_oacc_routine_name): Add locus loc field.
(symbol_attribute): Update type of oacc_function field.
* openmp.c (gfc_oacc_routine_dims): Return oacc_function.
(gfc_match_oacc_routine): Update routine clause syntax checking.
Populate oacc_function attribute with dims.
* trans-decl.c (add_attributes_to_decl): Use oacc_build_routine_dims
to construct routine dims.
* trans.h (gfc_add_omp_offload_attributes): Declare.
* trans-decl.c (add_attributes_to_decl): Use it to set OMP and ACC
offload function attributes.
* trans-openmp.c (gfc_add_omp_offload_attributes): New function.
gcc/testsuite/
* gfortran.dg/goacc/classify-routine.f95: Adjust test.
* gfortran.dg/goacc/pr71704.f90: Likewise.
* gfortran.dg/goacc/routine-6.f90: Likewise.
* gfortran.dg/goacc/routine-8.f90: Likewise.
* gfortran.dg/goacc/routine-level-of-parallelism-1.f90: Likewise.
libgomp/
* testsuite/libgomp.oacc-fortran/routine-1.f90: Adjust test.
* testsuite/libgomp.oacc-fortran/routine-2.f90: Likewise.
* testsuite/libgomp.oacc-fortran/routine-3.f90: Likewise.
* testsuite/libgomp.oacc-fortran/routine-4.f90: Likewise.
* testsuite/libgomp.oacc-fortran/routine-5.f90: Likewise.
* testsuite/libgomp.oacc-fortran/routine-7.f90: Likewise.
* testsuite/libgomp.oacc-fortran/routine-9.f90: Likewise.
* libgomp.oacc-fortran/host_data-2.f90: Likewise.
* libgomp.oacc-fortran/host_data-3.f: Likewise.
* libgomp.oacc-fortran/host_data-4.f90: Likewise.
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 04b0024a992..3efd59c95f7 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -316,6 +316,16 @@ enum save_state
{ SAVE_NONE = 0, SAVE_EXPLICIT, SAVE_IMPLICIT
};
+/* Flags to keep track of ACC routine states. */
+enum oacc_function
+{ OACC_FUNCTION_NONE = 0,
+ OACC_FUNCTION_GANG,
+ OACC_FUNCTION_WORKER,
+ OACC_FUNCTION_VECTOR,
+ OACC_FUNCTION_SEQ,
+ OACC_FUNCTION_AUTO
+};
+
/* Strings for all symbol attributes. We use these for dumping the
parse tree, in error messages, and also when reading and writing
modules. In symbol.c. */
@@ -902,7 +912,7 @@ typedef struct
unsigned oacc_declare_link:1;
/* This is an OpenACC acclerator function at level N - 1 */
- unsigned oacc_function:3;
+ ENUM_BITFIELD (oacc_function) oacc_function:3;
/* Attributes set by compiler extensions (!GCC$ ATTRIBUTES). */
unsigned ext_attr:EXT_ATTR_NUM;
@@ -1726,6 +1736,7 @@ typedef struct gfc_oacc_routine_name
struct gfc_symbol *sym;
struct gfc_omp_clauses *clauses;
struct gfc_oacc_routine_name *next;
+ locus loc;
}
gfc_oacc_routine_name;
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 94a7f7eaa50..ac1923ea06b 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -2234,34 +2234,45 @@ gfc_match_oacc_cache (void)
return MATCH_YES;
}
-/* Determine the loop level for a routine. */
+/* Determine the loop level for a routine. Returns OACC_FUNCTION_NONE
+ if any error is detected. */
-static int
+static oacc_function
gfc_oacc_routine_dims (gfc_omp_clauses *clauses)
{
int level = -1;
+ oacc_function ret = OACC_FUNCTION_AUTO;
if (clauses)
{
unsigned mask = 0;
if (clauses->gang)
- level = GOMP_DIM_GANG, mask |= GOMP_DIM_MASK (level);
+ {
+ level = GOMP_DIM_GANG, mask |= GOMP_DIM_MASK (level);
+ ret = OACC_FUNCTION_GANG;
+ }
if (clauses->worker)
- level = GOMP_DIM_WORKER, mask |= GOMP_DIM_MASK (level);
+ {
+ level = GOMP_DIM_WORKER, mask |= GOMP_DIM_MASK (level);
+ ret = OACC_FUNCTION_WORKER;
+ }
if (clauses->vector)
- level = GOMP_DIM_VECTOR, mask |= GOMP_DIM_MASK (level);
+ {
+ level = GOMP_DIM_VECTOR, mask |= GOMP_DIM_MASK (level);
+ ret = OACC_FUNCTION_VECTOR;
+ }
if (clauses->seq)
- level = GOMP_DIM_MAX, mask |= GOMP_DIM_MASK (level);
+ {
+ level = GOMP_DIM_MAX, mask |= GOMP_DIM_MASK (level);
+ ret = OACC_FUNCTION_SEQ;
+ }
if (mask != (mask & -mask))
- gfc_error ("Multiple loop axes specified for routine");
+ ret = OACC_FUNCTION_NONE;
}
- if (level < 0)
- level = GOMP_DIM_MAX;
-
- return level;
+ return ret;
}
match
@@ -2272,6 +2283,8 @@ gfc_match_oacc_routine (void)
match m;
gfc_omp_clauses *c = NULL;
gfc_oacc_routine_name *n = NULL;
+ oacc_function dims;
+ bool seen_error = false;
old_loc = gfc_current_locus;
@@ -2318,17 +2331,15 @@ gfc_match_oacc_routine (void)
}
else
{
- gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C");
- gfc_current_locus = old_loc;
- return MATCH_ERROR;
+ gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %L", &old_loc);
+ goto cleanup;
}
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;
+ gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %L, expecting"
+ " ')' after NAME", &old_loc);
+ goto cleanup;
}
}
@@ -2337,26 +2348,72 @@ gfc_match_oacc_routine (void)
!= MATCH_YES))
return MATCH_ERROR;
+ /* Scan for invalid routine geometry. */
+ dims = gfc_oacc_routine_dims (c);
+ if (dims == OACC_FUNCTION_NONE)
+ {
+ gfc_error ("Multiple loop axes specified in !$ACC ROUTINE at %L",
+ &old_loc);
+
+ /* Don't abort early, because it's important to let the user
+ know of any potential duplicate routine directives. */
+ seen_error = true;
+ }
+ else if (dims == OACC_FUNCTION_AUTO)
+ {
+ gfc_warning (0, "Expected one of %<gang%>, %<worker%>, %<vector%> or "
+ "%<seq%> clauses in !$ACC ROUTINE at %L", &old_loc);
+ dims = OACC_FUNCTION_SEQ;
+ }
+
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;
+ bool needs_entry = true;
+
+ /* Scan for any repeated routine directives on 'sym' and report
+ an error if necessary. TODO: Extend this function to scan
+ for compatible DEVICE_TYPE dims. */
+ for (n = gfc_current_ns->oacc_routine_names; n; n = n->next)
+ if (n->sym == sym)
+ {
+ needs_entry = false;
+ if (dims != gfc_oacc_routine_dims (n->clauses))
+ goto duplicate_routine;
+ }
+
+ if (needs_entry)
+ {
+ n = gfc_get_oacc_routine_name ();
+ n->sym = sym;
+ n->clauses = c;
+ n->loc = old_loc;
+ n->next = gfc_current_ns->oacc_routine_names;
+ gfc_current_ns->oacc_routine_names = n;
+ }
+
+ if (seen_error)
+ goto cleanup;
}
else if (gfc_current_ns->proc_name)
{
+ if (gfc_current_ns->proc_name->attr.oacc_function != OACC_FUNCTION_NONE
+ && !seen_error)
+ goto duplicate_routine;
+
if (!gfc_add_omp_declare_target (&gfc_current_ns->proc_name->attr,
gfc_current_ns->proc_name->name,
&old_loc))
goto cleanup;
- gfc_current_ns->proc_name->attr.oacc_function
- = gfc_oacc_routine_dims (c) + 1;
+
+ gfc_current_ns->proc_name->attr.oacc_function = dims;
+
+ if (seen_error)
+ goto cleanup;
}
+ else
+ /* Something has gone wrong. Perhaps there was a syntax error
+ in the program-stmt. */
+ goto cleanup;
if (n)
n->clauses = c;
@@ -2367,6 +2424,9 @@ gfc_match_oacc_routine (void)
new_st.ext.omp_clauses = c;
return MATCH_YES;
+duplicate_routine:
+ gfc_error ("!$ACC ROUTINE already applied at %L", &old_loc);
+
cleanup:
gfc_current_locus = old_loc;
return MATCH_ERROR;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 06066eb93dd..e2e96da9a57 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -44,7 +44,6 @@ 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"
#include "gimplify.h"
#define MAX_LABEL_VALUE 99999
@@ -1396,26 +1395,7 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list)
list = chainon (list, attr);
}
- if (sym_attr.omp_declare_target_link)
- list = tree_cons (get_identifier ("omp declare target link"),
- NULL_TREE, list);
- else if (sym_attr.omp_declare_target)
- 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);
- }
+ list = gfc_add_omp_offload_attributes (sym_attr, list);
return list;
}
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index f038f4c5bf8..753272d84c2 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -1281,6 +1281,48 @@ gfc_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *ctx, tree type)
}
}
+/* Add OpenMP / OpenACC function attributes to LIST. */
+
+tree
+gfc_add_omp_offload_attributes (symbol_attribute sym_attr, tree list)
+{
+ if (sym_attr.omp_declare_target_link)
+ list = tree_cons (get_identifier ("omp declare target link"),
+ NULL_TREE, list);
+ else if (sym_attr.omp_declare_target)
+ list = tree_cons (get_identifier ("omp declare target"),
+ NULL_TREE, list);
+
+ if (sym_attr.oacc_function != OACC_FUNCTION_NONE)
+ {
+ omp_clause_code code;
+ tree clause, dims;
+
+ switch (sym_attr.oacc_function)
+ {
+ case OACC_FUNCTION_GANG:
+ code = OMP_CLAUSE_GANG;
+ break;
+ case OACC_FUNCTION_WORKER:
+ code = OMP_CLAUSE_WORKER;
+ break;
+ case OACC_FUNCTION_VECTOR:
+ code = OMP_CLAUSE_VECTOR;
+ break;
+ case OACC_FUNCTION_SEQ:
+ default:
+ code = OMP_CLAUSE_SEQ;
+ }
+
+ clause = build_omp_clause (UNKNOWN_LOCATION, code);
+ dims = oacc_build_routine_dims (clause);
+ list = tree_cons (get_identifier ("oacc function"),
+ dims, list);
+ }
+
+ return list;
+}
+
static inline tree
gfc_trans_add_clause (tree node, tree tail)
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 1813882fe36..ecaf3d87827 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -780,6 +780,7 @@ bool gfc_omp_private_debug_clause (tree, bool);
bool gfc_omp_private_outer_ref (tree);
struct gimplify_omp_ctx;
void gfc_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *, tree);
+tree gfc_add_omp_offload_attributes (symbol_attribute, tree);
/* Runtime library function decls. */
extern GTY(()) tree gfor_fndecl_pause_numeric;
diff --git a/gcc/testsuite/gfortran.dg/goacc/classify-routine.f95 b/gcc/testsuite/gfortran.dg/goacc/classify-routine.f95
index 4ca406742f9..445ff9afd4e 100644
--- a/gcc/testsuite/gfortran.dg/goacc/classify-routine.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/classify-routine.f95
@@ -20,10 +20,10 @@ subroutine ROUTINE
end subroutine ROUTINE
! Check the offloaded function's attributes.
-! { dg-final { scan-tree-dump-times "(?n)__attribute__\\(\\(omp declare target, oacc function \\(0 0, 1 0, 1 0\\)\\)\\)" 1 "ompexp" } }
+! { dg-final { scan-tree-dump-times "(?n)__attribute__\\(\\(omp declare target, oacc function \\(0 1, 1 0, 1 0\\)\\)\\)" 1 "ompexp" } }
! Check the offloaded function's classification and compute dimensions (will
! always be 1 x 1 x 1 for non-offloading compilation).
! { dg-final { scan-tree-dump-times "(?n)Function is OpenACC routine level 1" 1 "oaccdevlow" } }
! { dg-final { scan-tree-dump-times "(?n)Compute dimensions \\\[1, 1, 1\\\]" 1 "oaccdevlow" } }
-! { dg-final { scan-tree-dump-times "(?n)__attribute__\\(\\(oacc function \\(0 1, 1 1, 1 1\\), omp declare target, oacc function \\(0 0, 1 0, 1 0\\)\\)\\)" 1 "oaccdevlow" } }
+! { dg-final { scan-tree-dump-times "(?n)__attribute__\\(\\(oacc function \\(0 1, 1 1, 1 1\\), omp declare target, oacc function \\(0 1, 1 0, 1 0\\)\\)\\)" 1 "oaccdevlow" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr71704.f90 b/gcc/testsuite/gfortran.dg/goacc/pr71704.f90
index 0235e85d42a..92d0c71d75c 100644
--- a/gcc/testsuite/gfortran.dg/goacc/pr71704.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/pr71704.f90
@@ -2,7 +2,7 @@
! { dg-do compile }
real function f1 ()
-!$acc routine (f1)
+!$acc routine (f1) seq
f1 = 1
end
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-6.f90
index 10943cff304..5c1f652ff6d 100644
--- a/gcc/testsuite/gfortran.dg/goacc/routine-6.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-6.f90
@@ -4,8 +4,7 @@ module m
contains
subroutine subr5 (x)
implicit none
- !$acc routine (subr5)
- !$acc routine (m1int) ! { dg-error "invalid function name" }
+ !$acc routine (subr5) seq
integer, intent(inout) :: x
if (x < 1) then
x = 1
@@ -19,22 +18,21 @@ program main
implicit none
interface
function subr6 (x)
- !$acc routine (subr6) ! { dg-error "without list is allowed in interface" }
+ !$acc routine (subr6) seq ! { 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 routine (subr2) seq
external :: R1, R2
- !$acc routine (R1 R2 R3) ! { dg-error "Syntax error in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), expecting .\\). after NAME" }
- !$acc routine (R1, R2, R3) ! { dg-error "Syntax error in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), expecting .\\). after NAME" }
- !$acc routine (R1)
- !$acc routine (R2)
+ !$acc routine (R1 R2 R3) seq ! { dg-error "Syntax error in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), expecting .\\). after NAME" }
+ !$acc routine (R1, R2, R3) seq ! { dg-error "Syntax error in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), expecting .\\). after NAME" }
+ !$acc routine (R1) seq
+ !$acc routine (R2) seq
!$acc parallel
!$acc loop
@@ -46,7 +44,7 @@ program main
end program main
subroutine subr1 (x)
- !$acc routine
+ !$acc routine seq
integer, intent(inout) :: x
if (x < 1) then
x = 1
@@ -56,7 +54,6 @@ subroutine subr1 (x)
end subroutine subr1
subroutine subr2 (x)
- !$acc routine (subr1) ! { dg-error "invalid function name" }
integer, intent(inout) :: x
if (x < 1) then
x = 1
@@ -66,7 +63,7 @@ subroutine subr2 (x)
end subroutine subr2
subroutine subr3 (x)
- !$acc routine (subr3)
+ !$acc routine (subr3) seq
integer, intent(inout) :: x
if (x < 1) then
x = 1
@@ -76,7 +73,7 @@ subroutine subr3 (x)
end subroutine subr3
subroutine subr4 (x)
- !$acc routine (subr4)
+ !$acc routine (subr4) seq
integer, intent(inout) :: x
if (x < 1) then
x = 1
@@ -86,7 +83,6 @@ subroutine subr4 (x)
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
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-8.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-8.f90
index c9039153885..beca43f2d60 100644
--- a/gcc/testsuite/gfortran.dg/goacc/routine-8.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-8.f90
@@ -4,7 +4,7 @@ program main
interface
function s_1 (a)
integer a
- !$acc routine
+ !$acc routine seq
end function s_1
end interface
@@ -18,7 +18,7 @@ program main
interface
function s_3 (a)
integer a
- !$acc routine (s_3) ! { dg-error "Only the ..ACC ROUTINE form without list is allowed in interface block" }
+ !$acc routine (s_3) seq ! { dg-error "Only the ..ACC ROUTINE form without list is allowed in interface block" }
end function s_3
end interface
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-level-of-parallelism-1.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-level-of-parallelism-1.f90
index 75dd1b01f6f..efc1b400add 100644
--- a/gcc/testsuite/gfortran.dg/goacc/routine-level-of-parallelism-1.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-level-of-parallelism-1.f90
@@ -7,7 +7,7 @@ subroutine g_1
end subroutine g_1
subroutine s_1_2a
- !$acc routine
+ !$acc routine seq
end subroutine s_1_2a
subroutine s_1_2b
@@ -15,7 +15,7 @@ subroutine s_1_2b
end subroutine s_1_2b
subroutine s_1_2c
- !$acc routine (s_1_2c)
+ !$acc routine (s_1_2c) seq
end subroutine s_1_2c
subroutine s_1_2d
@@ -25,7 +25,7 @@ end subroutine s_1_2d
module s_2
contains
subroutine s_2_1a
- !$acc routine
+ !$acc routine seq
end subroutine s_2_1a
subroutine s_2_1b
@@ -33,7 +33,7 @@ contains
end subroutine s_2_1b
subroutine s_2_1c
- !$acc routine (s_2_1c)
+ !$acc routine (s_2_1c) seq
end subroutine s_2_1c
subroutine s_2_1d
@@ -48,7 +48,7 @@ subroutine test
interface
function s_3_1a (a)
integer a
- !$acc routine
+ !$acc routine seq
end function s_3_1a
end interface
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/host_data-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/host_data-2.f90
index ff0921863f6..4cdaa0c4d60 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/host_data-2.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/host_data-2.f90
@@ -81,7 +81,7 @@ subroutine saxpy (nn, aa, xx, yy)
integer :: nn
real*4 :: aa, xx(nn), yy(nn)
integer i
- !$acc routine
+ !$acc routine seq
do i = 1, nn
yy(i) = yy(i) + aa * xx(i)
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/host_data-3.f b/libgomp/testsuite/libgomp.oacc-fortran/host_data-3.f
index 05ed949ee5c..fe0b904bb91 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/host_data-3.f
+++ b/libgomp/testsuite/libgomp.oacc-fortran/host_data-3.f
@@ -67,7 +67,7 @@
integer :: nn
real*4 :: aa, xx(nn), yy(nn)
integer i
-!$acc routine
+!$acc routine seq
do i = 1, nn
yy(i) = yy(i) + aa * xx(i)
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/host_data-4.f90 b/libgomp/testsuite/libgomp.oacc-fortran/host_data-4.f90
index 6e379b5485b..e192c59a97c 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/host_data-4.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/host_data-4.f90
@@ -21,7 +21,7 @@ contains
integer :: nn
real*4 :: aa, xx(nn), yy(nn)
integer i
- !$acc routine
+ !$acc routine seq
do i = 1, nn
yy(i) = yy(i) + aa * xx(i)
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-1.f90
index 6a573218b7a..346e875ba00 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-1.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-1.f90
@@ -3,7 +3,7 @@
interface
recursive function fact (x)
- !$acc routine
+ !$acc routine seq
integer, intent(in) :: x
integer :: fact
end function fact
@@ -21,7 +21,7 @@
end do
end
recursive function fact (x) result (res)
- !$acc routine
+ !$acc routine seq
integer, intent(in) :: x
integer :: res
if (x < 1) then
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-2.f90
index b6979747902..1391979291c 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-2.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-2.f90
@@ -4,7 +4,7 @@
module m1
contains
recursive function fact (x) result (res)
- !$acc routine
+ !$acc routine seq
integer, intent(in) :: x
integer :: res
if (x < 1) then
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-3.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-3.f90
index e7b9d8ab364..6f49db97b80 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-3.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-3.f90
@@ -4,7 +4,7 @@
integer, parameter :: n = 10
integer :: a(n), i
integer, external :: fact
- !$acc routine (fact)
+ !$acc routine (fact) seq
!$acc parallel
!$acc loop
do i = 1, n
@@ -16,7 +16,7 @@
end do
end
recursive function fact (x) result (res)
- !$acc routine
+ !$acc routine seq
integer, intent(in) :: x
integer :: res
if (x < 1) then
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-4.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-4.f90
index a96363b8cde..85bdb2a0a07 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-4.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-4.f90
@@ -17,7 +17,7 @@
end do
end
subroutine incr (x)
- !$acc routine
+ !$acc routine seq
integer, intent(inout) :: x
x = x + 1
end subroutine incr
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90
index a803ad96bb5..88d65741b7c 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90
@@ -15,7 +15,7 @@ program main
contains
function func (n) result (rc)
- !$acc routine
+ !$acc routine seq
integer, intent (in) :: n
integer :: rc
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90
index f58a95fe670..a83e92ab129 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90
@@ -1,4 +1,3 @@
-
! { dg-do run }
! { dg-additional-options "-cpp" }
@@ -100,7 +99,7 @@ subroutine gang (a)
integer, intent (inout) :: a(N)
integer :: i
- !$acc loop gang
+ !$acc loop gang worker vector
do i = 1, N
a(i) = a(i) - i
end do
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90
index b1a1338dd8c..4a1250405cb 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90
@@ -6,7 +6,7 @@ program main
integer, parameter :: n = 10
integer :: a(n), i
integer, external :: fact
- !$acc routine (fact)
+ !$acc routine (fact) seq
!$acc parallel
!$acc loop
do i = 1, n
@@ -20,7 +20,7 @@ end program main
recursive function fact (x) result (res)
implicit none
- !$acc routine (fact)
+ !$acc routine (fact) seq
integer, intent(in) :: x
integer :: res
if (x < 1) then
--
2.17.1
^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: [openacc] Teach gfortran to lower OpenACC routine dims
2018-09-24 14:49 ` Cesar Philippidis
@ 2018-09-25 7:08 ` Bernhard Reutner-Fischer
0 siblings, 0 replies; 6+ messages in thread
From: Bernhard Reutner-Fischer @ 2018-09-25 7:08 UTC (permalink / raw)
To: Cesar Philippidis; +Cc: gcc-patches, Fortran List, Jakub Jelinek
On 24 September 2018 16:45:38 CEST, Cesar Philippidis <cesar@codesourcery.com> wrote:
>I updated the patch by incorporating all of those changes. Is it OK for
>trunk?
LGTM but I cannot approve it.
thanks,
^ permalink raw reply [flat|nested] 6+ messages in thread
end of thread, other threads:[~2018-09-25 7:06 UTC | newest]
Thread overview: 6+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2018-09-05 19:52 [openacc] Teach gfortran to lower OpenACC routine dims Cesar Philippidis
2018-09-19 22:30 ` Bernhard Reutner-Fischer
2018-09-20 14:41 ` Cesar Philippidis
2018-09-20 16:20 ` Bernhard Reutner-Fischer
2018-09-24 14:49 ` Cesar Philippidis
2018-09-25 7:08 ` Bernhard Reutner-Fischer
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).